* [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
@ 2015-01-25 11:07 Gustav Wikström
2015-01-31 8:41 ` Nicolas Goaziou
0 siblings, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-01-25 11:07 UTC (permalink / raw)
To: Org Mode List
[-- Attachment #1: Type: text/plain, Size: 3490 bytes --]
Hi!
My name is Gustav and I'm a user of Orgmode since some time (..years)
now. I've made minor contributions to this list before but mostly in
discussions.
This time I've made some changes in the code. More specifically in how
tag groups function and would like them to be included in Orgmode.
I suppose an FSF-assignment signature is needed before it can be
included. I'll start with that process if this is something the
community can agree to include. But until then; please take it for a
ride. I've attached a file which can be used to test the
functionality. There are a few more things to do too; Like updating
the manual and improving the tag-selection UI. If you have the
interest, please look into that ;-). I suspect some might have
comments on the code too. The tag-expansion function, for example,
(`ORG-TAGS-EXPAND') has grown a bit..
The changes are listed below:
- Grouptags don't have to be unique on a headline if added with [ ]
instead of with { }:
,----
| #+TAGS: [ group : include1 included2 ]
`----
- Grouptags can have regular expressions as "sub-tags". The regular
expressions in the group must be marked up within { }. Example use:
,----
| #+TAGS: [ Project : {^P@.+} ]
`----
Searching for the tag Project will now list all tags also including
regular expression matches for ^P@.+. it is good, for example, if tags
for a certain project are tagged with a common project-identifier, i.e.
P@2014_OrgTags.
- Grouptags are not filtered when setting up tags (in
`ORG--SETUP-PROCESS-TAGS'). This means they can exist multiple times
in org-tag-alist. Will be usable if nesting of grouptags is ever
to become reality.
There is a slightly annoying side-effect when setting tags, in that a
tag which is both a part of a grouptag and is a grouptag of its own will
get multiple key-choices in the selection-UI. The whole selection-UI
could use some refactoring. Especially with the addition of the point
below.
- 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.
A new variable is defined `ORG-GROUP-TAGS-MAX-DEPTH' that is used to
limit the depth of recursion when expanding tags. It defaults to 2.
- Filtering in the agenda on grouptags should filter also subcategories.
Exception if filter is applied with a (double) prefix-argument.
Filtering in the agenda on subcategories should not filter the "above"
levels.
If a grouptag contains a regular expression the regular expression is
also used as a filter.
- `ORG-AGENDA-REDO' expands the tag-filters when redrawing the agenda.
It might be counterintuitive if a filter was applied with a double C-u
argument just before to *not* expand tags in the filter.
- Some bugs relating to grouptags have been fixed.
- When filtering on tags in the agenda after using a grouptag, it no
longer complains about wrong type.
- Regular expressions with tag-names inside are not affected by
group-expansion. Example:
,----
| #+TAGS: { Tag : Tag1 Tag2 }
| search expression: {Tag.*} now works predictably.
`----
I look forward to hearing what you think!
Best regards
Gustav
[-- Attachment #2: Testfile.org --]
[-- Type: application/octet-stream, Size: 3269 bytes --]
#+TITLE: Test of expanded Tag group functionality
#+BEGIN_SRC emacs-lisp
;New variable, tweak if needed
(setq org-group-tags-max-depth 2)
#+END_SRC
** Tags:PIM :PIM:
:PROPERTIES:
:CATEGORY: Tag
:END:
#+TAGS: [ PIM : Ref Persp Control ]
*** Reference information :Ref:
#+TAGS: [ Ref : CS Lang ]
**** CS :CS:
#+TAGS: [ CS : DB OS Software PLang Programming ]
***** PLang :PLang:
#+TAGS: { PLang : {^PLang@.+} }
**** Lang :Lang:
#+TAGS: [ Lang : Grammar En Ro Sv ]
*** Perspectives :Persp:
#+TAGS: { Persp : Vision Goal AOF Project }
**** Vision :Vision:
#+TAGS: { Vision : {^V@.+} }
**** Goal :Goal:
#+TAGS: { Goal : {^G@.+} }
**** Area of Focus :AOF:
#+TAGS: { AOF : {^AOF@.+} }
**** Project :Project:
#+TAGS: { Project : {^P@.+} }
***** Orgmode-project :OrgProj:
#+TAGS: { OrgProj : {P@Org_.+} }
*** Control :Control:
#+TAGS: [ Control : Context ]
**** Context :Context:
#+TAGS: [ Context : {^@.+} ]
** Test
:PROPERTIES:
:CATEGORY: Node
:END:
*** First article :Grammar:
*** Second article :PLang@Elisp:
*** Third article :Programming:
*** Forth article :Sv:
:LOGBOOK:
State "DONE" from "TODO" [2014-12-14 sön 07:47]
:END:
What the hell!?
*** TODO activity 1 :G@Test1:
SCHEDULED: <2014-12-10 ons>
*** TODO activity 2 :AOF@Test1:
SCHEDULED: <2014-12-22 mån>
*** TODO activity 3 :Vision:
DEADLINE: <2014-12-13 lör>
*** TODO activity 4 :Goal:
DEADLINE: <2014-12-23 tis>
*** TODO activity 5 :@home:P@Org_14grouptag:
SCHEDULED: <2014-12-10 ons>
*** TODO activity 6 :@errend:
SCHEDULED: <2014-12-22 mån>
*** TODO activity 7 :@errend:
DEADLINE: <2014-12-13 lör>
*** TODO activity 8 :@comp:
DEADLINE: <2014-12-23 tis>
*** TODO activity 9 :@home:P@Org_14grouptag:
:LOGBOOK:
- State "TODO" from "" [2015-01-19 Mon 00:21]
:END:
*** PROJECT Better grouptags for orgmode :P@Org_14grouptag:
[-- Attachment #3: 0001-Grouptags-not-unique-and-can-contain-regular-exp.patch --]
[-- Type: application/octet-stream, Size: 8791 bytes --]
From aa34ecd40f5b55c9bde9194183768a6d649f8bf0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:26 +0100
Subject: [PATCH 1/3] Grouptags; not unique and can contain regular exp
- Grouptags don't have to be unique on a headline if added with [ ]
instead of with { }: : [ group : include1 included2 ]
- Grouptags can have regular expressions as "sub-tags". The regular
expressions in the group must be marked up within { }. Example use:
: #+TAGS: [ Project : {P@.+} ]
Searching for the tag Project will now list all tags also including
regular expression matches for P@.+. Good for example if tags for a
certain project is tagged with a common project-identifier,
i.e. P@2014_OrgTags.
- Grouptags are not filtered when setting up tags (in
=ORG--SETUP-PROCESS-TAGS=). This means they can exist multiple times
in org-tag-alist list. Will be usable if nesting of grouptags is
ever to become reality.
There is a slightly annoying side-effect when setting tags in that a
tag which is both a part of a grouptag and a grouptag of it's own
will get multiple key-choices in the selection-UI.
---
lisp/org.el | 99 ++++++++++++++++++++++++++++++++++++++++++++++---------------
1 file changed, 75 insertions(+), 24 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index db2b6c0..05b7307 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -5217,6 +5217,8 @@ FILETAGS is a list of tags, as strings."
(case (car tag)
(:startgroup "{")
(:endgroup "}")
+ (:startgrouptags "[")
+ (:endgrouptags "]")
(:grouptags ":")
(:newline "\\n")
(otherwise (concat (car tag)
@@ -5237,12 +5239,20 @@ FILETAGS is a list of tags, as strings."
((equal e "}")
(push '(:endgroup) org-tag-alist)
(setq group-flag nil))
+ ((equal e "[")
+ (push '(:startgrouptags) org-tag-alist)
+ (when (equal (nth 1 tags) ":") (setq group-flag t)))
+ ((equal e "]")
+ (push '(:endgrouptags) 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 "\\`\\([[:alnum:]_@#%]+\\)\\(?:(\\(.\\))\\)?\\'") e)
+ (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)))))
@@ -5250,7 +5260,8 @@ FILETAGS is a list of tags, as strings."
(setcar org-tag-groups-alist
(append (car org-tag-groups-alist) (list tag))))
(group-flag (push (list tag) org-tag-groups-alist)))
- (unless (assoc tag org-tag-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)))
@@ -14544,32 +14555,63 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(if org-group-tags
(let* ((case-fold-search t)
(stable org-mode-syntax-table)
- (tal (or org-tag-groups-alist-for-agenda
- org-tag-groups-alist))
- (tal (if downcased
- (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
- (tml (mapcar 'car tal))
- (rtnmatch match) rpl)
+ (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)
+ 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)
(modify-syntax-entry ?_ "w" stable)
- (while (and tml
+ ;; Temporarily replace regexp-expressions in the match-expression
+ (while (string-match "{.+?}" return-match)
+ (setq count (1+ count))
+ (setq regexps-in-match (cons (match-string 0 return-match) regexps-in-match))
+ (setq return-match (replace-match (concat "<" (number-to-string count) ">") t nil return-match)))
+ (while (and taggroups-keys
(with-syntax-table stable
(string-match
(concat "\\(?1:[+-]?\\)\\(?2:\\<"
- (regexp-opt tml) "\\>\\)") rtnmatch)))
- (let* ((dir (match-string 1 rtnmatch))
- (tag (match-string 2 rtnmatch))
+ (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)))
- (setq tml (delete tag tml))
- (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
- (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
- (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
- (if (stringp rpl) (org-add-props rpl '(grouptag t)))
- (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (when (not (get-text-property 0 'grouptag (match-string 2 return-match)))
+ (setq tags-in-group (assoc tag taggroups))
+ ; Filter tag-regexps from tags
+ (setq regexp-in-group-escaped (delq nil (mapcar (lambda (x)
+ (if (stringp x)
+ (and (string-prefix-p "{" x)
+ (string-suffix-p "}" x)
+ 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 (string-prefix-p "{" x))
+ (not (string-suffix-p "}" x))
+ x)
+ x)) tags-in-group)))
+ ; If single-as-list, do no more in the while-loop...
+ (if (not single-as-list)
+ (progn
+ (if 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 "\\>}"))
+ (if (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 (concat "<" (number-to-string count) ">")
+ (pop regexps-in-match)
+ return-match t t))
+ (setq count (1- count)))
(if single-as-list
- (or (reverse rpl) (list rtnmatch))
- rtnmatch))
+ (if tags-in-group tags-in-group (list return-match))
+ return-match))
(if single-as-list (list (if downcased (downcase match) match))
match)))
@@ -15029,7 +15071,7 @@ Returns the new tags string, or nil to not change the current settings."
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
- groups ingroup)
+ groups ingroup intaggroup)
(save-excursion
(beginning-of-line 1)
(if (looking-at
@@ -15071,6 +15113,15 @@ Returns the new tags string, or nil to not change the current settings."
((equal (car e) :endgroup)
(setq ingroup nil cnt 0)
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((equal (car e) :startgrouptags)
+ (setq intaggroup t)
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "[ "))
+ ((equal (car e) :endgrouptags)
+ (setq intaggroup nil cnt 0)
+ (insert "]\n"))
((equal e '(:newline))
(when (not (= cnt 0))
(setq cnt 0)
@@ -15079,7 +15130,7 @@ Returns the new tags string, or nil to not change the current settings."
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) nil)
+ ((equal e '(:grouptags)) (insert " : "))
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -15102,13 +15153,13 @@ Returns the new tags string, or nil to not change the current settings."
((member tg inherited) i-face))))
(if (equal (caar tbl) :grouptags)
(org-add-props tg nil 'face 'org-tag-group))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (if (and (= cnt 0) (not ingroup) (not intaggroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
(when (= (setq cnt (1+ cnt)) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (if (or ingroup intaggroup) (insert " "))
(setq cnt 0)))))
(setq ntable (nreverse ntable))
(insert "\n")
--
1.9.1
[-- Attachment #4: 0002-Filtering-in-the-agenda-on-grouptags.patch --]
[-- Type: application/octet-stream, Size: 9471 bytes --]
From ceb2afd63880c6831f781d0adbb751a137104d2a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:35 +0100
Subject: [PATCH 2/3] Filtering in the agenda on grouptags
- Filtering in the agenda on grouptags should filter also
subcategories. Exception if filter is applied with a (double)
prefix-argument.
Filtering in the agenda on subcategories should not filter the
"above" levels.
If a grouptag contains a regular expression the regular expression
is also used as a filter.
---
lisp/org-agenda.el | 119 ++++++++++++++++++++++++++++-------------------------
1 file changed, 64 insertions(+), 55 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index ad4018d..96fecf9 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -7317,7 +7317,7 @@ in the agenda."
(cat (or cat-filter cat-preset))
(effort (or effort-filter effort-preset))
(re (or re-filter re-preset)))
- (when tag (org-agenda-filter-apply tag 'tag))
+ (when tag (org-agenda-filter-apply tag 'tag t))
(when cat (org-agenda-filter-apply cat 'category))
(when effort (org-agenda-filter-apply effort 'effort))
(when re (org-agenda-filter-apply re 'regexp)))
@@ -7439,13 +7439,16 @@ With two prefix arguments, remove the effort filters."
(org-agenda-filter-show-all-effort))
(org-agenda-finalize))
-(defun org-agenda-filter-by-tag (strip &optional char narrow)
+(defun org-agenda-filter-by-tag (arg &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
The tag is selected with its fast selection letter, as configured.
-With prefix argument STRIP, remove all lines that do have the tag.
-A lisp caller can specify CHAR. NARROW means that the new tag should be
-used to narrow the search - the interactive user can also press `-' or `+'
-to switch to narrowing."
+With a single `C-u' prefix ARG, exclude the agenda search. With a
+double `C-u' prefix ARG, filter the literal tag. I.e. don't filter on
+all its group members.
+
+A lisp caller can specify CHAR. EXCLUDE means that the new tag should be
+used to exclude the search - the interactive user can also press `-' or `+'
+to switch between filtering and excluding."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(tag-chars (mapconcat
@@ -7453,23 +7456,24 @@ to switch to narrowing."
(cdr x))
(char-to-string (cdr x))
""))
- alist ""))
+ org-tag-alist-for-agenda ""))
+ (exclude (if exclude exclude (equal arg '(4))))
+ (expand (not (equal arg '(16))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
a n tag)
(unless char
- (message
- "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow"
- (if narrow "Narrow" "Filter") tag-chars
- (if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char-exclusive)))
- (when (member char '(?+ ?-))
- ;; Narrowing down
- (cond ((equal char ?-) (setq strip t narrow t))
- ((equal char ?+) (setq strip nil narrow t)))
- (message
- "Narrow by tag [%s ], [TAB], [/]:off" tag-chars)
- (setq char (read-char-exclusive)))
+ (while (not (member char (append '(?\t ?\r ?/ ?. ?\ ?q)
+ (string-to-list tag-chars))))
+ (message
+ "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
+ (if exclude "Exclude" "Filter") tag-chars
+ (if org-agenda-auto-exclude-function "[RET], " "")
+ (if expand "" ", no grouptag expand"))
+ (setq char (read-char-exclusive))
+ ;; Excluding or filtering down
+ (cond ((equal char ?-) (setq exclude t))
+ ((equal char ?+) (setq exclude nil)))))
(when (equal char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
(org-set-local 'org-global-tags-completion-table
@@ -7487,25 +7491,26 @@ to switch to narrowing."
(if modifier
(push modifier org-agenda-tag-filter))))
(if (not (null org-agenda-tag-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
((equal char ?/)
(org-agenda-filter-show-all-tag)
(when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
((equal char ?. )
(setq org-agenda-tag-filter
(mapcar (lambda(tag) (concat "+" tag))
(org-get-at-bol 'tags)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ ((equal char ?q)) ;If q, abort (even if there is a q-key for a tag...)
((or (equal char ?\ )
(setq a (rassoc char alist))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-tag-filter
- (cons (concat (if strip "-" "+") tag)
- (if narrow current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (cons (concat (if exclude "-" "+") tag)
+ current))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
(t (error "Invalid tag selection character %c" char)))))
(defun org-agenda-get-represented-tags ()
@@ -7519,12 +7524,12 @@ to switch to narrowing."
(get-text-property (point) 'tags))))
tags))
-(defun org-agenda-filter-by-tag-refine (strip &optional char)
+(defun org-agenda-filter-by-tag-refine (arg &optional char)
"Refine the current filter. See `org-agenda-filter-by-tag'."
(interactive "P")
- (org-agenda-filter-by-tag strip char 'refine))
+ (org-agenda-filter-by-tag arg char 'refine))
-(defun org-agenda-filter-make-matcher (filter type)
+(defun org-agenda-filter-make-matcher (filter type &optional expand)
"Create the form that tests a line for agenda filter."
(let (f f1)
(cond
@@ -7534,27 +7539,13 @@ to switch to narrowing."
(delete-dups
(append (get 'org-agenda-tag-filter :preset-filter)
filter)))
+ ;(if expand (setq filter (org-agenda-filter-expand-tags filter)))
(dolist (x filter)
- (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
- (ffunc
- (lambda (nf0 nf01 fltr notgroup op)
- (dolist (x fltr)
- (if (member x '("-" "+"))
- (setq nf01 (if (equal x "-") 'tags '(not tags)))
- (setq nf01 (list 'member (downcase (substring x 1))
- 'tags))
- (when (equal (string-to-char x) ?-)
- (setq nf01 (list 'not nf01))
- (when (not notgroup) (setq op 'and))))
- (push nf01 nf0))
- (if notgroup
- (push (cons 'and nf0) f)
- (push (cons (or op 'or) nf0) f)))))
- (cond ((equal filter '("+"))
- (setq f (list (list 'not 'tags))))
- ((equal nfilter filter)
- (funcall ffunc f1 f filter t nil))
- (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ (let ((op (string-to-char x)))
+ (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
+ (setq x (list x)))
+ (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
+ (push f1 f))))
;; Category filter
((eq type 'category)
(setq filter
@@ -7587,6 +7578,28 @@ to switch to narrowing."
(push (org-agenda-filter-effort-form x) f))))
(cons 'and (nreverse f))))
+(defun org-agenda-filter-make-matcher-tag-exp (tags op)
+ (let (f f1) ;f = return expression. f1 = working-area
+ (dolist (x tags)
+ (let* ((tag (substring x 1))
+ (isregexp (and (string-prefix-p "{" tag)
+ (string-suffix-p "}" tag)))
+ regexp)
+ (cond
+ (isregexp
+ (setq regexp (substring tag 1 -1))
+ (setq f1 (list 'string-match regexp '(apply 'concat tags))))
+ (t
+ (setq f1 (list 'member (downcase tag) 'tags))
+ (when (equal op ?-)
+ (setq f1 (list 'not f1))))))
+ (push f1 f))
+ ; any of the expressions can match if op = +
+ ; all must match if the operator is -. All o
+ (if (equal op ?-)
+ (cons 'and f)
+ (cons 'or f))))
+
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
E looks like \"+<2:25\"."
@@ -7625,12 +7638,12 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(reverse rtn))
filter))
-(defun org-agenda-filter-apply (filter type)
+(defun org-agenda-filter-apply (filter type &optional expand)
"Set FILTER as the new agenda filter and apply it."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
(let (tags cat txt)
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand))
;; Only set `org-agenda-filtered-by-category' to t when a unique
;; category is used as the filter:
(setq org-agenda-filtered-by-category
@@ -7642,11 +7655,7 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags ; used in eval
- (apply 'append
- (mapcar (lambda (f)
- (org-agenda-filter-expand-tags (list f) t))
- (org-get-at-bol 'tags)))
+ (setq tags (org-get-at-bol 'tags)
cat (org-get-at-eol 'org-category 1)
txt (org-get-at-eol 'txt 1))
(if (not (eval org-agenda-filter-form))
--
1.9.1
[-- Attachment #5: 0003-Nesting-grouptags.patch --]
[-- Type: application/octet-stream, Size: 3685 bytes --]
From 862518eb620ba95899b2e92dc4ad5fdeb5b5faa5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:47 +0100
Subject: [PATCH 3/3] Nesting grouptags
- 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.
A new variable is defined =ORG-GROUP-TAGS-MAX-DEPTH= that is used to
limit the depth of recursion when expanding tags. It defaults to 2.
Conflicts:
lisp/org.el
---
lisp/org.el | 27 ++++++++++++++++++++++++++-
1 file changed, 26 insertions(+), 1 deletion(-)
diff --git a/lisp/org.el b/lisp/org.el
index 05b7307..f4d93fb 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -4929,6 +4929,12 @@ This can be turned on/off through `org-toggle-tags-groups'."
:group 'org-startup
:type 'boolean)
+(defcustom org-group-tags-max-depth 2
+ "Specifies the maximum recursive depth tags will be
+expanded. Only applies if org-group-tags is activated."
+ :group 'org-tags
+ :type 'integer)
+
(defvar org-inhibit-startup nil) ; Dynamically-scoped param.
(defun org-toggle-tags-groups ()
@@ -14528,7 +14534,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 recursion-level)
"Expand group tags in MATCH.
This replaces every group tag in MATCH with a regexp tag search.
@@ -14579,6 +14585,20 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(tag (if downcased (downcase tag) tag)))
(when (not (get-text-property 0 'grouptag (match-string 2 return-match)))
(setq tags-in-group (assoc tag taggroups))
+ ; Recursively expand each tag in the group, if there are
+ ; nested groups and org-group-tags-max-depth allows it
+ (if (or (not recursion-level)
+ (> org-group-tags-max-depth recursion-level))
+ (let ((lvl (if recursion-level (1+ recursion-level) 1))
+ tags-expanded-in-group)
+ (dolist (x (cdr tags-in-group))
+ (if (member x taggroups-keys)
+ ;(match &optional single-as-list downcased recursion-level)
+ (setq tags-expanded-in-group (append (org-tags-expand x t downcased lvl)
+ tags-expanded-in-group))
+ (setq tags-expanded-in-group (append (list x) tags-expanded-in-group))))
+ (setq tags-in-group (cons (car tags-in-group)
+ tags-expanded-in-group))))
; Filter tag-regexps from tags
(setq regexp-in-group-escaped (delq nil (mapcar (lambda (x)
(if (stringp x)
@@ -14600,6 +14620,11 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(setq regexp-in-group (concat "\\|" (mapconcat 'identity regexp-in-group "\\|"))))
(setq tags-in-group (concat dir "{\\<" (regexp-opt tags-in-group) regexp-in-group "\\>}"))
(if (stringp tags-in-group) (org-add-props tags-in-group '(grouptag t)))
+ ;; Redo the regexp-match because the recursive calls seems to mess it up...
+ (with-syntax-table stable
+ (string-match
+ (concat "\\(?1:[+-]?\\)\\(?2:\\<"
+ (regexp-opt taggroups-keys) "\\>\\)") return-match))
(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))))
--
1.9.1
^ permalink raw reply related [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-01-25 11:07 Gustav Wikström
@ 2015-01-31 8:41 ` Nicolas Goaziou
2015-02-19 20:00 ` Gustav Wikström
0 siblings, 1 reply; 23+ messages in thread
From: Nicolas Goaziou @ 2015-01-31 8:41 UTC (permalink / raw)
To: Gustav Wikström; +Cc: Org Mode List
Hello,
Gustav Wikström <gustav.erik@gmail.com> writes:
> This time I've made some changes in the code. More specifically in how
> tag groups function and would like them to be included in Orgmode.
Thank you.
>
> I suppose an FSF-assignment signature is needed before it can be
> included.
Indeed.
> I'll start with that process if this is something the
> community can agree to include. But until then; please take it for a
> ride.
OK. Some comments follow.
> The changes are listed below:
>
> - Grouptags don't have to be unique on a headline if added with [ ]
> instead of with { }:
> ,----
> | #+TAGS: [ group : include1 included2 ]
> `----
I'd rather not introduce yet another syntax for group tags. IIUC, the
current one (with curly braces) can be extended.
Also, I don't get the "have to be unique on a headline" part.
> - Grouptags can have regular expressions as "sub-tags". The regular
> expressions in the group must be marked up within { }. Example use:
>
> ,----
> | #+TAGS: [ Project : {^P@.+} ]
> `----
>
> Searching for the tag Project will now list all tags also including
> regular expression matches for ^P@.+. it is good, for example, if tags
> for a certain project are tagged with a common project-identifier, i.e.
> P@2014_OrgTags.
This seems an interesting addition.
> - 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.
OK.
> A new variable is defined `ORG-GROUP-TAGS-MAX-DEPTH' that is used to
> limit the depth of recursion when expanding tags. It defaults to 2.
I don't think this variable is necessary. However, a check for circular
inclusions would be necessary.
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-01-31 8:41 ` Nicolas Goaziou
@ 2015-02-19 20:00 ` Gustav Wikström
2015-02-24 16:43 ` Nicolas Goaziou
0 siblings, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-02-19 20:00 UTC (permalink / raw)
To: Gustav Wikström, Org Mode List
[-- Attachment #1: Type: text/plain, Size: 1678 bytes --]
Hi again! The FSA-assignment is now complete. New patches are attached
and comments below.
On Sat, Jan 31, 2015 at 9:41 AM, Nicolas Goaziou <mail@nicolasgoaziou.fr> wrote:
>> I suppose an FSF-assignment signature is needed before it can be
>> included.
> Indeed.
Marked as done now, as stated above :-)
>> - Grouptags don't have to be unique on a headline if added with [ ]
>> instead of with { }: ,---- | #+TAGS: [ group : include1 included2 ]
>> `----
> I'd rather not introduce yet another syntax for group tags. IIUC, the
> current one (with curly braces) can be extended.
> Also, I don't get the "have to be unique on a headline" part.
The reason for the use of [ ] is because { } already has another purpose
- it is used to make the tags within { } exclusive.
this example
,----
| #+TAGS: { group : include1 include2 }
`----
will only allow one of the tags on any specific headline. [ ] solves
this. Note that grouptags doesn't care if { } or [ ] is used. The only
difference is the exclusiveness. I.e both
,----
| #+TAGS: [ group : include1 include2 ]
| #+TAGS: { group : include1 include2 }
`----
will work. With some limitations on the second example due to the way {
} works since before.
>> A new variable is defined `ORG-GROUP-TAGS-MAX-DEPTH' that is used
>> to limit the depth of recursion when expanding tags. It defaults to
>> 2.
> I don't think this variable is necessary. However, a check for
> circular inclusions would be necessary.
Indeed. The variable is removed and the function `org-tags-expand' now
handles circular definitions with grace ;-)
Best regards
Gustav Wikström
[-- Attachment #2: 0001-org-Grouptags-not-unique-and-can-contain-regexp.patch --]
[-- Type: application/octet-stream, Size: 9187 bytes --]
From db680619c0bee593d6f15bdd96862bbf817cd2a4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:26 +0100
Subject: [PATCH 1/3] org: Grouptags not unique and can contain regexp
* lisp/org.el (org--setup-process-tags):
(org-fast-tag-selection):
Grouptags had to previously be defined with { }. This syntax is
already used for exclusive tags and Grouptags need their own,
non-exclusive syntax. This behaviour is achieved with [ ]
instead. Note: { } can still be used also for Grouptags but then
only one of the given tags can be used on the headline at the same
time. Example:
[ group : include1 included2 ]
* lisp/org.el (org--setup-process-tags):
(org-tags-expand):
Grouptags can have regular expressions as
"sub-tags". The regular expressions in the group must be marked up
within { }. Example use:
: #+TAGS: [ Project : {P@.+} ]
Searching for the tag Project will now list all tags also including
regular expression matches for P@.+. Good for example if tags for a
certain project is tagged with a common project-identifier,
i.e. P@2014_OrgTags.
* lisp/org.el (org--setup-process-tags):
Grouptags are not filtered when setting up tags. This means they can
exist multiple times in org-tag-alist list. Will be usable if
nesting of grouptags is ever to become reality.
There is a slightly annoying side-effect when setting tags in that a
tag which is both a part of a grouptag and a grouptag of it's own
will get multiple key-choices in the selection-UI.
---
lisp/org.el | 99 ++++++++++++++++++++++++++++++++++++++++++++++---------------
1 file changed, 75 insertions(+), 24 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index 3107e70..6bb8edf 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -5219,6 +5219,8 @@ FILETAGS is a list of tags, as strings."
(case (car tag)
(:startgroup "{")
(:endgroup "}")
+ (:startgrouptags "[")
+ (:endgrouptags "]")
(:grouptags ":")
(:newline "\\n")
(otherwise (concat (car tag)
@@ -5239,12 +5241,20 @@ FILETAGS is a list of tags, as strings."
((equal e "}")
(push '(:endgroup) org-tag-alist)
(setq group-flag nil))
+ ((equal e "[")
+ (push '(:startgrouptags) org-tag-alist)
+ (when (equal (nth 1 tags) ":") (setq group-flag t)))
+ ((equal e "]")
+ (push '(:endgrouptags) 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 "\\`\\([[:alnum:]_@#%]+\\)\\(?:(\\(.\\))\\)?\\'") e)
+ (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)))))
@@ -5252,7 +5262,8 @@ FILETAGS is a list of tags, as strings."
(setcar org-tag-groups-alist
(append (car org-tag-groups-alist) (list tag))))
(group-flag (push (list tag) org-tag-groups-alist)))
- (unless (assoc tag org-tag-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)))
@@ -14559,32 +14570,63 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(if org-group-tags
(let* ((case-fold-search t)
(stable org-mode-syntax-table)
- (tal (or org-tag-groups-alist-for-agenda
- org-tag-groups-alist))
- (tal (if downcased
- (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
- (tml (mapcar 'car tal))
- (rtnmatch match) rpl)
+ (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)
+ 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)
(modify-syntax-entry ?_ "w" stable)
- (while (and tml
+ ;; Temporarily replace regexp-expressions in the match-expression
+ (while (string-match "{.+?}" return-match)
+ (setq count (1+ count))
+ (setq regexps-in-match (cons (match-string 0 return-match) regexps-in-match))
+ (setq return-match (replace-match (concat "<" (number-to-string count) ">") t nil return-match)))
+ (while (and taggroups-keys
(with-syntax-table stable
(string-match
(concat "\\(?1:[+-]?\\)\\(?2:\\<"
- (regexp-opt tml) "\\>\\)") rtnmatch)))
- (let* ((dir (match-string 1 rtnmatch))
- (tag (match-string 2 rtnmatch))
+ (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)))
- (setq tml (delete tag tml))
- (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
- (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
- (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
- (if (stringp rpl) (org-add-props rpl '(grouptag t)))
- (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (when (not (get-text-property 0 'grouptag (match-string 2 return-match)))
+ (setq tags-in-group (assoc tag taggroups))
+ ; Filter tag-regexps from tags
+ (setq regexp-in-group-escaped (delq nil (mapcar (lambda (x)
+ (if (stringp x)
+ (and (string-prefix-p "{" x)
+ (string-suffix-p "}" x)
+ 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 (string-prefix-p "{" x))
+ (not (string-suffix-p "}" x))
+ x)
+ x)) tags-in-group)))
+ ; If single-as-list, do no more in the while-loop...
+ (if (not single-as-list)
+ (progn
+ (if 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 "\\>}"))
+ (if (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 (concat "<" (number-to-string count) ">")
+ (pop regexps-in-match)
+ return-match t t))
+ (setq count (1- count)))
(if single-as-list
- (or (reverse rpl) (list rtnmatch))
- rtnmatch))
+ (if tags-in-group tags-in-group (list return-match))
+ return-match))
(if single-as-list (list (if downcased (downcase match) match))
match)))
@@ -15044,7 +15086,7 @@ Returns the new tags string, or nil to not change the current settings."
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
- groups ingroup)
+ groups ingroup intaggroup)
(save-excursion
(beginning-of-line 1)
(if (looking-at
@@ -15086,6 +15128,15 @@ Returns the new tags string, or nil to not change the current settings."
((equal (car e) :endgroup)
(setq ingroup nil cnt 0)
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((equal (car e) :startgrouptags)
+ (setq intaggroup t)
+ (when (not (= cnt 0))
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "[ "))
+ ((equal (car e) :endgrouptags)
+ (setq intaggroup nil cnt 0)
+ (insert "]\n"))
((equal e '(:newline))
(when (not (= cnt 0))
(setq cnt 0)
@@ -15094,7 +15145,7 @@ Returns the new tags string, or nil to not change the current settings."
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) nil)
+ ((equal e '(:grouptags)) (insert " : "))
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -15117,13 +15168,13 @@ Returns the new tags string, or nil to not change the current settings."
((member tg inherited) i-face))))
(if (equal (caar tbl) :grouptags)
(org-add-props tg nil 'face 'org-tag-group))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (if (and (= cnt 0) (not ingroup) (not intaggroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
(when (= (setq cnt (1+ cnt)) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (if (or ingroup intaggroup) (insert " "))
(setq cnt 0)))))
(setq ntable (nreverse ntable))
(insert "\n")
--
1.9.1
[-- Attachment #3: 0002-org-agenda-Filtering-in-the-agenda-on-grouptags.patch --]
[-- Type: application/octet-stream, Size: 11591 bytes --]
From c5edd23d8fdb965c0753c24bb0f7d873bab24c34 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:35 +0100
Subject: [PATCH 2/3] org-agenda: Filtering in the agenda on grouptags
* lisp/org-agenda.el:
(overview)
Filtering in the agenda on grouptags filter also
subcategories. Exception if filter is applied with a (double)
prefix-argument.
Filtering in the agenda on subcategories does not filter the "above"
levels anymore.
If a grouptag contains a regular expression the regular expression
is also used as a filter.
(details)
- (org-agenda-filter-by-tag): improved UI and refactoring. Now uses
the argument arg and optional argument exclude instead of strip
and narrow. ARG because the argument has multiple purposes and
makes more sense than strip now. The term narrowing is changed to
exclude.
- (org-agenda-filter-by-tag-refine): name change in argument to
match org-agenda-filter-by-tag.
- (org-agenda-filter-make-matcher): new optional argument EXPAND and
refactoring
- (org-agenda-filter-make-matcher-tag-exp): new function, previously
baked into org-agenda-filter-make-matcher.
- (org-agenda-filter-apply): New optional parameter EXPAND, used in
call to org-agenda-filter-make-matcher.
- (org-agenda-reapply-filters): Uses another parameter (the new
optional one) in call to org-agenda-filter-apply
- (org-agenda-finalize): use of new parameter in call to org-agenda-filter-apply
- (org-agenda-redo): Use of new parameter in call to org-agenda-filter-apply
---
lisp/org-agenda.el | 125 ++++++++++++++++++++++++++++-------------------------
1 file changed, 67 insertions(+), 58 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 9f2d9d1..6a2f2c4 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -3761,10 +3761,10 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-agenda-filter-top-headline-apply
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
(when (get 'org-agenda-tag-filter :preset-filter)
(org-agenda-filter-apply
- (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (get 'org-agenda-tag-filter :preset-filter) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
(when (get 'org-agenda-category-filter :preset-filter)
@@ -7333,7 +7333,7 @@ in the agenda."
(cat (or cat-filter cat-preset))
(effort (or effort-filter effort-preset))
(re (or re-filter re-preset)))
- (when tag (org-agenda-filter-apply tag 'tag))
+ (when tag (org-agenda-filter-apply tag 'tag t))
(when cat (org-agenda-filter-apply cat 'category))
(when effort (org-agenda-filter-apply effort 'effort))
(when re (org-agenda-filter-apply re 'regexp)))
@@ -7455,13 +7455,16 @@ With two prefix arguments, remove the effort filters."
(org-agenda-filter-show-all-effort))
(org-agenda-finalize))
-(defun org-agenda-filter-by-tag (strip &optional char narrow)
+(defun org-agenda-filter-by-tag (arg &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
The tag is selected with its fast selection letter, as configured.
-With prefix argument STRIP, remove all lines that do have the tag.
-A lisp caller can specify CHAR. NARROW means that the new tag should be
-used to narrow the search - the interactive user can also press `-' or `+'
-to switch to narrowing."
+With a single `C-u' prefix ARG, exclude the agenda search. With a
+double `C-u' prefix ARG, filter the literal tag. I.e. don't filter on
+all its group members.
+
+A lisp caller can specify CHAR. EXCLUDE means that the new tag should be
+used to exclude the search - the interactive user can also press `-' or `+'
+to switch between filtering and excluding."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(tag-chars (mapconcat
@@ -7469,23 +7472,24 @@ to switch to narrowing."
(cdr x))
(char-to-string (cdr x))
""))
- alist ""))
+ org-tag-alist-for-agenda ""))
+ (exclude (if exclude exclude (equal arg '(4))))
+ (expand (not (equal arg '(16))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
a n tag)
(unless char
- (message
- "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow"
- (if narrow "Narrow" "Filter") tag-chars
- (if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char-exclusive)))
- (when (member char '(?+ ?-))
- ;; Narrowing down
- (cond ((equal char ?-) (setq strip t narrow t))
- ((equal char ?+) (setq strip nil narrow t)))
- (message
- "Narrow by tag [%s ], [TAB], [/]:off" tag-chars)
- (setq char (read-char-exclusive)))
+ (while (not (member char (append '(?\t ?\r ?/ ?. ?\ ?q)
+ (string-to-list tag-chars))))
+ (message
+ "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
+ (if exclude "Exclude" "Filter") tag-chars
+ (if org-agenda-auto-exclude-function "[RET], " "")
+ (if expand "" ", no grouptag expand"))
+ (setq char (read-char-exclusive))
+ ;; Excluding or filtering down
+ (cond ((equal char ?-) (setq exclude t))
+ ((equal char ?+) (setq exclude nil)))))
(when (equal char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
(org-set-local 'org-global-tags-completion-table
@@ -7503,25 +7507,26 @@ to switch to narrowing."
(if modifier
(push modifier org-agenda-tag-filter))))
(if (not (null org-agenda-tag-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
((equal char ?/)
(org-agenda-filter-show-all-tag)
(when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
((equal char ?. )
(setq org-agenda-tag-filter
(mapcar (lambda(tag) (concat "+" tag))
(org-get-at-bol 'tags)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ ((equal char ?q)) ;If q, abort (even if there is a q-key for a tag...)
((or (equal char ?\ )
(setq a (rassoc char alist))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-tag-filter
- (cons (concat (if strip "-" "+") tag)
- (if narrow current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (cons (concat (if exclude "-" "+") tag)
+ current))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
(t (error "Invalid tag selection character %c" char)))))
(defun org-agenda-get-represented-tags ()
@@ -7535,12 +7540,12 @@ to switch to narrowing."
(get-text-property (point) 'tags))))
tags))
-(defun org-agenda-filter-by-tag-refine (strip &optional char)
+(defun org-agenda-filter-by-tag-refine (arg &optional char)
"Refine the current filter. See `org-agenda-filter-by-tag'."
(interactive "P")
- (org-agenda-filter-by-tag strip char 'refine))
+ (org-agenda-filter-by-tag arg char 'refine))
-(defun org-agenda-filter-make-matcher (filter type)
+(defun org-agenda-filter-make-matcher (filter type &optional expand)
"Create the form that tests a line for agenda filter."
(let (f f1)
(cond
@@ -7550,27 +7555,13 @@ to switch to narrowing."
(delete-dups
(append (get 'org-agenda-tag-filter :preset-filter)
filter)))
+ ;(if expand (setq filter (org-agenda-filter-expand-tags filter)))
(dolist (x filter)
- (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
- (ffunc
- (lambda (nf0 nf01 fltr notgroup op)
- (dolist (x fltr)
- (if (member x '("-" "+"))
- (setq nf01 (if (equal x "-") 'tags '(not tags)))
- (setq nf01 (list 'member (downcase (substring x 1))
- 'tags))
- (when (equal (string-to-char x) ?-)
- (setq nf01 (list 'not nf01))
- (when (not notgroup) (setq op 'and))))
- (push nf01 nf0))
- (if notgroup
- (push (cons 'and nf0) f)
- (push (cons (or op 'or) nf0) f)))))
- (cond ((equal filter '("+"))
- (setq f (list (list 'not 'tags))))
- ((equal nfilter filter)
- (funcall ffunc f1 f filter t nil))
- (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ (let ((op (string-to-char x)))
+ (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
+ (setq x (list x)))
+ (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
+ (push f1 f))))
;; Category filter
((eq type 'category)
(setq filter
@@ -7603,6 +7594,28 @@ to switch to narrowing."
(push (org-agenda-filter-effort-form x) f))))
(cons 'and (nreverse f))))
+(defun org-agenda-filter-make-matcher-tag-exp (tags op)
+ (let (f f1) ;f = return expression. f1 = working-area
+ (dolist (x tags)
+ (let* ((tag (substring x 1))
+ (isregexp (and (string-prefix-p "{" tag)
+ (string-suffix-p "}" tag)))
+ regexp)
+ (cond
+ (isregexp
+ (setq regexp (substring tag 1 -1))
+ (setq f1 (list 'string-match regexp '(apply 'concat tags))))
+ (t
+ (setq f1 (list 'member (downcase tag) 'tags))))
+ (when (equal op ?-)
+ (setq f1 (list 'not f1))))
+ (push f1 f))
+ ; any of the expressions can match if op = +
+ ; all must match if the operator is -. All o
+ (if (equal op ?-)
+ (cons 'and f)
+ (cons 'or f))))
+
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
E looks like \"+<2:25\"."
@@ -7641,12 +7654,12 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(reverse rtn))
filter))
-(defun org-agenda-filter-apply (filter type)
+(defun org-agenda-filter-apply (filter type &optional expand)
"Set FILTER as the new agenda filter and apply it."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
(let (tags cat txt)
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand))
;; Only set `org-agenda-filtered-by-category' to t when a unique
;; category is used as the filter:
(setq org-agenda-filtered-by-category
@@ -7658,11 +7671,7 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags ; used in eval
- (apply 'append
- (mapcar (lambda (f)
- (org-agenda-filter-expand-tags (list f) t))
- (org-get-at-bol 'tags)))
+ (setq tags (org-get-at-bol 'tags)
cat (org-get-at-eol 'org-category 1)
txt (org-get-at-eol 'txt 1))
(if (not (eval org-agenda-filter-form))
@@ -9977,7 +9986,7 @@ current HH:MM time."
(defun org-agenda-reapply-filters ()
"Re-apply all agenda filters."
(mapcar
- (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
`((,org-agenda-tag-filter tag)
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
--
1.9.1
[-- Attachment #4: 0003-org-Nesting-grouptags.patch --]
[-- Type: application/octet-stream, Size: 3760 bytes --]
From a537e4fe76c967db35923c02cae7902b04be788c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:47 +0100
Subject: [PATCH 3/3] 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.
---
lisp/org.el | 25 +++++++++++++++++++++++--
1 file changed, 23 insertions(+), 2 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index 6bb8edf..5c80238 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -14543,7 +14543,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.
@@ -14575,6 +14575,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)
@@ -14592,8 +14593,23 @@ 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)))
+ (when (and (not (get-text-property 0 'grouptag (match-string 2 return-match)))
+ (not (member tag work-already-expanded)))
(setq tags-in-group (assoc tag taggroups))
+ (setq work-already-expanded (append (list tag) work-already-expanded))
+ ; Recursively expand each tag in the group, if the tag hasn't
+ ; already been expanded
+ (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)
@@ -14615,6 +14631,11 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(setq regexp-in-group (concat "\\|" (mapconcat 'identity regexp-in-group "\\|"))))
(setq tags-in-group (concat dir "{\\<" (regexp-opt tags-in-group) regexp-in-group "\\>}"))
(if (stringp tags-in-group) (org-add-props tags-in-group '(grouptag t)))
+ ;; Redo the regexp-match because the recursive calls seems to mess it up...
+ (with-syntax-table stable
+ (string-match
+ (concat "\\(?1:[+-]?\\)\\(?2:\\<"
+ (regexp-opt taggroups-keys) "\\>\\)") return-match))
(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))))
--
1.9.1
^ permalink raw reply related [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-02-19 20:00 ` Gustav Wikström
@ 2015-02-24 16:43 ` Nicolas Goaziou
2015-03-05 1:08 ` Gustav Wikström
0 siblings, 1 reply; 23+ messages in thread
From: Nicolas Goaziou @ 2015-02-24 16:43 UTC (permalink / raw)
To: Gustav Wikström; +Cc: Org Mode List
Gustav Wikström <gustav.erik@gmail.com> writes:
> Hi again! The FSA-assignment is now complete. New patches are attached
> and comments below.
OK. I updated list of contributors accordingly.
> The reason for the use of [ ] is because { } already has another purpose
> - it is used to make the tags within { } exclusive.
>
> this example
>
> ,----
> | #+TAGS: { group : include1 include2 }
> `----
>
> will only allow one of the tags on any specific headline. [ ] solves
> this. Note that grouptags doesn't care if { } or [ ] is used. The only
> difference is the exclusiveness. I.e both
>
> ,----
> | #+TAGS: [ group : include1 include2 ]
> | #+TAGS: { group : include1 include2 }
> `----
>
> will work. With some limitations on the second example due to the way {
> } works since before.
OK, but is it really needed? What is the point of having two tags of the
same group (or, if we consider nested group tags, the same set of
siblings) at the same time?
> Subject: [PATCH 1/3] org: Grouptags not unique and can contain regexp
>
> * lisp/org.el (org--setup-process-tags):
> (org-fast-tag-selection):
>
> Grouptags had to previously be defined with { }. This syntax is
> already used for exclusive tags and Grouptags need their own,
> non-exclusive syntax. This behaviour is achieved with [ ]
> instead. Note: { } can still be used also for Grouptags but then
> only one of the given tags can be used on the headline at the same
> time. Example:
You need to separate sentences with two spaces. Also, commit messages
need to be formatted this way
* lisp/org.el (function): Small description.
(other function): Small description.
Long explanations.
> - (org-re "\\`\\([[:alnum:]_@#%]+\\)\\(?:(\\(.\\))\\)?\\'") e)
> + (org-re (concat "\\`\\([[:alnum:]_@#%]+"
> + "\\|{.+}\\)" ; regular expression
^^^
I think it should be non-greedy above.
> + (taggroups (or org-tag-groups-alist-for-agenda org-tag-groups-alist))
> + (taggroups (if downcased (mapcar (lambda(tg) (mapcar 'downcase tg)) taggroups) taggroups))
Nitpick:
"(lambda (tg) ... #'downcase ...)"
Also it should be wrapped at 80 characters.
> + (taggroups-keys (mapcar 'car taggroups))
Nitpick: (mapcar #'car taggroups)
> + (return-match (if downcased (downcase match) match))
> + (count 0)
> + 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)
> (modify-syntax-entry ?_ "w" stable)
> - (while (and tml
> + ;; Temporarily replace regexp-expressions in the match-expression
Nitpick: missing full stop.
> + (while (string-match "{.+?}" return-match)
> + (setq count (1+ count))
Nitpick:
(incf count)
> + (setq regexps-in-match (cons (match-string 0 return-match) regexps-in-match))
Nitpick:
(push (match-string 0 return-match) regexps-in-match)
> + (setq return-match (replace-match (concat "<" (number-to-string count) ">") t nil return-match)))
Nitpick:
(format "<%d>" count)
> + ; Filter tag-regexps from tags
> + (setq regexp-in-group-escaped (delq nil (mapcar (lambda (x)
> + (if (stringp x)
> + (and (string-prefix-p "{" x)
> + (string-suffix-p "}" x)
> + x)
> + x)) tags-in-group))
We cannot use `string-prefix-p' and `string-suffix-p' due to backward
compatibility. The former will be fine in Org 8.4 (it was introduced in
Emacs 24.1), but the latter comes from Emacs 24.4.
You can use (equal (substring x ... ...) ...) instead.
Be careful about line width, too.
> + tags-in-group (delq nil (mapcar (lambda (x)
> + (if (stringp x)
> + (and (not (string-prefix-p "{" x))
> + (not (string-suffix-p "}" x))
> + x)
> + x)) tags-in-group)))
Ditto.
> + ; If single-as-list, do no more in the while-loop...
> + (if (not single-as-list)
> + (progn
> + (if 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 "\\>}"))
> + (if (stringp tags-in-group) (org-add-props tags-in-group '(grouptag t)))
Nitpick: (when (stringp tags-in-group) ...)
> + (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))))
I think you can refactor this part into a `cond'.
(cond (single-as-list (setq taggroups-keys (delete tag taggroups-keys)))
(regexp-in-group (setq regexp-in-group ...))
(t (setq tags-in-group ....)
(when (stringp tags-in-group) ...)
(setq return match ...))
> + ;; Add the regular expressions back into the match-expression again
See above.
> + (while regexps-in-match
> + (setq return-match (replace-regexp-in-string (concat "<" (number-to-string count) ">")
See above.
> + ((equal (car e) :startgrouptags)
`eq' instead of `equal'.
> + (setq intaggroup t)
> + (when (not (= cnt 0))
(unless (zerop cnt) ...)
or
(unless (= cnt 0) ...)
> + ((equal (car e) :endgrouptags)
See above.
> (when (not (= cnt 0))
Ditto.
> + (if (and (= cnt 0) (not ingroup) (not intaggroup)) (insert " "))
`when' instead of `if'.
> + (if (or ingroup intaggroup) (insert " "))
Ditto.
> Subject: [PATCH 2/3] org-agenda: Filtering in the agenda on grouptags
[...]
> + (while (not (member char (append '(?\t ?\r ?/ ?. ?\ ?q)
> + (string-to-list tag-chars))))
Nitpick: `memq' instead of `member'.
> + (cond ((equal char ?-) (setq exclude t))
> + ((equal char ?+) (setq exclude nil)))))
Nitpick: `eq' instead of `equal'.
> + ((equal char ?q)) ;If q, abort (even if there is a q-key for a tag...)
Ditto.
> -(defun org-agenda-filter-make-matcher (filter type)
> +(defun org-agenda-filter-make-matcher (filter type &optional expand)
> "Create the form that tests a line for agenda filter."
You need to explain arguments (data type, purpose) in the docstring.
> + ;(if expand (setq filter (org-agenda-filter-expand-tags filter)))
This line should be removed.
> + (let ((op (string-to-char x)))
> + (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
> + (setq x (list x)))
> + (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
> + (push f1 f))))
Is it useful to bind OP since you use it only once anyway?
> +(defun org-agenda-filter-make-matcher-tag-exp (tags op)
Missing docstring.
> + (let (f f1) ;f = return expression. f1 = working-area
> + (dolist (x tags)
> + (let* ((tag (substring x 1))
> + (isregexp (and (string-prefix-p "{" tag)
> + (string-suffix-p "}" tag)))
See above.
> + regexp)
> + (cond
> + (isregexp
> + (setq regexp (substring tag 1 -1))
> + (setq f1 (list 'string-match regexp '(apply 'concat tags))))
Spurious space.
> + (t
> + (setq f1 (list 'member (downcase tag) 'tags))))
> + (when (equal op ?-)
`eq'
> + ; any of the expressions can match if op = +
> + ; all must match if the operator is -. All o
You need two semi-colons here.
> + (if (equal op ?-)
`eq'
> +(defun org-agenda-filter-apply (filter type &optional expand)
> "Set FILTER as the new agenda filter and apply it."
See above.
> Subject: [PATCH 3/3] 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.
> ---
> lisp/org.el | 25 +++++++++++++++++++++++--
> 1 file changed, 23 insertions(+), 2 deletions(-)
>
> diff --git a/lisp/org.el b/lisp/org.el
> index 6bb8edf..5c80238 100755
> --- a/lisp/org.el
> +++ b/lisp/org.el
> @@ -14543,7 +14543,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.
See above.
> + (when (and (not (get-text-property 0 'grouptag (match-string 2 return-match)))
> + (not (member tag work-already-expanded)))
Nitpick:
(unless (or (get-text-property ...)
(member tag ...)))
> + (setq work-already-expanded (append (list tag) work-already-expanded))
(push tag work-already-expanded)
> + ; Recursively expand each tag in the group, if the tag hasn't
> + ; already been expanded
See above. Missing full stop, too.
> + ;; Redo the regexp-match because the recursive calls seems to mess it up...
You can also use `save-match-data' and restore it later.
Thanks for your work.
Regards,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-02-24 16:43 ` Nicolas Goaziou
@ 2015-03-05 1:08 ` Gustav Wikström
2015-03-07 21:51 ` Nicolas Goaziou
0 siblings, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-03-05 1:08 UTC (permalink / raw)
To: Gustav Wikström, Org Mode List
[-- Attachment #1: Type: text/plain, Size: 1531 bytes --]
Hi, and thanks for the extensive comments!
I've fixed the issues raised (IMO), and new patches are attached. I've
added a patch for documentation also.
>> ,----
>> | #+TAGS: { group : include1 include2 }
>> `----
>>
>> will only allow one of the tags on any specific headline. [ ] solves
>> this. Note that grouptags doesn't care if { } or [ ] is used. The only
>> difference is the exclusiveness. I.e both
>>
>> ,----
>> | #+TAGS: [ group : include1 include2 ]
>> | #+TAGS: { group : include1 include2 }
>> `----
>>
>> will work. With some limitations on the second example due to the way {
>> } works since before.
>
> OK, but is it really needed? What is the point of having two tags of the
> same group (or, if we consider nested group tags, the same set of
> siblings) at the same time?
I'd say it's an unnecessary limitation if group tags have to be
exclusive on a headline. The more general case should be allowed and I
can see use-cases for it.
If you, for example, want to create a taxonomy of your tags and a part
of your taxonomy is this:
#+TAGS: [ CS : DB OS Software Versioning Programming BI ]
What reason is there for Org mode to limit me to only choosing one of
the above? Lets say I find an article on the web and want to create a
node in my org-mode repository about it. Maybe linking the article and
adding a few thoughts. The fictive article may be called "the
importance of good database-design in Business intelligence". It seems
two tags of the above would fit just fine; DB & BI.
Best regards
Gustav
[-- Attachment #2: 0001-org-Grouptags-not-unique-and-can-contain-regexp.patch --]
[-- Type: application/octet-stream, Size: 12754 bytes --]
From 2e241a934947f180e3cff6b6dec852f3c0cd7646 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:26 +0100
Subject: [PATCH 1/4] org: Grouptags not unique and can contain regexp
* lisp/org.el (org-tags-expand): Grouptags can have regular expressions as
"sub-tags".
The regular expressions in the group must be marked up within { }.
Example use:
: #+TAGS: [ Project : {P@.+} ]
Searching for the tag Project will now list all tags also including
regular expression matches for P@.+. Good for example if tags for a
certain project is tagged with a common project-identifier,
i.e. P@2014_OrgTags.
* lisp/org.el (org-tag-alist) : New symbols for grouptags when the
tags in the group don't have to be distinct on a heading.
Grouptags had to previously be defined with { }. This syntax is
already used for exclusive tags and Grouptags need their own,
non-exclusive syntax. This behaviour is achieved with [ ]. Note: {
} can still be used also for Grouptags but then only one of the
given tags can be used on the headline at the same time. Example:
[ group : sub1 sub2 ]
Grouptags also are not filtered when setting up tags. This means
they can exist multiple times in org-tag-alist list. it will be
usable if nesting of grouptags is ever to become reality.
There is a slightly annoying side-effect when setting tags in that a
tag which is both a part of a grouptag and a grouptag of it's own
will get multiple key-choices in the selection-UI.
* lisp/org.el (org--setup-process-tags): Adaption for the added syntax
for non-distinct grouptags.
* lisp/org.el (org-fast-tag-selection): Add support for the added,
non-unique, grouptag-syntax.
---
lisp/org.el | 148 ++++++++++++++++++++++++++++++++++++++++++------------------
1 file changed, 105 insertions(+), 43 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index d05a7b8..8d47173 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -3482,11 +3482,17 @@ See the manual for details."
(list :tag "Start radio group"
(const :startgroup)
(option (string :tag "Group description")))
+ (list :tag "Start tag group, non distinct"
+ (const :startgrouptag)
+ (option (string :tag "Group description")))
(list :tag "Group tags delimiter"
(const :grouptags))
(list :tag "End radio group"
(const :endgroup)
(option (string :tag "Group description")))
+ (list :tag "End tag group, non distinct"
+ (const :endgrouptag)
+ (option (string :tag "Group description")))
(const :tag "New line" (:newline)))))
(defcustom org-tag-persistent-alist nil
@@ -5216,6 +5222,8 @@ FILETAGS is a list of tags, as strings."
(case (car tag)
(:startgroup "{")
(:endgroup "}")
+ (:startgrouptag "[")
+ (:endgrouptag "]")
(:grouptags ":")
(:newline "\\n")
(otherwise (concat (car tag)
@@ -5236,12 +5244,20 @@ FILETAGS is a list of tags, as strings."
((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 "\\`\\([[:alnum:]_@#%]+\\)\\(?:(\\(.\\))\\)?\\'") e)
+ (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)))))
@@ -5249,7 +5265,8 @@ FILETAGS is a list of tags, as strings."
(setcar org-tag-groups-alist
(append (car org-tag-groups-alist) (list tag))))
(group-flag (push (list tag) org-tag-groups-alist)))
- (unless (assoc tag org-tag-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)))
@@ -14548,32 +14565,68 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(if org-group-tags
(let* ((case-fold-search t)
(stable org-mode-syntax-table)
- (tal (or org-tag-groups-alist-for-agenda
- org-tag-groups-alist))
- (tal (if downcased
- (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
- (tml (mapcar 'car tal))
- (rtnmatch match) rpl)
- ;; @ and _ are allowed as word-components in tags
+ (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)
+ 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)
(modify-syntax-entry ?_ "w" stable)
- (while (and tml
+ ;; Temporarily replace regexp-expressions in the match-expression.
+ (while (string-match "{.+?}" return-match)
+ (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 tml) "\\>\\)") rtnmatch)))
- (let* ((dir (match-string 1 rtnmatch))
- (tag (match-string 2 rtnmatch))
+ (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)))
- (setq tml (delete tag tml))
- (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
- (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
- (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
- (if (stringp rpl) (org-add-props rpl '(grouptag t)))
- (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (when (not (get-text-property 0 'grouptag (match-string 2 return-match)))
+ (setq tags-in-group (assoc tag taggroups))
+ ;; 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
+ (if 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 "\\>}"))
+ (if (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))
+ (decf count))
(if single-as-list
- (or (reverse rpl) (list rtnmatch))
- rtnmatch))
+ (if tags-in-group tags-in-group (list return-match))
+ return-match))
(if single-as-list (list (if downcased (downcase match) match))
match)))
@@ -15033,7 +15086,7 @@ Returns the new tags string, or nil to not change the current settings."
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
- groups ingroup)
+ groups ingroup intaggroup)
(save-excursion
(beginning-of-line 1)
(if (looking-at
@@ -15066,24 +15119,33 @@ Returns the new tags string, or nil to not change the current settings."
(setq tbl fulltable char ?a cnt 0)
(while (setq e (pop tbl))
(cond
- ((equal (car e) :startgroup)
+ ((eq (car e) :startgroup)
(push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n"))
(insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
- ((equal (car e) :endgroup)
+ ((eq (car e) :endgroup)
(setq ingroup nil cnt 0)
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((eq (car e) :startgrouptag)
+ (setq intaggroup t)
+ (unless (zerop cnt)
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "[ "))
+ ((eq (car e) :endgrouptag)
+ (setq intaggroup nil cnt 0)
+ (insert "]\n"))
((equal e '(:newline))
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n")
(setq e (car tbl))
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) nil)
+ ((equal e '(:grouptags)) (insert " : "))
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -15097,27 +15159,27 @@ Returns the new tags string, or nil to not change the current settings."
(setq char (1+ char)))
(setq c2 c1))
(setq c (or c2 char)))
- (if ingroup (push tg (car groups)))
+ (when ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
(cond
((not (assoc tg table))
(org-get-todo-face tg))
((member tg current) c-face)
((member tg inherited) i-face))))
- (if (equal (caar tbl) :grouptags)
- (org-add-props tg nil 'face 'org-tag-group))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (when (equal (caar tbl) :grouptags)
+ (org-add-props tg nil 'face 'org-tag-group))
+ (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
- (when (= (setq cnt (1+ cnt)) ncol)
+ (when (= (incf cnt) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (when (or ingroup intaggroup) (insert " "))
(setq cnt 0)))))
(setq ntable (nreverse ntable))
(insert "\n")
(goto-char (point-min))
- (if (not expert) (org-fit-window-to-buffer))
+ (unless expert (org-fit-window-to-buffer))
(setq rtn
(catch 'exit
(while t
@@ -15147,7 +15209,7 @@ Returns the new tags string, or nil to not change the current settings."
(setq quit-flag t))
((= c ?\ )
(setq current nil)
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((= c ?\t)
(condition-case nil
(setq tg (org-icompleting-read
@@ -15161,28 +15223,28 @@ Returns the new tags string, or nil to not change the current settings."
(if (member tg current)
(setq current (delete tg current))
(push tg current)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c todo-table) tg (car e))
(with-current-buffer buf
(save-excursion (org-todo tg)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c ntable) tg (car e))
(if (member tg current)
(setq current (delete tg current))
(loop for g in groups do
- (if (member tg g)
- (mapc (lambda (x)
- (setq current (delete x current)))
- g)))
+ (when (member tg g)
+ (mapc (lambda (x)
+ (setq current (delete x current)))
+ g)))
(push tg current))
- (if exit-after-next (setq exit-after-next 'now))))
+ (when exit-after-next (setq exit-after-next 'now))))
;; Create a sorted list
(setq current
(sort current
(lambda (a b)
(assoc b (cdr (memq (assoc a ntable) ntable))))))
- (if (eq exit-after-next 'now) (throw 'exit t))
+ (when (eq exit-after-next 'now) (throw 'exit t))
(goto-char (point-min))
(beginning-of-line 2)
(delete-region (point) (point-at-eol))
--
1.9.1
[-- Attachment #3: 0002-org-agenda-Filtering-in-the-agenda-on-grouptags.patch --]
[-- Type: application/octet-stream, Size: 12637 bytes --]
From 5c8515a63367447200b8437d34f946bdf4868c47 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:35 +0100
Subject: [PATCH 2/4] org-agenda: Filtering in the agenda on grouptags
Filtering in the agenda on grouptags filter also subcategories.
Exception if filter is applied with a (double) prefix-argument.
Filtering in the agenda on subcategories does not filter the "above"
levels anymore.
If a grouptag contains a regular expression the regular expression
is also used as a filter.
* lisp/org-agenda.el (org-agenda-filter-by-tag): improved UI and
refactoring.
Now uses the argument arg and optional argument exclude instead of
strip and narrow. ARG because the argument has multiple purposes
and makes more sense than strip now. The term narrowing is changed
to exclude.
* lisp/org-agenda.el (org-agenda-filter-by-tag-refine): name change in
argument to match org-agenda-filter-by-tag.
* lisp/org-agenda.el (org-agenda-filter-make-matcher): new optional
argument EXPAND and refactoring.
* lisp/org-agenda.el (org-agenda-filter-make-matcher-tag-exp): new
function, previously baked into org-agenda-filter-make-matcher.
* lisp/org-agenda.el (org-agenda-filter-apply): New optional parameter
EXPAND, used in call to org-agenda-filter-make-matcher.
* lisp/org-agenda.el (org-agenda-reapply-filters): Uses another
parameter (the new optional one) in call to org-agenda-filter-apply.
* lisp/org-agenda.el (org-agenda-finalize): use of new parameter in
call to org-agenda-filter-apply.
* lisp/org-agenda.el (org-agenda-redo): Use of new parameter in call
to org-agenda-filter-apply.
---
lisp/org-agenda.el | 146 +++++++++++++++++++++++++++++------------------------
1 file changed, 81 insertions(+), 65 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index b0e1224..482f2f6 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -3761,10 +3761,10 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-agenda-filter-top-headline-apply
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
(when (get 'org-agenda-tag-filter :preset-filter)
(org-agenda-filter-apply
- (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (get 'org-agenda-tag-filter :preset-filter) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
(when (get 'org-agenda-category-filter :preset-filter)
@@ -7333,7 +7333,7 @@ in the agenda."
(cat (or cat-filter cat-preset))
(effort (or effort-filter effort-preset))
(re (or re-filter re-preset)))
- (when tag (org-agenda-filter-apply tag 'tag))
+ (when tag (org-agenda-filter-apply tag 'tag t))
(when cat (org-agenda-filter-apply cat 'category))
(when effort (org-agenda-filter-apply effort 'effort))
(when re (org-agenda-filter-apply re 'regexp)))
@@ -7455,13 +7455,16 @@ With two prefix arguments, remove the effort filters."
(org-agenda-filter-show-all-effort))
(org-agenda-finalize))
-(defun org-agenda-filter-by-tag (strip &optional char narrow)
+(defun org-agenda-filter-by-tag (arg &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
The tag is selected with its fast selection letter, as configured.
-With prefix argument STRIP, remove all lines that do have the tag.
-A lisp caller can specify CHAR. NARROW means that the new tag should be
-used to narrow the search - the interactive user can also press `-' or `+'
-to switch to narrowing."
+With a single `C-u' prefix ARG, exclude the agenda search. With a
+double `C-u' prefix ARG, filter the literal tag. I.e. don't filter on
+all its group members.
+
+A lisp caller can specify CHAR. EXCLUDE means that the new tag should be
+used to exclude the search - the interactive user can also press `-' or `+'
+to switch between filtering and excluding."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(tag-chars (mapconcat
@@ -7469,24 +7472,25 @@ to switch to narrowing."
(cdr x))
(char-to-string (cdr x))
""))
- alist ""))
+ org-tag-alist-for-agenda ""))
+ (exclude (if exclude exclude (equal arg '(4))))
+ (expand (not (equal arg '(16))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
a n tag)
(unless char
- (message
- "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow"
- (if narrow "Narrow" "Filter") tag-chars
- (if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char-exclusive)))
- (when (member char '(?+ ?-))
- ;; Narrowing down
- (cond ((equal char ?-) (setq strip t narrow t))
- ((equal char ?+) (setq strip nil narrow t)))
- (message
- "Narrow by tag [%s ], [TAB], [/]:off" tag-chars)
- (setq char (read-char-exclusive)))
- (when (equal char ?\t)
+ (while (not (memq char (append '(?\t ?\r ?/ ?. ?\ ?q)
+ (string-to-list tag-chars))))
+ (message
+ "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
+ (if exclude "Exclude" "Filter") tag-chars
+ (if org-agenda-auto-exclude-function "[RET], " "")
+ (if expand "" ", no grouptag expand"))
+ (setq char (read-char-exclusive))
+ ;; Excluding or filtering down
+ (cond ((eq char ?-) (setq exclude t))
+ ((eq char ?+) (setq exclude nil)))))
+ (when (eq char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
(org-set-local 'org-global-tags-completion-table
(org-global-tags-completion-table)))
@@ -7494,7 +7498,7 @@ to switch to narrowing."
(setq tag (org-icompleting-read
"Tag: " org-global-tags-completion-table))))
(cond
- ((equal char ?\r)
+ ((eq char ?\r)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
(setq org-agenda-tag-filter nil)
@@ -7503,25 +7507,26 @@ to switch to narrowing."
(if modifier
(push modifier org-agenda-tag-filter))))
(if (not (null org-agenda-tag-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))))
- ((equal char ?/)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
+ ((eq char ?/)
(org-agenda-filter-show-all-tag)
(when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
- ((equal char ?. )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
+ ((eq char ?. )
(setq org-agenda-tag-filter
(mapcar (lambda(tag) (concat "+" tag))
(org-get-at-bol 'tags)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
- ((or (equal char ?\ )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
+ ((or (eq char ?\ )
(setq a (rassoc char alist))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-tag-filter
- (cons (concat (if strip "-" "+") tag)
- (if narrow current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (cons (concat (if exclude "-" "+") tag)
+ current))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
(t (error "Invalid tag selection character %c" char)))))
(defun org-agenda-get-represented-tags ()
@@ -7535,13 +7540,15 @@ to switch to narrowing."
(get-text-property (point) 'tags))))
tags))
-(defun org-agenda-filter-by-tag-refine (strip &optional char)
+(defun org-agenda-filter-by-tag-refine (arg &optional char)
"Refine the current filter. See `org-agenda-filter-by-tag'."
(interactive "P")
- (org-agenda-filter-by-tag strip char 'refine))
+ (org-agenda-filter-by-tag arg char 'refine))
-(defun org-agenda-filter-make-matcher (filter type)
- "Create the form that tests a line for agenda filter."
+(defun org-agenda-filter-make-matcher (filter type &optional expand)
+ "Create the form that tests a line for agenda filter. Optional
+argument EXPAND can be used for the TYPE tag and will expand the
+tags in the FILTER if any of the tags in FILTER are grouptags."
(let (f f1)
(cond
;; Tag filter
@@ -7551,26 +7558,11 @@ to switch to narrowing."
(append (get 'org-agenda-tag-filter :preset-filter)
filter)))
(dolist (x filter)
- (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
- (ffunc
- (lambda (nf0 nf01 fltr notgroup op)
- (dolist (x fltr)
- (if (member x '("-" "+"))
- (setq nf01 (if (equal x "-") 'tags '(not tags)))
- (setq nf01 (list 'member (downcase (substring x 1))
- 'tags))
- (when (equal (string-to-char x) ?-)
- (setq nf01 (list 'not nf01))
- (when (not notgroup) (setq op 'and))))
- (push nf01 nf0))
- (if notgroup
- (push (cons 'and nf0) f)
- (push (cons (or op 'or) nf0) f)))))
- (cond ((equal filter '("+"))
- (setq f (list (list 'not 'tags))))
- ((equal nfilter filter)
- (funcall ffunc f1 f filter t nil))
- (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ (let ((op (string-to-char x)))
+ (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
+ (setq x (list x)))
+ (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
+ (push f1 f))))
;; Category filter
((eq type 'category)
(setq filter
@@ -7603,6 +7595,32 @@ to switch to narrowing."
(push (org-agenda-filter-effort-form x) f))))
(cons 'and (nreverse f))))
+(defun org-agenda-filter-make-matcher-tag-exp (tags op)
+ "Create the form that tests a line for agenda filter for
+tag-expressions. Return a match-expression given TAGS. OP is an
+operator of type CHAR that allows the function to set the right
+switches in the returned form."
+ (let (f f1) ;f = return expression. f1 = working-area
+ (dolist (x tags)
+ (let* ((tag (substring x 1))
+ (isregexp (and (equal "{" (substring tag 0 1))
+ (equal "}" (substring tag -1))))
+ regexp)
+ (cond
+ (isregexp
+ (setq regexp (substring tag 1 -1))
+ (setq f1 (list 'string-match regexp '(apply 'concat tags))))
+ (t
+ (setq f1 (list 'member (downcase tag) 'tags))))
+ (when (eq op ?-)
+ (setq f1 (list 'not f1))))
+ (push f1 f))
+ ;; Any of the expressions can match if op = +
+ ;; all must match if the operator is -.
+ (if (eq op ?-)
+ (cons 'and f)
+ (cons 'or f))))
+
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
E looks like \"+<2:25\"."
@@ -7641,12 +7659,14 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(reverse rtn))
filter))
-(defun org-agenda-filter-apply (filter type)
- "Set FILTER as the new agenda filter and apply it."
+(defun org-agenda-filter-apply (filter type &optional expand)
+ "Set FILTER as the new agenda filter and apply it. Optional
+argument EXPAND can be used for the TYPE tag and will expand the
+tags in the FILTER if any of the tags in FILTER are grouptags."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
(let (tags cat txt)
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand))
;; Only set `org-agenda-filtered-by-category' to t when a unique
;; category is used as the filter:
(setq org-agenda-filtered-by-category
@@ -7658,11 +7678,7 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags ; used in eval
- (apply 'append
- (mapcar (lambda (f)
- (org-agenda-filter-expand-tags (list f) t))
- (org-get-at-bol 'tags)))
+ (setq tags (org-get-at-bol 'tags)
cat (org-get-at-eol 'org-category 1)
txt (org-get-at-eol 'txt 1))
(if (not (eval org-agenda-filter-form))
@@ -9973,7 +9989,7 @@ current HH:MM time."
(defun org-agenda-reapply-filters ()
"Re-apply all agenda filters."
(mapcar
- (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
`((,org-agenda-tag-filter tag)
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
--
1.9.1
[-- Attachment #4: 0003-org-Nesting-grouptags.patch --]
[-- Type: application/octet-stream, Size: 3435 bytes --]
From e041a552f4d99d503e70f808dbf00f0b1756365d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:47 +0100
Subject: [PATCH 3/4] 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.
---
lisp/org.el | 25 +++++++++++++++++++++----
1 file changed, 21 insertions(+), 4 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index 8d47173..041c192 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -14538,7 +14538,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,24 @@ 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)
@@ -14607,8 +14624,8 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(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...
+ x)) tags-in-group)))
+ ;; If single-as-list, do no more in the while-loop.
(if (not single-as-list)
(progn
(if regexp-in-group
--
1.9.1
[-- Attachment #5: 0004-org.texi-Complement-info-for-group-tags.patch --]
[-- Type: application/octet-stream, Size: 6498 bytes --]
From d87fdc79db01df662bcd8cb6a41367d507def5c7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Thu, 5 Mar 2015 01:45:57 +0100
Subject: [PATCH 4/4] org.texi: Complement info for group tags
group tags are more general and a name-change (or addition) is made in
the manual: tag groups are now called tag hierarchy.
Adding information about the added tag hierarchy functionality and
use-cases.
---
doc/org.texi | 99 +++++++++++++++++++++++++++++++++++++++++++++++-------------
1 file changed, 78 insertions(+), 21 deletions(-)
diff --git a/doc/org.texi b/doc/org.texi
index c0ea662..a40fa98 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -432,7 +432,7 @@ Tags
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
Properties and columns
@@ -4877,7 +4877,7 @@ You may specify special faces for specific tags using the option
@menu
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
@end menu
@@ -5116,41 +5116,98 @@ instead of @kbd{C-c C-c}). If you set the variable to the value
@code{expert}, the special window is not even shown for single-key tag
selection, it comes up only when you press an extra @kbd{C-c}.
-@node Tag groups
-@section Tag groups
+@node Tag hierarchy
+@section Tag hierarchy
@cindex group tags
@cindex tags, groups
-In a set of mutually exclusive tags, the first tag can be defined as a
-@emph{group tag}. When you search for a group tag, it will return matches
-for all members in the group. In an agenda view, filtering by a group tag
-will display headlines tagged with at least one of the members of the
-group. This makes tag searches and filters even more flexible.
+@cindex tag hierarchy
+Tags can be defined in hierarchies. A tag can be defined as a @emph{group
+tag} for a set of other tags. The group tag can be seen as the ``broader
+term'' for its set of tags. Defining multiple @emph{group tags} and nesting
+them creates a tag hierarchy.
-You can set group tags by inserting a colon between the group tag and other
-tags---beware that all whitespaces are mandatory so that Org can parse this
-line correctly:
+One use-case is to create a taxonomy of terms (tags) that can be used to
+classify nodes in a document or set of documents.
+
+When you search for a group tag, it will return matches for all members in
+the group and its subgroup. In an agenda view, filtering by a group tag will
+display or hide headlines tagged with at least one of the members of the
+group or any of its subgroups. This makes tag searches and filters even more
+flexible.
+
+You can set group tags by using brackets and inserting a colon between the
+group tag and its related tags---beware that all whitespaces are mandatory so
+that Org can parse this line correctly:
+
+@example
+#+TAGS: [ GTD : Control Persp ]
+@end example
+
+In this example, @samp{GTD} is the @emph{group tag} and it is related to two other
+tags: @samp{Control}, @samp{Persp}. Defining @samp{Persp} and @samp{Control}
+as group tags creates an hierarchy of tags:
@example
-#+TAGS: @{ @@read : @@read_book @@read_ebook @}
+#+TAGS: [ Persp : Vision Goal AOF Project ]
+#+TAGS: [ Control : Context Task ]
@end example
-In this example, @samp{@@read} is a @emph{group tag} for a set of three
-tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}.
+That can conceptually be seen as a hierarchy of tags:
-You can also use the @code{:grouptags} keyword directly when setting
-@code{org-tag-alist}:
+@example
+- GTD
+ - Persp
+ - Vision
+ - Goal
+ - AOF
+ - Project
+ - Control
+ - Context
+ - Task
+@end example
+
+You can use the @code{:startgrouptag}, @code{:grouptags} and
+@code{:endgrouptag} keyword directly when setting @code{org-tag-alist}
+directly:
@lisp
-(setq org-tag-alist '((:startgroup . nil)
+(setq org-tag-alist '((:startgrouptag . nil)
("@@read" . nil)
(:grouptags . nil)
("@@read_book" . nil)
("@@read_ebook" . nil)
- (:endgroup . nil)))
+ (:endgrouptag . nil)))
@end lisp
-You cannot nest group tags or use a group tag as a tag in another group.
+The tags in a group can be mutually exclusive if using the same group syntax
+as is used for grouping mutually exclusive tags together; using curly
+brackets.
+
+@example
+#+TAGS: @{ Context : @@Home @@Work @@Call @}
+@end example
+
+When setting @code{org-tag-alist} you can use @code{:startgroup} &
+@code{:endgroup} instead of @code{:startgrouptag} & @code{:endgrouptag} to
+make the tags mutually exclusive.
+
+Furthermore; The members of a @emph{group tag} can also be regular
+expression, creating the possibility of more dynamic and rule-based
+tag-structure. The regular expressions in the group must be marked up within
+@{ @}. Example use, to expand on the example given above:
+
+@example
+#+TAGS: [ Vision : @{V@.+@} ]
+#+TAGS: [ Goal : @{G@.+@} ]
+#+TAGS: [ AOF : @{AOF@.+@} ]
+#+TAGS: [ Project : @{P@.+@} ]
+@end example
+
+Searching for the tag Project will now list all tags also including regular
+expression matches for P@@.+. Similar for tag-searches on Vision, Goal and
+AOF. This can be good for example if tags for a certain project is tagged
+with a common project-identifier, i.e. P@@2014_OrgTags.
@kindex C-c C-x q
@vindex org-group-tags
@@ -8111,7 +8168,7 @@ braces. For example,
@samp{:work:} and any tag @i{starting} with @samp{boss}.
@cindex group tags, as regular expressions
-Group tags (@pxref{Tag groups}) are expanded as regular expressions. E.g.,
+Group tags (@pxref{Tag hierarchy}) are expanded as regular expressions. E.g.,
if @samp{:work:} is a group tag for the group @samp{:work:lab:conf:}, then
searching for @samp{work} will search for @samp{@{\(?:work\|lab\|conf\)@}}
and searching for @samp{-work} will search for all headlines but those with
--
1.9.1
^ permalink raw reply related [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-03-05 1:08 ` Gustav Wikström
@ 2015-03-07 21:51 ` Nicolas Goaziou
2015-03-15 10:17 ` Gustav Wikström
2015-03-16 20:38 ` Gustav Wikström
0 siblings, 2 replies; 23+ messages in thread
From: Nicolas Goaziou @ 2015-03-07 21:51 UTC (permalink / raw)
To: Gustav Wikström; +Cc: Org Mode List
Gustav Wikström <gustav.erik@gmail.com> writes:
> I've fixed the issues raised (IMO), and new patches are attached. I've
> added a patch for documentation also.
Thank you.
> I'd say it's an unnecessary limitation if group tags have to be
> exclusive on a headline. The more general case should be allowed and I
> can see use-cases for it.
>
> If you, for example, want to create a taxonomy of your tags and a part
> of your taxonomy is this:
>
> #+TAGS: [ CS : DB OS Software Versioning Programming BI ]
>
> What reason is there for Org mode to limit me to only choosing one of
> the above? Lets say I find an article on the web and want to create a
> node in my org-mode repository about it. Maybe linking the article and
> adding a few thoughts. The fictive article may be called "the
> importance of good database-design in Business intelligence". It seems
> two tags of the above would fit just fine; DB & BI.
Fair enough.
> + (taggroups (if downcased (mapcar (lambda (tg) (mapcar #'downcase tg))
> + taggroups) taggroups))
Nitpick: indentation
(taggroups (if downcased
(mapcar (lambda (tg) (mapcar #'downcase tg)) taggroups)
taggroups))
> + (delq nil (mapcar (lambda (x)
> + (if (stringp x)
> + (and (equal "{" (substring x 0 1))
> + (equal "}" (substring x -1))
> + x)
> + x)) tags-in-group))
Same here. TAGS-IN-GROUP should be at the same level as (lambda (x) ...)
> + regexp-in-group
> + (mapcar (lambda (x)
> + (substring x 1 -1)) regexp-in-group-escaped)
Ditto.
> + 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)))
Ditto.
> + ; If single-as-list, do no more in the while-loop...
> + (if (not single-as-list)
> + (progn
> + (if 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 "\\>}"))
You need to keep lines within 80 columns.
> + (when (member tg g)
> + (mapc (lambda (x)
> + (setq current (delete x current)))
> + g)))
While you're at it:
(when (member tg g) (dolist (x g) (setq current (delete x current))))
> +(defun org-agenda-filter-by-tag (arg &optional char exclude)
> "Keep only those lines in the agenda buffer that have a specific tag.
> The tag is selected with its fast selection letter, as configured.
> -With prefix argument STRIP, remove all lines that do have the tag.
> -A lisp caller can specify CHAR. NARROW means that the new tag should be
> -used to narrow the search - the interactive user can also press `-' or `+'
> -to switch to narrowing."
> +With a single `C-u' prefix ARG, exclude the agenda search. With a
> +double `C-u' prefix ARG, filter the literal tag. I.e. don't filter on
^^^
missing space
Also, instead of hard-coding `C-u', you could use \\[universal-argument]
within the doc string. See, for example, `org-tree-to-indirect-buffer'.
> + (exclude (if exclude exclude (equal arg '(4))))
(exclude (or exclude (equal arg '(4))))
> + (while (not (memq char (append '(?\t ?\r ?/ ?. ?\ ?q)
> + (string-to-list tag-chars))))
For clarity, use ?\s instead of ?\
Also, I suggest to move the consing before the while loop.
> + ((eq char ?. )
Spurious space.
> + ((or (eq char ?\ )
See above.
> + (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)))))
Lines too wide.
> +Tags can be defined in hierarchies. A tag can be defined as a @emph{group
^^^
missing space
> +#+TAGS: [ Persp : Vision Goal AOF Project ]
> +#+TAGS: [ Control : Context Task ]
> @end example
>
> -In this example, @samp{@@read} is a @emph{group tag} for a set of three
> -tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}.
> +That can conceptually be seen as a hierarchy of tags:
>
> -You can also use the @code{:grouptags} keyword directly when setting
> -@code{org-tag-alist}:
> +@example
> +- GTD
> + - Persp
> + - Vision
> + - Goal
> + - AOF
> + - Project
> + - Control
> + - Context
> + - Task
> +@end example
> +
> +You can use the @code{:startgrouptag}, @code{:grouptags} and
> +@code{:endgrouptag} keyword directly when setting @code{org-tag-alist}
> +directly:
>
> @lisp
> -(setq org-tag-alist '((:startgroup . nil)
> +(setq org-tag-alist '((:startgrouptag . nil)
> ("@@read" . nil)
> (:grouptags . nil)
> ("@@read_book" . nil)
> ("@@read_ebook" . nil)
> - (:endgroup . nil)))
> + (:endgrouptag . nil)))
> @end lisp
The following is clearer
@lisp
(setq org-tag-alist '((:startgrouptag)
("@@read")
(:grouptags)
("@@read_book")
("@@read_ebook")
(:endgrouptag)))
@end lisp
However, shouldn't this example apply to the one above? (e.g.., with
Control : Context Task tag line)?
> +Searching for the tag Project will now list all tags also including regular
> +expression matches for P@@.+. Similar for tag-searches on Vision, Goal and
> +AOF. This can be good for example if tags for a certain project is tagged
> +with a common project-identifier, i.e. P@@2014_OrgTags.
@samp{Project} @samp{Vision}... @samp{P@@2014_OrgTags}.
This all looks very nice. As a final step, would you mind adding tests
for this?
As a starter `test-org/set-regexps-and-options' in "test-org.el" could
be extended to test parsing of square brackets tags.
Since you're touching some hairy part of Org, the more tests the better.
Regards,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-03-07 21:51 ` Nicolas Goaziou
@ 2015-03-15 10:17 ` Gustav Wikström
2015-03-16 20:38 ` Gustav Wikström
1 sibling, 0 replies; 23+ messages in thread
From: Gustav Wikström @ 2015-03-15 10:17 UTC (permalink / raw)
To: Nicolas Goaziou, Org Mode List
[-- Attachment #1: Type: text/plain, Size: 5704 bytes --]
Hi again!
Comments below.
> From: Nicolas Goaziou [mailto:mail@nicolasgoaziou.fr]
> > + (taggroups (if downcased (mapcar (lambda (tg) (mapcar #'downcase tg))
> > + taggroups) taggroups))
>
> Nitpick: indentation
Can't see what's wrong.. Autoindent by emacs did this. Anyways.. I made the if-construct clearer by adding linebreaks.
> > + (delq nil (mapcar (lambda (x)
> > + (if (stringp x)
> > + (and (equal "{" (substring x 0 1))
> > + (equal "}" (substring x -1))
> > + x)
> > + x)) tags-in-group))
>
> Same here. TAGS-IN-GROUP should be at the same level as (lambda (x) ...)
Ok, fixed.
> > + regexp-in-group
> > + (mapcar (lambda (x)
> > + (substring x 1 -1)) regexp-in-group-escaped)
>
> Ditto.
Fixed.
> > + 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)))
>
> Ditto.
Fixed.
> > + ; If single-as-list, do no more in the while-loop...
> > + (if (not single-as-list)
> > + (progn
> > + (if 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 "\\>}"))
>
> You need to keep lines within 80 columns.
Trying to avoid it.
> > + (when (member tg g)
> > + (mapc (lambda (x)
> > + (setq current (delete x current)))
> > + g)))
>
> While you're at it:
>
> (when (member tg g) (dolist (x g) (setq current (delete x current))))
Ok!
> > +(defun org-agenda-filter-by-tag (arg &optional char exclude)
> > "Keep only those lines in the agenda buffer that have a specific tag.
> > The tag is selected with its fast selection letter, as configured.
> > -With prefix argument STRIP, remove all lines that do have the tag.
> > -A lisp caller can specify CHAR. NARROW means that the new tag should be
> > -used to narrow the search - the interactive user can also press `-' or `+'
> > -to switch to narrowing."
> > +With a single `C-u' prefix ARG, exclude the agenda search. With a
> > +double `C-u' prefix ARG, filter the literal tag. I.e. don't filter on
> ^^^
> missing space
Fixed.
> Also, instead of hard-coding `C-u', you could use \\[universal-argument]
> within the doc string. See, for example, `org-tree-to-indirect-buffer'.
Fixed.
> > + (exclude (if exclude exclude (equal arg '(4))))
>
> (exclude (or exclude (equal arg '(4))))
Fixed.
> > + (while (not (memq char (append '(?\t ?\r ?/ ?. ?\ ?q)
> > + (string-to-list tag-chars))))
>
> For clarity, use ?\s instead of ?\
Fixed.
> Also, I suggest to move the consing before the while loop.
Good point, changed.
> > + ((eq char ?. )
>
> Spurious space.
Fixed.
> > + ((or (eq char ?\ )
>
> See above.
Fixed.
>
> > + (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)))))
>
> Lines too wide.
Ok, fixed kind of. I don't want to compromise on the relatively long variable names.
>
> > +Tags can be defined in hierarchies. A tag can be defined as a @emph{group
> ^^^
> missing space
Fixed.
> > @lisp
> > -(setq org-tag-alist '((:startgroup . nil)
> > +(setq org-tag-alist '((:startgrouptag . nil)
> > ("@@read" . nil)
> > (:grouptags . nil)
> > ("@@read_book" . nil)
> > ("@@read_ebook" . nil)
> > - (:endgroup . nil)))
> > + (:endgrouptag . nil)))
> > @end lisp
>
> The following is clearer
>
> @lisp
> (setq org-tag-alist '((:startgrouptag)
> ("@@read")
> (:grouptags)
> ("@@read_book")
> ("@@read_ebook")
> (:endgrouptag)))
> @end lisp
>
Indeed
> However, shouldn't this example apply to the one above? (e.g.., with
> Control : Context Task tag line)?
Indeed again!
>
> > +Searching for the tag Project will now list all tags also including regular
> > +expression matches for P@@.+. Similar for tag-searches on Vision, Goal and
> > +AOF. This can be good for example if tags for a certain project is tagged
> > +with a common project-identifier, i.e. P@@2014_OrgTags.
>
> @samp{Project} @samp{Vision}... @samp{P@@2014_OrgTags}.
>
> This all looks very nice.
Thx!
> As a final step, would you mind adding tests
> for this?
Added a few now. Actually found an error in the way regexps were matched and filtered due to the added tests. So, good point. The errors are fixed ofc.
Fixed patches are attached,
Best regards
Gustav Wikström
[-- Attachment #2: 0001-org-Grouptags-not-unique-and-can-contain-regexp.patch --]
[-- Type: application/octet-stream, Size: 15894 bytes --]
From b1a85ca66260f3ac87607d617e059d72f09ba495 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:26 +0100
Subject: [PATCH 1/4] org: Grouptags not unique and can contain regexp
* lisp/org.el (org-tags-expand): Grouptags can have regular expressions as
"sub-tags".
The regular expressions in the group must be marked up within { }.
Example use:
: #+TAGS: [ Project : {P@.+} ]
Searching for the tag Project will now list all tags also including
regular expression matches for P@.+. Good for example if tags for a
certain project is tagged with a common project-identifier,
i.e. P@2014_OrgTags.
* lisp/org.el (org-tag-alist) : New symbols for grouptags when the
tags in the group don't have to be distinct on a heading.
Grouptags had to previously be defined with { }. This syntax is
already used for exclusive tags and Grouptags need their own,
non-exclusive syntax. This behaviour is achieved with [ ]. Note: {
} can still be used also for Grouptags but then only one of the
given tags can be used on the headline at the same time. Example:
[ group : sub1 sub2 ]
Grouptags also are not filtered when setting up tags. This means
they can exist multiple times in org-tag-alist list. It will be
usable if nesting of grouptags is ever to become reality.
There is a slightly annoying side-effect when setting tags in that a
tag which is both a part of a grouptag and a grouptag of it's own
will get multiple key-choices in the selection-UI.
* lisp/org.el (org--setup-process-tags): Adaption for the added syntax
for non-distinct grouptags.
* lisp/org.el (org-fast-tag-selection): Add support for the added,
non-unique, grouptag-syntax. Minor (if ...) to (when ...) refactor.
---
lisp/org.el | 178 ++++++++++++++++++++++++++++++++++-------------
testing/lisp/test-org.el | 36 ++++++++++
2 files changed, 167 insertions(+), 47 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index da5de84..b39cb98 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -3482,11 +3482,17 @@ See the manual for details."
(list :tag "Start radio group"
(const :startgroup)
(option (string :tag "Group description")))
+ (list :tag "Start tag group, non distinct"
+ (const :startgrouptag)
+ (option (string :tag "Group description")))
(list :tag "Group tags delimiter"
(const :grouptags))
(list :tag "End radio group"
(const :endgroup)
(option (string :tag "Group description")))
+ (list :tag "End tag group, non distinct"
+ (const :endgrouptag)
+ (option (string :tag "Group description")))
(const :tag "New line" (:newline)))))
(defcustom org-tag-persistent-alist nil
@@ -5216,6 +5222,8 @@ FILETAGS is a list of tags, as strings."
(case (car tag)
(:startgroup "{")
(:endgroup "}")
+ (:startgrouptag "[")
+ (:endgrouptag "]")
(:grouptags ":")
(:newline "\\n")
(otherwise (concat (car tag)
@@ -5236,12 +5244,20 @@ FILETAGS is a list of tags, as strings."
((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 "\\`\\([[:alnum:]_@#%]+\\)\\(?:(\\(.\\))\\)?\\'") e)
+ (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)))))
@@ -5249,7 +5265,8 @@ FILETAGS is a list of tags, as strings."
(setcar org-tag-groups-alist
(append (car org-tag-groups-alist) (list tag))))
(group-flag (push (list tag) org-tag-groups-alist)))
- (unless (assoc tag org-tag-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)))
@@ -14528,9 +14545,9 @@ This replaces every group tag in MATCH with a regexp tag search.
For example, a group tag \"Work\" defined as { Work : Lab Conf }
will be replaced like this:
- Work => {\\(?:Work\\|Lab\\|Conf\\)}
- +Work => +{\\(?:Work\\|Lab\\|Conf\\)}
- -Work => -{\\(?:Work\\|Lab\\|Conf\\)}
+ Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
+ +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
+ -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
Replacing by a regexp preserves the structure of the match.
E.g., this expansion
@@ -14540,6 +14557,12 @@ E.g., this expansion
will match anything tagged with \"Lab\" and \"Home\", or tagged
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@.+} }
+will be replaced like this:
+
+ Proj => {\\<\\(?:Proj\\)\\>\\|P@.+}
+
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.
@@ -14548,33 +14571,87 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(if org-group-tags
(let* ((case-fold-search t)
(stable org-mode-syntax-table)
- (tal (or org-tag-groups-alist-for-agenda
- org-tag-groups-alist))
- (tal (if downcased
- (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
- (tml (mapcar 'car tal))
- (rtnmatch match) rpl)
- ;; @ and _ are allowed as word-components in tags
+ (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)
+ 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)
(modify-syntax-entry ?_ "w" stable)
- (while (and tml
+ ;; Temporarily replace regexp-expressions in the match-expression.
+ (while (string-match "{.+?}" return-match)
+ (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 tml) "\\>\\)") rtnmatch)))
- (let* ((dir (match-string 1 rtnmatch))
- (tag (match-string 2 rtnmatch))
+ (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)))
- (setq tml (delete tag tml))
- (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
- (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
- (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
- (if (stringp rpl) (org-add-props rpl '(grouptag t)))
- (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (when (not (get-text-property 0 'grouptag (match-string 2 return-match)))
+ (setq tags-in-group (assoc tag taggroups))
+ ;; 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))
+ (decf count))
(if single-as-list
- (or (reverse rpl) (list rtnmatch))
- rtnmatch))
- (if single-as-list (list (if downcased (downcase match) match))
+ (if tags-in-group tags-in-group (list return-match))
+ return-match))
+ (if single-as-list
+ (list (if downcased (downcase match) match))
match)))
(defun org-op-to-function (op &optional stringp)
@@ -15033,7 +15110,7 @@ Returns the new tags string, or nil to not change the current settings."
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
- groups ingroup)
+ groups ingroup intaggroup)
(save-excursion
(beginning-of-line 1)
(if (looking-at
@@ -15066,24 +15143,33 @@ Returns the new tags string, or nil to not change the current settings."
(setq tbl fulltable char ?a cnt 0)
(while (setq e (pop tbl))
(cond
- ((equal (car e) :startgroup)
+ ((eq (car e) :startgroup)
(push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n"))
(insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
- ((equal (car e) :endgroup)
+ ((eq (car e) :endgroup)
(setq ingroup nil cnt 0)
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((eq (car e) :startgrouptag)
+ (setq intaggroup t)
+ (unless (zerop cnt)
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "[ "))
+ ((eq (car e) :endgrouptag)
+ (setq intaggroup nil cnt 0)
+ (insert "]\n"))
((equal e '(:newline))
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n")
(setq e (car tbl))
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) nil)
+ ((equal e '(:grouptags)) (insert " : "))
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -15097,27 +15183,27 @@ Returns the new tags string, or nil to not change the current settings."
(setq char (1+ char)))
(setq c2 c1))
(setq c (or c2 char)))
- (if ingroup (push tg (car groups)))
+ (when ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
(cond
((not (assoc tg table))
(org-get-todo-face tg))
((member tg current) c-face)
((member tg inherited) i-face))))
- (if (equal (caar tbl) :grouptags)
- (org-add-props tg nil 'face 'org-tag-group))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (when (equal (caar tbl) :grouptags)
+ (org-add-props tg nil 'face 'org-tag-group))
+ (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
- (when (= (setq cnt (1+ cnt)) ncol)
+ (when (= (incf cnt) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (when (or ingroup intaggroup) (insert " "))
(setq cnt 0)))))
(setq ntable (nreverse ntable))
(insert "\n")
(goto-char (point-min))
- (if (not expert) (org-fit-window-to-buffer))
+ (unless expert (org-fit-window-to-buffer))
(setq rtn
(catch 'exit
(while t
@@ -15147,7 +15233,7 @@ Returns the new tags string, or nil to not change the current settings."
(setq quit-flag t))
((= c ?\ )
(setq current nil)
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((= c ?\t)
(condition-case nil
(setq tg (org-icompleting-read
@@ -15161,28 +15247,26 @@ Returns the new tags string, or nil to not change the current settings."
(if (member tg current)
(setq current (delete tg current))
(push tg current)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c todo-table) tg (car e))
(with-current-buffer buf
(save-excursion (org-todo tg)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c ntable) tg (car e))
(if (member tg current)
(setq current (delete tg current))
(loop for g in groups do
- (if (member tg g)
- (mapc (lambda (x)
- (setq current (delete x current)))
- g)))
+ (when (member tg g)
+ (dolist (x g) (setq current (delete x current)))))
(push tg current))
- (if exit-after-next (setq exit-after-next 'now))))
+ (when exit-after-next (setq exit-after-next 'now))))
;; Create a sorted list
(setq current
(sort current
(lambda (a b)
(assoc b (cdr (memq (assoc a ntable) ntable))))))
- (if (eq exit-after-next 'now) (throw 'exit t))
+ (when (eq exit-after-next 'now) (throw 'exit t))
(goto-char (point-min))
(beginning-of-line 2)
(delete-region (point) (point-at-eol))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 5c10dd4..70aa38d 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -1160,6 +1160,16 @@
(org-test-with-temp-text "#+TAGS: { A : B C }"
(org-mode-restart)
org-tag-groups-alist)))
+ (should
+ (equal '((:startgrouptag) ("A") (:grouptags) ("B") ("C") (:endgrouptag))
+ (org-test-with-temp-text "#+TAGS: [ A : B C ]"
+ (org-mode-restart)
+ org-tag-alist)))
+ (should
+ (equal '(("A" "B" "C"))
+ (org-test-with-temp-text "#+TAGS: [ A : B C ]"
+ (org-mode-restart)
+ org-tag-groups-alist)))
;; FILETAGS keyword.
(should
(equal '("A" "B" "C")
@@ -3076,6 +3086,32 @@ Text.
(org-match-sparse-tree nil "work")
(search-forward "H2")
(org-invisible-p2)))
+ ;; Match group tags with hard brackets.
+ (should-not
+ (org-test-with-temp-text
+ "#+TAGS: [ work : lab ]\n* H\n** H1 :work:\n** H2 :lab:"
+ (org-match-sparse-tree nil "work")
+ (search-forward "H1")
+ (org-invisible-p2)))
+ (should-not
+ (org-test-with-temp-text
+ "#+TAGS: [ work : lab ]\n* H\n** H1 :work:\n** H2 :lab:"
+ (org-match-sparse-tree nil "work")
+ (search-forward "H2")
+ (org-invisible-p2)))
+ ;; Match regular expressions in tags
+ (should-not
+ (org-test-with-temp-text
+ "#+TAGS: [ Lev : {Lev_[0-9]} ]\n* H\n** H1 :Lev_1:"
+ (org-match-sparse-tree nil "Lev")
+ (search-forward "H1")
+ (org-invisible-p2)))
+ (should
+ (org-test-with-temp-text
+ "#+TAGS: [ Lev : {Lev_[0-9]} ]\n* H\n** H1 :Lev_n:"
+ (org-match-sparse-tree nil "Lev")
+ (search-forward "H1")
+ (org-invisible-p2)))
;; Match properties.
(should
(org-test-with-temp-text
--
1.9.1
[-- Attachment #3: 0002-org-agenda-Filtering-in-the-agenda-on-grouptags.patch --]
[-- Type: application/octet-stream, Size: 12755 bytes --]
From 706a35d80922630ad8fdf26d89430ebd742ce2cb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:35 +0100
Subject: [PATCH 2/4] org-agenda: Filtering in the agenda on grouptags
Filtering in the agenda on grouptags filter also subcategories.
Exception if filter is applied with a (double) prefix-argument.
Filtering in the agenda on subcategories does not filter the "above"
levels anymore.
If a grouptag contains a regular expression the regular expression
is also used as a filter.
* lisp/org-agenda.el (org-agenda-filter-by-tag): improved UI and
refactoring.
Now uses the argument arg and optional argument exclude instead of
strip and narrow. ARG because the argument has multiple purposes
and makes more sense than strip now. The term narrowing is changed
to exclude.
* lisp/org-agenda.el (org-agenda-filter-by-tag-refine): name change in
argument to match org-agenda-filter-by-tag.
* lisp/org-agenda.el (org-agenda-filter-make-matcher): new optional
argument EXPAND and refactoring.
* lisp/org-agenda.el (org-agenda-filter-make-matcher-tag-exp): new
function, previously baked into org-agenda-filter-make-matcher.
* lisp/org-agenda.el (org-agenda-filter-apply): New optional parameter
EXPAND, used in call to org-agenda-filter-make-matcher.
* lisp/org-agenda.el (org-agenda-reapply-filters): Uses another
parameter (the new optional one) in call to org-agenda-filter-apply.
* lisp/org-agenda.el (org-agenda-finalize): use of new parameter in
call to org-agenda-filter-apply.
* lisp/org-agenda.el (org-agenda-redo): Use of new parameter in call
to org-agenda-filter-apply.
---
lisp/org-agenda.el | 150 ++++++++++++++++++++++++++++++-----------------------
1 file changed, 84 insertions(+), 66 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index b0e1224..959496f 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -3761,10 +3761,10 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-agenda-filter-top-headline-apply
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
(when (get 'org-agenda-tag-filter :preset-filter)
(org-agenda-filter-apply
- (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (get 'org-agenda-tag-filter :preset-filter) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
(when (get 'org-agenda-category-filter :preset-filter)
@@ -7333,7 +7333,7 @@ in the agenda."
(cat (or cat-filter cat-preset))
(effort (or effort-filter effort-preset))
(re (or re-filter re-preset)))
- (when tag (org-agenda-filter-apply tag 'tag))
+ (when tag (org-agenda-filter-apply tag 'tag t))
(when cat (org-agenda-filter-apply cat 'category))
(when effort (org-agenda-filter-apply effort 'effort))
(when re (org-agenda-filter-apply re 'regexp)))
@@ -7455,13 +7455,17 @@ With two prefix arguments, remove the effort filters."
(org-agenda-filter-show-all-effort))
(org-agenda-finalize))
-(defun org-agenda-filter-by-tag (strip &optional char narrow)
+(defun org-agenda-filter-by-tag (arg &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
-The tag is selected with its fast selection letter, as configured.
-With prefix argument STRIP, remove all lines that do have the tag.
-A lisp caller can specify CHAR. NARROW means that the new tag should be
-used to narrow the search - the interactive user can also press `-' or `+'
-to switch to narrowing."
+The tag is selected with its fast selection letter, as
+configured. With a single \\[universal-argument] prefix ARG,
+exclude the agenda search. With a double \\[universal-argument]
+prefix ARG, filter the literal tag. I.e. don't filter on all its
+group members.
+
+A lisp caller can specify CHAR. EXCLUDE means that the new tag should be
+used to exclude the search - the interactive user can also press `-' or `+'
+to switch between filtering and excluding."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(tag-chars (mapconcat
@@ -7469,24 +7473,26 @@ to switch to narrowing."
(cdr x))
(char-to-string (cdr x))
""))
- alist ""))
+ org-tag-alist-for-agenda ""))
+ (valid-char-list (append '(?\t ?\r ?/ ?. ?\s ?q)
+ (string-to-list tag-chars)))
+ (exclude (or exclude (equal arg '(4))))
+ (expand (not (equal arg '(16))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
a n tag)
(unless char
- (message
- "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow"
- (if narrow "Narrow" "Filter") tag-chars
- (if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char-exclusive)))
- (when (member char '(?+ ?-))
- ;; Narrowing down
- (cond ((equal char ?-) (setq strip t narrow t))
- ((equal char ?+) (setq strip nil narrow t)))
- (message
- "Narrow by tag [%s ], [TAB], [/]:off" tag-chars)
- (setq char (read-char-exclusive)))
- (when (equal char ?\t)
+ (while (not (memq char valid-char-list))
+ (message
+ "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
+ (if exclude "Exclude" "Filter") tag-chars
+ (if org-agenda-auto-exclude-function "[RET], " "")
+ (if expand "" ", no grouptag expand"))
+ (setq char (read-char-exclusive))
+ ;; Excluding or filtering down
+ (cond ((eq char ?-) (setq exclude t))
+ ((eq char ?+) (setq exclude nil)))))
+ (when (eq char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
(org-set-local 'org-global-tags-completion-table
(org-global-tags-completion-table)))
@@ -7494,7 +7500,7 @@ to switch to narrowing."
(setq tag (org-icompleting-read
"Tag: " org-global-tags-completion-table))))
(cond
- ((equal char ?\r)
+ ((eq char ?\r)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
(setq org-agenda-tag-filter nil)
@@ -7503,25 +7509,26 @@ to switch to narrowing."
(if modifier
(push modifier org-agenda-tag-filter))))
(if (not (null org-agenda-tag-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))))
- ((equal char ?/)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
+ ((eq char ?/)
(org-agenda-filter-show-all-tag)
(when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
- ((equal char ?. )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
+ ((eq char ?.)
(setq org-agenda-tag-filter
(mapcar (lambda(tag) (concat "+" tag))
(org-get-at-bol 'tags)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
- ((or (equal char ?\ )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
+ ((or (eq char ?\s)
(setq a (rassoc char alist))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-tag-filter
- (cons (concat (if strip "-" "+") tag)
- (if narrow current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (cons (concat (if exclude "-" "+") tag)
+ current))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
(t (error "Invalid tag selection character %c" char)))))
(defun org-agenda-get-represented-tags ()
@@ -7535,13 +7542,15 @@ to switch to narrowing."
(get-text-property (point) 'tags))))
tags))
-(defun org-agenda-filter-by-tag-refine (strip &optional char)
+(defun org-agenda-filter-by-tag-refine (arg &optional char)
"Refine the current filter. See `org-agenda-filter-by-tag'."
(interactive "P")
- (org-agenda-filter-by-tag strip char 'refine))
+ (org-agenda-filter-by-tag arg char 'refine))
-(defun org-agenda-filter-make-matcher (filter type)
- "Create the form that tests a line for agenda filter."
+(defun org-agenda-filter-make-matcher (filter type &optional expand)
+ "Create the form that tests a line for agenda filter. Optional
+argument EXPAND can be used for the TYPE tag and will expand the
+tags in the FILTER if any of the tags in FILTER are grouptags."
(let (f f1)
(cond
;; Tag filter
@@ -7551,26 +7560,11 @@ to switch to narrowing."
(append (get 'org-agenda-tag-filter :preset-filter)
filter)))
(dolist (x filter)
- (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
- (ffunc
- (lambda (nf0 nf01 fltr notgroup op)
- (dolist (x fltr)
- (if (member x '("-" "+"))
- (setq nf01 (if (equal x "-") 'tags '(not tags)))
- (setq nf01 (list 'member (downcase (substring x 1))
- 'tags))
- (when (equal (string-to-char x) ?-)
- (setq nf01 (list 'not nf01))
- (when (not notgroup) (setq op 'and))))
- (push nf01 nf0))
- (if notgroup
- (push (cons 'and nf0) f)
- (push (cons (or op 'or) nf0) f)))))
- (cond ((equal filter '("+"))
- (setq f (list (list 'not 'tags))))
- ((equal nfilter filter)
- (funcall ffunc f1 f filter t nil))
- (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ (let ((op (string-to-char x)))
+ (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
+ (setq x (list x)))
+ (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
+ (push f1 f))))
;; Category filter
((eq type 'category)
(setq filter
@@ -7603,6 +7597,32 @@ to switch to narrowing."
(push (org-agenda-filter-effort-form x) f))))
(cons 'and (nreverse f))))
+(defun org-agenda-filter-make-matcher-tag-exp (tags op)
+ "Create the form that tests a line for agenda filter for
+tag-expressions. Return a match-expression given TAGS. OP is an
+operator of type CHAR that allows the function to set the right
+switches in the returned form."
+ (let (f f1) ;f = return expression. f1 = working-area
+ (dolist (x tags)
+ (let* ((tag (substring x 1))
+ (isregexp (and (equal "{" (substring tag 0 1))
+ (equal "}" (substring tag -1))))
+ regexp)
+ (cond
+ (isregexp
+ (setq regexp (substring tag 1 -1))
+ (setq f1 (list 'org-match-any-p regexp 'tags)))
+ (t
+ (setq f1 (list 'member (downcase tag) 'tags))))
+ (when (eq op ?-)
+ (setq f1 (list 'not f1))))
+ (push f1 f))
+ ;; Any of the expressions can match if op = +
+ ;; all must match if the operator is -.
+ (if (eq op ?-)
+ (cons 'and f)
+ (cons 'or f))))
+
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
E looks like \"+<2:25\"."
@@ -7641,12 +7661,14 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(reverse rtn))
filter))
-(defun org-agenda-filter-apply (filter type)
- "Set FILTER as the new agenda filter and apply it."
+(defun org-agenda-filter-apply (filter type &optional expand)
+ "Set FILTER as the new agenda filter and apply it. Optional
+argument EXPAND can be used for the TYPE tag and will expand the
+tags in the FILTER if any of the tags in FILTER are grouptags."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
(let (tags cat txt)
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand))
;; Only set `org-agenda-filtered-by-category' to t when a unique
;; category is used as the filter:
(setq org-agenda-filtered-by-category
@@ -7658,11 +7680,7 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags ; used in eval
- (apply 'append
- (mapcar (lambda (f)
- (org-agenda-filter-expand-tags (list f) t))
- (org-get-at-bol 'tags)))
+ (setq tags (org-get-at-bol 'tags)
cat (org-get-at-eol 'org-category 1)
txt (org-get-at-eol 'txt 1))
(if (not (eval org-agenda-filter-form))
@@ -9973,7 +9991,7 @@ current HH:MM time."
(defun org-agenda-reapply-filters ()
"Re-apply all agenda filters."
(mapcar
- (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
`((,org-agenda-tag-filter tag)
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
--
1.9.1
[-- Attachment #4: 0003-org-Nesting-grouptags.patch --]
[-- Type: application/octet-stream, Size: 3791 bytes --]
From 1d01c58d909f5c49c98c2ae141e126b48a1396b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:47 +0100
Subject: [PATCH 3/4] 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.
---
lisp/org.el | 29 +++++++++++++++++++++++++++--
testing/lisp/test-org.el | 10 ++++++++++
2 files changed, 37 insertions(+), 2 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index b39cb98..22c7526 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -14538,7 +14538,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.
@@ -14579,6 +14579,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)
@@ -14596,8 +14597,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)
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 70aa38d..f597255 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3099,6 +3099,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
--
1.9.1
[-- Attachment #5: 0004-org.texi-Complement-info-for-group-tags.patch --]
[-- Type: application/octet-stream, Size: 6882 bytes --]
From bdc6a29390d9d60f69ffdf442c28a469601ab998 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Thu, 5 Mar 2015 01:45:57 +0100
Subject: [PATCH 4/4] org.texi: Complement info for group tags
group tags are more general and a name-change (or addition) is made in
the manual: tag groups are now called tag hierarchy.
Adding information about the added tag hierarchy functionality and
use-cases.
---
doc/org.texi | 114 ++++++++++++++++++++++++++++++++++++++++++++++-------------
1 file changed, 89 insertions(+), 25 deletions(-)
diff --git a/doc/org.texi b/doc/org.texi
index edb6cf0..68e6436 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -432,7 +432,7 @@ Tags
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
Properties and columns
@@ -4877,7 +4877,7 @@ You may specify special faces for specific tags using the option
@menu
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
@end menu
@@ -5116,41 +5116,105 @@ instead of @kbd{C-c C-c}). If you set the variable to the value
@code{expert}, the special window is not even shown for single-key tag
selection, it comes up only when you press an extra @kbd{C-c}.
-@node Tag groups
-@section Tag groups
+@node Tag hierarchy
+@section Tag hierarchy
@cindex group tags
@cindex tags, groups
-In a set of mutually exclusive tags, the first tag can be defined as a
-@emph{group tag}. When you search for a group tag, it will return matches
-for all members in the group. In an agenda view, filtering by a group tag
-will display headlines tagged with at least one of the members of the
-group. This makes tag searches and filters even more flexible.
+@cindex tag hierarchy
+Tags can be defined in hierarchies. A tag can be defined as a @emph{group
+tag} for a set of other tags. The group tag can be seen as the ``broader
+term'' for its set of tags. Defining multiple @emph{group tags} and nesting
+them creates a tag hierarchy.
-You can set group tags by inserting a colon between the group tag and other
-tags---beware that all whitespaces are mandatory so that Org can parse this
-line correctly:
+One use-case is to create a taxonomy of terms (tags) that can be used to
+classify nodes in a document or set of documents.
+
+When you search for a group tag, it will return matches for all members in
+the group and its subgroup. In an agenda view, filtering by a group tag will
+display or hide headlines tagged with at least one of the members of the
+group or any of its subgroups. This makes tag searches and filters even more
+flexible.
+
+You can set group tags by using brackets and inserting a colon between the
+group tag and its related tags---beware that all whitespaces are mandatory so
+that Org can parse this line correctly:
+
+@example
+#+TAGS: [ GTD : Control Persp ]
+@end example
+
+In this example, @samp{GTD} is the @emph{group tag} and it is related to two
+other tags: @samp{Control}, @samp{Persp}. Defining @samp{Control} and
+@samp{Persp} as group tags creates an hierarchy of tags:
@example
-#+TAGS: @{ @@read : @@read_book @@read_ebook @}
+#+TAGS: [ Control : Context Task ]
+#+TAGS: [ Persp : Vision Goal AOF Project ]
@end example
-In this example, @samp{@@read} is a @emph{group tag} for a set of three
-tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}.
+That can conceptually be seen as a hierarchy of tags:
-You can also use the @code{:grouptags} keyword directly when setting
-@code{org-tag-alist}:
+@example
+- GTD
+ - Persp
+ - Vision
+ - Goal
+ - AOF
+ - Project
+ - Control
+ - Context
+ - Task
+@end example
+
+You can use the @code{:startgrouptag}, @code{:grouptags} and
+@code{:endgrouptag} keyword directly when setting @code{org-tag-alist}
+directly:
@lisp
-(setq org-tag-alist '((:startgroup . nil)
- ("@@read" . nil)
- (:grouptags . nil)
- ("@@read_book" . nil)
- ("@@read_ebook" . nil)
- (:endgroup . nil)))
+(setq org-tag-alist '((:startgrouptag)
+ ("GTD")
+ (:grouptags)
+ ("Control")
+ ("Persp")
+ (:endgrouptag)
+ (:startgrouptag)
+ ("Control")
+ (:grouptags)
+ ("Context")
+ ("Task")
+ (:endgrouptag)))
@end lisp
-You cannot nest group tags or use a group tag as a tag in another group.
+The tags in a group can be mutually exclusive if using the same group syntax
+as is used for grouping mutually exclusive tags together; using curly
+brackets.
+
+@example
+#+TAGS: @{ Context : @@Home @@Work @@Call @}
+@end example
+
+When setting @code{org-tag-alist} you can use @code{:startgroup} &
+@code{:endgroup} instead of @code{:startgrouptag} & @code{:endgrouptag} to
+make the tags mutually exclusive.
+
+Furthermore; The members of a @emph{group tag} can also be regular
+expression, creating the possibility of more dynamic and rule-based
+tag-structure. The regular expressions in the group must be marked up within
+@{ @}. Example use, to expand on the example given above:
+
+@example
+#+TAGS: [ Vision : @{V@.+@} ]
+#+TAGS: [ Goal : @{G@.+@} ]
+#+TAGS: [ AOF : @{AOF@.+@} ]
+#+TAGS: [ Project : @{P@.+@} ]
+@end example
+
+Searching for the tag @samp{Project} will now list all tags also including
+regular expression matches for @samp{P@@.+}. Similar for tag-searches on
+@samp{Vision}, @samp{Goal} and @samp{AOF}. This can be good for example if
+tags for a certain project is tagged with a common project-identifier,
+i.e. @samp{P@@2014_OrgTags}.
@kindex C-c C-x q
@vindex org-group-tags
@@ -8111,7 +8175,7 @@ braces. For example,
@samp{:work:} and any tag @i{starting} with @samp{boss}.
@cindex group tags, as regular expressions
-Group tags (@pxref{Tag groups}) are expanded as regular expressions. E.g.,
+Group tags (@pxref{Tag hierarchy}) are expanded as regular expressions. E.g.,
if @samp{:work:} is a group tag for the group @samp{:work:lab:conf:}, then
searching for @samp{work} will search for @samp{@{\(?:work\|lab\|conf\)@}}
and searching for @samp{-work} will search for all headlines but those with
--
1.9.1
^ permalink raw reply related [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-03-07 21:51 ` Nicolas Goaziou
2015-03-15 10:17 ` Gustav Wikström
@ 2015-03-16 20:38 ` Gustav Wikström
2015-03-16 21:30 ` Nicolas Goaziou
1 sibling, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-03-16 20:38 UTC (permalink / raw)
To: Org Mode List, Nicolas Goaziou
[-- Attachment #1: Type: text/plain, Size: 5672 bytes --]
Hi again!
It seems my mail got stuck in some filters - I sent one from another
address yesterday. Oh well, here it is anyway!
Comments below.
> From: Nicolas Goaziou [mailto:mail@nicolasgoaziou.fr]
> > + (taggroups (if downcased (mapcar (lambda (tg) (mapcar #'downcase tg))
> > + taggroups) taggroups))
>
> Nitpick: indentation
Can't see what's wrong.. Autoindent by emacs did this. Anyways.. I
made the if-construct clearer by adding linebreaks.
> > + (delq nil (mapcar (lambda (x)
> > + (if (stringp x)
> > + (and (equal "{" (substring x 0 1))
> > + (equal "}" (substring x -1))
> > + x)
> > + x)) tags-in-group))
>
> Same here. TAGS-IN-GROUP should be at the same level as (lambda (x) ...)
Ok, fixed.
> > + regexp-in-group
> > + (mapcar (lambda (x)
> > + (substring x 1 -1)) regexp-in-group-escaped)
>
> Ditto.
Fixed.
> > + 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)))
>
> Ditto.
Fixed.
> > + ; If single-as-list, do no more in the while-loop...
> > + (if (not single-as-list)
> > + (progn
> > + (if 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 "\\>}"))
>
> You need to keep lines within 80 columns.
Trying to avoid it.
> > + (when (member tg g)
> > + (mapc (lambda (x)
> > + (setq current (delete x current)))
> > + g)))
>
> While you're at it:
>
> (when (member tg g) (dolist (x g) (setq current (delete x current))))
Ok!
> > +(defun org-agenda-filter-by-tag (arg &optional char exclude)
> > "Keep only those lines in the agenda buffer that have a specific tag.
> > The tag is selected with its fast selection letter, as configured.
> > -With prefix argument STRIP, remove all lines that do have the tag.
> > -A lisp caller can specify CHAR. NARROW means that the new tag should be
> > -used to narrow the search - the interactive user can also press `-' or `+'
> > -to switch to narrowing."
> > +With a single `C-u' prefix ARG, exclude the agenda search. With a
> > +double `C-u' prefix ARG, filter the literal tag. I.e. don't filter on
> ^^^
> missing space
Fixed.
> Also, instead of hard-coding `C-u', you could use \\[universal-argument]
> within the doc string. See, for example, `org-tree-to-indirect-buffer'.
Fixed.
> > + (exclude (if exclude exclude (equal arg '(4))))
>
> (exclude (or exclude (equal arg '(4))))
Fixed.
> > + (while (not (memq char (append '(?\t ?\r ?/ ?. ?\ ?q)
> > + (string-to-list tag-chars))))
>
> For clarity, use ?\s instead of ?\
Fixed.
> Also, I suggest to move the consing before the while loop.
Good point, changed.
> > + ((eq char ?. )
>
> Spurious space.
Fixed.
> > + ((or (eq char ?\ )
>
> See above.
Fixed.
>
> > + (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)))))
>
> Lines too wide.
Ok, fixed kind of. I don't want to compromise on the relatively long
variable names.
>
> > +Tags can be defined in hierarchies. A tag can be defined as a @emph{group
> ^^^
> missing space
Fixed.
> > @lisp
> > -(setq org-tag-alist '((:startgroup . nil)
> > +(setq org-tag-alist '((:startgrouptag . nil)
> > ("@@read" . nil)
> > (:grouptags . nil)
> > ("@@read_book" . nil)
> > ("@@read_ebook" . nil)
> > - (:endgroup . nil)))
> > + (:endgrouptag . nil)))
> > @end lisp
>
> The following is clearer
>
> @lisp
> (setq org-tag-alist '((:startgrouptag)
> ("@@read")
> (:grouptags)
> ("@@read_book")
> ("@@read_ebook")
> (:endgrouptag)))
> @end lisp
>
Indeed
> However, shouldn't this example apply to the one above? (e.g.., with
> Control : Context Task tag line)?
Indeed again!
>
> > +Searching for the tag Project will now list all tags also including regular
> > +expression matches for P@@.+. Similar for tag-searches on Vision, Goal and
> > +AOF. This can be good for example if tags for a certain project is tagged
> > +with a common project-identifier, i.e. P@@2014_OrgTags.
>
> @samp{Project} @samp{Vision}... @samp{P@@2014_OrgTags}.
>
> This all looks very nice.
Thx!
> As a final step, would you mind adding tests
> for this?
Added a few now. Actually found an error in the way regexps were
matched and filtered due to the added tests. So, good point. The
errors are fixed ofc.
Fixed patches are attached,
Best regards
Gustav Wikström
[-- Attachment #2: 0001-org-Grouptags-not-unique-and-can-contain-regexp.patch --]
[-- Type: application/octet-stream, Size: 15894 bytes --]
From b1a85ca66260f3ac87607d617e059d72f09ba495 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:26 +0100
Subject: [PATCH 1/4] org: Grouptags not unique and can contain regexp
* lisp/org.el (org-tags-expand): Grouptags can have regular expressions as
"sub-tags".
The regular expressions in the group must be marked up within { }.
Example use:
: #+TAGS: [ Project : {P@.+} ]
Searching for the tag Project will now list all tags also including
regular expression matches for P@.+. Good for example if tags for a
certain project is tagged with a common project-identifier,
i.e. P@2014_OrgTags.
* lisp/org.el (org-tag-alist) : New symbols for grouptags when the
tags in the group don't have to be distinct on a heading.
Grouptags had to previously be defined with { }. This syntax is
already used for exclusive tags and Grouptags need their own,
non-exclusive syntax. This behaviour is achieved with [ ]. Note: {
} can still be used also for Grouptags but then only one of the
given tags can be used on the headline at the same time. Example:
[ group : sub1 sub2 ]
Grouptags also are not filtered when setting up tags. This means
they can exist multiple times in org-tag-alist list. It will be
usable if nesting of grouptags is ever to become reality.
There is a slightly annoying side-effect when setting tags in that a
tag which is both a part of a grouptag and a grouptag of it's own
will get multiple key-choices in the selection-UI.
* lisp/org.el (org--setup-process-tags): Adaption for the added syntax
for non-distinct grouptags.
* lisp/org.el (org-fast-tag-selection): Add support for the added,
non-unique, grouptag-syntax. Minor (if ...) to (when ...) refactor.
---
lisp/org.el | 178 ++++++++++++++++++++++++++++++++++-------------
testing/lisp/test-org.el | 36 ++++++++++
2 files changed, 167 insertions(+), 47 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index da5de84..b39cb98 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -3482,11 +3482,17 @@ See the manual for details."
(list :tag "Start radio group"
(const :startgroup)
(option (string :tag "Group description")))
+ (list :tag "Start tag group, non distinct"
+ (const :startgrouptag)
+ (option (string :tag "Group description")))
(list :tag "Group tags delimiter"
(const :grouptags))
(list :tag "End radio group"
(const :endgroup)
(option (string :tag "Group description")))
+ (list :tag "End tag group, non distinct"
+ (const :endgrouptag)
+ (option (string :tag "Group description")))
(const :tag "New line" (:newline)))))
(defcustom org-tag-persistent-alist nil
@@ -5216,6 +5222,8 @@ FILETAGS is a list of tags, as strings."
(case (car tag)
(:startgroup "{")
(:endgroup "}")
+ (:startgrouptag "[")
+ (:endgrouptag "]")
(:grouptags ":")
(:newline "\\n")
(otherwise (concat (car tag)
@@ -5236,12 +5244,20 @@ FILETAGS is a list of tags, as strings."
((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 "\\`\\([[:alnum:]_@#%]+\\)\\(?:(\\(.\\))\\)?\\'") e)
+ (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)))))
@@ -5249,7 +5265,8 @@ FILETAGS is a list of tags, as strings."
(setcar org-tag-groups-alist
(append (car org-tag-groups-alist) (list tag))))
(group-flag (push (list tag) org-tag-groups-alist)))
- (unless (assoc tag org-tag-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)))
@@ -14528,9 +14545,9 @@ This replaces every group tag in MATCH with a regexp tag search.
For example, a group tag \"Work\" defined as { Work : Lab Conf }
will be replaced like this:
- Work => {\\(?:Work\\|Lab\\|Conf\\)}
- +Work => +{\\(?:Work\\|Lab\\|Conf\\)}
- -Work => -{\\(?:Work\\|Lab\\|Conf\\)}
+ Work => {\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
+ +Work => +{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
+ -Work => -{\\<\\(?:Work\\|Lab\\|Conf\\)\\>}
Replacing by a regexp preserves the structure of the match.
E.g., this expansion
@@ -14540,6 +14557,12 @@ E.g., this expansion
will match anything tagged with \"Lab\" and \"Home\", or tagged
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@.+} }
+will be replaced like this:
+
+ Proj => {\\<\\(?:Proj\\)\\>\\|P@.+}
+
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.
@@ -14548,33 +14571,87 @@ When DOWNCASE is non-nil, expand downcased TAGS."
(if org-group-tags
(let* ((case-fold-search t)
(stable org-mode-syntax-table)
- (tal (or org-tag-groups-alist-for-agenda
- org-tag-groups-alist))
- (tal (if downcased
- (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
- (tml (mapcar 'car tal))
- (rtnmatch match) rpl)
- ;; @ and _ are allowed as word-components in tags
+ (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)
+ 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)
(modify-syntax-entry ?_ "w" stable)
- (while (and tml
+ ;; Temporarily replace regexp-expressions in the match-expression.
+ (while (string-match "{.+?}" return-match)
+ (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 tml) "\\>\\)") rtnmatch)))
- (let* ((dir (match-string 1 rtnmatch))
- (tag (match-string 2 rtnmatch))
+ (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)))
- (setq tml (delete tag tml))
- (when (not (get-text-property 0 'grouptag (match-string 2 rtnmatch)))
- (setq rpl (append (org-uniquify rpl) (assoc tag tal)))
- (setq rpl (concat dir "{\\<" (regexp-opt rpl) "\\>}"))
- (if (stringp rpl) (org-add-props rpl '(grouptag t)))
- (setq rtnmatch (replace-match rpl t t rtnmatch)))))
+ (when (not (get-text-property 0 'grouptag (match-string 2 return-match)))
+ (setq tags-in-group (assoc tag taggroups))
+ ;; 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))
+ (decf count))
(if single-as-list
- (or (reverse rpl) (list rtnmatch))
- rtnmatch))
- (if single-as-list (list (if downcased (downcase match) match))
+ (if tags-in-group tags-in-group (list return-match))
+ return-match))
+ (if single-as-list
+ (list (if downcased (downcase match) match))
match)))
(defun org-op-to-function (op &optional stringp)
@@ -15033,7 +15110,7 @@ Returns the new tags string, or nil to not change the current settings."
ov-start ov-end ov-prefix
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
- groups ingroup)
+ groups ingroup intaggroup)
(save-excursion
(beginning-of-line 1)
(if (looking-at
@@ -15066,24 +15143,33 @@ Returns the new tags string, or nil to not change the current settings."
(setq tbl fulltable char ?a cnt 0)
(while (setq e (pop tbl))
(cond
- ((equal (car e) :startgroup)
+ ((eq (car e) :startgroup)
(push '() groups) (setq ingroup t)
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n"))
(insert (if (cdr e) (format "%s: " (cdr e)) "") "{ "))
- ((equal (car e) :endgroup)
+ ((eq (car e) :endgroup)
(setq ingroup nil cnt 0)
(insert "}" (if (cdr e) (format " (%s) " (cdr e)) "") "\n"))
+ ((eq (car e) :startgrouptag)
+ (setq intaggroup t)
+ (unless (zerop cnt)
+ (setq cnt 0)
+ (insert "\n"))
+ (insert "[ "))
+ ((eq (car e) :endgrouptag)
+ (setq intaggroup nil cnt 0)
+ (insert "]\n"))
((equal e '(:newline))
- (when (not (= cnt 0))
+ (unless (zerop cnt)
(setq cnt 0)
(insert "\n")
(setq e (car tbl))
(while (equal (car tbl) '(:newline))
(insert "\n")
(setq tbl (cdr tbl)))))
- ((equal e '(:grouptags)) nil)
+ ((equal e '(:grouptags)) (insert " : "))
(t
(setq tg (copy-sequence (car e)) c2 nil)
(if (cdr e)
@@ -15097,27 +15183,27 @@ Returns the new tags string, or nil to not change the current settings."
(setq char (1+ char)))
(setq c2 c1))
(setq c (or c2 char)))
- (if ingroup (push tg (car groups)))
+ (when ingroup (push tg (car groups)))
(setq tg (org-add-props tg nil 'face
(cond
((not (assoc tg table))
(org-get-todo-face tg))
((member tg current) c-face)
((member tg inherited) i-face))))
- (if (equal (caar tbl) :grouptags)
- (org-add-props tg nil 'face 'org-tag-group))
- (if (and (= cnt 0) (not ingroup)) (insert " "))
+ (when (equal (caar tbl) :grouptags)
+ (org-add-props tg nil 'face 'org-tag-group))
+ (when (and (zerop cnt) (not ingroup) (not intaggroup)) (insert " "))
(insert "[" c "] " tg (make-string
(- fwidth 4 (length tg)) ?\ ))
(push (cons tg c) ntable)
- (when (= (setq cnt (1+ cnt)) ncol)
+ (when (= (incf cnt) ncol)
(insert "\n")
- (if ingroup (insert " "))
+ (when (or ingroup intaggroup) (insert " "))
(setq cnt 0)))))
(setq ntable (nreverse ntable))
(insert "\n")
(goto-char (point-min))
- (if (not expert) (org-fit-window-to-buffer))
+ (unless expert (org-fit-window-to-buffer))
(setq rtn
(catch 'exit
(while t
@@ -15147,7 +15233,7 @@ Returns the new tags string, or nil to not change the current settings."
(setq quit-flag t))
((= c ?\ )
(setq current nil)
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((= c ?\t)
(condition-case nil
(setq tg (org-icompleting-read
@@ -15161,28 +15247,26 @@ Returns the new tags string, or nil to not change the current settings."
(if (member tg current)
(setq current (delete tg current))
(push tg current)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c todo-table) tg (car e))
(with-current-buffer buf
(save-excursion (org-todo tg)))
- (if exit-after-next (setq exit-after-next 'now)))
+ (when exit-after-next (setq exit-after-next 'now)))
((setq e (rassoc c ntable) tg (car e))
(if (member tg current)
(setq current (delete tg current))
(loop for g in groups do
- (if (member tg g)
- (mapc (lambda (x)
- (setq current (delete x current)))
- g)))
+ (when (member tg g)
+ (dolist (x g) (setq current (delete x current)))))
(push tg current))
- (if exit-after-next (setq exit-after-next 'now))))
+ (when exit-after-next (setq exit-after-next 'now))))
;; Create a sorted list
(setq current
(sort current
(lambda (a b)
(assoc b (cdr (memq (assoc a ntable) ntable))))))
- (if (eq exit-after-next 'now) (throw 'exit t))
+ (when (eq exit-after-next 'now) (throw 'exit t))
(goto-char (point-min))
(beginning-of-line 2)
(delete-region (point) (point-at-eol))
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 5c10dd4..70aa38d 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -1160,6 +1160,16 @@
(org-test-with-temp-text "#+TAGS: { A : B C }"
(org-mode-restart)
org-tag-groups-alist)))
+ (should
+ (equal '((:startgrouptag) ("A") (:grouptags) ("B") ("C") (:endgrouptag))
+ (org-test-with-temp-text "#+TAGS: [ A : B C ]"
+ (org-mode-restart)
+ org-tag-alist)))
+ (should
+ (equal '(("A" "B" "C"))
+ (org-test-with-temp-text "#+TAGS: [ A : B C ]"
+ (org-mode-restart)
+ org-tag-groups-alist)))
;; FILETAGS keyword.
(should
(equal '("A" "B" "C")
@@ -3076,6 +3086,32 @@ Text.
(org-match-sparse-tree nil "work")
(search-forward "H2")
(org-invisible-p2)))
+ ;; Match group tags with hard brackets.
+ (should-not
+ (org-test-with-temp-text
+ "#+TAGS: [ work : lab ]\n* H\n** H1 :work:\n** H2 :lab:"
+ (org-match-sparse-tree nil "work")
+ (search-forward "H1")
+ (org-invisible-p2)))
+ (should-not
+ (org-test-with-temp-text
+ "#+TAGS: [ work : lab ]\n* H\n** H1 :work:\n** H2 :lab:"
+ (org-match-sparse-tree nil "work")
+ (search-forward "H2")
+ (org-invisible-p2)))
+ ;; Match regular expressions in tags
+ (should-not
+ (org-test-with-temp-text
+ "#+TAGS: [ Lev : {Lev_[0-9]} ]\n* H\n** H1 :Lev_1:"
+ (org-match-sparse-tree nil "Lev")
+ (search-forward "H1")
+ (org-invisible-p2)))
+ (should
+ (org-test-with-temp-text
+ "#+TAGS: [ Lev : {Lev_[0-9]} ]\n* H\n** H1 :Lev_n:"
+ (org-match-sparse-tree nil "Lev")
+ (search-forward "H1")
+ (org-invisible-p2)))
;; Match properties.
(should
(org-test-with-temp-text
--
1.9.1
[-- Attachment #3: 0002-org-agenda-Filtering-in-the-agenda-on-grouptags.patch --]
[-- Type: application/octet-stream, Size: 12755 bytes --]
From 706a35d80922630ad8fdf26d89430ebd742ce2cb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:35 +0100
Subject: [PATCH 2/4] org-agenda: Filtering in the agenda on grouptags
Filtering in the agenda on grouptags filter also subcategories.
Exception if filter is applied with a (double) prefix-argument.
Filtering in the agenda on subcategories does not filter the "above"
levels anymore.
If a grouptag contains a regular expression the regular expression
is also used as a filter.
* lisp/org-agenda.el (org-agenda-filter-by-tag): improved UI and
refactoring.
Now uses the argument arg and optional argument exclude instead of
strip and narrow. ARG because the argument has multiple purposes
and makes more sense than strip now. The term narrowing is changed
to exclude.
* lisp/org-agenda.el (org-agenda-filter-by-tag-refine): name change in
argument to match org-agenda-filter-by-tag.
* lisp/org-agenda.el (org-agenda-filter-make-matcher): new optional
argument EXPAND and refactoring.
* lisp/org-agenda.el (org-agenda-filter-make-matcher-tag-exp): new
function, previously baked into org-agenda-filter-make-matcher.
* lisp/org-agenda.el (org-agenda-filter-apply): New optional parameter
EXPAND, used in call to org-agenda-filter-make-matcher.
* lisp/org-agenda.el (org-agenda-reapply-filters): Uses another
parameter (the new optional one) in call to org-agenda-filter-apply.
* lisp/org-agenda.el (org-agenda-finalize): use of new parameter in
call to org-agenda-filter-apply.
* lisp/org-agenda.el (org-agenda-redo): Use of new parameter in call
to org-agenda-filter-apply.
---
lisp/org-agenda.el | 150 ++++++++++++++++++++++++++++++-----------------------
1 file changed, 84 insertions(+), 66 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index b0e1224..959496f 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -3761,10 +3761,10 @@ FILTER-ALIST is an alist of filters we need to apply when
(org-agenda-filter-top-headline-apply
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag t))
(when (get 'org-agenda-tag-filter :preset-filter)
(org-agenda-filter-apply
- (get 'org-agenda-tag-filter :preset-filter) 'tag))
+ (get 'org-agenda-tag-filter :preset-filter) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
(when (get 'org-agenda-category-filter :preset-filter)
@@ -7333,7 +7333,7 @@ in the agenda."
(cat (or cat-filter cat-preset))
(effort (or effort-filter effort-preset))
(re (or re-filter re-preset)))
- (when tag (org-agenda-filter-apply tag 'tag))
+ (when tag (org-agenda-filter-apply tag 'tag t))
(when cat (org-agenda-filter-apply cat 'category))
(when effort (org-agenda-filter-apply effort 'effort))
(when re (org-agenda-filter-apply re 'regexp)))
@@ -7455,13 +7455,17 @@ With two prefix arguments, remove the effort filters."
(org-agenda-filter-show-all-effort))
(org-agenda-finalize))
-(defun org-agenda-filter-by-tag (strip &optional char narrow)
+(defun org-agenda-filter-by-tag (arg &optional char exclude)
"Keep only those lines in the agenda buffer that have a specific tag.
-The tag is selected with its fast selection letter, as configured.
-With prefix argument STRIP, remove all lines that do have the tag.
-A lisp caller can specify CHAR. NARROW means that the new tag should be
-used to narrow the search - the interactive user can also press `-' or `+'
-to switch to narrowing."
+The tag is selected with its fast selection letter, as
+configured. With a single \\[universal-argument] prefix ARG,
+exclude the agenda search. With a double \\[universal-argument]
+prefix ARG, filter the literal tag. I.e. don't filter on all its
+group members.
+
+A lisp caller can specify CHAR. EXCLUDE means that the new tag should be
+used to exclude the search - the interactive user can also press `-' or `+'
+to switch between filtering and excluding."
(interactive "P")
(let* ((alist org-tag-alist-for-agenda)
(tag-chars (mapconcat
@@ -7469,24 +7473,26 @@ to switch to narrowing."
(cdr x))
(char-to-string (cdr x))
""))
- alist ""))
+ org-tag-alist-for-agenda ""))
+ (valid-char-list (append '(?\t ?\r ?/ ?. ?\s ?q)
+ (string-to-list tag-chars)))
+ (exclude (or exclude (equal arg '(4))))
+ (expand (not (equal arg '(16))))
(inhibit-read-only t)
(current org-agenda-tag-filter)
a n tag)
(unless char
- (message
- "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow"
- (if narrow "Narrow" "Filter") tag-chars
- (if org-agenda-auto-exclude-function "[RET], " ""))
- (setq char (read-char-exclusive)))
- (when (member char '(?+ ?-))
- ;; Narrowing down
- (cond ((equal char ?-) (setq strip t narrow t))
- ((equal char ?+) (setq strip nil narrow t)))
- (message
- "Narrow by tag [%s ], [TAB], [/]:off" tag-chars)
- (setq char (read-char-exclusive)))
- (when (equal char ?\t)
+ (while (not (memq char valid-char-list))
+ (message
+ "%s by tag [%s ], [TAB], %s[/]:off, [+/-]:filter/exclude%s, [q]:quit"
+ (if exclude "Exclude" "Filter") tag-chars
+ (if org-agenda-auto-exclude-function "[RET], " "")
+ (if expand "" ", no grouptag expand"))
+ (setq char (read-char-exclusive))
+ ;; Excluding or filtering down
+ (cond ((eq char ?-) (setq exclude t))
+ ((eq char ?+) (setq exclude nil)))))
+ (when (eq char ?\t)
(unless (local-variable-p 'org-global-tags-completion-table (current-buffer))
(org-set-local 'org-global-tags-completion-table
(org-global-tags-completion-table)))
@@ -7494,7 +7500,7 @@ to switch to narrowing."
(setq tag (org-icompleting-read
"Tag: " org-global-tags-completion-table))))
(cond
- ((equal char ?\r)
+ ((eq char ?\r)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
(setq org-agenda-tag-filter nil)
@@ -7503,25 +7509,26 @@ to switch to narrowing."
(if modifier
(push modifier org-agenda-tag-filter))))
(if (not (null org-agenda-tag-filter))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))))
- ((equal char ?/)
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))))
+ ((eq char ?/)
(org-agenda-filter-show-all-tag)
(when (get 'org-agenda-tag-filter :preset-filter)
- (org-agenda-filter-apply org-agenda-tag-filter 'tag)))
- ((equal char ?. )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
+ ((eq char ?.)
(setq org-agenda-tag-filter
(mapcar (lambda(tag) (concat "+" tag))
(org-get-at-bol 'tags)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
- ((or (equal char ?\ )
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
+ ((eq char ?q)) ;If q, abort (even if there is a q-key for a tag...)
+ ((or (eq char ?\s)
(setq a (rassoc char alist))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-tag-filter
- (cons (concat (if strip "-" "+") tag)
- (if narrow current nil)))
- (org-agenda-filter-apply org-agenda-tag-filter 'tag))
+ (cons (concat (if exclude "-" "+") tag)
+ current))
+ (org-agenda-filter-apply org-agenda-tag-filter 'tag expand))
(t (error "Invalid tag selection character %c" char)))))
(defun org-agenda-get-represented-tags ()
@@ -7535,13 +7542,15 @@ to switch to narrowing."
(get-text-property (point) 'tags))))
tags))
-(defun org-agenda-filter-by-tag-refine (strip &optional char)
+(defun org-agenda-filter-by-tag-refine (arg &optional char)
"Refine the current filter. See `org-agenda-filter-by-tag'."
(interactive "P")
- (org-agenda-filter-by-tag strip char 'refine))
+ (org-agenda-filter-by-tag arg char 'refine))
-(defun org-agenda-filter-make-matcher (filter type)
- "Create the form that tests a line for agenda filter."
+(defun org-agenda-filter-make-matcher (filter type &optional expand)
+ "Create the form that tests a line for agenda filter. Optional
+argument EXPAND can be used for the TYPE tag and will expand the
+tags in the FILTER if any of the tags in FILTER are grouptags."
(let (f f1)
(cond
;; Tag filter
@@ -7551,26 +7560,11 @@ to switch to narrowing."
(append (get 'org-agenda-tag-filter :preset-filter)
filter)))
(dolist (x filter)
- (let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
- (ffunc
- (lambda (nf0 nf01 fltr notgroup op)
- (dolist (x fltr)
- (if (member x '("-" "+"))
- (setq nf01 (if (equal x "-") 'tags '(not tags)))
- (setq nf01 (list 'member (downcase (substring x 1))
- 'tags))
- (when (equal (string-to-char x) ?-)
- (setq nf01 (list 'not nf01))
- (when (not notgroup) (setq op 'and))))
- (push nf01 nf0))
- (if notgroup
- (push (cons 'and nf0) f)
- (push (cons (or op 'or) nf0) f)))))
- (cond ((equal filter '("+"))
- (setq f (list (list 'not 'tags))))
- ((equal nfilter filter)
- (funcall ffunc f1 f filter t nil))
- (t (funcall ffunc nf1 nf nfilter nil nil))))))
+ (let ((op (string-to-char x)))
+ (if expand (setq x (org-agenda-filter-expand-tags (list x) t))
+ (setq x (list x)))
+ (setq f1 (org-agenda-filter-make-matcher-tag-exp x op))
+ (push f1 f))))
;; Category filter
((eq type 'category)
(setq filter
@@ -7603,6 +7597,32 @@ to switch to narrowing."
(push (org-agenda-filter-effort-form x) f))))
(cons 'and (nreverse f))))
+(defun org-agenda-filter-make-matcher-tag-exp (tags op)
+ "Create the form that tests a line for agenda filter for
+tag-expressions. Return a match-expression given TAGS. OP is an
+operator of type CHAR that allows the function to set the right
+switches in the returned form."
+ (let (f f1) ;f = return expression. f1 = working-area
+ (dolist (x tags)
+ (let* ((tag (substring x 1))
+ (isregexp (and (equal "{" (substring tag 0 1))
+ (equal "}" (substring tag -1))))
+ regexp)
+ (cond
+ (isregexp
+ (setq regexp (substring tag 1 -1))
+ (setq f1 (list 'org-match-any-p regexp 'tags)))
+ (t
+ (setq f1 (list 'member (downcase tag) 'tags))))
+ (when (eq op ?-)
+ (setq f1 (list 'not f1))))
+ (push f1 f))
+ ;; Any of the expressions can match if op = +
+ ;; all must match if the operator is -.
+ (if (eq op ?-)
+ (cons 'and f)
+ (cons 'or f))))
+
(defun org-agenda-filter-effort-form (e)
"Return the form to compare the effort of the current line with what E says.
E looks like \"+<2:25\"."
@@ -7641,12 +7661,14 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(reverse rtn))
filter))
-(defun org-agenda-filter-apply (filter type)
- "Set FILTER as the new agenda filter and apply it."
+(defun org-agenda-filter-apply (filter type &optional expand)
+ "Set FILTER as the new agenda filter and apply it. Optional
+argument EXPAND can be used for the TYPE tag and will expand the
+tags in the FILTER if any of the tags in FILTER are grouptags."
;; Deactivate `org-agenda-entry-text-mode' when filtering
(if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
(let (tags cat txt)
- (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type))
+ (setq org-agenda-filter-form (org-agenda-filter-make-matcher filter type expand))
;; Only set `org-agenda-filtered-by-category' to t when a unique
;; category is used as the filter:
(setq org-agenda-filtered-by-category
@@ -7658,11 +7680,7 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
- (setq tags ; used in eval
- (apply 'append
- (mapcar (lambda (f)
- (org-agenda-filter-expand-tags (list f) t))
- (org-get-at-bol 'tags)))
+ (setq tags (org-get-at-bol 'tags)
cat (org-get-at-eol 'org-category 1)
txt (org-get-at-eol 'txt 1))
(if (not (eval org-agenda-filter-form))
@@ -9973,7 +9991,7 @@ current HH:MM time."
(defun org-agenda-reapply-filters ()
"Re-apply all agenda filters."
(mapcar
- (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f))))
+ (lambda(f) (when (car f) (org-agenda-filter-apply (car f) (cadr f) t)))
`((,org-agenda-tag-filter tag)
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
--
1.9.1
[-- Attachment #4: 0003-org-Nesting-grouptags.patch --]
[-- Type: application/octet-stream, Size: 3791 bytes --]
From 1d01c58d909f5c49c98c2ae141e126b48a1396b7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Sat, 24 Jan 2015 02:47:47 +0100
Subject: [PATCH 3/4] 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.
---
lisp/org.el | 29 +++++++++++++++++++++++++++--
testing/lisp/test-org.el | 10 ++++++++++
2 files changed, 37 insertions(+), 2 deletions(-)
diff --git a/lisp/org.el b/lisp/org.el
index b39cb98..22c7526 100755
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -14538,7 +14538,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.
@@ -14579,6 +14579,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)
@@ -14596,8 +14597,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)
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 70aa38d..f597255 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -3099,6 +3099,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
--
1.9.1
[-- Attachment #5: 0004-org.texi-Complement-info-for-group-tags.patch --]
[-- Type: application/octet-stream, Size: 6882 bytes --]
From bdc6a29390d9d60f69ffdf442c28a469601ab998 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@UVServer>
Date: Thu, 5 Mar 2015 01:45:57 +0100
Subject: [PATCH 4/4] org.texi: Complement info for group tags
group tags are more general and a name-change (or addition) is made in
the manual: tag groups are now called tag hierarchy.
Adding information about the added tag hierarchy functionality and
use-cases.
---
doc/org.texi | 114 ++++++++++++++++++++++++++++++++++++++++++++++-------------
1 file changed, 89 insertions(+), 25 deletions(-)
diff --git a/doc/org.texi b/doc/org.texi
index edb6cf0..68e6436 100644
--- a/doc/org.texi
+++ b/doc/org.texi
@@ -432,7 +432,7 @@ Tags
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
Properties and columns
@@ -4877,7 +4877,7 @@ You may specify special faces for specific tags using the option
@menu
* Tag inheritance:: Tags use the tree structure of the outline
* Setting tags:: How to assign tags to a headline
-* Tag groups:: Use one tag to search for several tags
+* Tag hierarchy:: Create a hierarchy of tags
* Tag searches:: Searching for combinations of tags
@end menu
@@ -5116,41 +5116,105 @@ instead of @kbd{C-c C-c}). If you set the variable to the value
@code{expert}, the special window is not even shown for single-key tag
selection, it comes up only when you press an extra @kbd{C-c}.
-@node Tag groups
-@section Tag groups
+@node Tag hierarchy
+@section Tag hierarchy
@cindex group tags
@cindex tags, groups
-In a set of mutually exclusive tags, the first tag can be defined as a
-@emph{group tag}. When you search for a group tag, it will return matches
-for all members in the group. In an agenda view, filtering by a group tag
-will display headlines tagged with at least one of the members of the
-group. This makes tag searches and filters even more flexible.
+@cindex tag hierarchy
+Tags can be defined in hierarchies. A tag can be defined as a @emph{group
+tag} for a set of other tags. The group tag can be seen as the ``broader
+term'' for its set of tags. Defining multiple @emph{group tags} and nesting
+them creates a tag hierarchy.
-You can set group tags by inserting a colon between the group tag and other
-tags---beware that all whitespaces are mandatory so that Org can parse this
-line correctly:
+One use-case is to create a taxonomy of terms (tags) that can be used to
+classify nodes in a document or set of documents.
+
+When you search for a group tag, it will return matches for all members in
+the group and its subgroup. In an agenda view, filtering by a group tag will
+display or hide headlines tagged with at least one of the members of the
+group or any of its subgroups. This makes tag searches and filters even more
+flexible.
+
+You can set group tags by using brackets and inserting a colon between the
+group tag and its related tags---beware that all whitespaces are mandatory so
+that Org can parse this line correctly:
+
+@example
+#+TAGS: [ GTD : Control Persp ]
+@end example
+
+In this example, @samp{GTD} is the @emph{group tag} and it is related to two
+other tags: @samp{Control}, @samp{Persp}. Defining @samp{Control} and
+@samp{Persp} as group tags creates an hierarchy of tags:
@example
-#+TAGS: @{ @@read : @@read_book @@read_ebook @}
+#+TAGS: [ Control : Context Task ]
+#+TAGS: [ Persp : Vision Goal AOF Project ]
@end example
-In this example, @samp{@@read} is a @emph{group tag} for a set of three
-tags: @samp{@@read}, @samp{@@read_book} and @samp{@@read_ebook}.
+That can conceptually be seen as a hierarchy of tags:
-You can also use the @code{:grouptags} keyword directly when setting
-@code{org-tag-alist}:
+@example
+- GTD
+ - Persp
+ - Vision
+ - Goal
+ - AOF
+ - Project
+ - Control
+ - Context
+ - Task
+@end example
+
+You can use the @code{:startgrouptag}, @code{:grouptags} and
+@code{:endgrouptag} keyword directly when setting @code{org-tag-alist}
+directly:
@lisp
-(setq org-tag-alist '((:startgroup . nil)
- ("@@read" . nil)
- (:grouptags . nil)
- ("@@read_book" . nil)
- ("@@read_ebook" . nil)
- (:endgroup . nil)))
+(setq org-tag-alist '((:startgrouptag)
+ ("GTD")
+ (:grouptags)
+ ("Control")
+ ("Persp")
+ (:endgrouptag)
+ (:startgrouptag)
+ ("Control")
+ (:grouptags)
+ ("Context")
+ ("Task")
+ (:endgrouptag)))
@end lisp
-You cannot nest group tags or use a group tag as a tag in another group.
+The tags in a group can be mutually exclusive if using the same group syntax
+as is used for grouping mutually exclusive tags together; using curly
+brackets.
+
+@example
+#+TAGS: @{ Context : @@Home @@Work @@Call @}
+@end example
+
+When setting @code{org-tag-alist} you can use @code{:startgroup} &
+@code{:endgroup} instead of @code{:startgrouptag} & @code{:endgrouptag} to
+make the tags mutually exclusive.
+
+Furthermore; The members of a @emph{group tag} can also be regular
+expression, creating the possibility of more dynamic and rule-based
+tag-structure. The regular expressions in the group must be marked up within
+@{ @}. Example use, to expand on the example given above:
+
+@example
+#+TAGS: [ Vision : @{V@.+@} ]
+#+TAGS: [ Goal : @{G@.+@} ]
+#+TAGS: [ AOF : @{AOF@.+@} ]
+#+TAGS: [ Project : @{P@.+@} ]
+@end example
+
+Searching for the tag @samp{Project} will now list all tags also including
+regular expression matches for @samp{P@@.+}. Similar for tag-searches on
+@samp{Vision}, @samp{Goal} and @samp{AOF}. This can be good for example if
+tags for a certain project is tagged with a common project-identifier,
+i.e. @samp{P@@2014_OrgTags}.
@kindex C-c C-x q
@vindex org-group-tags
@@ -8111,7 +8175,7 @@ braces. For example,
@samp{:work:} and any tag @i{starting} with @samp{boss}.
@cindex group tags, as regular expressions
-Group tags (@pxref{Tag groups}) are expanded as regular expressions. E.g.,
+Group tags (@pxref{Tag hierarchy}) are expanded as regular expressions. E.g.,
if @samp{:work:} is a group tag for the group @samp{:work:lab:conf:}, then
searching for @samp{work} will search for @samp{@{\(?:work\|lab\|conf\)@}}
and searching for @samp{-work} will search for all headlines but those with
--
1.9.1
^ permalink raw reply related [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-03-16 20:38 ` Gustav Wikström
@ 2015-03-16 21:30 ` Nicolas Goaziou
2015-03-19 21:07 ` Gustav Wikström
0 siblings, 1 reply; 23+ messages in thread
From: Nicolas Goaziou @ 2015-03-16 21:30 UTC (permalink / raw)
To: Gustav Wikström; +Cc: Org Mode List
Gustav Wikström <gustav.erik@gmail.com> writes:
> Fixed patches are attached,
Applied. Thank you.
As a final step, would you mind preparing an entry in ORG-NEWS? I think
most of it can be extracted from your commit messages.
Regards,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-03-16 21:30 ` Nicolas Goaziou
@ 2015-03-19 21:07 ` Gustav Wikström
2015-03-19 22:43 ` Nicolas Goaziou
0 siblings, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-03-19 21:07 UTC (permalink / raw)
To: Nicolas Goaziou, Org Mode List
[-- Attachment #1: Type: text/plain, Size: 261 bytes --]
Nicolas Goaziou <mail@nicolasgoaziou.fr> wrote:
> As a final step, would you mind preparing an entry in ORG-NEWS? I think
> most of it can be extracted from your commit messages.
I don't mind. Wrote a few lines and the patch is attached!
Best regards
Gustav
[-- Attachment #2: 0001-ORG-NEWS-Mention-change-in-grouptags-functionality.patch --]
[-- Type: application/octet-stream, Size: 3803 bytes --]
From 3238280abe5eb84561cb3270a09ac271fb5b04c1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gustav=20Wikstr=C3=B6m?= <gustav@whil.se>
Date: Thu, 19 Mar 2015 21:55:18 +0100
Subject: [PATCH] ORG-NEWS: Mention change in grouptags functionality
* etc/ORG-NEWS: Mention change of previous commits for grouptags:
Entries added to ORG-NEWS for the description of:
- ecfd00c org.texi: Complement info for group tags
- 8562bd0 org: Nesting grouptags
- 6c6ae99 org-agenda: Filtering in the agenda on grouptags
- ee45258 org: Grouptags not unique and can contain regexp
---
etc/ORG-NEWS | 78 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
1 file changed, 78 insertions(+)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 877761d..7ba8fc6 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -124,6 +124,84 @@ end-users browser. You may force initial usage of MathML via
~org-html-mathjax-template~ or by setting the ~path~ property of
~org-html-mathjax-options~.
** New features
+*** Hierarchies of tags
+The functionality of nesting tags in hierarchies is added to org-mode.
+This is the generalization of what was previously called "Tag groups"
+in the manual. That term is now changed to "Tag hierarchy".
+
+The following in-buffer definition:
+#+BEGIN_SRC org
+ ,#+TAGS: [ Group : SubOne SubTwo ]
+ ,#+TAGS: [ SubOne : SubOne1 SubOne2 ]
+ ,#+TAGS: [ SubTwo : SubTwo1 SubTwo2 ]
+#+END_SRC
+
+Should be seen as the following tree of tags:
+- Group
+ - SubOne
+ - SubOne1
+ - SubOne2
+ - SubTwo
+ - SubTwo1
+ - SubTwo2
+
+Searching for "Group" should return all tags defined above. Filtering
+on SubOne filters also it's sub-tags. Etc.
+
+There is no limit on the depth for the tag hierarchy.
+
+*** Additional syntax for non-unique grouptags
+Additional syntax is defined for grouptags if the tags in the group
+don't have to be distinct on a heading.
+
+Grouptags had to previously be defined with { }. This syntax is
+already used for exclusive tags and Grouptags need their own,
+non-exclusive syntax. This behaviour is achieved with [ ]. Note: {
+} can still be used also for Grouptags but then only one of the
+given tags can be used on the headline at the same time. Example:
+
+[ group : sub1 sub2 ]
+
+#+BEGIN_SRC org
+ ,* Test :sub1:sub2:
+#+END_SRC
+
+This is a more general case than the already existing syntax for
+grouptags; { }.
+
+*** Define regular expression patterns as tags
+Tags can be defined as grouptags with regular expressions as
+"sub-tags".
+
+The regular expressions in the group must be marked up within { }.
+Example use:
+
+: #+TAGS: [ Project : {P@.+} ]
+
+Searching for the tag Project will now list all tags also including
+regular expression matches for P@.+. Good for example if tags for a
+certain project is tagged with a common project-identifier,
+i.e. P@2014_OrgTags.
+
+*** Filtering in the agenda on grouptags (Tag hierarchies)
+Filtering in the agenda on grouptags filter all of the related tags.
+Exception if filter is applied with a (double) prefix-argument.
+
+Filtering in the agenda on subcategories does not filter the "above"
+levels anymore.
+
+If a grouptag contains a regular expression the regular expression
+is also used as a filter.
+
+*** Minor refactoring of ~org-agenda-filter-by-tag~
+Now uses the argument arg and optional argument exclude instead of
+strip and narrow. ARG because the argument has multiple purposes and
+makes more sense than strip now. The term narrowing is changed to
+exclude.
+
+The main purpose is for the function to make more logical sense when
+filtering on tags now when tags can be structured in hierarchies.
+
*** New behaviour for `org-toggle-latex-fragment'.
The new behaviour is the following:
--
1.9.1
^ permalink raw reply related [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-03-19 21:07 ` Gustav Wikström
@ 2015-03-19 22:43 ` Nicolas Goaziou
0 siblings, 0 replies; 23+ messages in thread
From: Nicolas Goaziou @ 2015-03-19 22:43 UTC (permalink / raw)
To: Gustav Wikström; +Cc: Org Mode List
Gustav Wikström <gustav.erik@gmail.com> writes:
> I don't mind. Wrote a few lines and the patch is attached!
Applied. Thank you.
Regards,
^ permalink raw reply [flat|nested] 23+ messages in thread
* [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
@ 2015-11-25 7:50 sgeorgii .
2015-11-25 10:26 ` Gustav Wikström
0 siblings, 1 reply; 23+ messages in thread
From: sgeorgii . @ 2015-11-25 7:50 UTC (permalink / raw)
To: gustav.erik, mail, emacs-orgmode
Dear Gustav, Eric,
I was referred to your subject discussion in respect to my problem:
With new version of org-mode I am now unable to filter agenda to show
only non-tagged items:
> "sgeorgii ." <sgeorgii@gmail.com> writes:
>
>> Hello!
>>
>> Having installed latest org 8.3.2 I am now having the subject problem:
>>
>> M-x org-agenda
>>
>> When in agenda:
>>
>> / (filter)
>>
>> TAB (filter by tag)
>>
>> <Enter> (without entering any tags for "Tag:" question)
>>
>> Before this gave me agenda view filtered to show only non-tagged items.
>> I believe this was right and just fine.
>>
>> Now I have error:
>>
>> Debugger entered--Lisp error: (args-out-of-range "" 0 1)
>> org-agenda-filter-make-matcher-tag-exp(("+") 43)
>> org-agenda-filter-make-matcher(("+") tag t)
>> org-agenda-filter-apply(("+") tag t)
>> org-agenda-filter-by-tag(nil)
>> call-interactively(org-agenda-filter-by-tag nil nil)
>> command-execute(org-agenda-filter-by-tag)
>
> I believe 6c6ae99 (org-agenda: Filtering in the agenda on grouptags,
> 2015-01-24) changed this behavior. The discussion about these changes
> is here (sorry, the gmane web interface is down for me):
> https://lists.gnu.org/archive/html/emacs-orgmode/2015-01/msg00618.html
>
> org-agenda-filter-by-tag should be fixed to handle the empty tag case
> that causes the error above, either by behaving as before or by giving a
> clear error. I haven't looked closely enough at the changes or the
> discussion to guess whether that commit intended to preserve the empty
> tag behavior you were relying on. Is that behavior documented anywhere?
>
> --
> Kyle
Any help?
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 7:50 [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps sgeorgii .
@ 2015-11-25 10:26 ` Gustav Wikström
2015-11-25 11:05 ` sgeorgii .
0 siblings, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-11-25 10:26 UTC (permalink / raw)
To: sgeorgii ., mail@nicolasgoaziou.fr, emacs-orgmode@gnu.org
Hi!
Indeed, I do get the same error as you. I'll look into it a bit. Not sure if the behavior is documented though.
As a workaround for you sgeorgii (and for everyone else with this problem I suppose :-) ), you can exclude tags instead of filtering. The behavior is similar except instead of only showing the rows with the provided tag, it excludes all rows with the provided tag. If you provide a regular expression, eg. {.*}, then all rows with tags are hidden from the agenda-view.
So, to recreate with commands, what I just tried to describe with words:
M-x org-agenda
\ (exclude) (alternatively use the combination of / (filter) - (exclude) )
<TAB> (exclude by tag)
{.*}
<ENTER>
Voila!
Best regards
Gustav
> -----Original Message-----
> From: sgeorgii . [mailto:sgeorgii@gmail.com]
> Sent: Wednesday, November 25, 2015 08:51
> To: gustav.erik@gmail.com; mail@nicolasgoaziou.fr; emacs-
> orgmode@gnu.org
> Subject: [O] [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
>
> Dear Gustav, Eric,
>
>
> I was referred to your subject discussion in respect to my problem:
>
> With new version of org-mode I am now unable to filter agenda to show only
> non-tagged items:
>
>
> > "sgeorgii ." <sgeorgii@gmail.com> writes:
> >
> >> Hello!
> >>
> >> Having installed latest org 8.3.2 I am now having the subject problem:
> >>
> >> M-x org-agenda
> >>
> >> When in agenda:
> >>
> >> / (filter)
> >>
> >> TAB (filter by tag)
> >>
> >> <Enter> (without entering any tags for "Tag:" question)
> >>
> >> Before this gave me agenda view filtered to show only non-tagged items.
> >> I believe this was right and just fine.
> >>
> >> Now I have error:
> >>
> >> Debugger entered--Lisp error: (args-out-of-range "" 0 1)
> >> org-agenda-filter-make-matcher-tag-exp(("+") 43)
> >> org-agenda-filter-make-matcher(("+") tag t)
> >> org-agenda-filter-apply(("+") tag t)
> >> org-agenda-filter-by-tag(nil)
> >> call-interactively(org-agenda-filter-by-tag nil nil)
> >> command-execute(org-agenda-filter-by-tag)
>
> >
> > I believe 6c6ae99 (org-agenda: Filtering in the agenda on grouptags,
> > 2015-01-24) changed this behavior. The discussion about these changes
> > is here (sorry, the gmane web interface is down for me):
> > https://lists.gnu.org/archive/html/emacs-orgmode/2015-01/msg00618.html
> >
> > org-agenda-filter-by-tag should be fixed to handle the empty tag case
> > that causes the error above, either by behaving as before or by giving
> > a clear error. I haven't looked closely enough at the changes or the
> > discussion to guess whether that commit intended to preserve the empty
> > tag behavior you were relying on. Is that behavior documented anywhere?
> >
> > --
> > Kyle
>
>
> Any help?
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 10:26 ` Gustav Wikström
@ 2015-11-25 11:05 ` sgeorgii .
2015-11-25 12:20 ` Gustav Wikström
0 siblings, 1 reply; 23+ messages in thread
From: sgeorgii . @ 2015-11-25 11:05 UTC (permalink / raw)
To: Gustav Wikström; +Cc: emacs-orgmode@gnu.org, mail@nicolasgoaziou.fr
Indeed, the {.*} works. Thank you!
If we could still use the empty parameter when filtering by "no tags"
it would be really sweet :)
On 25 November 2015 at 13:26, Gustav Wikström <gustav@whil.se> wrote:
> Hi!
>
> Indeed, I do get the same error as you. I'll look into it a bit. Not sure if the behavior is documented though.
>
> As a workaround for you sgeorgii (and for everyone else with this problem I suppose :-) ), you can exclude tags instead of filtering. The behavior is similar except instead of only showing the rows with the provided tag, it excludes all rows with the provided tag. If you provide a regular expression, eg. {.*}, then all rows with tags are hidden from the agenda-view.
>
> So, to recreate with commands, what I just tried to describe with words:
> M-x org-agenda
> \ (exclude) (alternatively use the combination of / (filter) - (exclude) )
> <TAB> (exclude by tag)
> {.*}
> <ENTER>
>
> Voila!
>
> Best regards
> Gustav
>
>> -----Original Message-----
>> From: sgeorgii . [mailto:sgeorgii@gmail.com]
>> Sent: Wednesday, November 25, 2015 08:51
>> To: gustav.erik@gmail.com; mail@nicolasgoaziou.fr; emacs-
>> orgmode@gnu.org
>> Subject: [O] [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
>>
>> Dear Gustav, Eric,
>>
>>
>> I was referred to your subject discussion in respect to my problem:
>>
>> With new version of org-mode I am now unable to filter agenda to show only
>> non-tagged items:
>>
>>
>> > "sgeorgii ." <sgeorgii@gmail.com> writes:
>> >
>> >> Hello!
>> >>
>> >> Having installed latest org 8.3.2 I am now having the subject problem:
>> >>
>> >> M-x org-agenda
>> >>
>> >> When in agenda:
>> >>
>> >> / (filter)
>> >>
>> >> TAB (filter by tag)
>> >>
>> >> <Enter> (without entering any tags for "Tag:" question)
>> >>
>> >> Before this gave me agenda view filtered to show only non-tagged items.
>> >> I believe this was right and just fine.
>> >>
>> >> Now I have error:
>> >>
>> >> Debugger entered--Lisp error: (args-out-of-range "" 0 1)
>> >> org-agenda-filter-make-matcher-tag-exp(("+") 43)
>> >> org-agenda-filter-make-matcher(("+") tag t)
>> >> org-agenda-filter-apply(("+") tag t)
>> >> org-agenda-filter-by-tag(nil)
>> >> call-interactively(org-agenda-filter-by-tag nil nil)
>> >> command-execute(org-agenda-filter-by-tag)
>>
>> >
>> > I believe 6c6ae99 (org-agenda: Filtering in the agenda on grouptags,
>> > 2015-01-24) changed this behavior. The discussion about these changes
>> > is here (sorry, the gmane web interface is down for me):
>> > https://lists.gnu.org/archive/html/emacs-orgmode/2015-01/msg00618.html
>> >
>> > org-agenda-filter-by-tag should be fixed to handle the empty tag case
>> > that causes the error above, either by behaving as before or by giving
>> > a clear error. I haven't looked closely enough at the changes or the
>> > discussion to guess whether that commit intended to preserve the empty
>> > tag behavior you were relying on. Is that behavior documented anywhere?
>> >
>> > --
>> > Kyle
>>
>>
>> Any help?
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 11:05 ` sgeorgii .
@ 2015-11-25 12:20 ` Gustav Wikström
2015-11-25 12:58 ` Nicolas Goaziou
0 siblings, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-11-25 12:20 UTC (permalink / raw)
To: emacs-orgmode@gnu.org; +Cc: sgeorgii ., mail@nicolasgoaziou.fr
[-- Attachment #1: Type: text/plain, Size: 3721 bytes --]
Hi again,
Patch attached.
If someone could apply it I'd be glad.
Best Regards
Gustav
> -----Original Message-----
> From: sgeorgii . [mailto:sgeorgii@gmail.com]
> Sent: Wednesday, November 25, 2015 12:05
> To: Gustav Wikström <gustav@whil.se>
> Cc: mail@nicolasgoaziou.fr; emacs-orgmode@gnu.org
> Subject: Re: [O] [RFC] [PATCH] Changes to Tag groups - allow nesting and
> regexps
>
> Indeed, the {.*} works. Thank you!
>
> If we could still use the empty parameter when filtering by "no tags"
> it would be really sweet :)
>
> On 25 November 2015 at 13:26, Gustav Wikström <gustav@whil.se> wrote:
> > Hi!
> >
> > Indeed, I do get the same error as you. I'll look into it a bit. Not sure if the
> behavior is documented though.
> >
> > As a workaround for you sgeorgii (and for everyone else with this problem I
> suppose :-) ), you can exclude tags instead of filtering. The behavior is similar
> except instead of only showing the rows with the provided tag, it excludes all
> rows with the provided tag. If you provide a regular expression, eg. {.*}, then all
> rows with tags are hidden from the agenda-view.
> >
> > So, to recreate with commands, what I just tried to describe with words:
> > M-x org-agenda
> > \ (exclude) (alternatively use the combination of / (filter) -
> > (exclude) ) <TAB> (exclude by tag) {.*} <ENTER>
> >
> > Voila!
> >
> > Best regards
> > Gustav
> >
> >> -----Original Message-----
> >> From: sgeorgii . [mailto:sgeorgii@gmail.com]
> >> Sent: Wednesday, November 25, 2015 08:51
> >> To: gustav.erik@gmail.com; mail@nicolasgoaziou.fr; emacs-
> >> orgmode@gnu.org
> >> Subject: [O] [RFC] [PATCH] Changes to Tag groups - allow nesting and
> >> regexps
> >>
> >> Dear Gustav, Eric,
> >>
> >>
> >> I was referred to your subject discussion in respect to my problem:
> >>
> >> With new version of org-mode I am now unable to filter agenda to show
> >> only non-tagged items:
> >>
> >>
> >> > "sgeorgii ." <sgeorgii@gmail.com> writes:
> >> >
> >> >> Hello!
> >> >>
> >> >> Having installed latest org 8.3.2 I am now having the subject problem:
> >> >>
> >> >> M-x org-agenda
> >> >>
> >> >> When in agenda:
> >> >>
> >> >> / (filter)
> >> >>
> >> >> TAB (filter by tag)
> >> >>
> >> >> <Enter> (without entering any tags for "Tag:" question)
> >> >>
> >> >> Before this gave me agenda view filtered to show only non-tagged items.
> >> >> I believe this was right and just fine.
> >> >>
> >> >> Now I have error:
> >> >>
> >> >> Debugger entered--Lisp error: (args-out-of-range "" 0 1)
> >> >> org-agenda-filter-make-matcher-tag-exp(("+") 43)
> >> >> org-agenda-filter-make-matcher(("+") tag t)
> >> >> org-agenda-filter-apply(("+") tag t)
> >> >> org-agenda-filter-by-tag(nil)
> >> >> call-interactively(org-agenda-filter-by-tag nil nil)
> >> >> command-execute(org-agenda-filter-by-tag)
> >>
> >> >
> >> > I believe 6c6ae99 (org-agenda: Filtering in the agenda on
> >> > grouptags,
> >> > 2015-01-24) changed this behavior. The discussion about these
> >> > changes is here (sorry, the gmane web interface is down for me):
> >> > https://lists.gnu.org/archive/html/emacs-orgmode/2015-01/msg00618.h
> >> > tml
> >> >
> >> > org-agenda-filter-by-tag should be fixed to handle the empty tag
> >> > case that causes the error above, either by behaving as before or
> >> > by giving a clear error. I haven't looked closely enough at the
> >> > changes or the discussion to guess whether that commit intended to
> >> > preserve the empty tag behavior you were relying on. Is that behavior
> documented anywhere?
> >> >
> >> > --
> >> > Kyle
> >>
> >>
> >> Any help?
[-- Attachment #2: 0001-org-agenda-Filter-empty-tags.patch --]
[-- Type: application/octet-stream, Size: 1246 bytes --]
From 445995e1fad646b2b22c014e09e3e05a7aeeede1 Mon Sep 17 00:00:00 2001
From: Gustav Wikstrom <gustav.erik@gmail.com>
Date: Wed, 25 Nov 2015 13:06:31 +0100
Subject: [PATCH] org-agenda: Filter empty tags
* lisp/org-agenda.el (org-agenda-filter-make-matcher-tag-exp): Deal with
the case when the user provided an empty string to filter or exclude
rows from the agenda.
---
lisp/org-agenda.el | 6 +++++-
1 file changed, 5 insertions(+), 1 deletion(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 27ca20c..9a6cf10 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -7636,13 +7636,17 @@ switches in the returned form."
(let (f f1) ;f = return expression. f1 = working-area
(dolist (x tags)
(let* ((tag (substring x 1))
- (isregexp (and (equal "{" (substring tag 0 1))
+ (isemptystring (string= "" tag))
+ (isregexp (and (not isemptystring)
+ (equal "{" (substring tag 0 1))
(equal "}" (substring tag -1))))
regexp)
(cond
(isregexp
(setq regexp (substring tag 1 -1))
(setq f1 (list 'org-match-any-p regexp 'tags)))
+ (isemptystring
+ (setq f1 '(not tags)))
(t
(setq f1 (list 'member (downcase tag) 'tags))))
(when (eq op ?-)
--
1.9.5.msysgit.1
^ permalink raw reply related [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 12:20 ` Gustav Wikström
@ 2015-11-25 12:58 ` Nicolas Goaziou
2015-11-25 14:44 ` Gustav Wikström
0 siblings, 1 reply; 23+ messages in thread
From: Nicolas Goaziou @ 2015-11-25 12:58 UTC (permalink / raw)
To: Gustav Wikström; +Cc: sgeorgii ., emacs-orgmode@gnu.org
Hello,
Gustav Wikström <gustav@whil.se> writes:
> Patch attached.
Thank you. A minor comment below.
> From 445995e1fad646b2b22c014e09e3e05a7aeeede1 Mon Sep 17 00:00:00 2001
> From: Gustav Wikstrom <gustav.erik@gmail.com>
> Date: Wed, 25 Nov 2015 13:06:31 +0100
> Subject: [PATCH] org-agenda: Filter empty tags
>
> * lisp/org-agenda.el (org-agenda-filter-make-matcher-tag-exp): Deal with
> the case when the user provided an empty string to filter or exclude
> rows from the agenda.
Please provide a reference to the discussion that lead to this patch.
> (let* ((tag (substring x 1))
> - (isregexp (and (equal "{" (substring tag 0 1))
> + (isemptystring (string= "" tag))
> + (isregexp (and (not isemptystring)
> + (equal "{" (substring tag 0 1))
> (equal "}" (substring tag -1))))
> regexp)
> (cond
> (isregexp
> (setq regexp (substring tag 1 -1))
> (setq f1 (list 'org-match-any-p regexp 'tags)))
> + (isemptystring
> + (setq f1 '(not tags)))
> (t
> (setq f1 (list 'member (downcase tag) 'tags))))
> (when (eq op ?-)
Nitpick time:
You don't need isemptystring if it is the first branch in cond
(cond
((string= "" tag) (setq f1 '(not tags)))
(isregexp ...)
(t ...))
Obviously, in that case, you don't need to change isregexp at all.
Regards,
--
Nicolas Goaziou 0x80A93738
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 12:58 ` Nicolas Goaziou
@ 2015-11-25 14:44 ` Gustav Wikström
2015-11-25 14:52 ` Nicolas Goaziou
0 siblings, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-11-25 14:44 UTC (permalink / raw)
To: Nicolas Goaziou; +Cc: sgeorgii ., emacs-orgmode@gnu.org
Hi, see below
> >
> > * lisp/org-agenda.el (org-agenda-filter-make-matcher-tag-exp): Deal with
> > the case when the user provided an empty string to filter or exclude
> > rows from the agenda.
>
> Please provide a reference to the discussion that lead to this patch.
The reference being the subject-line and date of the mail from sgeorgii?
>
> > (let* ((tag (substring x 1))
> > - (isregexp (and (equal "{" (substring tag 0 1))
> > + (isemptystring (string= "" tag))
> > + (isregexp (and (not isemptystring)
> > + (equal "{" (substring tag 0 1))
> > (equal "}" (substring tag -1))))
> > regexp)
> > (cond
> > (isregexp
> > (setq regexp (substring tag 1 -1))
> > (setq f1 (list 'org-match-any-p regexp 'tags)))
> > + (isemptystring
> > + (setq f1 '(not tags)))
> > (t
> > (setq f1 (list 'member (downcase tag) 'tags))))
> > (when (eq op ?-)
>
> Nitpick time:
>
> You don't need isemptystring if it is the first branch in cond
>
> (cond
> ((string= "" tag) (setq f1 '(not tags)))
> (isregexp ...)
> (t ...))
>
> Obviously, in that case, you don't need to change isregexp at all.
Hmm, since the error was thrown when trying to look at indexes outside of the string in (substring ... ), I don't see how isregexp can be left as is. We have to make sure the substring-code is not evaluated if the tag is empty. What am I missing?
>
>
> Regards,
>
> --
> Nicolas Goaziou 0x80A93738
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 14:44 ` Gustav Wikström
@ 2015-11-25 14:52 ` Nicolas Goaziou
2015-11-25 15:39 ` Gustav Wikström
0 siblings, 1 reply; 23+ messages in thread
From: Nicolas Goaziou @ 2015-11-25 14:52 UTC (permalink / raw)
To: Gustav Wikström; +Cc: sgeorgii ., emacs-orgmode@gnu.org
Gustav Wikström <gustav@whil.se> writes:
> Hmm, since the error was thrown when trying to look at indexes outside
> of the string in (substring ... ), I don't see how isregexp can be
> left as is. We have to make sure the substring-code is not evaluated
> if the tag is empty. What am I missing?
Nothing, I was clear as mud.
(cond
((string= "" tag) (setq f1 '(not tags)))
((and (equal "{" ...)
(equal "}"...))
...)
(t ...))
Or even
((and (string-prefix-p "{" ...)
(string-suffix-p "}" ...)))
on master.
Regards,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 14:52 ` Nicolas Goaziou
@ 2015-11-25 15:39 ` Gustav Wikström
2015-11-26 7:30 ` sgeorgii .
2015-11-26 8:21 ` Nicolas Goaziou
0 siblings, 2 replies; 23+ messages in thread
From: Gustav Wikström @ 2015-11-25 15:39 UTC (permalink / raw)
To: Nicolas Goaziou; +Cc: sgeorgii ., emacs-orgmode@gnu.org
[-- Attachment #1: Type: text/plain, Size: 1180 bytes --]
Hi,
Taking your comments and improving the first patch a bit resulted in the attached one. It replaces the previous. Using string-prefix-p and string-suffix-p solves the out of index problem in the substrings.
BR
Gustav
> -----Original Message-----
> From: Nicolas Goaziou [mailto:mail@nicolasgoaziou.fr]
> Sent: Wednesday, November 25, 2015 15:53
> To: Gustav Wikström <gustav@whil.se>
> Cc: emacs-orgmode@gnu.org; sgeorgii . <sgeorgii@gmail.com>
> Subject: Re: [O] [RFC] [PATCH] Changes to Tag groups - allow nesting and
> regexps
>
> Gustav Wikström <gustav@whil.se> writes:
>
> > Hmm, since the error was thrown when trying to look at indexes outside
> > of the string in (substring ... ), I don't see how isregexp can be
> > left as is. We have to make sure the substring-code is not evaluated
> > if the tag is empty. What am I missing?
>
> Nothing, I was clear as mud.
>
> (cond
> ((string= "" tag) (setq f1 '(not tags)))
> ((and (equal "{" ...)
> (equal "}"...))
> ...)
> (t ...))
>
> Or even
>
> ((and (string-prefix-p "{" ...)
> (string-suffix-p "}" ...)))
>
> on master.
>
> Regards,
[-- Attachment #2: 0001-org-agenda-Filter-empty-tags.patch --]
[-- Type: application/octet-stream, Size: 1321 bytes --]
From e5a86a3e89f5d624945b2f5b563c6e9c4aa95cbc Mon Sep 17 00:00:00 2001
From: Gustav Wikstrom <gustav.erik@gmail.com>
Date: Wed, 25 Nov 2015 13:06:31 +0100
Subject: [PATCH] org-agenda: Filter empty tags
* lisp/org-agenda.el (org-agenda-filter-make-matcher-tag-exp): Deal with
the case when the user provided an empty string to filter or exclude
rows from the agenda.
This is done in order to fix a problem reported in emacs-orgmode
mailing list 2015-11-25 02:50 with subject "[O] [RFC] [PATCH] Changes
to Tag groups - allow nesting and regexps".
---
lisp/org-agenda.el | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 27ca20c..93c6bf8 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -7636,10 +7636,12 @@ switches in the returned form."
(let (f f1) ;f = return expression. f1 = working-area
(dolist (x tags)
(let* ((tag (substring x 1))
- (isregexp (and (equal "{" (substring tag 0 1))
- (equal "}" (substring tag -1))))
+ (isregexp (and (string-prefix-p "{" tag)
+ (string-suffix-p "}" tag)))
regexp)
(cond
+ ((string= "" tag)
+ (setq f1 '(not tags)))
(isregexp
(setq regexp (substring tag 1 -1))
(setq f1 (list 'org-match-any-p regexp 'tags)))
--
1.9.5.msysgit.1
^ permalink raw reply related [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 15:39 ` Gustav Wikström
@ 2015-11-26 7:30 ` sgeorgii .
2015-11-26 8:21 ` Nicolas Goaziou
1 sibling, 0 replies; 23+ messages in thread
From: sgeorgii . @ 2015-11-26 7:30 UTC (permalink / raw)
To: Gustav Wikström; +Cc: emacs-orgmode@gnu.org, Nicolas Goaziou
From my side I confirm the second patch works fine for me so far on
current org-mode.
Thank you Gustav, Nikolas!
Any chance for this patch to go upstream, please?
On 25 November 2015 at 18:39, Gustav Wikström <gustav@whil.se> wrote:
> Hi,
>
> Taking your comments and improving the first patch a bit resulted in the attached one. It replaces the previous. Using string-prefix-p and string-suffix-p solves the out of index problem in the substrings.
>
> BR
> Gustav
>
>> -----Original Message-----
>> From: Nicolas Goaziou [mailto:mail@nicolasgoaziou.fr]
>> Sent: Wednesday, November 25, 2015 15:53
>> To: Gustav Wikström <gustav@whil.se>
>> Cc: emacs-orgmode@gnu.org; sgeorgii . <sgeorgii@gmail.com>
>> Subject: Re: [O] [RFC] [PATCH] Changes to Tag groups - allow nesting and
>> regexps
>>
>> Gustav Wikström <gustav@whil.se> writes:
>>
>> > Hmm, since the error was thrown when trying to look at indexes outside
>> > of the string in (substring ... ), I don't see how isregexp can be
>> > left as is. We have to make sure the substring-code is not evaluated
>> > if the tag is empty. What am I missing?
>>
>> Nothing, I was clear as mud.
>>
>> (cond
>> ((string= "" tag) (setq f1 '(not tags)))
>> ((and (equal "{" ...)
>> (equal "}"...))
>> ...)
>> (t ...))
>>
>> Or even
>>
>> ((and (string-prefix-p "{" ...)
>> (string-suffix-p "}" ...)))
>>
>> on master.
>>
>> Regards,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-25 15:39 ` Gustav Wikström
2015-11-26 7:30 ` sgeorgii .
@ 2015-11-26 8:21 ` Nicolas Goaziou
2015-11-26 10:01 ` Gustav Wikström
1 sibling, 1 reply; 23+ messages in thread
From: Nicolas Goaziou @ 2015-11-26 8:21 UTC (permalink / raw)
To: Gustav Wikström; +Cc: sgeorgii ., emacs-orgmode@gnu.org
Gustav Wikström <gustav@whil.se> writes:
> Taking your comments and improving the first patch a bit resulted in
> the attached one. It replaces the previous. Using string-prefix-p and
> string-suffix-p solves the out of index problem in the substrings.
Applied. Thank you.
I modified a bit the patch however, since my suggestion about using
`string-suffix-p' doesn't hold: it isn't compatible with Emacs 24.3.
I also removed a bunch of `setq'.
Regards,
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-26 8:21 ` Nicolas Goaziou
@ 2015-11-26 10:01 ` Gustav Wikström
2015-11-26 10:21 ` Nicolas Goaziou
0 siblings, 1 reply; 23+ messages in thread
From: Gustav Wikström @ 2015-11-26 10:01 UTC (permalink / raw)
To: Nicolas Goaziou; +Cc: sgeorgii ., emacs-orgmode@gnu.org
Hi,
> -----Original Message-----
> From: Nicolas Goaziou [mailto:mail@nicolasgoaziou.fr]
> Sent: Thursday, November 26, 2015 09:22
> To: Gustav Wikström <gustav@whil.se>
> Cc: sgeorgii . <sgeorgii@gmail.com>; emacs-orgmode@gnu.org
> Subject: Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
>
> Gustav Wikström <gustav@whil.se> writes:
>
> > Taking your comments and improving the first patch a bit resulted in
> > the attached one. It replaces the previous. Using string-prefix-p and
> > string-suffix-p solves the out of index problem in the substrings.
Ok, darnit. And I see you found another workaround for that ;-)
>
> Applied. Thank you.
Great.
>
> I modified a bit the patch however, since my suggestion about using `string-
> suffix-p' doesn't hold: it isn't compatible with Emacs 24.3.
> I also removed a bunch of `setq'.
Ok, fair enough. A bit more difficult to follow the code now (in my opinion) but I guess it saves a few I/O's.
There was a small error in your edit though. The push-statement feels lonely outside of the let*.
>
>
> Regards,
Kind regards
Gustav
^ permalink raw reply [flat|nested] 23+ messages in thread
* Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
2015-11-26 10:01 ` Gustav Wikström
@ 2015-11-26 10:21 ` Nicolas Goaziou
0 siblings, 0 replies; 23+ messages in thread
From: Nicolas Goaziou @ 2015-11-26 10:21 UTC (permalink / raw)
To: Gustav Wikström; +Cc: sgeorgii ., emacs-orgmode@gnu.org
Gustav Wikström <gustav@whil.se> writes:
> Ok, fair enough. A bit more difficult to follow the code now (in my
> opinion)
I honestly don't think so. Of course, YMMV.
> but I guess it saves a few I/O's.
If `setq' can be avoided (assuming a context of lexical binding) it's
better, indeed.
> There was a small error in your edit though. The push-statement feels
> lonely outside of the let*.
Duh. Fixed. Thank you.
Regards,
^ permalink raw reply [flat|nested] 23+ messages in thread
end of thread, other threads:[~2015-11-26 10:19 UTC | newest]
Thread overview: 23+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2015-11-25 7:50 [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps sgeorgii .
2015-11-25 10:26 ` Gustav Wikström
2015-11-25 11:05 ` sgeorgii .
2015-11-25 12:20 ` Gustav Wikström
2015-11-25 12:58 ` Nicolas Goaziou
2015-11-25 14:44 ` Gustav Wikström
2015-11-25 14:52 ` Nicolas Goaziou
2015-11-25 15:39 ` Gustav Wikström
2015-11-26 7:30 ` sgeorgii .
2015-11-26 8:21 ` Nicolas Goaziou
2015-11-26 10:01 ` Gustav Wikström
2015-11-26 10:21 ` Nicolas Goaziou
-- strict thread matches above, loose matches on Subject: below --
2015-01-25 11:07 Gustav Wikström
2015-01-31 8:41 ` Nicolas Goaziou
2015-02-19 20:00 ` Gustav Wikström
2015-02-24 16:43 ` Nicolas Goaziou
2015-03-05 1:08 ` Gustav Wikström
2015-03-07 21:51 ` Nicolas Goaziou
2015-03-15 10:17 ` Gustav Wikström
2015-03-16 20:38 ` Gustav Wikström
2015-03-16 21:30 ` Nicolas Goaziou
2015-03-19 21:07 ` Gustav Wikström
2015-03-19 22:43 ` Nicolas Goaziou
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).