summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien <bzg@gnu.org>2018-10-19 10:19:08 +0200
committerBastien <bzg@gnu.org>2018-10-19 10:19:08 +0200
commitf4785b0a19cee4a579eba9045afdf486bc4a6a5d (patch)
tree37aefead3624f3d61f5748d86ae4333db817a759
parent99b6a481ca64c1ec847bf52e4cb1cd051a778273 (diff)
parent9e05a6ac8ad54268159374486aa75d87c033ef75 (diff)
downloadorg-mode-f4785b0a19cee4a579eba9045afdf486bc4a6a5d.tar.gz
Merge branch 'master' of code.orgmode.org:bzg/org-mode
-rw-r--r--lisp/org-pcomplete.el231
-rw-r--r--testing/lisp/test-org-pcomplete.el104
2 files changed, 232 insertions, 103 deletions
diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el
index a10a6a2..d245f69 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-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-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-at-heading-p)
+ (eq ?: (save-excursion
+ (skip-chars-backward "[:alnum:]_@#%")
+ (char-before))))
+ (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
@@ -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 56f7185..c9fa4c9 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<point>\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<point>"
+ (pcomplete)
+ (buffer-string)))))
+
+(ert-deftest test-org-pcomplete/drawer ()
+ "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