Factorize tags parsing

* lisp/org.el (org-tag-string-to-alist):
(org-tag-alist-to-string):
(org-tag-alist-to-groups): New functions.
(org-set-regexps-and-options): Use new functions.

(org--setup-process-tags): Remove function.

(org--setup-collect-keywords): Return tag groups as a string instead of
a list so as to be compatible with new functions.

* lisp/org-mobile.el (org-mobile-create-index-file): Use new functions.

* lisp/org-pcomplete.el (pcomplete/org-mode/file-option/tags): Use new
  functions.
(pcomplete/org-mode/tag): Small refactoring.

* testing/lisp/test-org.el (test-org/tag-string-to-alist):
(test-org/tag-alist-to-string):
(test-org/tag-alist-to-groups): New tests.

4 files changed, 159 insertions, 99 deletions

diff --git a/lisp/org-mobile.el b/lisp/org-mobile.el
index 2c8b852..9ceecc9 100644
--- a/lisp/org-mobile.el
+++ b/lisp/org-mobile.el
@@ -453,19 +453,7 @@ agenda view showing the flagged items."
       (when (or todo-kwds done-kwds)
 	(insert "#+TODO: " (mapconcat 'identity todo-kwds " ") " | "
 		(mapconcat 'identity done-kwds " ") "\n"))
-      (setq def-tags (mapcar
-		      (lambda (tag)
-			(cl-case (car tag)
-			  ((nil) nil)
-			  (:startgroup "{")
-			  (:endgroup "}")
-			  (:startgrouptag "[")
-			  (:endgrouptag "]")
-			  (:grouptags ":")
-			  (:newline nil)
-			  (t (car tag))))
-		      def-tags))
-      (setq def-tags (delq nil def-tags))
+      (setq def-tags (split-string (org-tag-alist-to-string def-tags t)))
       (setq tags (org-delete-all def-tags tags))
       (setq tags (sort tags (lambda (a b) (string< (downcase a) (downcase b)))))
       (setq tags (append def-tags tags nil))
diff --git a/lisp/org-pcomplete.el b/lisp/org-pcomplete.el
index aaff7c3..e652fe2 100644
--- a/lisp/org-pcomplete.el
+++ b/lisp/org-pcomplete.el
@@ -52,6 +52,7 @@
 
 (defvar org-drawer-regexp)
 (defvar org-property-re)
+(defvar org-tag-alist)
 
 (defun org-thing-at-point ()
   "Examine the thing at point and let the caller know what it is.
@@ -237,20 +238,10 @@ When completing for #+STARTUP, for example, this function returns
 		(setq opts (delete "showstars" opts)))))
 	    opts))))
 
-(defvar org-tag-alist)
 (defun pcomplete/org-mode/file-option/tags ()
   "Complete arguments for the #+TAGS file option."
   (pcomplete-here
-   (list
-    (mapconcat (lambda (x)
-		 (cond
-		  ((eq :startgroup (car x)) "{")
-		  ((eq :endgroup (car x)) "}")
-		  ((eq :grouptags (car x)) ":")
-		  ((eq :newline (car x)) "\\n")
-		  ((cdr x) (format "%s(%c)" (car x) (cdr x)))
-		  (t (car x))))
-	       org-tag-alist " "))))
+   (list (org-tag-alist-to-string org-tag-alist))))
 
 (defun pcomplete/org-mode/file-option/title ()
   "Complete arguments for the #+TITLE file option."
@@ -335,19 +326,16 @@ This needs more work, to handle headings with lots of spaces in them."
 	   (pcomplete-uniqify-list tbl)))
        (substring pcomplete-stub 1))))
 
-(defvar org-tag-alist)
 (defun pcomplete/org-mode/tag ()
   "Complete a tag name.  Omit tags already set."
   (while (pcomplete-here
-	  (mapcar (lambda (x)
-		    (concat x ":"))
+	  (mapcar (lambda (x) (concat x ":"))
 		  (let ((lst (pcomplete-uniqify-list
-			      (or (remove
+			      (or (remq
 				   nil
-				   (mapcar (lambda (x)
-					     (and (stringp (car x)) (car x)))
+				   (mapcar (lambda (x) (org-string-nw-p (car x)))
 					   org-tag-alist))
-				  (mapcar 'car (org-get-buffer-tags))))))
+				  (mapcar #'car (org-get-buffer-tags))))))
 		    (dolist (tag (org-get-tags))
 		      (setq lst (delete tag lst)))
 		    lst))
diff --git a/lisp/org.el b/lisp/org.el
index ba6a055..66ac7f6 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4901,8 +4901,13 @@ related expressions."
 				'("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS"
 				  "LINK" "OPTIONS" "PRIORITIES" "PROPERTY"
 				  "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO")))))))
-      (org--setup-process-tags
-       (cdr (assq 'tags alist)) (cdr (assq 'filetags alist)))
+      (setq-local org-file-tags
+		  (mapcar #'org-add-prop-inherited
+			  (cdr (assq 'filetags alist))))
+      (setq-local org-tag-alist
+		  (let ((tags (cdr (assq 'tags alist))))
+		    (if tags (org-tag-string-to-alist tags) org-tag-alist)))
+      (setq-local org-tag-groups-alist (org-tag-alist-to-groups org-tag-alist))
       (unless tags-only
 	;; File properties.
 	(setq-local org-file-properties (cdr (assq 'property alist)))
@@ -5120,11 +5125,8 @@ Return value contains the following keys: `archive', `category',
 	      ((equal key "TAGS")
 	       (let ((tag-cell (assq 'tags alist)))
 		 (if tag-cell
-		     (setcdr tag-cell
-			     (append (cdr tag-cell)
-				     '("\\n")
-				     (org-split-string value)))
-		   (push (cons 'tags (org-split-string value)) alist))))
+		     (setcdr tag-cell (concat (cdr tag-cell) "\n" value))
+		   (push (cons 'tags value) alist))))
 	      ((member key '("TODO" "SEQ_TODO" "TYP_TODO"))
 	       (let ((todo (assq 'todo alist))
 		     (value (cons (if (equal key "TYP_TODO") 'type 'sequence)
@@ -5148,67 +5150,93 @@ Return value contains the following keys: `archive', `category',
 				regexp (cons f files) alist)))))))))))))))
   alist)
 
-(defun org--setup-process-tags (tags filetags)
-  "Precompute variables used for tags.
-TAGS is a list of tags and tag group symbols, as strings.
-FILETAGS is a list of tags, as strings."
-  ;; Process the file tags.
-  (setq-local org-file-tags
-	      (mapcar #'org-add-prop-inherited filetags))
-  ;; Provide default tags if no local tags are found.
-  (when (and (not tags) org-tag-alist)
-    (setq tags
-	  (mapcar (lambda (tag)
-		    (cl-case (car tag)
-		      (:startgroup "{")
-		      (:endgroup "}")
-		      (:startgrouptag "[")
-		      (:endgrouptag "]")
-		      (:grouptags ":")
-		      (:newline "\\n")
-		      (otherwise (concat (car tag)
-					 (and (characterp (cdr tag))
-					      (format "(%c)" (cdr tag)))))))
-		  org-tag-alist)))
-  ;; Process the tags.
-  (setq-local org-tag-groups-alist nil)
-  (setq-local org-tag-alist nil)
-  (let (group-flag)
-    (while tags
-      (let ((e (car tags)))
-	(setq tags (cdr tags))
-	(cond
-	 ((equal e "{")
-	  (push '(:startgroup) org-tag-alist)
-	  (when (equal (nth 1 tags) ":") (setq group-flag t)))
-	 ((equal e "}")
-	  (push '(:endgroup) org-tag-alist)
-	  (setq group-flag nil))
-	 ((equal e "[")
-	  (push '(:startgrouptag) org-tag-alist)
-	  (when (equal (nth 1 tags) ":") (setq group-flag t)))
-	 ((equal e "]")
-	  (push '(:endgrouptag) org-tag-alist)
-	  (setq group-flag nil))
-	 ((equal e ":")
-	  (push '(:grouptags) org-tag-alist)
-	  (setq group-flag 'append))
-	 ((equal e "\\n") (push '(:newline) org-tag-alist))
-	 ((string-match
-	   (org-re (concat "\\`\\([[:alnum:]_@#%]+"
-			   "\\|{.+?}\\)" ; regular expression
-			   "\\(?:(\\(.\\))\\)?\\'")) e)
-	  (let ((tag (match-string 1 e))
-		(key (and (match-beginning 2)
-			  (string-to-char (match-string 2 e)))))
-	    (cond ((eq group-flag 'append)
-		   (setcar org-tag-groups-alist
-			   (append (car org-tag-groups-alist) (list tag))))
-		  (group-flag (push (list tag) org-tag-groups-alist)))
-	    ;; Push all tags in groups, no matter if they already exist.
-	    (unless (and (not group-flag) (assoc tag org-tag-alist))
-	      (push (cons tag key) org-tag-alist))))))))
-  (setq org-tag-alist (nreverse org-tag-alist)))
+(defun org-tag-string-to-alist (s)
+  "Return tag alist associated to string S.
+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
+			"\\(?:(\\(.\\))\\)?\\'"))
+	alist group-flag)
+    (dolist (tokens lines (cdr (nreverse alist)))
+      (push '(:newline) alist)
+      (while tokens
+	(let ((token (pop tokens)))
+	  (pcase token
+	    ("{"
+	     (push '(:startgroup) alist)
+	     (when (equal (nth 1 tokens) ":") (setq group-flag t)))
+	    ("}"
+	     (push '(:endgroup) alist)
+	     (setq group-flag nil))
+	    ("["
+	     (push '(:startgrouptag) alist)
+	     (when (equal (nth 1 tokens) ":") (setq group-flag t)))
+	    ("]"
+	     (push '(:endgrouptag) alist)
+	     (setq group-flag nil))
+	    (":"
+	     (push '(:grouptags) alist))
+	    ((guard (string-match tag-re token))
+	     (let ((tag (match-string 1 token))
+		   (key (and (match-beginning 2)
+			     (string-to-char (match-string 2 token)))))
+	       ;; Push all tags in groups, no matter if they already
+	       ;; appear somewhere else in the list.
+	       (when (or group-flag (not (assoc tag alist)))
+		 (push (cons tag key) alist))))))))))
+
+(defun org-tag-alist-to-string (alist &optional skip-key)
+  "Return tag string associated to ALIST.
+
+ALIST is an alist, as defined in `org-tag-alist' or
+`org-tag-persistent-alist', or produced with
+`org-tag-string-to-alist'.
+
+Return value is a string suitable as a value for \"TAGS\"
+keyword.
+
+When optional argument SKIP-KEY is non-nil, skip selection keys
+next to tags."
+  (mapconcat (lambda (token)
+	       (pcase token
+		 (`(:startgroup) "{")
+		 (`(:endgroup) "}")
+		 (`(:startgrouptag) "[")
+		 (`(:endgrouptag) "]")
+		 (`(:grouptags) ":")
+		 (`(:newline) "\\n")
+		 ((and
+		   (guard (not skip-key))
+		   `(,(and tag (pred stringp)) . ,(and key (pred characterp))))
+		  (format "%s(%c)" tag key))
+		 (`(,(and tag (pred stringp)) . ,_) tag)
+		 (_ (user-error "Invalid tag token: %S" token))))
+	     alist
+	     " "))
+
+(defun org-tag-alist-to-groups (alist)
+  "Return group alist from tag ALIST.
+ALIST is an alist, as defined in `org-tag-alist' or
+`org-tag-persistent-alist', or produced with
+`org-tag-string-to-alist'.  Return value is an alist following
+the pattern (GROUP-TAG TAGS) where GROUP-TAG is the tag, as
+a string, summarizing TAGS, as a list of strings."
+  (let (groups group-status current-group)
+    (dolist (token alist (nreverse groups))
+      (pcase token
+	(`(,(or :startgroup :startgrouptag)) (setq group-status t))
+	(`(,(or :endgroup :endgrouptag))
+	 (when (eq group-status 'append)
+	   (push (nreverse current-group) groups))
+	 (setq group-status nil))
+	(`(:grouptags) (setq group-status 'append))
+	((and `(,tag . ,_) (guard group-status))
+	 (if (eq group-status 'append) (push tag current-group)
+	   (setq current-group (list tag))))
+	(_ nil)))))
 
 (defun org-file-contents (file &optional noerror)
   "Return the contents of FILE, as a string."
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 7fa9898..197839d 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -4241,6 +4241,62 @@ Paragraph<point>"
      (org-invisible-p2))))
 
 
+;;; Tags
+
+(ert-deftest test-org/tag-string-to-alist ()
+  "Test `org-tag-string-to-alist' specifications."
+  ;; Tag without selection key.
+  (should (equal (org-tag-string-to-alist "tag1") '(("tag1"))))
+  ;; Tag with selection key.
+  (should (equal (org-tag-string-to-alist "tag1(t)") '(("tag1" . ?t))))
+  ;; Tag group.
+  (should
+   (equal
+    (org-tag-string-to-alist "[ group : t1 t2 ]")
+    '((:startgrouptag) ("group") (:grouptags) ("t1") ("t2") (:endgrouptag))))
+  ;; Mutually exclusive tags.
+  (should (equal (org-tag-string-to-alist "{ tag1 tag2 }")
+		 '((:startgroup) ("tag1") ("tag2") (:endgroup))))
+  (should
+   (equal
+    (org-tag-string-to-alist "{ group : tag1 tag2 }")
+    '((:startgroup) ("group") (:grouptags) ("tag1") ("tag2") (:endgroup)))))
+
+(ert-deftest test-org/tag-alist-to-string ()
+  "Test `org-tag-alist-to-string' specifications."
+  (should (equal (org-tag-alist-to-string '(("tag1"))) "tag1"))
+  (should (equal (org-tag-alist-to-string '(("tag1" . ?t))) "tag1(t)"))
+  (should
+   (equal
+    (org-tag-alist-to-string
+     '((:startgrouptag) ("group") (:grouptags) ("t1") ("t2") (:endgrouptag)))
+    "[ group : t1 t2 ]"))
+  (should
+   (equal (org-tag-alist-to-string
+	   '((:startgroup) ("tag1") ("tag2") (:endgroup)))
+	  "{ tag1 tag2 }"))
+  (should
+   (equal
+    (org-tag-alist-to-string
+     '((:startgroup) ("group") (:grouptags) ("tag1") ("tag2") (:endgroup)))
+    "{ group : tag1 tag2 }")))
+
+(ert-deftest test-org/tag-alist-to-groups ()
+  "Test `org-tag-alist-to-groups' specifications."
+  (should
+   (equal (org-tag-alist-to-groups
+	   '((:startgroup) ("group") (:grouptags) ("t1") ("t2") (:endgroup)))
+	  '(("group" "t1" "t2"))))
+  (should
+   (equal
+    (org-tag-alist-to-groups
+     '((:startgrouptag) ("group") (:grouptags) ("t1") ("t2") (:endgrouptag)))
+    '(("group" "t1" "t2"))))
+  (should-not
+   (org-tag-alist-to-groups
+    '((:startgroup) ("group") ("t1") ("t2") (:endgroup)))))
+
+
 ;;; Timestamps API
 
 (ert-deftest test-org/time-stamp ()