From: "Gustav Wikström" <gustav.erik@gmail.com>
To: "Gustav Wikström" <gustav.erik@gmail.com>,
"Org Mode List" <emacs-orgmode@gnu.org>
Subject: Re: [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps
Date: Thu, 19 Feb 2015 21:00:27 +0100 [thread overview]
Message-ID: <CA+SyOP-DVW8HFprsjV7iHqvaYg9N+eXE6nrmKhjW0d3HdBJ42w@mail.gmail.com> (raw)
In-Reply-To: <874mr7pcju.fsf@nicolasgoaziou.fr>
[-- 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
next prev parent reply other threads:[~2015-02-19 20:00 UTC|newest]
Thread overview: 23+ messages / expand[flat|nested] mbox.gz Atom feed top
2015-01-25 11:07 [RFC] [PATCH] Changes to Tag groups - allow nesting and regexps Gustav Wikström
2015-01-31 8:41 ` Nicolas Goaziou
2015-02-19 20:00 ` Gustav Wikström [this message]
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
-- strict thread matches above, loose matches on Subject: below --
2015-11-25 7:50 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=CA+SyOP-DVW8HFprsjV7iHqvaYg9N+eXE6nrmKhjW0d3HdBJ42w@mail.gmail.com \
--to=gustav.erik@gmail.com \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).