From 9df82be0742722b0c008b9b13e02627899c3387d Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 8 Nov 2018 18:20:57 +0100 Subject: [PATCH] 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 --- lisp/org.el | 180 +++++++++++++++------------------------ testing/lisp/test-org.el | 48 +++++++++++ 2 files changed, 116 insertions(+), 112 deletions(-) diff --git a/lisp/org.el b/lisp/org.el index 33c846765..14029b71d 100644 --- a/lisp/org.el +++ b/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." diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 3f5aa09e4..6fa6c6532 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -6468,6 +6468,54 @@ Paragraph" (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