diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el index a10a6a2f2..d245f6981 100644 --- a/lisp/org-pcomplete.el +++ b/lisp/org-pcomplete.el @@ -31,69 +31,124 @@ (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" (&optional pos local)) +(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-make-org-heading-search-string "org" (&optional string)) (declare-function org-tag-alist-to-string "org" (alist &optional skip-key)) -;;;; Customization variables - -(defvar org-drawer-regexp) -(defvar org-property-re) (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-startup-options) +(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)) - (cons "todo" nil)) - ((equal (char-before beg) ?*) - (cons "searchhead" nil)) - ((and (equal (char-before beg1) ?:) - (equal (char-after (point-at-bol)) ?*)) + ;; Tags on a headline. + ((and (org-at-heading-p) + (eq ?: (save-excursion + (skip-chars-backward "[:alnum:]_@#%") + (char-before)))) (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)) + ;; TODO keywords on an empty headline. + ((and (string-match "^\\*+ +\\S-*$" line-to-here) + (looking-at-p "[ \t]*$")) + (cons "todo" nil)) + ;; 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)) + ;; 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 @@ -132,9 +187,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) @@ -166,7 +221,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))))) @@ -175,7 +229,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) @@ -183,12 +236,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) @@ -196,9 +247,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" @@ -206,7 +254,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) @@ -214,7 +261,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 @@ -243,7 +289,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 @@ -277,17 +322,15 @@ When completing for #+STARTUP, for example, this function returns (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) @@ -295,27 +338,25 @@ 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-make-org-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." @@ -333,16 +374,34 @@ This needs more work, to handle headings with lots of spaces in them." (and (string-match ".*:" pcomplete-stub) (substring pcomplete-stub (match-end 0)))))) +(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))))) - (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 () @@ -371,14 +430,8 @@ switches." ":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))) - -;;;; Finish up + +;;; Finish up (provide 'org-pcomplete) diff --git a/testing/lisp/test-org-pcomplete.el b/testing/lisp/test-org-pcomplete.el index 56f7185e5..c9fa4c908 100644 --- a/testing/lisp/test-org-pcomplete.el +++ b/testing/lisp/test-org-pcomplete.el @@ -24,21 +24,39 @@ ;;; Code: -(ert-deftest test-org-pcomplete/prop () - "Test property completion." - ;; Drawer where we are currently completing property name is - ;; malformed in any case, it'll become valid only after successful - ;; completion. We expect that this completion process will finish - ;; successfully, and there will be no interactive drawer repair - ;; attempts. +(ert-deftest test-org-pcomplete/clocktable () + "Test completion of clock table parameters." (should - (equal - "* a\n:PROPERTIES:\n:pname: \n:END:\n* b\n:PROPERTIES:\n:pname: pvalue\n:END:\n" - (org-test-with-temp-text "* a\n:PROPERTIES:\n:pna\n:END:\n* b\n:PROPERTIES:\n:pname: pvalue\n:END:\n" - (cl-letf (((symbol-function 'y-or-n-p) - (lambda (_) (error "Should not be called")))) - (pcomplete)) - (buffer-string))))) + (equal "#+begin: clocktable :scope" + (org-test-with-temp-text "#+begin: clocktable :sco" + (pcomplete) + (buffer-string))))) + +(ert-deftest test-org-pcomplete/drawer () + "Test drawer completion." + (should + (equal "* Foo\n:PROPERTIES:" + (org-test-with-temp-text "* Foo\n:" + (pcomplete) + (buffer-string)))) + (should + (equal ":DRAWER:\nContents\n:END:\n* Foo\n:DRAWER:" + (org-test-with-temp-text ":DRAWER:\nContents\n:END:\n* Foo\n:D" + (pcomplete) + (buffer-string))))) + +(ert-deftest test-org-pcomplete/entity () + "Test entity completion." + (should + (equal "\\alpha" + (org-test-with-temp-text "\\alp" + (pcomplete) + (buffer-string)))) + (should + (equal "\\frac12" + (org-test-with-temp-text "\\frac1" + (pcomplete) + (buffer-string))))) (ert-deftest test-org-pcomplete/keyword () "Test keyword and block completion." @@ -57,5 +75,63 @@ (buffer-string)) t))) +(ert-deftest test-org-pcomplete/link () + "Test link completion" + (should + (equal "[[org:" + (org-test-with-temp-text "[[o" + (let ((org-link-abbrev-alist '(("org" . "https://orgmode.org/")))) + (pcomplete)) + (buffer-string)))) + (should-not + (equal "[org:" + (org-test-with-temp-text "[[o" + (let ((org-link-abbrev-alist '(("org" . "https://orgmode.org/")))) + (pcomplete)) + (buffer-string))))) + +(ert-deftest test-org-pcomplete/prop () + "Test property completion." + (should + (equal + " +* a +:PROPERTIES: +:pname:\s +:END: +* b +:PROPERTIES: +:pname: pvalue +:END: +" + (org-test-with-temp-text " +* a +:PROPERTIES: +:pna +:END: +* b +:PROPERTIES: +:pname: pvalue +:END: +" + (pcomplete) + (buffer-string))))) + +(ert-deftest test-org-pcomplete/search-heading () + "Test search heading completion." + (should + (equal "* Foo\n[[*Foo" + (org-test-with-temp-text "* Foo\n[[*" + (pcomplete) + (buffer-string))))) + +(ert-deftest test-org-pcomplete/todo () + "Test TODO completion." + (should + (equal "* TODO" + (org-test-with-temp-text "* T" + (pcomplete) + (buffer-string))))) + (provide 'test-org-pcomplete) ;;; test-org-pcomplete.el ends here