mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2025-01-09 15:50:59 +00:00
Code

org: Nesting grouptags

Browse Source 
* 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.
This commit is contained in:
Gustav Wikström 2015-01-24 02:47:47 +01:00 committed by Nicolas Goaziou
parent 6c6ae990c1
commit 8562bd09ec
2 changed files with 37 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
lisp/org.el
View File

@ -14530,7 +14530,7 @@ See also `org-scan-tags'.
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.
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))
(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)
;; @ and _ are allowed as word-components in tags.
(modify-syntax-entry ?@ "w" stable)
@ -14588,8 +14589,32 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(let* ((dir (match-string 1 return-match))
(tag (match-string 2 return-match))
(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))
(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)

10
testing/lisp/test-org.el
View File

@ -3174,6 +3174,16 @@ Text.
(org-match-sparse-tree nil "work")
(search-forward "H2")
(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
(should-not
(org-test-with-temp-text