Explorar el Código

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.
Nicolas Goaziou hace 6 años
padre
commit
be31a0c459
Se han modificado 3 ficheros con 38 adiciones y 26 borrados
  1. 9 9
      lisp/org-agenda.el
  2. 1 2
      lisp/org-archive.el
  3. 28 15
      lisp/org.el

+ 9 - 9
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\\)\\>"
 		       (format "^\\*+[ \t]+\\(%s\\)\\>"
 			       (mapconcat #'identity todo-wds "\\|"))))
 			       (mapconcat #'identity todo-wds "\\|"))))
 	 (tags-re (cond ((null tags) nil)
 	 (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
 			   (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)))
 			(t nil)))
 	 (re-list (delq nil (list todo-re tags-re gen-re)))
 	 (re-list (delq nil (list todo-re tags-re gen-re)))
 	 (skip-re
 	 (skip-re
@@ -6522,7 +6522,7 @@ Any match of REMOVE-RE will be removed from TXT."
 	    (setq duration (- (org-duration-to-minutes s2)
 	    (setq duration (- (org-duration-to-minutes s2)
 			      (org-duration-to-minutes s1)))))
 			      (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
 	  ;; Tags are in the string
 	  (if (or (eq org-agenda-remove-tags t)
 	  (if (or (eq org-agenda-remove-tags t)
 		  (and org-agenda-remove-tags
 		  (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
 The modified list may contain inherited tags, and tags matched by
 `org-agenda-hide-tags-regexp' will be removed."
 `org-agenda-hide-tags-regexp' will be removed."
   (when (or add-inherited hide-re)
   (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 txt (substring txt 0 (match-beginning 0))))
     (setq tags
     (setq tags
 	  (delq nil
 	  (delq nil

+ 1 - 2
lisp/org-archive.el

@@ -325,8 +325,7 @@ direct children of this heading."
 	      (if (and heading (not (and datetree-date (not datetree-subheading-p))))
 	      (if (and heading (not (and datetree-date (not datetree-subheading-p))))
 		  (progn
 		  (progn
 		    (if (re-search-forward
 		    (if (re-search-forward
-			 (concat "^" (regexp-quote heading)
-				 "[ \t]*\\(:[[:alnum:]_@#%:]+:\\)?[ \t]*\\($\\|\r\\)")
+			 (concat "^" (regexp-quote heading) org-tag-group-re)
 			 nil t)
 			 nil t)
 			(goto-char (match-end 0))
 			(goto-char (match-end 0))
 		      ;; Heading not found, just insert it at the end
 		      ;; Heading not found, just insert it at the end

+ 28 - 15
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
 An archived subtree does not open during visibility cycling, and does
 not contribute to the agenda listings.")
 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
 (defconst org-tag-line-re
   "^\\*+ \\(?:.*[ \t]\\)?\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$"
   "^\\*+ \\(?:.*[ \t]\\)?\\(:\\([[:alnum:]_@#%:]+\\):\\)[ \t]*$"
   "Regexp matching tags in a headline.
   "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-to-string'.  Return value is an alist suitable for
 `org-tag-alist' or `org-tag-persistent-alist'."
 `org-tag-alist' or `org-tag-persistent-alist'."
   (let ((lines (mapcar #'split-string (split-string s "\n" t)))
   (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)
 	alist group-flag)
     (dolist (tokens lines (cdr (nreverse alist)))
     (dolist (tokens lines (cdr (nreverse alist)))
@@ -13627,9 +13634,8 @@ headlines matching this string."
 			 ;; Get the correct level to match
 			 ;; Get the correct level to match
 			 (concat "\\*\\{" (number-to-string start-level) "\\} ")
 			 (concat "\\*\\{" (number-to-string start-level) "\\} ")
 		       org-outline-regexp)
 		       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
 	 (props (list 'face 'default
 		      'done-face 'org-agenda-done
 		      'done-face 'org-agenda-done
 		      'undone-face 'default
 		      'undone-face 'default
@@ -13878,7 +13884,12 @@ See also `org-scan-tags'."
 	     'org-tags-completion-function nil nil nil 'org-tags-history))))
 	     'org-tags-completion-function nil nil nil 'org-tags-history))))
 
 
   (let ((match0 match)
   (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)
 	(start 0)
 	tagsmatch todomatch tagsmatcher todomatcher)
 	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))
 		(delete-region (point) (point-at-eol))
 		(org-fast-tag-insert "Current" current c-face)
 		(org-fast-tag-insert "Current" current c-face)
 		(org-set-current-tags-overlay current ov-prefix)
 		(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)))))
 		(goto-char (point-min)))))
       (delete-overlay org-tags-overlay)
       (delete-overlay org-tags-overlay)
       (if rtn
       (if rtn