Merge branch 'master' into next

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-at-heading-p "org" (&optional ignored))
-(declare-function org-get-buffer-tags "org" ())
+(declare-function org-before-first-heading-p "org" ())
-(declare-function org-get-tags "org" (&optional pos local))
 (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
+  (let ((line-to-here (org-current-line-string t))
-		(skip-chars-backward "[:alnum:]-_@")
+	(case-fold-search t))
-		(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)
+     ;; 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
+     ;; Value for a known keyword.
-	(re-search-backward "^[ \t]*#\\+\\([A-Z_]+\\):.*"
+     ((org-match-line "[ \t]*#\\+\\(\\S-+\\):")
-			    (line-beginning-position) t))
       (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]+\\'"
+     ;; Tags on a headline.
-		    (buffer-substring (point-at-bol) beg))
+     ((and (org-at-heading-p)
-      (cons "todo" nil))
+	   (eq ?: (save-excursion
-     ((equal (char-before beg) ?*)
+		    (skip-chars-backward "[:alnum:]_@#%")
-      (cons "searchhead" nil))
+		    (char-before))))
-     ((and (equal (char-before beg1) ?:)
-	   (equal (char-after (point-at-bol)) ?*))
       (cons "tag" nil))
-     ((and (equal (char-before beg1) ?:)
+     ;; TODO keywords on an empty headline.
-	   (not (equal (char-after (point-at-bol)) ?*))
+     ((and (string-match "^\\*+ +\\S-*$" line-to-here)
-	   (save-excursion
+	   (looking-at-p "[ \t]*$"))
-	     (move-beginning-of-line 1)
+      (cons "todo" nil))
-	     (skip-chars-backward "[ \t\n]")
+     ;; Heading after a star for search strings or links.
-	     ;; org-drawer-regexp matches a whole line but while
+     ((save-excursion
-	     ;; looking-back, we just ignore trailing whitespaces
+	(skip-chars-backward "^*" (line-beginning-position))
-	     (or (looking-back (substring org-drawer-regexp 0 -1)
+	(and (eq ?* (char-before))
-			       (line-beginning-position))
+	     (eq (char-before (1- (point))) '?\[)
-		 (looking-back org-property-re
+	     (eq (char-before (- (point) 2)) '?\[)))
-			       (line-beginning-position)))))
+      (cons "searchhead" nil))
-      (cons "prop" nil))
+     ;; Property or drawer name, depending on point.  If point is at
-     ((and (equal (char-before beg1) ?:)
+     ;; a valid location for a node property, offer completion on all
-	   (not (equal (char-after (point-at-bol)) ?*)))
+     ;; node properties in the buffer. Otherwise, offer completion on
-      (cons "drawer" nil))
+     ;; 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
+;;; Completion functions
-(declare-function org-get-export-keywords "org" ())
+
 (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 (lambda (e) (concat (car e) ":"))
-	     (mapcar 'car org-link-abbrev-alist))))))
+	     (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
+  (while (pcomplete-here
-      (pcomplete-here
+	  (save-excursion
-       (save-excursion
+	    (goto-char (point-min))
-	 (goto-char (point-min))
+	    (let (tbl)
-	 (let (tbl)
+	      (while (re-search-forward org-outline-regexp nil t)
-	   (let ((case-fold-search nil))
+		(push (org-make-org-heading-search-string
-	     (while (re-search-forward org-todo-line-regexp nil t)
+		       (org-get-heading t t t t))
-	       (push (org-make-org-heading-search-string
+		      tbl))
-		      (match-string-no-properties 3))
+	      (pcomplete-uniquify-list tbl)))
-		     tbl)))
+	  ;; When completing a bracketed link, i.e., "[[*", argument
-	   (pcomplete-uniquify-list tbl)))
+	  ;; starts at the star, so remove this character.
-       (substring pcomplete-stub 1))))
+	  (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)
+   (org-pcomplete-case-double
-	     (concat x ": "))
+    (mapcar (lambda (x)
-	   (let ((lst (pcomplete-uniquify-list
+	      (concat x ": "))
-		       (copy-sequence (org-buffer-property-keys nil t t)))))
+	    (let ((lst (pcomplete-uniquify-list
-	     (dolist (prop (org-entry-properties))
+			(copy-sequence (org-buffer-property-keys nil t t)))))
-	       (setq lst (delete (car prop) lst)))
+	      (dolist (prop (org-entry-properties))
-	     lst))
+		(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."
+;;; Finish up
-  (let (e res)
-    (while (setq e (pop list))
-      (setq res (cons (downcase e) (cons (upcase e) res))))
-    (nreverse res)))
-
-;;;; Finish up
 
 (provide 'org-pcomplete)
 

testing/lisp/test-org-pcomplete.el

@@ -24,21 +24,39 @@
 
 ;;; Code:
 
-(ert-deftest test-org-pcomplete/prop ()
+(ert-deftest test-org-pcomplete/clocktable ()
-  "Test property completion."
+  "Test completion of clock table parameters."
-  ;; 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.
   (should
-   (equal
+   (equal "#+begin: clocktable :scope"
-    "* a\n:PROPERTIES:\n:pname: \n:END:\n* b\n:PROPERTIES:\n:pname: pvalue\n:END:\n"
+	  (org-test-with-temp-text "#+begin: clocktable :sco<point>"
-    (org-test-with-temp-text "* a\n:PROPERTIES:\n:pna<point>\n:END:\n* b\n:PROPERTIES:\n:pname: pvalue\n:END:\n"
+	    (pcomplete)
-      (cl-letf (((symbol-function 'y-or-n-p)
+	    (buffer-string)))))
-		 (lambda (_) (error "Should not be called"))))
+
-	(pcomplete))
+(ert-deftest test-org-pcomplete/drawer ()
-      (buffer-string)))))
+  "Test drawer completion."
+  (should
+   (equal "* Foo\n:PROPERTIES:"
+	  (org-test-with-temp-text "* Foo\n:<point>"
+	    (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<point>"
+	    (pcomplete)
+	    (buffer-string)))))
+
+(ert-deftest test-org-pcomplete/entity ()
+  "Test entity completion."
+  (should
+   (equal "\\alpha"
+	  (org-test-with-temp-text "\\alp<point>"
+	    (pcomplete)
+	    (buffer-string))))
+  (should
+   (equal "\\frac12"
+	  (org-test-with-temp-text "\\frac1<point>"
+	    (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<point>"
+	    (let ((org-link-abbrev-alist '(("org" . "https://orgmode.org/"))))
+	      (pcomplete))
+	    (buffer-string))))
+  (should-not
+   (equal "[org:"
+	  (org-test-with-temp-text "[[o<point>"
+	    (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<point>
+: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[[*<point>"
+	    (pcomplete)
+	    (buffer-string)))))
+
+(ert-deftest test-org-pcomplete/todo ()
+  "Test TODO completion."
+  (should
+   (equal "* TODO"
+	  (org-test-with-temp-text "* T<point>"
+	    (pcomplete)
+	    (buffer-string)))))
+
 (provide 'test-org-pcomplete)
 ;;; test-org-pcomplete.el ends here