From: Stefan Kangas <stefan@marxist.se>
To: Kyle Meyer <kyle@kyleam.com>
Cc: emacs-orgmode@gnu.org
Subject: Re: [PATCH] New function org-agenda-filter-set
Date: Fri, 22 May 2020 22:16:24 -0700 [thread overview]
Message-ID: <CADwFkmkX8isQgwKC1NpZJ7f3Ve41VKmkVk9d7FO7=N=AqjabnA@mail.gmail.com> (raw)
In-Reply-To: <875zcns0ph.fsf@kyleam.com>
[-- Attachment #1: Type: text/plain, Size: 239 bytes --]
Kyle Meyer <kyle@kyleam.com> writes:
> nitpick: Could you update the docstring to explicitly mention STR and to
> describe NEGATE?
Fixed in the attached patch.
> Thanks for the patch.
Thanks for reviewing.
Best regards,
Stefan Kangas
[-- Attachment #2: 0001-New-function-org-agenda-filter-set.patch --]
[-- Type: text/x-diff, Size: 6056 bytes --]
From 5a9a7d810e174dfad30a6ec657b39cbe83879f94 Mon Sep 17 00:00:00 2001
From: Stefan Kangas <stefankangas@gmail.com>
Date: Sat, 23 May 2020 07:13:29 +0200
Subject: [PATCH] New function org-agenda-filter-set
* lisp/org-agenda.el (org-agenda-filter)
(org-agenda-filter-set): Refactor out from 'org-agenda-filter', to
create a better interface to filter the agenda from Lisp.
---
lisp/org-agenda.el | 102 +++++++++++++++++++++++++--------------------
1 file changed, 57 insertions(+), 45 deletions(-)
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index ab13f926c..858de02c7 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -7655,7 +7655,60 @@ consistency with the other filter commands."
(if keep current nil)))
(org-agenda-filter-apply org-agenda-effort-filter 'effort)))))
-(defun org-agenda-filter (&optional strip-or-accumulate)
+(defun org-agenda-filter-set (str &optional force-keep negate)
+ "Set agenda filter from string STR.
+STR is parsed according to the rules described in
+`org-agenda-filter'.
+
+If FORCE-KEEP is non-nil, add the new filter elements to the
+existing ones.
+
+If NEGATE is non-nil, negate the entire filter."
+ (let* ((tag-list (org-agenda-get-represented-tags))
+ (category-list (org-agenda-get-represented-categories))
+ (keep (or force-keep
+ (if (string-match "^\\+[+-]" str)
+ (progn (setq str (substring str 1)) t))))
+ (fc (if keep org-agenda-category-filter))
+ (ft (if keep org-agenda-tag-filter))
+ (fe (if keep org-agenda-effort-filter))
+ (fr (if keep org-agenda-regexp-filter))
+ pm s)
+ (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" str)
+ (setq pm (if (match-beginning 1) (match-string 1 str) "+"))
+ (when negate
+ (setq pm (if (equal pm "+") "-" "+")))
+ (cond
+ ((match-beginning 3)
+ ;; category or tag
+ (setq s (match-string 3 str))
+ (cond
+ ((member s tag-list)
+ (add-to-list 'ft (concat pm s) 'append 'equal))
+ ((member s category-list)
+ (add-to-list 'fc (concat pm s) 'append 'equal))
+ (t (message
+ "`%s%s' filter ignored because tag/category is not represented"
+ pm s))))
+ ((match-beginning 4)
+ ;; effort
+ (add-to-list 'fe (concat pm (match-string 4 str)) t 'equal))
+ ((match-beginning 5)
+ ;; regexp
+ (add-to-list 'fr (concat pm (match-string 6 str)) t 'equal)))
+ (setq str (substring str (match-end 0))))
+ (org-agenda-filter-remove-all)
+ (and fc (org-agenda-filter-apply
+ (setq org-agenda-category-filter fc) 'category))
+ (and ft (org-agenda-filter-apply
+ (setq org-agenda-tag-filter ft) 'tag 'expand))
+ (and fe (org-agenda-filter-apply
+ (setq org-agenda-effort-filter fe) 'effort))
+ (and fr (org-agenda-filter-apply
+ (setq org-agenda-regexp-filter fr) 'regexp))
+ (run-hooks 'org-agenda-filter-hook)))
+
+(defun org-agenda-filter (&optional strip-or-accumulate filter-string)
"Prompt for a general filter string and apply it to the agenda.
The string may contain filter elements like
@@ -7702,9 +7755,7 @@ the variable `org-agenda-auto-exclude-function'."
(unless (null org-agenda-tag-filter)
(org-agenda-filter-apply org-agenda-tag-filter 'tag 'expand)))
;; Prompt for a filter and act
- (let* ((tag-list (org-agenda-get-represented-tags))
- (category-list (org-agenda-get-represented-categories))
- (negate (equal strip-or-accumulate '(4)))
+ (let* ((negate (equal strip-or-accumulate '(4)))
(cf (mapconcat #'identity org-agenda-category-filter ""))
(tf (mapconcat #'identity org-agenda-tag-filter ""))
(rpl-fn (lambda (c) (replace-regexp-in-string "^\+" "" (or (car c) ""))))
@@ -7717,47 +7768,8 @@ the variable `org-agenda-auto-exclude-function'."
" [+cat-tag<0:10-/regexp/]: ")
'org-agenda-filter-completion-function
nil nil ff))
- (keep (or (if (string-match "^\\+[+-]" f-string)
- (progn (setq f-string (substring f-string 1)) t))
- (equal strip-or-accumulate '(16))))
- (fc (if keep org-agenda-category-filter))
- (ft (if keep org-agenda-tag-filter))
- (fe (if keep org-agenda-effort-filter))
- (fr (if keep org-agenda-regexp-filter))
- pm s)
- (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)" f-string)
- (setq pm (if (match-beginning 1) (match-string 1 f-string) "+"))
- (when negate
- (setq pm (if (equal pm "+") "-" "+")))
- (cond
- ((match-beginning 3)
- ;; category or tag
- (setq s (match-string 3 f-string))
- (cond
- ((member s tag-list)
- (add-to-list 'ft (concat pm s) 'append 'equal))
- ((member s category-list)
- (add-to-list 'fc (concat pm s) 'append 'equal))
- (t (message
- "`%s%s' filter ignored because tag/category is not represented"
- pm s))))
- ((match-beginning 4)
- ;; effort
- (add-to-list 'fe (concat pm (match-string 4 f-string)) t 'equal))
- ((match-beginning 5)
- ;; regexp
- (add-to-list 'fr (concat pm (match-string 6 f-string)) t 'equal)))
- (setq f-string (substring f-string (match-end 0))))
- (org-agenda-filter-remove-all)
- (and fc (org-agenda-filter-apply
- (setq org-agenda-category-filter fc) 'category))
- (and ft (org-agenda-filter-apply
- (setq org-agenda-tag-filter ft) 'tag 'expand))
- (and fe (org-agenda-filter-apply
- (setq org-agenda-effort-filter fe) 'effort))
- (and fr (org-agenda-filter-apply
- (setq org-agenda-regexp-filter fr) 'regexp))
- (run-hooks 'org-agenda-filter-hook))))
+ (keep (equal strip-or-accumulate '(16))))
+ (org-agenda-filter-set f-string keep negate))))
(defun org-agenda-filter-completion-function (string _predicate &optional flag)
"Complete a complex filter string.
--
2.26.2
next prev parent reply other threads:[~2020-05-23 5:16 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2020-05-21 6:23 [PATCH] New function org-agenda-filter-set Stefan Kangas
2020-05-23 5:02 ` Kyle Meyer
2020-05-23 5:16 ` Stefan Kangas [this message]
2020-05-23 9:07 ` Bastien
2020-06-01 12:50 ` Bastien
2020-06-05 3:58 ` Kyle Meyer
2020-09-05 7:45 ` Bastien
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='CADwFkmkX8isQgwKC1NpZJ7f3Ve41VKmkVk9d7FO7=N=AqjabnA@mail.gmail.com' \
--to=stefan@marxist.se \
--cc=emacs-orgmode@gnu.org \
--cc=kyle@kyleam.com \
/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).