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

