ndwarshuis
/
org-mode
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Fix tags completion 

* lisp/org.el (org-tags-completion-function): Refactor function. Fix
  tag completion.

Reported-by: Alain.Cochard@unistra.fr
<http://lists.gnu.org/r/emacs-orgmode/2018-05/msg00450.html>
This commit is contained in:
Nicolas Goaziou 2018-05-27 22:13:00 +02:00
parent 97fb642a64
commit c698c8e959
1 changed files with 24 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
lisp/org.el
View File

@ -14459,29 +14459,30 @@ This works in the agenda, and also in an Org buffer."
(message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt))) (message "Tag :%s: %s in %d headings" tag (if off "removed" "set") cnt)))
(defun org-tags-completion-function (string _predicate &optional flag) (defun org-tags-completion-function (string _predicate &optional flag)
(let (s1 s2 rtn (ctable org-last-tags-completion-table) "Complete tag STRING.
(confirm (lambda (x) (stringp (car x))))) FLAG specifies the type of completion operation to perform. This
(if (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string) function is passed as a collection function to `completing-read',
(setq s1 (match-string 1 string) which see."
s2 (match-string 2 string)) (let ((completion-ignore-case nil) ;tags are case-sensitive
(setq s1 "" s2 string)) (confirm (lambda (x) (stringp (car x))))
(cond (prefix ""))
((eq flag nil) (when (string-match "^\\(.*[-+:&,|]\\)\\([^-+:&,|]*\\)$" string)
;; try completion (setq prefix (match-string 1 string))
(setq rtn (try-completion s2 ctable confirm)) (setq string (match-string 2 string)))
(when (stringp rtn) (pcase flag
(setq rtn (`t (all-completions string org-last-tags-completion-table confirm))
(concat s1 s2 (substring rtn (length s2)) (`lambda (assoc string org-last-tags-completion-table)) ;exact match?
(if (and org-add-colon-after-tag-completion (`nil
(assoc rtn ctable)) (pcase (try-completion string org-last-tags-completion-table confirm)
":" "")))) ((and completion (pred stringp))
rtn) (concat prefix
((eq flag t) completion
;; all-completions (if (and org-add-colon-after-tag-completion
(all-completions s2 ctable confirm)) (assoc completion org-last-tags-completion-table))
((eq flag 'lambda) ":"
;; exact match? "")))
(assoc s2 ctable))))) (completion completion)))
(_ nil))))
(defun org-fast-tag-insert (kwd tags face &optional end) (defun org-fast-tag-insert (kwd tags face &optional end)
"Insert KWD, and the TAGS, the latter with face FACE. "Insert KWD, and the TAGS, the latter with face FACE.