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>

2 files changed, 116 insertions, 112 deletions

diff --git a/lisp/org.el b/lisp/org.el
index 33c8467..14029b7 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 3f5aa09..6fa6c65 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -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