Browse Source

org: Nesting grouptags

* lisp/org.el (org-tags-expand): Nesting grouptags.

  Allowing subtags to be defined as groups themselves.

  : #+TAGS: [ Group : SubOne(1) SubTwo ]
  : #+TAGS: [ SubOne : SubOne1 SubOne2 ]
  : #+TAGS: [ SubTwo : SubTwo1 SubTwo2 ]

  Should be seen as a tree of tags:
  - Group
    - SubOne
      - SubOne1
      - SubOne2
    - SubTwo
      - SubTwo1
      - SubTwo2

  Searching for "Group" should return all tags defined above.
Gustav Wikström 10 years ago
parent
commit
8562bd09ec
2 changed files with 37 additions and 2 deletions
  1. 27 2
      lisp/org.el
  2. 10 0
      testing/lisp/test-org.el

+ 27 - 2
lisp/org.el

@@ -14530,7 +14530,7 @@ See also `org-scan-tags'.
 			  matcher)))
 			  matcher)))
     (cons match0 matcher)))
     (cons match0 matcher)))
 
 
-(defun org-tags-expand (match &optional single-as-list downcased)
+(defun org-tags-expand (match &optional single-as-list downcased tags-already-expanded)
   "Expand group tags in MATCH.
   "Expand group tags in MATCH.
 
 
 This replaces every group tag in MATCH with a regexp tag search.
 This replaces every group tag in MATCH with a regexp tag search.
@@ -14571,6 +14571,7 @@ When DOWNCASE is non-nil, expand downcased TAGS."
 	     (taggroups-keys (mapcar #'car taggroups))
 	     (taggroups-keys (mapcar #'car taggroups))
 	     (return-match (if downcased (downcase match) match))
 	     (return-match (if downcased (downcase match) match))
 	     (count 0)
 	     (count 0)
+	     (work-already-expanded tags-already-expanded)
 	     regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped)
 	     regexps-in-match tags-in-group regexp-in-group regexp-in-group-escaped)
 	;; @ and _ are allowed as word-components in tags.
 	;; @ and _ are allowed as word-components in tags.
 	(modify-syntax-entry ?@ "w" stable)
 	(modify-syntax-entry ?@ "w" stable)
@@ -14588,8 +14589,32 @@ When DOWNCASE is non-nil, expand downcased TAGS."
 	  (let* ((dir (match-string 1 return-match))
 	  (let* ((dir (match-string 1 return-match))
 		 (tag (match-string 2 return-match))
 		 (tag (match-string 2 return-match))
 		 (tag (if downcased (downcase tag) tag)))
 		 (tag (if downcased (downcase tag) tag)))
-	    (when (not (get-text-property 0 'grouptag (match-string 2 return-match)))
+	    (unless (or (get-text-property 0 'grouptag (match-string 2 return-match))
+		        (member tag work-already-expanded))
 	      (setq tags-in-group (assoc tag taggroups))
 	      (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.
 	      ;; Filter tag-regexps from tags.
 	      (setq regexp-in-group-escaped
 	      (setq regexp-in-group-escaped
 		    (delq nil (mapcar (lambda (x)
 		    (delq nil (mapcar (lambda (x)

+ 10 - 0
testing/lisp/test-org.el

@@ -3174,6 +3174,16 @@ Text.
      (org-match-sparse-tree nil "work")
      (org-match-sparse-tree nil "work")
      (search-forward "H2")
      (search-forward "H2")
      (org-invisible-p2)))
      (org-invisible-p2)))
+  ;; Match tags in hierarchies
+  (should-not
+   (org-test-with-temp-text
+       "#+TAGS: [ Lev_1 : Lev_2 ]\n
+#+TAGS: [ Lev_2 : Lev_3 ]\n
+#+TAGS: { Lev_3 : Lev_4 }\n
+* H\n** H1 :Lev_1:\n** H2 :Lev_2:\n** H3 :Lev_3:\n** H4 :Lev_4:"
+     (org-match-sparse-tree nil "Lev_1")
+     (search-forward "H4")
+     (org-invisible-p2)))
   ;; Match regular expressions in tags
   ;; Match regular expressions in tags
   (should-not
   (should-not
    (org-test-with-temp-text
    (org-test-with-temp-text