forked from mirrors/org-mode
Fix tag groups expansion as a regexp
* lisp/org.el (org--tags-expand-group): New function. (org-tags-expand): Refactor code. Fix expansion of identical tag groups in the same match string. Fix docstring. Remove unused argument. * testing/lisp/test-org.el (test-org/tags-expand): New test. Reported-by: Omari Norman <omari@smileystation.com> <http://lists.gnu.org/r/emacs-orgmode/2018-10/msg00360.html>
This commit is contained in:
Nicolas Goaziou
parent
bfb946c7da
commit
9df82be074
180
lisp/org.el
180
lisp/org.el
|
|
@ -14083,7 +14083,20 @@ See also `org-scan-tags'."
|
|||
(setq matcher `(and (member todo org-not-done-keywords) ,matcher)))
|
||||
(cons match0 `(lambda (todo tags-list level) ,matcher)))))
|
||||
|
||||
(defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded)
|
||||
(defun org--tags-expand-group (group tag-groups expanded)
|
||||
"Recursively Expand all tags in GROUP, according to TAG-GROUPS.
|
||||
TAG-GROUPS is the list of groups used for expansion. EXPANDED is
|
||||
an accumulator used in recursive calls."
|
||||
(dolist (tag group)
|
||||
(unless (member tag expanded)
|
||||
(let ((group (assoc tag tag-groups)))
|
||||
(push tag expanded)
|
||||
(when group
|
||||
(setq expanded
|
||||
(org--tags-expand-group (cdr group) tag-groups expanded))))))
|
||||
expanded)
|
||||
|
||||
(defun org-tags-expand (match &optional single-as-list downcased)
|
||||
"Expand group tags in MATCH.
|
||||
|
||||
This replaces every group tag in MATCH with a regexp tag search.
|
||||
|
|
@ -14100,7 +14113,7 @@ E.g., this expansion
|
|||
Work|Home => {\\(?:Work\\|Lab\\|Conf\\}|Home
|
||||
|
||||
will match anything tagged with \"Lab\" and \"Home\", or tagged
|
||||
with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\".
|
||||
with \"Conf\" and \"Home\" or tagged with \"Work\" and \"Home\".
|
||||
|
||||
A group tag in MATCH can contain regular expressions of its own.
|
||||
For example, a group tag \"Proj\" defined as { Proj : {P@.+} }
|
||||
|
|
@ -14112,118 +14125,61 @@ When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
|
|||
assumed to be a single group tag, and the function will return
|
||||
the list of tags in this group.
|
||||
|
||||
When DOWNCASE is non-nil, expand downcased TAGS."
|
||||
(if org-group-tags
|
||||
When DOWNCASED is non-nil, expand downcased TAGS."
|
||||
(unless (org-string-nw-p match) (error "Invalid match tag: %S" match))
|
||||
(let ((tag-groups
|
||||
(let ((g (or org-tag-groups-alist-for-agenda org-tag-groups-alist)))
|
||||
(if (not downcased) g
|
||||
(mapcar (lambda (s) (mapcar #'downcase s)))))))
|
||||
(cond
|
||||
(single-as-list (org--tags-expand-group (list match) tag-groups nil))
|
||||
(org-group-tags
|
||||
(let* ((case-fold-search t)
|
||||
(stable org-mode-syntax-table)
|
||||
(taggroups (or org-tag-groups-alist-for-agenda org-tag-groups-alist))
|
||||
(taggroups (if downcased
|
||||
(mapcar (lambda (tg) (mapcar #'downcase tg))
|
||||
taggroups)
|
||||
taggroups))
|
||||
(taggroups-keys (mapcar #'car taggroups))
|
||||
(return-match (if downcased (downcase match) match))
|
||||
(count 0)
|
||||
(work-already-expanded tags-already-expanded)
|
||||
regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped)
|
||||
(tag-syntax org-mode-syntax-table)
|
||||
(group-keys (mapcar #'car tag-groups))
|
||||
(key-regexp (concat "\\([+-]?\\)" (regexp-opt group-keys 'words)))
|
||||
(return-match (if downcased (downcase match) match)))
|
||||
;; Mark regexp-expressions in the match-expression so that we
|
||||
;; do not replace them later on.
|
||||
(let ((s 0))
|
||||
(while (string-match "{.+?}" return-match s)
|
||||
(setq s (match-end 0))
|
||||
(add-text-properties
|
||||
(match-beginning 0) (match-end 0) '(regexp t) return-match)))
|
||||
;; @ and _ are allowed as word-components in tags.
|
||||
(modify-syntax-entry ?@ "w" stable)
|
||||
(modify-syntax-entry ?_ "w" stable)
|
||||
;; Temporarily replace regexp-expressions in the match-expression.
|
||||
(while (string-match "{.+?}" return-match)
|
||||
(cl-incf count)
|
||||
(push (match-string 0 return-match) regexps-in-match)
|
||||
(setq return-match (replace-match (format "<%d>" count) t nil return-match)))
|
||||
(while (and taggroups-keys
|
||||
(with-syntax-table stable
|
||||
(string-match
|
||||
(concat "\\(?1:[+-]?\\)\\(?2:\\<"
|
||||
(regexp-opt taggroups-keys) "\\>\\)")
|
||||
return-match)))
|
||||
(let* ((dir (match-string 1 return-match))
|
||||
(tag (match-string 2 return-match))
|
||||
(tag (if downcased (downcase tag) tag)))
|
||||
(unless (or (get-text-property 0 'grouptag (match-string 2 return-match))
|
||||
(member tag tags-already-expanded))
|
||||
(setq tags-in-group (assoc tag taggroups))
|
||||
(push tag work-already-expanded)
|
||||
;; Recursively expand each tag in the group, if the tag hasn't
|
||||
;; already been expanded. Restore the match-data after all recursive calls.
|
||||
(save-match-data
|
||||
(let (tags-expanded)
|
||||
(dolist (x (cdr tags-in-group))
|
||||
(if (and (member x taggroups-keys)
|
||||
(not (member x work-already-expanded)))
|
||||
(setq tags-expanded
|
||||
(delete-dups
|
||||
(append
|
||||
(org-tags-expand x t downcased
|
||||
work-already-expanded)
|
||||
tags-expanded)))
|
||||
(setq tags-expanded
|
||||
(append (list x) tags-expanded)))
|
||||
(setq work-already-expanded
|
||||
(delete-dups
|
||||
(append tags-expanded
|
||||
work-already-expanded))))
|
||||
(setq tags-in-group
|
||||
(delete-dups (cons (car tags-in-group)
|
||||
tags-expanded)))))
|
||||
;; Filter tag-regexps from tags.
|
||||
(setq regexp-in-group-escaped
|
||||
(delq nil (mapcar (lambda (x)
|
||||
(if (stringp x)
|
||||
(and (equal "{" (substring x 0 1))
|
||||
(equal "}" (substring x -1))
|
||||
x)
|
||||
x))
|
||||
tags-in-group))
|
||||
regexp-in-group
|
||||
(mapcar (lambda (x)
|
||||
(substring x 1 -1))
|
||||
regexp-in-group-escaped)
|
||||
tags-in-group
|
||||
(delq nil (mapcar (lambda (x)
|
||||
(if (stringp x)
|
||||
(and (not (equal "{" (substring x 0 1)))
|
||||
(not (equal "}" (substring x -1)))
|
||||
x)
|
||||
x))
|
||||
tags-in-group)))
|
||||
;; If single-as-list, do no more in the while-loop.
|
||||
(if (not single-as-list)
|
||||
(progn
|
||||
(when regexp-in-group
|
||||
(setq regexp-in-group
|
||||
(concat "\\|"
|
||||
(mapconcat 'identity regexp-in-group
|
||||
"\\|"))))
|
||||
(setq tags-in-group
|
||||
(concat dir
|
||||
"{\\<"
|
||||
(regexp-opt tags-in-group)
|
||||
"\\>"
|
||||
regexp-in-group
|
||||
"}"))
|
||||
(when (stringp tags-in-group)
|
||||
(org-add-props tags-in-group '(grouptag t)))
|
||||
(setq return-match
|
||||
(replace-match tags-in-group t t return-match)))
|
||||
(setq tags-in-group
|
||||
(append regexp-in-group-escaped tags-in-group))))
|
||||
(setq taggroups-keys (delete tag taggroups-keys))))
|
||||
;; Add the regular expressions back into the match-expression again.
|
||||
(while regexps-in-match
|
||||
(setq return-match (replace-regexp-in-string (format "<%d>" count)
|
||||
(pop regexps-in-match)
|
||||
return-match t t))
|
||||
(cl-decf count))
|
||||
(if single-as-list
|
||||
(if tags-in-group tags-in-group (list return-match))
|
||||
return-match))
|
||||
(if single-as-list
|
||||
(list (if downcased (downcase match) match))
|
||||
match)))
|
||||
(modify-syntax-entry ?@ "w" tag-syntax)
|
||||
(modify-syntax-entry ?_ "w" tag-syntax)
|
||||
;; For each tag token found in MATCH, compute a regexp and it
|
||||
(with-syntax-table tag-syntax
|
||||
(replace-regexp-in-string
|
||||
key-regexp
|
||||
(lambda (m)
|
||||
(if (get-text-property (match-beginning 2) 'regexp m)
|
||||
m ;regexp tag: ignore
|
||||
(let* ((operator (match-string 1 m))
|
||||
(tag-token (let ((tag (match-string 2 m)))
|
||||
(list (if downcased (downcase tag) tag))))
|
||||
regexp-tags regular-tags)
|
||||
;; Partition tags between regexp and regular tags.
|
||||
;; Remove curly bracket syntax from regexp tags.
|
||||
(dolist (tag (org--tags-expand-group tag-token tag-groups nil))
|
||||
(save-match-data
|
||||
(if (string-match "{\\(.+?\\)}" tag)
|
||||
(push (match-string 1 tag) regexp-tags)
|
||||
(push tag regular-tags))))
|
||||
;; Replace tag token by the appropriate regexp.
|
||||
;; Regular tags need to be regexp-quoted, whereas
|
||||
;; regexp-tags are inserted as-is.
|
||||
(let ((regular (regexp-opt regular-tags))
|
||||
(regexp (mapconcat #'identity regexp-tags "\\|")))
|
||||
(concat operator
|
||||
(cond
|
||||
((null regular-tags) (format "{%s}" regexp))
|
||||
((null regexp-tags) (format "{\\<%s\\>}" regular))
|
||||
(t (format "{\\<%s\\>\\|%s}" regular regexp))))))))
|
||||
return-match
|
||||
t t))))
|
||||
(t match))))
|
||||
|
||||
(defun org-op-to-function (op &optional stringp)
|
||||
"Turn an operator into the appropriate function."
|
||||
|
|
|
|||
|
|
@ -6468,6 +6468,54 @@ Paragraph<point>"
|
|||
(org-toggle-tag "foo"))
|
||||
(buffer-string)))))
|
||||
|
||||
(ert-deftest test-org/tags-expand ()
|
||||
"Test `org-tags-expand' specifications."
|
||||
;; Expand tag groups as a regexp enclosed withing curly brackets.
|
||||
(should
|
||||
(equal "{\\<[ABC]\\>}"
|
||||
(org-test-with-temp-text "#+TAGS: [ A : B C ]"
|
||||
(org-mode-restart)
|
||||
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "A")))))
|
||||
(should
|
||||
(equal "{\\<\\(?:Aa\\|Bb\\|Cc\\)\\>}"
|
||||
(org-test-with-temp-text "#+TAGS: [ Aa : Bb Cc ]"
|
||||
(org-mode-restart)
|
||||
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "Aa")))))
|
||||
;; Preserve operator before the regexp.
|
||||
(should
|
||||
(equal "+{\\<[ABC]\\>}"
|
||||
(org-test-with-temp-text "#+TAGS: [ A : B C ]"
|
||||
(org-mode-restart)
|
||||
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "+A")))))
|
||||
(should
|
||||
(equal "-{\\<[ABC]\\>}"
|
||||
(org-test-with-temp-text "#+TAGS: [ A : B C ]"
|
||||
(org-mode-restart)
|
||||
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "-A")))))
|
||||
;; Handle "|" syntax.
|
||||
(should
|
||||
(equal "{\\<[ABC]\\>}|D"
|
||||
(org-test-with-temp-text "#+TAGS: [ A : B C ]"
|
||||
(org-mode-restart)
|
||||
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "A|D")))))
|
||||
;; Handle nested groups.
|
||||
(should
|
||||
(equal "{\\<[A-D]\\>}"
|
||||
(org-test-with-temp-text "#+TAGS: [ A : B C ]\n#+TAGS: [ B : D ]"
|
||||
(org-mode-restart)
|
||||
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "A")))))
|
||||
;; Expand multiple occurrences of the same group.
|
||||
(should
|
||||
(equal "{\\<[ABC]\\>}|{\\<[ABC]\\>}"
|
||||
(org-test-with-temp-text "#+TAGS: [ A : B C ]"
|
||||
(org-mode-restart)
|
||||
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "A|A")))))
|
||||
;; Preserve regexp matches.
|
||||
(should
|
||||
(equal "{A+}"
|
||||
(org-test-with-temp-text "#+TAGS: [ A : B C ]"
|
||||
(org-mode-restart)
|
||||
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "{A+}"))))))
|
||||
|
||||
|
||||
;;; TODO keywords
|
||||
|
|
|
|||
Loading…
Reference in New Issue