From 718cb5258a407d8a51eb4a5bac3d0c8025a3f198 Mon Sep 17 00:00:00 2001 From: Liu Hui Date: Tue, 4 Oct 2022 11:12:41 +0800 Subject: [PATCH] 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. --- lisp/org-agenda.el | 108 +++++++++++++++----------------- testing/lisp/test-org-agenda.el | 60 ++++++++++++++++++ 2 files changed, 109 insertions(+), 59 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index e5df768ff..c303aead1 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -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. diff --git a/testing/lisp/test-org-agenda.el b/testing/lisp/test-org-agenda.el index ed178a4c9..256f701df 100644 --- a/testing/lisp/test-org-agenda.el +++ b/testing/lisp/test-org-agenda.el @@ -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." -- 2.25.1