summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCarsten Dominik <carsten.dominik@gmail.com>2010-11-20 12:33:45 +0100
committerCarsten Dominik <carsten.dominik@gmail.com>2010-11-20 12:33:45 +0100
commitdce955fad095a6580933d326cdc72e425e44594c (patch)
treedb706f322450719dffbd539fe4f194fc19353957
parent3dc846ae3852b391e45c8454de702397b8db836a (diff)
parent69ba4a181cbfd9e03c9cb3b03701746c13daa9a5 (diff)
downloadorg-mode-dce955fad095a6580933d326cdc72e425e44594c.tar.gz
Merge branch 'master' of git+ssh://repo.or.cz/srv/git/org-mode
-rw-r--r--Makefile1
-rw-r--r--lisp/ob.el107
-rw-r--r--lisp/org-agenda.el12
-rw-r--r--lisp/org-clock.el10
-rw-r--r--lisp/org-complete.el261
-rw-r--r--lisp/org-list.el59
-rw-r--r--lisp/org-src.el4
-rw-r--r--lisp/org.el158
8 files changed, 379 insertions, 233 deletions
diff --git a/Makefile b/Makefile
index e6bdfbe..d473904 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/ob.el b/lisp/ob.el
index 96c2744..3689619 100644
--- a/lisp/ob.el
+++ b/lisp/ob.el
@@ -585,6 +585,60 @@ results already exist."
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.
Call `org-babel-execute-src-block' on every source block in
@@ -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.
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index b7de45a..a248068 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
diff --git a/lisp/org-clock.el b/lisp/org-clock.el
index 3146926..e798027 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)
diff --git a/lisp/org-complete.el b/lisp/org-complete.el
new file mode 100644
index 0000000..a9fed99
--- /dev/null
+++ b/lisp/org-complete.el
@@ -0,0 +1,261 @@
+;;; org-complete.el --- In-buffer completion code
+
+;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010
+;; Free Software Foundation, Inc.
+;;
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; John Wiegley <johnw at gnu dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 7.03trans
+;;
+;; 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 <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; 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)))
+ (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 "^[ \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) ?\\)
+ (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) "/" (downcase (cdr thing))))
+ ((string= "block-option" (car thing))
+ (concat (car thing) "/" (downcase (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
+ (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 ()
+ "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/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
+ (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."
+ (require 'org-entities)
+ (while (pcomplete-here
+ (pcomplete-uniqify-list (remove nil (mapcar 'car-safe org-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 (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)))
+ 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)))
+
+(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)
+
+;; arch-tag:
+
+;;; org-complete.el ends here
diff --git a/lisp/org-list.el b/lisp/org-list.el
index e54c2a0..2290b4a 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
diff --git a/lisp/org-src.el b/lisp/org-src.el
index c4f0065..fd827f9 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)
diff --git a/lisp/org.el b/lisp/org.el
index 6049f2f..c634a6c 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)
@@ -17698,7 +17580,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"]