summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2018-04-19 14:27:12 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2018-04-19 14:28:54 +0200
commitbe31a0c4595a6d68b03b5cfbcbcdbf2cd76d2b7f (patch)
treec69210a8a15b8c3c528a8456a1698dcb5ac04972
parentedc159c2f2b02b2dcb9b9ac11dc4588b53d653ee (diff)
downloadorg-mode-be31a0c4595a6d68b03b5cfbcbcdbf2cd76d2b7f.tar.gz
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.
-rw-r--r--lisp/org-agenda.el18
-rw-r--r--lisp/org-archive.el3
-rw-r--r--lisp/org.el43
3 files changed, 38 insertions, 26 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index e2620a1..7c74b9d 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 ca41616..385a1bf 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 f091488..cde3f19 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