diff options
author | John Wiegley <johnw@newartisans.com> | 2009-10-20 04:34:09 -0400 |
---|---|---|
committer | Carsten Dominik <carsten.dominik@gmail.com> | 2010-11-18 07:34:16 +0100 |
commit | 0ff8d32131b58a655492b97ebb9536907efa64dd (patch) | |
tree | ded03b0c76c2f1c3bf60b1e3fcc0e7d59bd4e2e4 | |
parent | b3d6f0448380c0dc35126ba235f1902ff8b83ad7 (diff) | |
download | org-mode-0ff8d32131b58a655492b97ebb9536907efa64dd.tar.gz |
Now using pcomplete for in-buffer completion
-rw-r--r-- | Makefile | 1 | ||||
-rw-r--r-- | lisp/org-complete.el | 207 | ||||
-rw-r--r-- | lisp/org.el | 158 |
3 files changed, 228 insertions, 138 deletions
@@ -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 0000000..cc3877b --- /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 <carsten at orgmode dot org> +;; John Wiegley <johnw at gnu dot org> +;; 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 <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)))) + (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 e45dab0..66c651f 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"] |