mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

Fix filter preset problem for sticky agenda 

* lisp/org-agenda.el (org-agenda-local-vars):
(org-agenda-filters-preset): Add a new variable
`org-agenda-filters-preset' for storing per-buffer filter presets.
(org-agenda):
(org-agenda-filter-any):
(org-agenda-prepare):
(org-agenda-finalize):
(org-agenda-redo):
(org-agenda-filter-by-tag):
(org-agenda-filter-make-matcher):
(org-agenda-set-mode-name):
(org-agenda-reapply-filters): Use `org-agenda-filters-preset' for
getting and setting per-buffer filter presets, rather than modifying
the global symbol property.  Change `org-lprops' from symbol property
to per-buffer text property.  Delete unused `last-args' symbol
property.
* testing/lisp/test-org-agenda.el (test-org-agenda/sticky-agenda-filter-preset):
(test-org-agenda/redo-setting): Add tests.
This commit is contained in:
Liu Hui 2022-10-04 11:12:41 +08:00 committed by Ihor Radchenko
parent 580f286140
commit edf5afc1d8
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
2 changed files with 109 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
lisp/org-agenda.el
View File

@ -2276,6 +2276,7 @@ When nil, `q' will kill the single agenda buffer."
org-agenda-top-headline-filter
org-agenda-regexp-filter
org-agenda-effort-filter
org-agenda-filters-preset
org-agenda-markers
org-agenda-last-search-view-search-was-boolean
org-agenda-last-indirect-buffer
@ -2929,10 +2930,6 @@ Pressing `<' twice means to restrict to the current subtree or region
(setq org-agenda-restrict nil)
(move-marker org-agenda-restrict-begin nil)
(move-marker org-agenda-restrict-end nil))
;; Delete old local properties
(put 'org-agenda-redo-command 'org-lprops nil)
;; Delete previously set last-arguments
(put 'org-agenda-redo-command 'last-args nil)
;; Remember where this call originated
(setq org-agenda-last-dispatch-buffer (current-buffer))
(unless org-keys
@ -2981,7 +2978,6 @@ Pressing `<' twice means to restrict to the current subtree or region
(setq org-agenda-buffer-name
(or (and (stringp org-match) (format "*Org Agenda(%s:%s)*" org-keys org-match))
(format "*Org Agenda(%s)*" org-keys))))
(put 'org-agenda-redo-command 'org-lprops lprops)
(cl-progv
(mapcar #'car lprops)
(mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
@ -3016,7 +3012,10 @@ Pressing `<' twice means to restrict to the current subtree or region
(funcall type org-match))
;; FIXME: Will signal an error since it's not `functionp'!
((pred fboundp) (funcall type org-match))
(_ (user-error "Invalid custom agenda command type %s" type)))))
(_ (user-error "Invalid custom agenda command type %s" type))))
(let ((inhibit-read-only t))
(add-text-properties (point-min) (point-max)
`(org-lprops ,lprops))))
(org-agenda-run-series (nth 1 entry) (cddr entry))))
((equal org-keys "C")
(setq org-agenda-custom-commands org-agenda-custom-commands-orig)
@ -3808,6 +3807,10 @@ 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-filters-preset nil
"Alist of filter types and associated preset of filters.
This variable is local in `org-agenda' buffers. See `org-agenda-local-vars'.")
(defconst org-agenda-filter-variables
'((category . org-agenda-category-filter)
(tag . org-agenda-tag-filter)
@ -3818,7 +3821,7 @@ the global options and expect it to be applied to the entire view.")
"Is any filter active?"
(cl-some (lambda (x)
(or (symbol-value (cdr x))
(get :preset-filter x)))
(assoc-default (car x) org-agenda-filters-preset)))
org-agenda-filter-variables))
(defvar org-agenda-category-filter-preset nil
@ -3927,10 +3930,6 @@ FILTER-ALIST is an alist of filters we need to apply when
(cat . ,org-agenda-category-filter))))))
(if (org-agenda-use-sticky-p)
(progn
(put 'org-agenda-tag-filter :preset-filter nil)
(put 'org-agenda-category-filter :preset-filter nil)
(put 'org-agenda-regexp-filter :preset-filter nil)
(put 'org-agenda-effort-filter :preset-filter nil)
;; Popup existing buffer
(org-agenda-prepare-window (get-buffer org-agenda-buffer-name)
filter-alist)
@ -3938,14 +3937,6 @@ FILTER-ALIST is an alist of filters we need to apply when
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
(throw 'exit "Sticky Agenda buffer, use `r' to refresh"))
(setq org-todo-keywords-for-agenda 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)
(put 'org-agenda-regexp-filter :preset-filter
org-agenda-regexp-filter-preset)
(put 'org-agenda-effort-filter :preset-filter
org-agenda-effort-filter-preset)
(if org-agenda-multi
(progn
(setq buffer-read-only nil)
@ -3970,7 +3961,12 @@ FILTER-ALIST is an alist of filters we need to apply when
(setq org-agenda-buffer (current-buffer))
(setq org-agenda-contributing-files nil)
(setq org-agenda-columns-active nil)
(org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
(setq org-agenda-filters-preset
`((tag . ,org-agenda-tag-filter-preset)
(category . ,org-agenda-category-filter-preset)
(regexp . ,org-agenda-regexp-filter-preset)
(effort . ,org-agenda-effort-filter-preset)))
(org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
(setq org-todo-keywords-for-agenda
(org-uniquify org-todo-keywords-for-agenda))
(setq org-done-keywords-for-agenda
@ -4040,24 +4036,24 @@ agenda display, configure `org-agenda-finalize-hook'."
org-agenda-top-headline-filter))
(when org-agenda-tag-filter
(org-agenda-filter-apply org-agenda-tag-filter 'tag t))
(when (get 'org-agenda-tag-filter :preset-filter)
(when (assoc-default 'tag org-agenda-filters-preset)
(org-agenda-filter-apply
(get 'org-agenda-tag-filter :preset-filter) 'tag t))
(assoc-default 'tag org-agenda-filters-preset) 'tag t))
(when org-agenda-category-filter
(org-agenda-filter-apply org-agenda-category-filter 'category))
(when (get 'org-agenda-category-filter :preset-filter)
(when (assoc-default 'category org-agenda-filters-preset)
(org-agenda-filter-apply
(get 'org-agenda-category-filter :preset-filter) 'category))
(assoc-default 'category org-agenda-filters-preset) 'category))
(when org-agenda-regexp-filter
(org-agenda-filter-apply org-agenda-regexp-filter 'regexp))
(when (get 'org-agenda-regexp-filter :preset-filter)
(when (assoc-default 'regexp org-agenda-filters-preset)
(org-agenda-filter-apply
(get 'org-agenda-regexp-filter :preset-filter) 'regexp))
(assoc-default 'regexp org-agenda-filters-preset) 'regexp))
(when org-agenda-effort-filter
(org-agenda-filter-apply org-agenda-effort-filter 'effort))
(when (get 'org-agenda-effort-filter :preset-filter)
(when (assoc-default 'effort org-agenda-filters-preset)
(org-agenda-filter-apply
(get 'org-agenda-effort-filter :preset-filter) 'effort))
(assoc-default 'effort org-agenda-filters-preset) 'effort))
(add-hook 'kill-buffer-hook #'org-agenda-reset-markers 'append 'local))
(run-hooks 'org-agenda-finalize-hook))))
@ -8098,19 +8094,19 @@ in the agenda."
org-agenda-buffer-name))
(org-agenda-keep-modes t)
(tag-filter org-agenda-tag-filter)
(tag-preset (get 'org-agenda-tag-filter :preset-filter))
(tag-preset (assoc-default 'tag org-agenda-filters-preset))
(top-hl-filter org-agenda-top-headline-filter)
(cat-filter org-agenda-category-filter)
(cat-preset (get 'org-agenda-category-filter :preset-filter))
(cat-preset (assoc-default 'category org-agenda-filters-preset))
(re-filter org-agenda-regexp-filter)
(re-preset (get 'org-agenda-regexp-filter :preset-filter))
(re-preset (assoc-default 'regexp org-agenda-filters-preset))
(effort-filter org-agenda-effort-filter)
(effort-preset (get 'org-agenda-effort-filter :preset-filter))
(effort-preset (assoc-default 'effort org-agenda-filters-preset))
(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))
(lprops (get-text-property p 'org-lprops))
(redo-cmd (get-text-property p 'org-redo-cmd))
(last-args (get-text-property p 'org-last-args))
(org-agenda-overriding-cmd (get-text-property p 'org-series-cmd))
@ -8121,10 +8117,6 @@ in the agenda."
((stringp last-args)
last-args))))
(series-redo-cmd (get-text-property p 'org-series-redo-cmd)))
(put 'org-agenda-tag-filter :preset-filter nil)
(put 'org-agenda-category-filter :preset-filter nil)
(put 'org-agenda-regexp-filter :preset-filter nil)
(put 'org-agenda-effort-filter :preset-filter nil)
(and cols (org-columns-quit))
(message "Rebuilding agenda buffer...")
(if series-redo-cmd
@ -8132,7 +8124,9 @@ in the agenda."
(cl-progv
(mapcar #'car lprops)
(mapcar (lambda (binding) (eval (cadr binding) t)) lprops)
(eval redo-cmd t)))
(eval redo-cmd t))
(let ((inhibit-read-only t))
(add-text-properties (point-min) (point-max) `(org-lprops ,lprops))))
(setq org-agenda-undo-list nil
org-agenda-pending-undo-list nil
org-agenda-tag-filter tag-filter
@ -8141,10 +8135,6 @@ in the agenda."
org-agenda-effort-filter effort-filter
org-agenda-top-headline-filter top-hl-filter)
(message "Rebuilding agenda buffer...done")
(put 'org-agenda-tag-filter :preset-filter tag-preset)
(put 'org-agenda-category-filter :preset-filter cat-preset)
(put 'org-agenda-regexp-filter :preset-filter re-preset)
(put 'org-agenda-effort-filter :preset-filter effort-preset)
(let ((tag (or tag-filter tag-preset))
(cat (or cat-filter cat-preset))
(effort (or effort-filter effort-preset))
@ -8540,7 +8530,7 @@ also press `-' or `+' to switch between filtering and excluding."
(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)
(when (assoc-default 'tag org-agenda-filters-preset)
(org-agenda-filter-apply org-agenda-tag-filter 'tag expand)))
((eq char ?.)
(setq org-agenda-tag-filter
@ -8613,7 +8603,7 @@ grouptags."
((eq type 'tag)
(setq filter
(delete-dups
(append (get 'org-agenda-tag-filter :preset-filter)
(append (assoc-default 'tag org-agenda-filters-preset)
filter)))
(dolist (x filter)
(let ((op (string-to-char x)))
@ -8625,7 +8615,7 @@ grouptags."
((eq type 'category)
(setq filter
(delete-dups
(append (get 'org-agenda-category-filter :preset-filter)
(append (assoc-default 'category org-agenda-filters-preset)
filter)))
(dolist (x filter)
(if (equal "-" (substring x 0 1))
@ -8636,7 +8626,7 @@ grouptags."
((eq type 'regexp)
(setq filter
(delete-dups
(append (get 'org-agenda-regexp-filter :preset-filter)
(append (assoc-default 'regexp org-agenda-filters-preset)
filter)))
(dolist (x filter)
(if (equal "-" (substring x 0 1))
@ -8647,7 +8637,7 @@ grouptags."
((eq type 'effort)
(setq filter
(delete-dups
(append (get 'org-agenda-effort-filter :preset-filter)
(append (assoc-default 'effort org-agenda-filters-preset)
filter)))
(dolist (x filter)
(push (org-agenda-filter-effort-form x) f))))
@ -9340,13 +9330,13 @@ When called with a prefix argument, include all archive files as well."
(t ""))
(if (org-agenda-filter-any) " " "")
(if (or org-agenda-category-filter
(get 'org-agenda-category-filter :preset-filter))
(assoc-default 'category org-agenda-filters-preset))
'(:eval (propertize
(concat "["
(mapconcat
#'identity
(append
(get 'org-agenda-category-filter :preset-filter)
(assoc-default 'category org-agenda-filters-preset)
org-agenda-category-filter)
"")
"]")
@ -9354,36 +9344,36 @@ When called with a prefix argument, include all archive files as well."
'help-echo "Category used in filtering"))
"")
(if (or org-agenda-tag-filter
(get 'org-agenda-tag-filter :preset-filter))
(assoc-default 'tag org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
#'identity
(append
(get 'org-agenda-tag-filter :preset-filter)
(assoc-default 'tag org-agenda-filters-preset)
org-agenda-tag-filter)
""))
'face 'org-agenda-filter-tags
'help-echo "Tags used in filtering"))
"")
(if (or org-agenda-effort-filter
(get 'org-agenda-effort-filter :preset-filter))
(assoc-default 'effort org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
#'identity
(append
(get 'org-agenda-effort-filter :preset-filter)
(assoc-default 'effort org-agenda-filters-preset)
org-agenda-effort-filter)
""))
'face 'org-agenda-filter-effort
'help-echo "Effort conditions used in filtering"))
"")
(if (or org-agenda-regexp-filter
(get 'org-agenda-regexp-filter :preset-filter))
(assoc-default 'regexp org-agenda-filters-preset))
'(:eval (propertize
(concat (mapconcat
(lambda (x) (concat (substring x 0 1) "/" (substring x 1) "/"))
(append
(get 'org-agenda-regexp-filter :preset-filter)
(assoc-default 'regexp org-agenda-filters-preset)
org-agenda-regexp-filter)
""))
'face 'org-agenda-filter-regexp
@ -11235,10 +11225,10 @@ current HH:MM time."
(,org-agenda-category-filter category)
(,org-agenda-regexp-filter regexp)
(,org-agenda-effort-filter effort)
(,(get 'org-agenda-tag-filter :preset-filter) tag)
(,(get 'org-agenda-category-filter :preset-filter) category)
(,(get 'org-agenda-effort-filter :preset-filter) effort)
(,(get 'org-agenda-regexp-filter :preset-filter) regexp))))
(,(assoc-default 'tag org-agenda-filters-preset) tag)
(,(assoc-default 'category org-agenda-filters-preset) category)
(,(assoc-default 'effort org-agenda-filters-preset) effort)
(,(assoc-default 'regexp org-agenda-filters-preset) regexp))))
(defun org-agenda-drag-line-forward (arg &optional backward)
"Drag an agenda line forward by ARG lines.

60
testing/lisp/test-org-agenda.el
View File

@ -196,6 +196,53 @@ See https://list.orgmode.org/06d301d83d9e$f8b44340$ea1cc9c0$@tomdavey.com"
(org-toggle-sticky-agenda)
(org-test-agenda--kill-all-agendas))
(ert-deftest test-org-agenda/sticky-agenda-filter-preset ()
"Update sticky agenda buffers properly with preset of filters."
(unless org-agenda-sticky
(org-toggle-sticky-agenda))
(org-test-agenda-with-agenda "* TODO Foo"
(org-set-property "CATEGORY" "foo")
(let ((org-agenda-custom-commands
'(("f" "foo: multi-command"
((tags-todo "+CATEGORY=\"foo\"")
(alltodo ""))
((org-agenda-category-filter-preset '("+foo"))))
("b" "bar: multi-command"
((tags-todo "+CATEGORY=\"bar\"")
(alltodo ""))
((org-agenda-category-filter-preset '("+bar"))))
("f1" "foo: single-command"
tags-todo "+CATEGORY=\"foo\""
((org-agenda-category-filter-preset '("+foo"))))
("b1" "bar: single-command"
tags-todo "+CATEGORY=\"bar\""
((org-agenda-category-filter-preset '("+bar"))))
("f2" "foo: single-command"
alltodo "" ((org-agenda-category-filter-preset '("+foo"))))
("b2" "bar: single-command"
alltodo "" ((org-agenda-category-filter-preset '("+bar")))))))
(org-agenda nil "f")
(org-agenda nil "b")
(set-buffer "*Org Agenda(f)*")
(org-agenda-redo)
(goto-char (point-min))
(should (not (invisible-p (1- (search-forward "TODO Foo")))))
(org-test-agenda--kill-all-agendas)
(org-agenda nil "f1")
(org-agenda nil "b1")
(set-buffer "*Org Agenda(f1:+CATEGORY=\"foo\")*")
(org-agenda-redo)
(goto-char (point-min))
(should (not (invisible-p (1- (search-forward "TODO Foo")))))
(org-test-agenda--kill-all-agendas)
(org-agenda nil "f2")
(org-agenda nil "b2")
(set-buffer "*Org Agenda(f2)*")
(org-agenda-redo)
(goto-char (point-min))
(should (not (invisible-p (1- (search-forward "TODO Foo")))))))
(org-toggle-sticky-agenda))
(ert-deftest test-org-agenda/goto-date ()
"Test `org-agenda-goto-date'."
(unwind-protect
@ -229,6 +276,19 @@ See https://list.orgmode.org/06d301d83d9e$f8b44340$ea1cc9c0$@tomdavey.com"
(should (= 11 text-scale-mode-amount)))
(org-test-agenda--kill-all-agendas)))
(ert-deftest test-org-agenda/redo-setting ()
"Command settings survives `org-agenda-redo'."
(org-test-agenda--kill-all-agendas)
(let ((org-agenda-custom-commands
'(("t" "TODOs" alltodo ""
((org-agenda-overriding-header "Test"))))))
(org-agenda nil "t")
(org-agenda-redo)
(org-agenda-redo)
(goto-char (point-min))
(should (looking-at-p "Test")))
(org-test-agenda--kill-all-agendas))
(ert-deftest test-org-agenda/diary-inclusion ()
"Diary inclusion happens."