From 0ff8d32131b58a655492b97ebb9536907efa64dd Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Tue, 20 Oct 2009 04:34:09 -0400 Subject: [PATCH 1/7] Now using pcomplete for in-buffer completion --- Makefile | 1 + lisp/org-complete.el | 207 +++++++++++++++++++++++++++++++++++++++++++ lisp/org.el | 158 +++++---------------------------- 3 files changed, 228 insertions(+), 138 deletions(-) create mode 100644 lisp/org-complete.el diff --git a/Makefile b/Makefile index e6bdfbef8..d4739042c 100644 --- a/Makefile +++ b/Makefile @@ -71,6 +71,7 @@ LISPF = org.el \ org-colview.el \ org-colview-xemacs.el \ org-compat.el \ + org-complete.el \ org-crypt.el \ org-ctags.el \ org-datetree.el \ diff --git a/lisp/org-complete.el b/lisp/org-complete.el new file mode 100644 index 000000000..cc3877bf7 --- /dev/null +++ b/lisp/org-complete.el @@ -0,0 +1,207 @@ +;;; org-complete.el --- In-buffer completion code + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Free Software Foundation, Inc. +;; +;; Author: Carsten Dominik +;; John Wiegley +;; Keywords: outlines, hypermedia, calendar, wp +;; Homepage: http://orgmode.org +;; Version: 6.31trans +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;;; Code: + +;;;; Require other packages + +(eval-when-compile + (require 'cl)) + +(require 'org-macs) +(require 'pcomplete) + +;;;; Customization variables + +(defgroup org-complete nil + "Outline-based notes management and organizer." + :tag "Org" + :group 'org) + +(defun org-thing-at-point () + "Examine the thing at point and let the caller know what it is. +The return value is a string naming the thing at point." + (let ((beg1 (save-excursion + (skip-chars-backward (org-re "[:alnum:]_@")) + (point))) + (beg (save-excursion + (skip-chars-backward "a-zA-Z0-9_:$") + (point)))) + (cond + ((save-excursion + (re-search-backward "^#\\+\\([A-Z_]+\\):.*" + (line-beginning-position) t)) + (cons "file-option" (match-string-no-properties 1))) + ((equal (char-before beg) ?\[) + (cons "link" nil)) + ((equal (char-before beg) ?\\) + (cons "tex" nil)) + ((string-match "\\`\\*+[ \t]+\\'" + (buffer-substring (point-at-bol) beg)) + (cons "todo" nil)) + ((equal (char-before beg) ?*) + (cons "searchhead" nil)) + ((and (equal (char-before beg1) ?:) + (equal (char-after (point-at-bol)) ?*)) + (cons "tag" nil)) + ((and (equal (char-before beg1) ?:) + (not (equal (char-after (point-at-bol)) ?*))) + (cons "prop" nil)) + (t nil)))) + +(defun org-command-at-point () + "Return the qualified name of the Org completion entity at point. +When completing for #+STARTUP, for example, this function returns +\"file-option/STARTUP\"." + (let ((thing (org-thing-at-point))) + (cond + ((string= "file-option" (car thing)) + (concat (car thing) "/" (cdr thing))) + (t + (car thing))))) + +(defun org-parse-arguments () + "Parse whitespace separated arguments in the current region." + (let ((begin (line-beginning-position)) + (end (line-end-position)) + begins args) + (save-restriction + (narrow-to-region begin end) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (skip-chars-forward " \t\n[") + (setq begins (cons (point) begins)) + (skip-chars-forward "^ \t\n[") + (setq args (cons (buffer-substring-no-properties + (car begins) (point)) + args))) + (cons (reverse args) (reverse begins)))))) + + +(defun org-complete-initial () + "Calls the right completion function for first argument completions." + (ignore + (funcall (or (pcomplete-find-completion-function + (car (org-thing-at-point))) + pcomplete-default-completion-function)))) + +(defun pcomplete/org-mode/file-option () + "Complete against all valid file options." + (require 'org-exp) + (pcomplete-here + (mapcar (lambda (x) + (if (= ?: (aref x (1- (length x)))) + (concat x " ") + x)) + (delq nil + (pcomplete-uniqify-list + (append + (mapcar (lambda (x) + (if (string-match "^#\\+\\([A-Z_]+:?\\)" x) + (match-string 1 x))) + (org-split-string (org-get-current-options) "\n")) + org-additional-option-like-keywords)))) + (substring pcomplete-stub 2))) + +(defun pcomplete/org-mode/file-option/STARTUP () + "Complete arguments for the #+STARTUP file option." + (while (pcomplete-here + (let ((opts (pcomplete-uniqify-list + (mapcar 'car org-startup-options)))) + ;; Some options are mutually exclusive, and shouldn't be completed + ;; against if certain other options have already been seen. + (dolist (arg pcomplete-args) + (cond + ((string= arg "hidestars") + (setq opts (delete "showstars" opts))))) + opts)))) + +(defun pcomplete/org-mode/link () + "Complete against defined #+LINK patterns." + (pcomplete-here + (pcomplete-uniqify-list (append (mapcar 'car org-link-abbrev-alist-local) + (mapcar 'car org-link-abbrev-alist))))) + +(defun pcomplete/org-mode/tex () + "Complete against TeX-style HTML entity names." + (while (pcomplete-here + (pcomplete-uniqify-list (mapcar 'car org-html-entities)) + (substring pcomplete-stub 1)))) + +(defun pcomplete/org-mode/todo () + "Complete against known TODO keywords." + (pcomplete-here (pcomplete-uniqify-list org-todo-keywords-1))) + +(defun pcomplete/org-mode/searchhead () + "Complete against all headings. +This needs more work, to handle headings with lots of spaces in them." + (while + (pcomplete-here + (save-excursion + (goto-char (point-min)) + (let (tbl) + (while (re-search-forward org-todo-line-regexp nil t) + (push (org-make-org-heading-search-string + (match-string-no-properties 3) t) + tbl)) + (pcomplete-uniqify-list tbl))) + (substring pcomplete-stub 1)))) + +(defun pcomplete/org-mode/tag () + "Complete a tag name. Omit tags already set." + (while (pcomplete-here + (mapcar (lambda (x) + (concat x ":")) + (let ((lst (pcomplete-uniqify-list + (or (mapcar 'car org-tag-alist) + (mapcar 'car (org-get-buffer-tags)))))) + (dolist (tag (org-get-tags)) + (setq lst (delete tag lst))) + lst)) + (and (string-match ".*:" pcomplete-stub) + (substring pcomplete-stub (match-end 0)))))) + +(defun pcomplete/org-mode/prop () + "Complete a property name. Omit properties already set." + (pcomplete-here + (mapcar (lambda (x) + (concat x ": ")) + (let ((lst (pcomplete-uniqify-list + (org-buffer-property-keys nil t t)))) + (dolist (prop (org-entry-properties)) + (setq lst (delete (car prop) lst))) + lst)) + (substring pcomplete-stub 1))) + +;;;; Finish up + +(provide 'org-complete) + +;; arch-tag: + +;;; org-complete.el ends here diff --git a/lisp/org.el b/lisp/org.el index e45dab0c1..66c651f6c 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -75,6 +75,7 @@ (require 'gnus-sum)) (require 'calendar) +(require 'pcomplete) ;; Emacs 22 calendar compatibility: Make sure the new variables are available (when (fboundp 'defvaralias) (unless (boundp 'calendar-view-holidays-initially-flag) @@ -98,6 +99,7 @@ (require 'org-compat) (require 'org-faces) (require 'org-list) +(require 'org-complete) (require 'org-src) (require 'org-footnote) @@ -3516,8 +3518,8 @@ Note that this variable has only an effect if `org-completion-use-ido' is nil." :type 'boolean) (defcustom org-completion-fallback-command 'hippie-expand - "The expansion command called by \\[org-complete] in normal context. -Normal means no org-mode-specific context." + "The expansion command called by \\[pcomplete] in normal context. +Normal means, no org-mode-specific context." :group 'org-completion :type 'function) @@ -4749,6 +4751,17 @@ The following commands are available: ;; Turn on org-beamer-mode? (and org-startup-with-beamer-mode (org-beamer-mode 1)) + ;; Setup the pcomplete hooks + (set (make-local-variable 'pcomplete-command-completion-function) + 'org-complete-initial) + (set (make-local-variable 'pcomplete-command-name-function) + 'org-command-at-point) + (set (make-local-variable 'pcomplete-default-completion-function) + 'ignore) + (set (make-local-variable 'pcomplete-parse-arguments-function) + 'org-parse-arguments) + (set (make-local-variable 'pcomplete-termination-string) "") + ;; If empty file that did not turn on org-mode automatically, make it to. (if (and org-insert-mode-line-in-empty-file (interactive-p) @@ -10620,137 +10633,6 @@ expands them." (insert rpl) (if (re-search-backward "\\?" start t) (delete-char 1)))) - -(defun org-complete (&optional arg) - "Perform completion on word at point. -At the beginning of a headline, this completes TODO keywords as given in -`org-todo-keywords'. -If the current word is preceded by a backslash, completes the TeX symbols -that are supported for HTML support. -If the current word is preceded by \"#+\", completes special words for -setting file options. -In the line after \"#+STARTUP:, complete valid keywords.\" -At all other locations, this simply calls the value of -`org-completion-fallback-command'." - (interactive "P") - (org-without-partial-completion - (catch 'exit - (let* ((a nil) - (end (point)) - (beg1 (save-excursion - (skip-chars-backward (org-re "[:alnum:]_@#%")) - (point))) - (beg (save-excursion - (skip-chars-backward "a-zA-Z0-9_:$") - (point))) - (confirm (lambda (x) (stringp (car x)))) - (searchhead (equal (char-before beg) ?*)) - (struct - (when (and (member (char-before beg1) '(?. ?<)) - (setq a (assoc (buffer-substring beg1 (point)) - org-structure-template-alist))) - (org-complete-expand-structure-template (1- beg1) a) - (throw 'exit t))) - (tag (and (equal (char-before beg1) ?:) - (equal (char-after (point-at-bol)) ?*))) - (prop (or (and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*))) - (string-match "^#\\+PROPERTY:.*" - (buffer-substring (point-at-bol) (point))))) - (texp (equal (char-before beg) ?\\)) - (link (equal (char-before beg) ?\[)) - (opt (equal (buffer-substring (max (point-at-bol) (- beg 2)) - beg) - "#+")) - (startup (string-match "^#\\+STARTUP:.*" - (buffer-substring (point-at-bol) (point)))) - (completion-ignore-case opt) - (type nil) - (tbl nil) - (table (cond - (opt - (setq type :opt) - (require 'org-exp) - (append - (delq nil - (mapcar - (lambda (x) - (if (string-match - "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x) - (cons (match-string 2 x) - (match-string 1 x)))) - (org-split-string (org-get-current-options) "\n"))) - (mapcar 'list org-additional-option-like-keywords))) - (startup - (setq type :startup) - org-startup-options) - (link (append org-link-abbrev-alist-local - org-link-abbrev-alist)) - (texp - (setq type :tex) - (append org-entities-user org-entities)) - ((string-match "\\`\\*+[ \t]+\\'" - (buffer-substring (point-at-bol) beg)) - (setq type :todo) - (mapcar 'list org-todo-keywords-1)) - (searchhead - (setq type :searchhead) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward org-todo-line-regexp nil t) - (push (list - (org-make-org-heading-search-string - (match-string 3) t)) - tbl))) - tbl) - (tag (setq type :tag beg beg1) - (or org-tag-alist (org-get-buffer-tags))) - (prop (setq type :prop beg beg1) - (mapcar 'list (org-buffer-property-keys nil t t))) - (t (progn - (call-interactively org-completion-fallback-command) - (throw 'exit nil))))) - (pattern (buffer-substring-no-properties beg end)) - (completion (try-completion pattern table confirm))) - (cond ((eq completion t) - (if (not (assoc (upcase pattern) table)) - (message "Already complete") - (if (and (equal type :opt) - (not (member (car (assoc (upcase pattern) table)) - org-additional-option-like-keywords))) - (insert (substring (cdr (assoc (upcase pattern) table)) - (length pattern))) - (if (memq type '(:tag :prop)) (insert ":"))))) - ((null completion) - (message "Can't find completion for \"%s\"" pattern) - (ding)) - ((not (string= pattern completion)) - (delete-region beg end) - (if (string-match " +$" completion) - (setq completion (replace-match "" t t completion))) - (insert completion) - (if (get-buffer-window "*Completions*") - (delete-window (get-buffer-window "*Completions*"))) - (if (assoc completion table) - (if (eq type :todo) (insert " ") - (if (and (memq type '(:tag :prop)) - (not (string-match "^#[ \t]*\\+property:" - (org-current-line-string t)))) - (insert ":")))) - (if (and (equal type :opt) (assoc completion table)) - (message "%s" (substitute-command-keys - "Press \\[org-complete] again to insert example settings")))) - (t - (message "Making completion list...") - (let ((list (sort (all-completions pattern table confirm) - 'string<))) - (with-output-to-temp-buffer "*Completions*" - (condition-case nil - ;; Protection needed for XEmacs and emacs 21 - (display-completion-list list pattern) - (error (display-completion-list list))))) - (message "Making completion list...%s" "done"))))))) - ;;;; TODO, DEADLINE, Comments (defun org-toggle-comment () @@ -16298,9 +16180,9 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map "\C-i" 'org-cycle) (org-defkey org-mode-map [(tab)] 'org-cycle) (org-defkey org-mode-map [(control tab)] 'org-force-cycle-archived) -(org-defkey org-mode-map [(meta tab)] 'org-complete) -(org-defkey org-mode-map "\M-\t" 'org-complete) -(org-defkey org-mode-map "\M-\C-i" 'org-complete) +(org-defkey org-mode-map [(meta tab)] 'pcomplete) +(org-defkey org-mode-map "\M-\t" 'pcomplete) +(org-defkey org-mode-map "\M-\C-i" 'pcomplete) ;; The following line is necessary under Suse GNU/Linux (unless (featurep 'xemacs) (org-defkey org-mode-map [S-iso-lefttab] 'org-shifttab)) @@ -16365,7 +16247,7 @@ BEG and END default to the buffer boundaries." (org-defkey org-mode-map [?\C-c (right)] 'org-shiftright) (org-defkey org-mode-map [?\C-c ?\C-x (right)] 'org-shiftcontrolright) (org-defkey org-mode-map [?\C-c ?\C-x (left)] 'org-shiftcontrolleft) - (org-defkey org-mode-map [?\e (tab)] 'org-complete) + (org-defkey org-mode-map [?\e (tab)] 'pcomplete) (org-defkey org-mode-map [?\e (shift return)] 'org-insert-todo-heading) (org-defkey org-mode-map [?\e (shift left)] 'org-shiftmetaleft) (org-defkey org-mode-map [?\e (shift right)] 'org-shiftmetaright) @@ -17695,7 +17577,7 @@ See the individual commands for more information." ("Select keyword" ["Next keyword" org-shiftright (org-on-heading-p)] ["Previous keyword" org-shiftleft (org-on-heading-p)] - ["Complete Keyword" org-complete (assq :todo-keyword (org-context))] + ["Complete Keyword" pcomplete (assq :todo-keyword (org-context))] ["Next keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))] ["Previous keyword set" org-shiftcontrolright (and (> (length org-todo-sets) 1) (org-on-heading-p))]) ["Show TODO Tree" org-show-todo-tree :active t :keys "C-c / t"] From 451acd11cef9db348aa26aa1bbc2a300c75cbe88 Mon Sep 17 00:00:00 2001 From: Eric Schulte Date: Fri, 19 Nov 2010 01:16:29 -0700 Subject: [PATCH 2/7] move ob-map-src-blocks up in ob.el and autoload it * lisp/ob.el (org-babel-map-src-blocks): Moved to earlier in the file and now autoloading. --- lisp/ob.el | 107 +++++++++++++++++++++++++++-------------------------- 1 file changed, 54 insertions(+), 53 deletions(-) diff --git a/lisp/ob.el b/lisp/ob.el index 96c274434..368961968 100644 --- a/lisp/ob.el +++ b/lisp/ob.el @@ -584,6 +584,60 @@ results already exist." (insert (echo-res results)))))) t))) +;;;###autoload +(defmacro org-babel-map-src-blocks (file &rest body) + "Evaluate BODY forms on each source-block in FILE. +If FILE is nil evaluate BODY forms on source blocks in current +buffer. During evaluation of BODY the following local variables +are set relative to the currently matched code block. + +full-block ------- string holding the entirety of the code block +beg-block -------- point at the beginning of the code block +end-block -------- point at the end of the matched code block +lang ------------- string holding the language of the code block +beg-lang --------- point at the beginning of the lang +end-lang --------- point at the end of the lang +switches --------- string holding the switches +beg-switches ----- point at the beginning of the switches +end-switches ----- point at the end of the switches +header-args ------ string holding the header-args +beg-header-args -- point at the beginning of the header-args +end-header-args -- point at the end of the header-args +body ------------- string holding the body of the code block +beg-body --------- point at the beginning of the body +end-body --------- point at the end of the body" + (declare (indent 1)) + (let ((tempvar (make-symbol "file"))) + `(let* ((,tempvar ,file) + (visited-p (or (null ,tempvar) + (get-file-buffer (expand-file-name ,tempvar)))) + (point (point)) to-be-removed) + (save-window-excursion + (when ,tempvar (find-file ,tempvar)) + (setq to-be-removed (current-buffer)) + (goto-char (point-min)) + (while (re-search-forward org-babel-src-block-regexp nil t) + (goto-char (match-beginning 0)) + (let ((full-block (match-string 0)) + (beg-block (match-beginning 0)) + (end-block (match-end 0)) + (lang (match-string 2)) + (beg-lang (match-beginning 2)) + (end-lang (match-end 2)) + (switches (match-string 3)) + (beg-switches (match-beginning 3)) + (end-switches (match-end 3)) + (header-args (match-string 4)) + (beg-header-args (match-beginning 4)) + (end-header-args (match-end 4)) + (body (match-string 5)) + (beg-body (match-beginning 5)) + (end-body (match-end 5))) + ,@body + (goto-char end-block)))) + (unless visited-p (kill-buffer to-be-removed)) + (goto-char point)))) + ;;;###autoload (defun org-babel-execute-buffer (&optional arg) "Execute source code blocks in a buffer. @@ -758,59 +812,6 @@ portions of results lines." (lambda () (org-add-hook 'change-major-mode-hook 'org-babel-show-result-all 'append 'local))) -(defmacro org-babel-map-src-blocks (file &rest body) - "Evaluate BODY forms on each source-block in FILE. -If FILE is nil evaluate BODY forms on source blocks in current -buffer. During evaluation of BODY the following local variables -are set relative to the currently matched code block. - -full-block ------- string holding the entirety of the code block -beg-block -------- point at the beginning of the code block -end-block -------- point at the end of the matched code block -lang ------------- string holding the language of the code block -beg-lang --------- point at the beginning of the lang -end-lang --------- point at the end of the lang -switches --------- string holding the switches -beg-switches ----- point at the beginning of the switches -end-switches ----- point at the end of the switches -header-args ------ string holding the header-args -beg-header-args -- point at the beginning of the header-args -end-header-args -- point at the end of the header-args -body ------------- string holding the body of the code block -beg-body --------- point at the beginning of the body -end-body --------- point at the end of the body" - (declare (indent 1)) - (let ((tempvar (make-symbol "file"))) - `(let* ((,tempvar ,file) - (visited-p (or (null ,tempvar) - (get-file-buffer (expand-file-name ,tempvar)))) - (point (point)) to-be-removed) - (save-window-excursion - (when ,tempvar (find-file ,tempvar)) - (setq to-be-removed (current-buffer)) - (goto-char (point-min)) - (while (re-search-forward org-babel-src-block-regexp nil t) - (goto-char (match-beginning 0)) - (let ((full-block (match-string 0)) - (beg-block (match-beginning 0)) - (end-block (match-end 0)) - (lang (match-string 2)) - (beg-lang (match-beginning 2)) - (end-lang (match-end 2)) - (switches (match-string 3)) - (beg-switches (match-beginning 3)) - (end-switches (match-end 3)) - (header-args (match-string 4)) - (beg-header-args (match-beginning 4)) - (end-header-args (match-end 4)) - (body (match-string 5)) - (beg-body (match-beginning 5)) - (end-body (match-end 5))) - ,@body - (goto-char end-block)))) - (unless visited-p (kill-buffer to-be-removed)) - (goto-char point)))) - (defvar org-file-properties) (defun org-babel-params-from-properties (&optional lang) "Retrieve parameters specified as properties. From ce329b330ca050a7ee3d5adea7020c9498ae48ea Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Thu, 18 Nov 2010 07:48:50 +0100 Subject: [PATCH 3/7] Fix completion for tags and TeX-like entity macros, add block arguments --- lisp/org-complete.el | 98 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 76 insertions(+), 22 deletions(-) diff --git a/lisp/org-complete.el b/lisp/org-complete.el index cc3877bf7..a9fed9940 100644 --- a/lisp/org-complete.el +++ b/lisp/org-complete.el @@ -1,13 +1,13 @@ ;;; org-complete.el --- In-buffer completion code -;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009 +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010 ;; Free Software Foundation, Inc. ;; ;; Author: Carsten Dominik ;; John Wiegley ;; Keywords: outlines, hypermedia, calendar, wp ;; Homepage: http://orgmode.org -;; Version: 6.31trans +;; Version: 7.03trans ;; ;; This file is part of GNU Emacs. ;; @@ -50,12 +50,19 @@ The return value is a string naming the thing at point." (point))) (beg (save-excursion (skip-chars-backward "a-zA-Z0-9_:$") - (point)))) + (point))) + (line-to-here (buffer-substring (point-at-bol) (point)))) (cond + ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here) + (cons "block-option" "clocktable")) + ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here) + (cons "block-option" "src")) ((save-excursion - (re-search-backward "^#\\+\\([A-Z_]+\\):.*" + (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*" (line-beginning-position) t)) (cons "file-option" (match-string-no-properties 1))) + ((string-match "\\`[ \t]*#\\+[a-zA-Z]*\\'" line-to-here) + (cons "file-option" nil)) ((equal (char-before beg) ?\[) (cons "link" nil)) ((equal (char-before beg) ?\\) @@ -76,11 +83,13 @@ The return value is a string naming the thing at point." (defun org-command-at-point () "Return the qualified name of the Org completion entity at point. When completing for #+STARTUP, for example, this function returns -\"file-option/STARTUP\"." +\"file-option/startup\"." (let ((thing (org-thing-at-point))) (cond ((string= "file-option" (car thing)) - (concat (car thing) "/" (cdr thing))) + (concat (car thing) "/" (downcase (cdr thing)))) + ((string= "block-option" (car thing)) + (concat (car thing) "/" (downcase (cdr thing)))) (t (car thing))))) @@ -114,21 +123,22 @@ When completing for #+STARTUP, for example, this function returns "Complete against all valid file options." (require 'org-exp) (pcomplete-here - (mapcar (lambda (x) - (if (= ?: (aref x (1- (length x)))) - (concat x " ") - x)) - (delq nil - (pcomplete-uniqify-list - (append - (mapcar (lambda (x) - (if (string-match "^#\\+\\([A-Z_]+:?\\)" x) - (match-string 1 x))) - (org-split-string (org-get-current-options) "\n")) - org-additional-option-like-keywords)))) + (org-complete-case-double + (mapcar (lambda (x) + (if (= ?: (aref x (1- (length x)))) + (concat x " ") + x)) + (delq nil + (pcomplete-uniqify-list + (append + (mapcar (lambda (x) + (if (string-match "^#\\+\\([A-Z_]+:?\\)" x) + (match-string 1 x))) + (org-split-string (org-get-current-options) "\n")) + org-additional-option-like-keywords))))) (substring pcomplete-stub 2))) - -(defun pcomplete/org-mode/file-option/STARTUP () + +(defun pcomplete/org-mode/file-option/startup () "Complete arguments for the #+STARTUP file option." (while (pcomplete-here (let ((opts (pcomplete-uniqify-list @@ -141,6 +151,13 @@ When completing for #+STARTUP, for example, this function returns (setq opts (delete "showstars" opts))))) opts)))) +(defun pcomplete/org-mode/file-option/bind () + "Complete arguments for the #+BIND file option, which are variable names" + (let (vars) + (mapatoms + (lambda (a) (if (boundp a) (setq vars (cons (symbol-name a) vars))))) + (pcomplete-here vars))) + (defun pcomplete/org-mode/link () "Complete against defined #+LINK patterns." (pcomplete-here @@ -149,8 +166,9 @@ When completing for #+STARTUP, for example, this function returns (defun pcomplete/org-mode/tex () "Complete against TeX-style HTML entity names." + (require 'org-entities) (while (pcomplete-here - (pcomplete-uniqify-list (mapcar 'car org-html-entities)) + (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-entities))) (substring pcomplete-stub 1)))) (defun pcomplete/org-mode/todo () @@ -178,7 +196,11 @@ This needs more work, to handle headings with lots of spaces in them." (mapcar (lambda (x) (concat x ":")) (let ((lst (pcomplete-uniqify-list - (or (mapcar 'car org-tag-alist) + (or (remove + nil + (mapcar (lambda (x) + (and (stringp (car x)) (car x))) + org-tag-alist)) (mapcar 'car (org-get-buffer-tags)))))) (dolist (tag (org-get-tags)) (setq lst (delete tag lst))) @@ -198,6 +220,38 @@ This needs more work, to handle headings with lots of spaces in them." lst)) (substring pcomplete-stub 1))) +(defun pcomplete/org-mode/block-option/src () + "Complete the arguments of a begin_src block. +Complete a language in the first field, the header arguments and switches." + (pcomplete-here + (mapcar + (lambda(x) (symbol-name (nth 3 x))) + (cdr (car (cdr (memq :key-type (plist-get + (symbol-plist + 'org-babel-load-languages) + 'custom-type))))))) + (while (pcomplete-here + '("-n" "-r" "-l" + ":cache" ":colnames" ":comments" ":dir" ":eval" ":exports" + ":file" ":hlines" ":no-expand" ":noweb" ":results" ":rownames" + ":session" ":shebang" ":tangle" ":var")))) + +(defun pcomplete/org-mode/block-option/clocktable () + "Complete keywords in a clocktable line" + (while (pcomplete-here '(":maxlevel" ":scope" + ":tstart" ":tend" ":block" ":step" + ":stepskip0" ":fileskip0" + ":emphasize" ":link" ":narrow" ":indent" + ":tcolumns" ":level" ":compact" ":timestamp" + ":formula" ":formatter")))) + +(defun org-complete-case-double (list) + "Return list with both upcase and downcase version of all strings in LIST." + (let (e res) + (while (setq e (pop list)) + (setq res (cons (downcase e) (cons (upcase e) res)))) + (nreverse res))) + ;;;; Finish up (provide 'org-complete) From 04f71ffc55ffa682efd78640f688e91b69637fb1 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Fri, 19 Nov 2010 20:14:37 +0100 Subject: [PATCH 4/7] Keep byte compiler happy --- lisp/org-agenda.el | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index b7de45a4e..a248068c3 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -916,6 +916,12 @@ This function makes sure that dates are aligned for easy reading." (format "%-10s %2d %s %4d%s" dayname day monthname year weekstring))) +(defcustom org-agenda-time-leading-zero nil + "Non-nil means use leading zero for military times in agenda. +For example, 9:30am would become 09:30 rather than 9:30." + :group 'org-agenda-daily/weekly + :type 'boolean) + (defcustom org-agenda-timegrid-use-ampm nil "When set, show AM/PM style timestamps on the timegrid." :group 'org-agenda @@ -945,12 +951,6 @@ based on `org-agenda-timegrid-use-ampm'" (org-agenda-time-of-day-to-ampm time) time)) -(defcustom org-agenda-time-leading-zero nil - "Non-nil means use leading zero for military times in agenda. -For example, 9:30am would become 09:30 rather than 9:30." - :group 'org-agenda-daily/weekly - :type 'boolean) - (defcustom org-agenda-weekend-days '(6 0) "Which days are weekend? These days get the special face `org-agenda-date-weekend' in the agenda From 85501c06231d47078b3c05da6e8f925d7caf6244 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Fri, 19 Nov 2010 23:47:02 +0100 Subject: [PATCH 5/7] Fix cycling bullet with point not at column 0 * org-list.el (org-cycle-list-bullet): ensure point is at bol before checking item indentation. --- lisp/org-list.el | 59 ++++++++++++++++++++++++------------------------ 1 file changed, 30 insertions(+), 29 deletions(-) diff --git a/lisp/org-list.el b/lisp/org-list.el index e54c2a0eb..2290b4a9d 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1629,35 +1629,36 @@ If WHICH is a valid string, use that as the new bullet. If WHICH is an integer, 0 means `-', 1 means `+' etc. If WHICH is 'previous, cycle backwards." (interactive "P") - (let* ((top (org-list-top-point)) - (bullet (save-excursion - (goto-char (org-get-beginning-of-list top)) - (org-get-bullet))) - (current (cond - ((string-match "\\." bullet) "1.") - ((string-match ")" bullet) "1)") - (t bullet))) - (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) - (bullet-list (append '("-" "+" ) - ;; *-bullets are not allowed at column 0 - (unless (and bullet-rule-p - (looking-at "\\S-")) '("*")) - ;; Description items cannot be numbered - (unless (and bullet-rule-p - (or (eq org-plain-list-ordered-item-terminator ?\)) - (org-at-item-description-p))) '("1.")) - (unless (and bullet-rule-p - (or (eq org-plain-list-ordered-item-terminator ?.) - (org-at-item-description-p))) '("1)")))) - (len (length bullet-list)) - (item-index (- len (length (member current bullet-list)))) - (get-value (lambda (index) (nth (mod index len) bullet-list))) - (new (cond - ((member which bullet-list) which) - ((numberp which) (funcall get-value which)) - ((eq 'previous which) (funcall get-value (1- item-index))) - (t (funcall get-value (1+ item-index)))))) - (org-list-repair new top))) + (save-excursion + (let* ((top (org-list-top-point)) + (bullet (progn + (goto-char (org-get-beginning-of-list top)) + (org-get-bullet))) + (current (cond + ((string-match "\\." bullet) "1.") + ((string-match ")" bullet) "1)") + (t bullet))) + (bullet-rule-p (cdr (assq 'bullet org-list-automatic-rules))) + (bullet-list (append '("-" "+" ) + ;; *-bullets are not allowed at column 0 + (unless (and bullet-rule-p + (looking-at "\\S-")) '("*")) + ;; Description items cannot be numbered + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?\)) + (org-at-item-description-p))) '("1.")) + (unless (and bullet-rule-p + (or (eq org-plain-list-ordered-item-terminator ?.) + (org-at-item-description-p))) '("1)")))) + (len (length bullet-list)) + (item-index (- len (length (member current bullet-list)))) + (get-value (lambda (index) (nth (mod index len) bullet-list))) + (new (cond + ((member which bullet-list) which) + ((numberp which) (funcall get-value which)) + ((eq 'previous which) (funcall get-value (1- item-index))) + (t (funcall get-value (1+ item-index)))))) + (org-list-repair new top)))) ;;; Checkboxes From 9db0d7e20b5121fad3fecfe1e6c432d6fce73034 Mon Sep 17 00:00:00 2001 From: Dan Davison Date: Fri, 19 Nov 2010 23:31:19 +0000 Subject: [PATCH 6/7] Tweak condition for src buffer to inherit active region. * lisp/org-src.el (org-edit-src-code): Allow region to be inherited by edit buffer when mark is one character beyond end of src block. Thanks to Jambunathan K. for the bug report: C-c C-v C-M-h and C-c C-v C-x interaction In the block below do 1. C-c C-v C-M-h, C-c C-v C-x C-M-\ 2. Mark (just) the code-block with C-SPC etc etc. C-c C-v C-x C-M-\ See the difference in behaviour. This is a xref to Heading8 . I have transient mark mode on. --- lisp/org-src.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/lisp/org-src.el b/lisp/org-src.el index c4f0065ec..fd827f94d 100644 --- a/lisp/org-src.el +++ b/lisp/org-src.el @@ -240,8 +240,8 @@ buffer." block-nindent (nth 5 info) lang-f (intern (concat lang "-mode")) begline (save-excursion (goto-char beg) (org-current-line))) - (if (and mark (>= mark beg) (<= mark end)) - (save-excursion (goto-char mark) + (if (and mark (>= mark beg) (<= mark (1+ end))) + (save-excursion (goto-char (min mark end)) (setq markline (org-current-line) markcol (current-column)))) (if (equal lang-f 'table.el-mode) From c906a75e48751e0e685458f307ed98c3dce154b0 Mon Sep 17 00:00:00 2001 From: Achim Gratz Date: Sat, 20 Nov 2010 11:43:45 +0100 Subject: [PATCH 7/7] org-clock.el: fix regex to recognize indented clock tables * lisp/org-clock.el (org-get-clocktable) previous patch incorrectly required whitespace in front of #+BEGIN: and #+END: TINYCHANGE - This patch is in the public domain. --- lisp/org-clock.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lisp/org-clock.el b/lisp/org-clock.el index 314692652..e798027d5 100644 --- a/lisp/org-clock.el +++ b/lisp/org-clock.el @@ -1623,7 +1623,7 @@ fontified, and then returned." (font-lock-fontify-buffer) (forward-line 2) (buffer-substring (point) (progn - (re-search-forward "^[ \t]+#\\+END" nil t) + (re-search-forward "^[ \t]*#\\+END" nil t) (point-at-bol))))) (defun org-clock-report (&optional arg) @@ -1648,9 +1648,9 @@ buffer and update it." (let ((pos (point)) start) (save-excursion (end-of-line 1) - (and (re-search-backward "^[ \t]+#\\+BEGIN:[ \t]+clocktable" nil t) + (and (re-search-backward "^[ \t]*#\\+BEGIN:[ \t]+clocktable" nil t) (setq start (match-beginning 0)) - (re-search-forward "^[ \t]+#\\+END:.*" nil t) + (re-search-forward "^[ \t]*#\\+END:.*" nil t) (>= (match-end 0) pos) start)))) @@ -1741,7 +1741,7 @@ the currently selected interval size." (and (memq dir '(left down)) (setq n (- n))) (save-excursion (goto-char (point-at-bol)) - (if (not (looking-at "^[ \t]+#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) + (if (not (looking-at "^[ \t]*#\\+BEGIN:[ \t]+clocktable\\>.*?:block[ \t]+\\(\\S-+\\)")) (error "Line needs a :block definition before this command works") (let* ((b (match-beginning 1)) (e (match-end 1)) (s (match-string 1)) @@ -2134,7 +2134,7 @@ from the dynamic block defintion." "Weekly report starting on: ") (plist-get p1 :tstart) "\n") (setq step-time (org-dblock-write:clocktable p1)) - (re-search-forward "^[ \t]+#\\+END:") + (re-search-forward "^[ \t]*#\\+END:") (when (and (equal step-time 0) stepskip0) ;; Remove the empty table (delete-region (point-at-bol)