Implement category filtering.

* org-agenda.el (org-agenda-filter-preset): New alias.
(org-agenda-filter-by-category): New command.
(org-agenda-mode-map): Add the new command.
(org-agenda-custom-commands-local-options): Add category
filter preset.
(org-agenda-mark-filtered-text): Mark both tag and filter
overlays.
(org-agenda-category-filter-preset): New variable.
(org-finalize-agenda, org-agenda-redo)
(org-agenda-filter-make-matcher, org-agenda-filter-apply):
Handle both category and tag filters.
(org-agenda-filter-show-all-tag): Rename from
`org-agenda-filter-by-tag-show-all'.
(org-agenda-filter-show-all-cat): New function.
(org-agenda-set-mode-name): Show the category filter in the
modeline.

* org-faces.el (org-agenda-filter-category): New face.

* org.texi (Agenda commands): Update documentation about the
new category filtering feature.

This feature has been requested by several people -- thanks
to all of them for mentioning this possibility.
This commit is contained in:
Bastien Guerry 2011-12-31 17:10:44 +01:00
parent 4e0fe88f7e
commit 8c36e92f88
3 changed files with 158 additions and 57 deletions

View File

@ -8034,18 +8034,27 @@ Remove the restriction lock on the agenda, if it is currently restricted to a
file or subtree (@pxref{Agenda files}).
@tsubheading{Secondary filtering and query editing}
@cindex filtering, by tag and effort, in agenda
@cindex filtering, by tag category and effort, in agenda
@cindex tag filtering, in agenda
@cindex category filtering, in agenda
@cindex effort filtering, in agenda
@cindex query editing, in agenda
@orgcmd{<,org-agenda-filter-by-category}
@vindex org-agenda-category-filter-preset
Filter the current agenda view with respect to the category of the item at
point. Pressing @code{<} another time will remove this filter. You can add
a filter preset through the option @code{org-agenda-category-filter-preset}
(see below.)
@orgcmd{/,org-agenda-filter-by-tag}
@vindex org-agenda-filter-preset
@vindex org-agenda-tag-filter-preset
Filter the current agenda view with respect to a tag and/or effort estimates.
The difference between this and a custom agenda command is that filtering is
very fast, so that you can switch quickly between different filters without
having to recreate the agenda.@footnote{Custom commands can preset a filter by
binding the variable @code{org-agenda-filter-preset} as an option. This
binding the variable @code{org-agenda-tag-filter-preset} as an option. This
filter will then be applied to the view and persist as a basic filter through
refreshes and more secondary filtering. The filter is a global property of
the entire agenda view---in a block agenda, you should only set this in the

View File

@ -245,6 +245,10 @@ you can \"misuse\" it to also add other text to the header. However,
(const user-defined-up) (const user-defined-down))
"Sorting choices.")
;; Keep custom values for `org-agenda-filter-preset' compatible with
;; the new variable `org-agenda-tag-filter-preset'.
(defvaralias 'org-agenda-filter-preset 'org-agenda-tag-filter-preset)
(defconst org-agenda-custom-commands-local-options
`(repeat :tag "Local settings for this command. Remember to quote values"
(choice :tag "Setting"
@ -286,8 +290,14 @@ you can \"misuse\" it to also add other text to the header. However,
(list :tag "Deadline Warning days"
(const org-deadline-warning-days)
(integer :value 1))
(list :tag "Category filter preset"
(const org-agenda-category-filter-preset)
(list
(const :format "" quote)
(repeat
(string :tag "+category or -category"))))
(list :tag "Tags filter preset"
(const org-agenda-filter-preset)
(const org-agenda-tag-filter-preset)
(list
(const :format "" quote)
(repeat
@ -1949,6 +1959,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "}" 'org-agenda-manipulate-query-subtract-re)
(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine)
(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
(org-defkey org-agenda-mode-map ";" 'org-timer-set-timer)
(define-key org-agenda-mode-map "?" 'org-agenda-show-the-flagging-note)
(org-defkey org-agenda-mode-map "\C-c\C-x\C-mg" 'org-mobile-pull)
@ -2841,7 +2852,8 @@ higher priority settings."
(set-buffer org-agenda-buffer-name))
(when open (org-open-file file)))
(defvar org-agenda-filter-overlays nil)
(defvar org-agenda-tag-filter-overlays nil)
(defvar org-agenda-cat-filter-overlays nil)
(defun org-agenda-mark-filtered-text ()
"Mark all text hidden by filtering with a text property."
@ -2852,7 +2864,8 @@ higher priority settings."
(put-text-property
(overlay-start o) (overlay-end o)
'org-filtered t)))
org-agenda-filter-overlays)))
(append org-agenda-tag-filter-overlays
org-agenda-cat-filter-overlays))))
(defun org-agenda-unmark-filtered-text ()
"Remove the filtering text property."
@ -3035,9 +3048,10 @@ removed from the entry content. Currently only `planning' is allowed here."
(defvar org-pre-agenda-window-conf nil)
(defvar org-agenda-columns-active nil)
(defvar org-agenda-name nil)
(defvar org-agenda-filter nil)
(defvar org-agenda-filter-while-redo nil)
(defvar org-agenda-filter-preset nil
(defvar org-agenda-tag-filter nil)
(defvar org-agenda-category-filter nil)
(defvar org-agenda-tag-filter-while-redo nil)
(defvar org-agenda-tag-filter-preset nil
"A preset of the tags filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single tag preceded
by \"+\" or \"-\".
@ -3047,13 +3061,25 @@ the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
(defvar org-agenda-category-filter-preset nil
"A preset of the categeory filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single category
preceded by \"+\" or \"-\".
This variable should not be set directly, but agenda custom commands can
bind it in the options section. The preset filter is a global property of
the entire agenda view. In a block agenda, it will not work reliably to
define a filter for one of the individual blocks. You need to set it in
the global options and expect it to be applied to the entire view.")
(defun org-prepare-agenda (&optional name)
(setq org-todo-keywords-for-agenda nil)
(setq org-done-keywords-for-agenda nil)
(setq org-drawers-for-agenda nil)
(unless org-agenda-persistent-filter
(setq org-agenda-filter nil))
(put 'org-agenda-filter :preset-filter org-agenda-filter-preset)
(setq org-agenda-tag-filter nil
org-agenda-category-filter nil))
(put 'org-agenda-tag-filter :preset-filter org-agenda-tag-filter-preset)
(put 'org-agenda-category-filter :preset-filter org-agenda-category-filter-preset)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
@ -3132,8 +3158,10 @@ the global options and expect it to be applied to the entire view.")
(org-habit-insert-consistency-graphs))
(run-hooks 'org-finalize-agenda-hook)
(setq org-agenda-type (org-get-at-bol 'org-agenda-type))
(when (or org-agenda-filter (get 'org-agenda-filter :preset-filter))
(org-agenda-filter-apply org-agenda-filter))
(when (or org-agenda-tag-filter (get 'org-agenda-tag-filter :preset-filter))
(org-agenda-filter-apply org-agenda-tag-filter 'tag))
(when (or org-agenda-category-filter (get 'org-agenda-category-filter :preset-filter))
(org-agenda-filter-apply org-agenda-category-filter 'category))
)))
(defun org-agenda-mark-clocking-task ()
@ -3667,8 +3695,8 @@ given in `org-agenda-start-on-weekday'."
(setq p (plist-put p :tend clocktable-end))
(setq p (plist-put p :scope 'agenda))
(when (and (eq org-agenda-clockreport-mode 'with-filter)
(setq filter (or org-agenda-filter-while-redo
(get 'org-agenda-filter :preset-filter))))
(setq filter (or org-agenda-tag-filter-while-redo
(get 'org-agenda-tag-filter :preset-filter))))
(setq p (plist-put p :tags (mapconcat (lambda (x)
(if (string-match "[<>=]" x)
""
@ -6126,29 +6154,45 @@ in the agenda."
When this is the global TODO list, a prefix argument will be interpreted."
(interactive)
(let* ((org-agenda-keep-modes t)
(filter org-agenda-filter)
(preset (get 'org-agenda-filter :preset-filter))
(org-agenda-filter-while-redo (or filter preset))
(tag-filter org-agenda-tag-filter)
(tag-preset (get 'org-agenda-tag-filter :preset-filter))
(cat-filter org-agenda-category-filter)
(cat-preset (get 'org-agenda-category-filter :preset-filter))
(org-agenda-tag-filter-while-redo (or tag-filter tag-preset))
(cols org-agenda-columns-active)
(line (org-current-line))
(window-line (- line (org-current-line (window-start))))
(lprops (get 'org-agenda-redo-command 'org-lprops)))
(put 'org-agenda-filter :preset-filter nil)
(put 'org-agenda-tag-filter :preset-filter nil)
(put 'org-agenda-category-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(org-let lprops '(eval org-agenda-redo-command))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil)
(message "Rebuilding agenda buffer...done")
(put 'org-agenda-filter :preset-filter preset)
(and (or filter preset) (org-agenda-filter-apply filter))
(put 'org-agenda-tag-filter :preset-filter tag-preset)
(put 'org-agenda-category-filter :preset-filter cat-preset)
(and (or tag-filter tag-preset) (org-agenda-filter-apply tag-filter 'tag))
(and (or cat-filter cat-preset) (org-agenda-filter-apply cat-filter 'category))
(and cols (org-called-interactively-p 'any) (org-agenda-columns))
(org-goto-line line)
(recenter window-line)))
(defvar org-global-tags-completion-table nil)
(defvar org-agenda-filter-form nil)
(defun org-agenda-filter-by-category (strip)
"Keep only those lines in the agenda buffer that have a specific category.
The category is that of the current line."
(interactive "P")
(if org-agenda-filtered-by-category
(org-agenda-filter-show-all-cat)
(let ((cat (org-no-properties (get-text-property (point) 'org-category))))
(if cat (org-agenda-filter-apply
(list (concat (if strip "-" "+") cat)) 'category)
(error "No category at point")))))
(defun org-agenda-filter-by-tag (strip &optional char narrow)
"Keep only those lines in the agenda buffer that have a specific tag.
The tag is selected with its fast selection letter, as configured.
@ -6172,7 +6216,7 @@ to switch to narrowing."
(effort-op org-agenda-filter-effort-default-operator)
(effort-prompt "")
(inhibit-read-only t)
(current org-agenda-filter)
(current org-agenda-tag-filter)
maybe-refresh a n tag)
(unless char
(message
@ -6211,20 +6255,26 @@ to switch to narrowing."
"Tag: " org-global-tags-completion-table))))
(cond
((equal char ?\r)
(org-agenda-filter-by-tag-show-all)
(org-agenda-filter-show-all-tag)
(when org-agenda-auto-exclude-function
(setq org-agenda-filter '())
(setq org-agenda-tag-filter '())
(dolist (tag (org-agenda-get-represented-tags))
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
(if modifier
(push modifier org-agenda-filter))))
(if (not (null org-agenda-filter))
(org-agenda-filter-apply org-agenda-filter)))
(push modifier org-agenda-tag-filter))))
(if (not (null org-agenda-tag-filter))
(org-agenda-filter-apply org-agenda-tag-filter 'tag)))
(setq maybe-refresh t))
((equal char ?/)
(org-agenda-filter-by-tag-show-all)
(when (get 'org-agenda-filter :preset-filter)
(org-agenda-filter-apply org-agenda-filter))
(org-agenda-filter-show-all-tag)
(when (get 'org-agenda-tag-filter :preset-filter)
(org-agenda-filter-apply org-agenda-tag-filter 'tag))
(setq maybe-refresh t))
((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)
(setq maybe-refresh t))
((or (equal char ?\ )
(setq a (rassoc char alist))
@ -6236,12 +6286,12 @@ to switch to narrowing."
(setq tag "?eff")
a (cons tag nil))
(and tag (setq a (cons tag nil))))
(org-agenda-filter-by-tag-show-all)
(org-agenda-filter-show-all-tag)
(setq tag (car a))
(setq org-agenda-filter
(setq org-agenda-tag-filter
(cons (concat (if strip "-" "+") tag)
(if narrow current nil)))
(org-agenda-filter-apply org-agenda-filter)
(org-agenda-filter-apply org-agenda-tag-filter 'tag)
(setq maybe-refresh t))
(t (error "Invalid tag selection character %c" char)))
(when (and maybe-refresh
@ -6265,10 +6315,12 @@ to switch to narrowing."
(org-agenda-filter-by-tag strip char 'refine))
(defun org-agenda-filter-make-matcher ()
"Create the form that tests a line for the agenda filter."
"Create the form that tests a line for agenda filter."
(let (f f1)
(dolist (x (append (get 'org-agenda-filter :preset-filter)
org-agenda-filter))
;; first compute the tag-filter matcher
(dolist (x (delete-dups
(append (get 'org-agenda-tag-filter
:preset-filter) org-agenda-tag-filter)))
(if (member x '("-" "+"))
(setq f1 (if (equal x "-") 'tags '(not tags)))
(if (string-match "[<=>?]" x)
@ -6277,6 +6329,12 @@ to switch to narrowing."
(if (equal (string-to-char x) ?-)
(setq f1 (list 'not f1))))
(push f1 f))
;; then compute the category-filter matcher
(dolist (x (delete-dups
(append (get 'org-agenda-category-filter
:preset-filter) org-agenda-category-filter)))
(setq f1 (list 'equal (substring x 1) 'cat))
(push f1 f))
(cons 'and (nreverse f))))
(defun org-agenda-filter-effort-form (e)
@ -6301,49 +6359,64 @@ If the line does not have an effort defined, return nil."
(funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
value))))
(defun org-agenda-filter-apply (filter)
(defvar org-agenda-filtered-by-category nil)
(defun org-agenda-filter-apply (filter type)
"Set FILTER as the new agenda filter and apply it."
(let (tags)
(setq org-agenda-filter filter
org-agenda-filter-form (org-agenda-filter-make-matcher))
(if (eq type 'tag)
(setq org-agenda-tag-filter filter)
(setq org-agenda-category-filter filter
org-agenda-filtered-by-category t))
(setq org-agenda-filter-form (org-agenda-filter-make-matcher))
(org-agenda-set-mode-name)
(save-excursion
(goto-char (point-min))
(while (not (eobp))
(if (org-get-at-bol 'org-marker)
(progn
(setq tags (org-get-at-bol 'tags)) ; used in eval
(setq tags (org-get-at-bol 'tags) ; used in eval
cat (get-text-property (point) 'org-category))
(if (not (eval org-agenda-filter-form))
(org-agenda-filter-by-tag-hide-line))
(org-agenda-filter-hide-line type))
(beginning-of-line 2))
(beginning-of-line 2))))
(if (get-char-property (point) 'invisible)
(org-agenda-previous-line))))
(defun org-agenda-filter-by-tag-hide-line ()
(defun org-agenda-filter-hide-line (type)
(let (ov)
(setq ov (make-overlay (max (point-min) (1- (point-at-bol)))
(point-at-eol)))
(overlay-put ov 'invisible t)
(overlay-put ov 'type 'tags-filter)
(push ov org-agenda-filter-overlays)))
(overlay-put ov 'type type)
(if (eq type 'tag)
(push ov org-agenda-tag-filter-overlays)
(push ov org-agenda-cat-filter-overlays))))
(defun org-agenda-fix-tags-filter-overlays-at (&optional pos)
(setq pos (or pos (point)))
(save-excursion
(dolist (ov (overlays-at pos))
(when (and (overlay-get ov 'invisible)
(eq (overlay-get ov 'type) 'tags-filter))
(eq (overlay-get ov 'type) 'tag))
(goto-char pos)
(if (< (overlay-start ov) (point-at-eol))
(move-overlay ov (point-at-eol)
(overlay-end ov)))))))
(defun org-agenda-filter-by-tag-show-all ()
(mapc 'delete-overlay org-agenda-filter-overlays)
(setq org-agenda-filter-overlays nil)
(setq org-agenda-filter nil)
(setq org-agenda-filter-form nil)
(defun org-agenda-filter-show-all-tag nil
(mapc 'delete-overlay org-agenda-tag-filter-overlays)
(setq org-agenda-tag-filter-overlays nil
org-agenda-tag-filter nil
org-agenda-filter-form nil)
(org-agenda-set-mode-name))
(defun org-agenda-filter-show-all-cat nil
(mapc 'delete-overlay org-agenda-cat-filter-overlays)
(setq org-agenda-cat-filter-overlays nil
org-agenda-filtered-by-category nil
org-agenda-category-filter nil
org-agenda-filter-form nil)
(org-agenda-set-mode-name))
(defun org-agenda-manipulate-query-add ()
@ -6758,16 +6831,29 @@ When called with a prefix argument, include all archive files as well."
((eq org-agenda-show-log 'clockcheck) " ClkCk")
(org-agenda-show-log " Log")
(t ""))
;; show tags used for filtering in a custom face
(if (or org-agenda-filter (get 'org-agenda-filter
(if (or org-agenda-category-filter (get 'org-agenda-category-filter
:preset-filter))
'(:eval (org-propertize
(concat " <"
(mapconcat
'identity
(append
(get 'org-agenda-category-filter :preset-filter)
org-agenda-category-filter)
"")
">")
'face 'org-agenda-filter-category
'help-echo "Category used in filtering"))
"")
(if (or org-agenda-tag-filter (get 'org-agenda-tag-filter
:preset-filter))
'(:eval (org-propertize
(concat " {"
(mapconcat
'identity
(append
(get 'org-agenda-filter :preset-filter)
org-agenda-filter)
(get 'org-agenda-tag-filter :preset-filter)
org-agenda-tag-filter)
"")
"}")
'face 'org-agenda-filter-tags
@ -8500,9 +8586,9 @@ details and examples."
(org-prepare-agenda-buffers files)
(while (setq file (pop files))
(setq entries
(delq nil
(delq nil
(append entries
(apply 'org-agenda-get-day-entries
(apply 'org-agenda-get-day-entries
file today scope)))))
;; Map thru entries and find if we should filter them out
(mapc

View File

@ -678,6 +678,12 @@ month and 365.24 days for a year)."
"Face for tag(s) in the mode-line when filtering the agenda."
:group 'org-faces)
(defface org-agenda-filter-category
(org-compatible-face 'modeline
nil)
"Face for tag(s) in the mode-line when filtering the agenda."
:group 'org-faces)
(defface org-time-grid ;; originally copied from font-lock-variable-name-face
(org-compatible-face nil
'((((class color) (min-colors 16) (background light)) (:foreground "DarkGoldenrod"))