summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorCarsten Dominik <carsten.dominik@gmail.com>2019-08-29 17:43:24 +0200
committerCarsten Dominik <carsten.dominik@gmail.com>2019-08-29 18:06:10 +0200
commit69bf64419b798d46cec5a3cf5a2ae4af08016109 (patch)
treec110b68ffd7d01c950a5188fa91fbe36b13ad8de
parent6543716d67be4d61ca94f5fc24b6143be4ca7329 (diff)
downloadorg-mode-69bf64419b798d46cec5a3cf5a2ae4af08016109.tar.gz
Add new generic filter interface
* lisp/org-agenda.el (org-agenda-filter): New function. (org-agenda-filter-completion-function): New function.
-rw-r--r--lisp/org-agenda.el113
1 files changed, 108 insertions, 5 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el
index 8cdaf2c..0ffb3dc 100644
--- a/lisp/org-agenda.el
+++ b/lisp/org-agenda.el
@@ -2402,6 +2402,7 @@ The following commands are available:
(org-defkey org-agenda-mode-map "/" 'org-agenda-filter-by-tag)
(org-defkey org-agenda-mode-map "_" 'org-agenda-filter-by-effort)
(org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp)
+(org-defkey org-agenda-mode-map "\\" 'org-agenda-filter)
(org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all)
(org-defkey org-agenda-mode-map "~" 'org-agenda-limit-interactively)
(org-defkey org-agenda-mode-map "<" 'org-agenda-filter-by-category)
@@ -2483,6 +2484,8 @@ The following commands are available:
"--"
["Remove Restriction" org-agenda-remove-restriction-lock org-agenda-restrict])
("Filter current view"
+ ["with generic interface" org-agenda-filter t]
+ "--"
["by category at cursor" org-agenda-filter-by-category t]
["by tag" org-agenda-filter-by-tag t]
["by effort" org-agenda-filter-by-effort t]
@@ -3659,11 +3662,12 @@ the global options and expect it to be applied to the entire view.")
"Alist of filter types and associated variables")
(defun org-agenda-filter-any ()
"Is any filter active?"
- (eval (cons 'or (mapcar (lambda (x)
- (or (symbol-value (cdr x))
- (get :preset-filter x)))
- org-agenda-filter-variables))))
-
+ (let ((form (cons 'or (mapcar (lambda (x)
+ (if (or (symbol-value (cdr x))
+ (get :preset-filter x))
+ t nil))
+ org-agenda-filter-variables))))
+ (eval form)))
(defvar org-agenda-category-filter-preset nil
"A preset of the category filter used for secondary agenda filtering.
This must be a list of strings, each string must be a single category
@@ -7580,6 +7584,105 @@ With two prefix arguments, remove the effort filters."
(t (org-agenda-filter-show-all-effort)
(message "Effort filter removed"))))
+
+(defun org-agenda-filter (&optional keep)
+ "Prompt for a general filter string and apply it to the agenda.
+The new filter replaces all existing elements. When called with a
+prefix arg KEEP, add the new elements to the existing filter.
+
+The string may contain filter elements like
+
++category
++tag
++<effort > and = are also allowed as effort operators
++/regexp/
+
+Instead of `+', `-' is allowed to strip the agenda of matching entries.
+`+' is optional if it is not required to separate two string parts.
+Multiple filter elements can be concatenated without spaces, for example
+
+ +work-John<0:10-/plot/
+
+selects entries with category `work' and effort estimates below 10 minutes,
+and deselects entries with tag `John' or matching the regexp `plot'.
+
+During entry of the filter, completion for tags, categories and effort
+values is offered. Since the syntax for categories and tags is identical
+there should be no overlap between categoroes and tags. If there is, tags
+get priority."
+ (interactive "P")
+ (let* ((tag-list (org-agenda-get-represented-tags))
+ (category-list (org-agenda-get-represented-categories))
+ (f-string (completing-read "Filter [+cat-tag<0:10-/regexp/]: " 'org-agenda-filter-completion-function))
+ (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)))
+ (while (string-match "^[ \t]*\\([-+]\\)?\\(\\([^-+<>=/ \t]+\\)\\|\\([<>=][0-9:]+\\)\\|\\(/\\([^/]+\\)/?\\)\\)"
+ f-string)
+ (setq log (if (match-beginning 1) (match-string 1 f-string) "+"))
+ (cond
+ ((match-beginning 3)
+ ;; category or tag
+ (setq s (match-string 3 f-string))
+ (cond ((member s tag-list)
+ (push (concat log s) ft))
+ ((member s category-list)
+ (push (concat log s) fc))
+ (t (message "`%s%s' filter ignored because it is not represented as tag or category" log s))))
+ ((match-beginning 4)
+ ;; effort
+ (push (concat log (match-string 4 f-string)) fe))
+ ((match-beginning 5)
+ ;; regexp
+ (push (concat log (match-string 6 f-string)) fr)))
+ (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))
+ (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))
+ ))
+
+(defun org-agenda-filter-completion-function (string _predicate &optional flag)
+ "Complete a complex filter string
+FLAG specifies the type of completion operation to perform. This
+function is passed as a collection function to `completing-read',
+which see."
+ (let ((completion-ignore-case t) ;tags are case-sensitive
+ (confirm (lambda (x) (stringp x)))
+ (prefix "")
+ (operator "")
+ table)
+ (when (string-match "^\\(.*\\([-+<>=]\\)\\)\\([^-+<>=]*\\)$" string)
+ (setq prefix (match-string 1 string)
+ operator (match-string 2 string)
+ string (match-string 3 string)))
+ (cond
+ ((member operator '("+" "-" "" nil))
+ (setq table (append (org-agenda-get-represented-categories)
+ (org-agenda-get-represented-tags))))
+ ((member operator '("<" ">" "="))
+ (setq table (split-string
+ (or (cdr (assoc (concat org-effort-property "_ALL")
+ org-global-properties))
+ "0 0:10 0:30 1:00 2:00 3:00 4:00 5:00 6:00 7:00")
+ " +")))
+ (t (setq table nil)))
+ (pcase flag
+ (`t (all-completions string table confirm))
+ (`lambda (assoc string table)) ;exact match?
+ (`nil
+ (pcase (try-completion string table confirm)
+ ((and completion (pred stringp))
+ (concat prefix completion))
+ (completion completion)))
+ (_ nil))))
+
(defun org-agenda-filter-remove-all ()
"Remove all filters from the current agenda buffer."
(interactive)