diff options
Diffstat (limited to 'lisp/org/org-pcomplete.el')
| -rw-r--r-- | lisp/org/org-pcomplete.el | 253 |
1 files changed, 154 insertions, 99 deletions
diff --git a/lisp/org/org-pcomplete.el b/lisp/org/org-pcomplete.el index cf272de90a8..e557b1a117c 100644 --- a/lisp/org/org-pcomplete.el +++ b/lisp/org/org-pcomplete.el @@ -31,70 +31,126 @@ (require 'org-compat) (require 'pcomplete) -(declare-function org-make-org-heading-search-string "org" (&optional string)) -(declare-function org-get-buffer-tags "org" ()) -(declare-function org-get-tags "org" ()) -(declare-function org-buffer-property-keys "org" - (&optional specials defaults columns ignore-malformed)) +(declare-function org-at-heading-p "org" (&optional ignored)) +(declare-function org-before-first-heading-p "org" ()) +(declare-function org-buffer-property-keys "org" (&optional specials defaults columns)) +(declare-function org-element-at-point "org-element" ()) +(declare-function org-element-property "org-element" property element) +(declare-function org-element-type "org-element" (element)) +(declare-function org-end-of-meta-data "org" (&optional full)) (declare-function org-entry-properties "org" (&optional pom which)) +(declare-function org-export-backend-options "ox" (cl-x) t) +(declare-function org-get-buffer-tags "org" ()) +(declare-function org-get-export-keywords "org" ()) +(declare-function org-get-heading "org" (&optional no-tags no-todo no-priority no-comment)) +(declare-function org-get-tags "org" (&optional pos local)) +(declare-function org-link-heading-search-string "ol" (&optional string)) (declare-function org-tag-alist-to-string "org" (alist &optional skip-key)) -;;;; Customization variables - +(defvar org-current-tag-alist) +(defvar org-default-priority) (defvar org-drawer-regexp) +(defvar org-element-affiliated-keywords) +(defvar org-entities) +(defvar org-export-default-language) +(defvar org-export-exclude-tags) +(defvar org-export-select-tags) +(defvar org-file-tags) +(defvar org-highest-priority) +(defvar org-link-abbrev-alist) +(defvar org-link-abbrev-alist-local) +(defvar org-lowest-priority) +(defvar org-options-keywords) +(defvar org-outline-regexp) (defvar org-property-re) -(defvar org-current-tag-alist) +(defvar org-startup-options) +(defvar org-tag-re) +(defvar org-time-stamp-formats) +(defvar org-todo-keywords-1) +(defvar org-todo-line-regexp) + + +;;; Internal Functions (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 "-[:alnum:]_@") - (point))) - (beg (save-excursion - (skip-chars-backward "-a-zA-Z0-9_:$") - (point))) - (line-to-here (buffer-substring (point-at-bol) (point)))) + (let ((line-to-here (org-current-line-string t)) + (case-fold-search t)) (cond - ((string-match "\\`[ \t]*#\\+begin: clocktable[ \t]+" line-to-here) + ;; Parameters on a clock table opening line. + ((org-match-line "[ \t]*#\\+BEGIN: clocktable[ \t]") (cons "block-option" "clocktable")) - ((string-match "\\`[ \t]*#\\+begin_src[ \t]+" line-to-here) + ;; Flags and parameters on a source block opening line. + ((org-match-line "[ \t]*#\\+BEGIN_SRC[ \t]") (cons "block-option" "src")) - ((save-excursion - (re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*" - (line-beginning-position) t)) + ;; Value for a known keyword. + ((org-match-line "[ \t]*#\\+\\(\\S-+\\):") (cons "file-option" (match-string-no-properties 1))) - ((string-match "\\`[ \t]*#\\+[a-zA-Z_]*\\'" line-to-here) + ;; Keyword name. + ((and (org-match-line "[ \t]*#\\+[a-zA-Z_]*$") + (looking-at-p "[ \t]*$")) (cons "file-option" nil)) - ((equal (char-before beg) ?\[) + ;; Link abbreviation. + ((save-excursion + (skip-chars-backward "-A-Za-z0-9_") + (and (eq ?\[ (char-before)) + (eq ?\[ (char-before (1- (point)))))) (cons "link" nil)) - ((equal (char-before beg) ?\\) + ;; Entities. Some of them accept numbers, but only at their end. + ;; So, we first skip numbers, then letters. + ((eq ?\\ (save-excursion + (skip-chars-backward "0-9") + (skip-chars-backward "a-zA-Z") + (char-before))) (cons "tex" nil)) - ((string-match "\\`\\*+[ \t]+\\'" - (buffer-substring (point-at-bol) beg)) + ;; Tags on a headline. + ((and (org-match-line + (format "\\*+ \\(?:.+? \\)?\\(:\\)\\(\\(?::\\|%s\\)+\\)?[ \t]*$" + org-tag-re)) + (or (org-point-in-group (point) 2) + (= (point) (match-end 1)))) + (cons "tag" nil)) + ;; TODO keywords on an empty headline. + ((and (string-match "^\\*+ +\\S-*$" line-to-here) + (looking-at-p "[ \t]*$")) (cons "todo" nil)) - ((equal (char-before beg) ?*) + ;; Heading after a star for search strings or links. + ((save-excursion + (skip-chars-backward "^*" (line-beginning-position)) + (and (eq ?* (char-before)) + (eq (char-before (1- (point))) '?\[) + (eq (char-before (- (point) 2)) '?\[))) (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)) ?*)) - (save-excursion - (move-beginning-of-line 1) - (skip-chars-backward " \t\n") - ;; org-drawer-regexp matches a whole line but while - ;; looking-back, we just ignore trailing whitespaces - (or (looking-back (substring org-drawer-regexp 0 -1) - (line-beginning-position)) - (looking-back org-property-re - (line-beginning-position))))) - (cons "prop" nil)) - ((and (equal (char-before beg1) ?:) - (not (equal (char-after (point-at-bol)) ?*))) - (cons "drawer" nil)) + ;; Property or drawer name, depending on point. If point is at + ;; a valid location for a node property, offer completion on all + ;; node properties in the buffer. Otherwise, offer completion on + ;; all drawer names, including "PROPERTIES". + ((and (string-match "^[ \t]*:\\S-*$" line-to-here) + (looking-at-p "[ \t]*$")) + (let ((origin (line-beginning-position))) + (if (org-before-first-heading-p) (cons "drawer" nil) + (save-excursion + (org-end-of-meta-data) + (if (or (= origin (point)) + (not (org-match-line "[ \t]*:PROPERTIES:[ \t]*$"))) + (cons "drawer" nil) + (while (org-match-line org-property-re) + (forward-line)) + (if (= origin (point)) (cons "prop" nil) + (cons "drawer" nil))))))) (t nil)))) +(defun org-pcomplete-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))) + + +;;; Completion API + (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 @@ -133,9 +189,9 @@ When completing for #+STARTUP, for example, this function returns (car (org-thing-at-point))) pcomplete-default-completion-function)))) -(defvar org-options-keywords) ; From org.el -(defvar org-element-affiliated-keywords) ; From org-element.el -(declare-function org-get-export-keywords "org" ()) + +;;; Completion functions + (defun pcomplete/org-mode/file-option () "Complete against all valid file options." (require 'org-element) @@ -167,7 +223,6 @@ When completing for #+STARTUP, for example, this function returns "Complete arguments for the #+AUTHOR file option." (pcomplete-here (list user-full-name))) -(defvar org-time-stamp-formats) (defun pcomplete/org-mode/file-option/date () "Complete arguments for the #+DATE file option." (pcomplete-here (list (format-time-string (car org-time-stamp-formats))))) @@ -176,7 +231,6 @@ When completing for #+STARTUP, for example, this function returns "Complete arguments for the #+EMAIL file option." (pcomplete-here (list user-mail-address))) -(defvar org-export-exclude-tags) (defun pcomplete/org-mode/file-option/exclude_tags () "Complete arguments for the #+EXCLUDE_TAGS file option." (require 'ox) @@ -184,12 +238,10 @@ When completing for #+STARTUP, for example, this function returns (and org-export-exclude-tags (list (mapconcat 'identity org-export-exclude-tags " "))))) -(defvar org-file-tags) (defun pcomplete/org-mode/file-option/filetags () "Complete arguments for the #+FILETAGS file option." (pcomplete-here (and org-file-tags (mapconcat 'identity org-file-tags " ")))) -(defvar org-export-default-language) (defun pcomplete/org-mode/file-option/language () "Complete arguments for the #+LANGUAGE file option." (require 'ox) @@ -197,9 +249,6 @@ When completing for #+STARTUP, for example, this function returns (pcomplete-uniquify-list (list org-export-default-language "en")))) -(defvar org-default-priority) -(defvar org-highest-priority) -(defvar org-lowest-priority) (defun pcomplete/org-mode/file-option/priorities () "Complete arguments for the #+PRIORITIES file option." (pcomplete-here (list (format "%c %c %c" @@ -207,7 +256,6 @@ When completing for #+STARTUP, for example, this function returns org-lowest-priority org-default-priority)))) -(defvar org-export-select-tags) (defun pcomplete/org-mode/file-option/select_tags () "Complete arguments for the #+SELECT_TAGS file option." (require 'ox) @@ -215,7 +263,6 @@ When completing for #+STARTUP, for example, this function returns (and org-export-select-tags (list (mapconcat 'identity org-export-select-tags " "))))) -(defvar org-startup-options) (defun pcomplete/org-mode/file-option/startup () "Complete arguments for the #+STARTUP file option." (while (pcomplete-here @@ -244,7 +291,6 @@ When completing for #+STARTUP, for example, this function returns (buffer-name (buffer-base-buffer))))))) -(declare-function org-export-backend-options "ox" (cl-x) t) (defun pcomplete/org-mode/file-option/options () "Complete arguments for the #+OPTIONS file option." (while (pcomplete-here @@ -275,20 +321,18 @@ When completing for #+STARTUP, for example, this function returns "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))))) + (lambda (a) (when (boundp a) (setq vars (cons (symbol-name a) vars))))) (pcomplete-here vars))) -(defvar org-link-abbrev-alist-local) -(defvar org-link-abbrev-alist) (defun pcomplete/org-mode/link () "Complete against defined #+LINK patterns." (pcomplete-here (pcomplete-uniquify-list (copy-sequence - (append (mapcar 'car org-link-abbrev-alist-local) - (mapcar 'car org-link-abbrev-alist)))))) + (mapcar (lambda (e) (concat (car e) ":")) + (append org-link-abbrev-alist-local + org-link-abbrev-alist)))))) -(defvar org-entities) (defun pcomplete/org-mode/tex () "Complete against TeX-style HTML entity names." (require 'org-entities) @@ -296,27 +340,24 @@ When completing for #+STARTUP, for example, this function returns (pcomplete-uniquify-list (remove nil (mapcar 'car-safe org-entities))) (substring pcomplete-stub 1)))) -(defvar org-todo-keywords-1) (defun pcomplete/org-mode/todo () "Complete against known TODO keywords." (pcomplete-here (pcomplete-uniquify-list (copy-sequence org-todo-keywords-1)))) -(defvar org-todo-line-regexp) (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) - (let ((case-fold-search nil)) - (while (re-search-forward org-todo-line-regexp nil t) - (push (org-make-org-heading-search-string - (match-string-no-properties 3)) - tbl))) - (pcomplete-uniquify-list tbl))) - (substring pcomplete-stub 1)))) + (while (pcomplete-here + (save-excursion + (goto-char (point-min)) + (let (tbl) + (while (re-search-forward org-outline-regexp nil t) + (push (org-link-heading-search-string (org-get-heading t t t t)) + tbl)) + (pcomplete-uniquify-list tbl))) + ;; When completing a bracketed link, i.e., "[[*", argument + ;; starts at the star, so remove this character. + (substring pcomplete-stub 1)))) (defun pcomplete/org-mode/tag () "Complete a tag name. Omit tags already set." @@ -328,28 +369,47 @@ This needs more work, to handle headings with lots of spaces in them." (mapcar (lambda (x) (org-string-nw-p (car x))) org-current-tag-alist)) (mapcar #'car (org-get-buffer-tags)))))) - (dolist (tag (org-get-tags)) + (dolist (tag (org-get-tags nil t)) (setq lst (delete tag lst))) lst)) (and (string-match ".*:" pcomplete-stub) - (substring pcomplete-stub (match-end 0)))))) + (substring pcomplete-stub (match-end 0))) + t))) + +(defun pcomplete/org-mode/drawer () + "Complete a drawer name, including \"PROPERTIES\"." + (pcomplete-here + (org-pcomplete-case-double + (mapcar (lambda (x) (concat x ":")) + (let ((names (list "PROPERTIES"))) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward org-drawer-regexp nil t) + (let ((drawer (org-element-at-point))) + (when (memq (org-element-type drawer) + '(drawer property-drawer)) + (push (org-element-property :drawer-name drawer) names) + (goto-char (org-element-property :end drawer)))))) + (pcomplete-uniquify-list names)))) + (substring pcomplete-stub 1))) ;remove initial colon (defun pcomplete/org-mode/prop () "Complete a property name. Omit properties already set." (pcomplete-here - (mapcar (lambda (x) - (concat x ": ")) - (let ((lst (pcomplete-uniquify-list - (copy-sequence - (org-buffer-property-keys nil t t t))))) - (dolist (prop (org-entry-properties)) - (setq lst (delete (car prop) lst))) - lst)) + (org-pcomplete-case-double + (mapcar (lambda (x) + (concat x ": ")) + (let ((lst (pcomplete-uniquify-list + (copy-sequence (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." + "Complete the arguments of a source block. +Complete a language in the first field, the header arguments and +switches." (pcomplete-here (mapcar (lambda(x) (symbol-name (nth 3 x))) @@ -369,17 +429,12 @@ Complete a language in the first field, the header arguments and switches." ":tstart" ":tend" ":block" ":step" ":stepskip0" ":fileskip0" ":emphasize" ":link" ":narrow" ":indent" - ":tcolumns" ":level" ":compact" ":timestamp" - ":formula" ":formatter" ":wstart" ":mstart")))) - -(defun org-pcomplete-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))) + ":hidefiles" ":tcolumns" ":level" ":compact" + ":timestamp" ":formula" ":formatter" + ":wstart" ":mstart")))) -;;;; Finish up + +;;; Finish up (provide 'org-pcomplete) |