emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [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
* [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
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).