Merge branch 'master' into next
This commit is contained in:
Nicolas Goaziou
commit
1f913ecc36
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue