From be31a0c4595a6d68b03b5cfbcbcdbf2cd76d2b7f Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Thu, 19 Apr 2018 14:27:12 +0200 Subject: [PATCH] Standardize tag regexps * lisp/org.el (org-tag-re): (org-tag-group-re): New variable (org-tag-string-to-alist): (org-scan-tags): (org-make-tags-matcher): (org-fast-tag-selection): Use new variables. * lisp/org-agenda.el (org-agenda-list-stuck-projects): (org-agenda-format-item): (org-agenda-fix-displayed-tags): * lisp/org-archive.el (org-archive-subtree): Use new variables. --- lisp/org-agenda.el | 18 +++++++++--------- lisp/org-archive.el | 3 +-- lisp/org.el | 43 ++++++++++++++++++++++++++++--------------- 3 files changed, 38 insertions(+), 26 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index e2620a1df..7c74b9df1 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4995,14 +4995,14 @@ of what a project is and how to check if it stuck, customize the variable (format "^\\*+[ \t]+\\(%s\\)\\>" (mapconcat #'identity todo-wds "\\|")))) (tags-re (cond ((null tags) nil) - ((member "*" tags) - (eval-when-compile + ((member "*" tags) org-tag-line-re) + (tags + (let ((other-tags (format "\\(?:%s:\\)*" org-tag-re))) (concat org-outline-regexp-bol - ".*:[[:alnum:]_@#%]+:[ \t]*$"))) - (tags (concat org-outline-regexp-bol - ".*:\\(" - (mapconcat #'identity tags "\\|") - "\\):[[:alnum:]_@#%:]*[ \t]*$")) + ".*?[ \t]:" + other-tags + (regexp-opt tags t) + ":" other-tags "[ \t]*$"))) (t nil))) (re-list (delq nil (list todo-re tags-re gen-re))) (skip-re @@ -6522,7 +6522,7 @@ Any match of REMOVE-RE will be removed from TXT." (setq duration (- (org-duration-to-minutes s2) (org-duration-to-minutes s1))))) - (when (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt) + (when (string-match org-tag-group-re txt) ;; Tags are in the string (if (or (eq org-agenda-remove-tags t) (and org-agenda-remove-tags @@ -6597,7 +6597,7 @@ Any match of REMOVE-RE will be removed from TXT." The modified list may contain inherited tags, and tags matched by `org-agenda-hide-tags-regexp' will be removed." (when (or add-inherited hide-re) - (if (string-match "\\([ \t]+\\)\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" txt) + (if (string-match org-tag-group-re txt) (setq txt (substring txt 0 (match-beginning 0)))) (setq tags (delq nil diff --git a/lisp/org-archive.el b/lisp/org-archive.el index ca41616bc..385a1bf40 100644 --- a/lisp/org-archive.el +++ b/lisp/org-archive.el @@ -325,8 +325,7 @@ direct children of this heading." (if (and heading (not (and datetree-date (not datetree-subheading-p)))) (progn (if (re-search-forward - (concat "^" (regexp-quote heading) - "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)") + (concat "^" (regexp-quote heading) org-tag-group-re) nil t) (goto-char (match-end 0)) ;; Heading not found, just insert it at the end diff --git a/lisp/org.el b/lisp/org.el index f09148838..cde3f1951 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -520,6 +520,14 @@ but the stars and the body are.") An archived subtree does not open during visibility cycling, and does not contribute to the agenda listings.") +(defconst org-tag-re "[[:alnum:]_@#%]+" + "Regexp matching a single tag.") + +(defconst org-tag-group-re "[ \t]+\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$" + "Regexp matching the tag group at the end of a line, with leading spaces. +Tags are stored in match group 1. Match group 2 stores the tags +without the enclosing colons.") + (defconst org-tag-line-re "^\\*+ \\(?:.*[ \t]\\)?\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$" "Regexp matching tags in a headline. @@ -5109,8 +5117,7 @@ S is a value for TAGS keyword or produced with `org-tag-alist-to-string'. Return value is an alist suitable for `org-tag-alist' or `org-tag-persistent-alist'." (let ((lines (mapcar #'split-string (split-string s "\n" t))) - (tag-re (concat "\\`\\([[:alnum:]_@#%]+" - "\\|{.+?}\\)" ; regular expression + (tag-re (concat "\\`\\(" org-tag-re "\\|{.+?}\\)" ; regular expression "\\(?:(\\(.\\))\\)?\\'")) alist group-flag) (dolist (tokens lines (cdr (nreverse alist))) @@ -13627,9 +13634,8 @@ headlines matching this string." ;; Get the correct level to match (concat "\\*\\{" (number-to-string start-level) "\\} ") org-outline-regexp) - " *\\(\\<\\(" - (mapconcat #'regexp-quote org-todo-keywords-1 "\\|") - "\\)\\>\\)? *\\(.*?\\)\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*$")) + " *\\(" (regexp-opt org-todo-keywords-1 'words) "\\)?" + " *\\(.*?\\)\\([ \t]:\\(?:" org-tag-re ":\\)+\\)?[ \t]*$")) (props (list 'face 'default 'done-face 'org-agenda-done 'undone-face 'default @@ -13878,7 +13884,12 @@ See also `org-scan-tags'." 'org-tags-completion-function nil nil nil 'org-tags-history)))) (let ((match0 match) - (re "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)\\([<>=]\\{1,2\\}\\)\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)\\|[[:alnum:]_@#%]+\\)") + (re (concat + "^&?\\([-+:]\\)?\\({[^}]+}\\|LEVEL\\([<=>]\\{1,2\\}\\)" + "\\([0-9]+\\)\\|\\(\\(?:[[:alnum:]_]+\\(?:\\\\-\\)*\\)+\\)" + "\\([<>=]\\{1,2\\}\\)" + "\\({[^}]+}\\|\"[^\"]*\"\\|-?[.0-9]+\\(?:[eE][-+]?[0-9]+\\)?\\)" + "\\|" org-tag-re "\\)")) (start 0) tagsmatch todomatch tagsmatcher todomatcher) @@ -14626,15 +14637,17 @@ Returns the new tags string, or nil to not change the current settings." (delete-region (point) (point-at-eol)) (org-fast-tag-insert "Current" current c-face) (org-set-current-tags-overlay current ov-prefix) - (while (re-search-forward "\\[.\\] \\([[:alnum:]_@#%]+\\)" nil t) - (setq tg (match-string 1)) - (add-text-properties - (match-beginning 1) (match-end 1) - (list 'face - (cond - ((member tg current) c-face) - ((member tg inherited) i-face) - (t (get-text-property (match-beginning 1) 'face)))))) + (let ((tag-re (concat "\\[.\\] \\(" org-tag-re "\\)"))) + (while (re-search-forward tag-re nil t) + (let ((tag (match-string 1))) + (add-text-properties + (match-beginning 1) (match-end 1) + (list 'face + (cond + ((member tag current) c-face) + ((member tag inherited) i-face) + (t (get-text-property (match-beginning 1) ' + face)))))))) (goto-char (point-min))))) (delete-overlay org-tags-overlay) (if rtn -- 2.11.4.GIT