From aa86e4bc9f7eab2b610460812af2cbc93ba2387e Mon Sep 17 00:00:00 2001 From: Bastien Guerry Date: Wed, 28 May 2014 12:26:54 +0200 Subject: [PATCH] org-agenda.el: Implement new effort filter * org-agenda.el (org-agenda-custom-commands-local-options): Add `org-agenda-effort-filter-preset'. (org-agenda-filter-effort-default-operator): Delete. (org-agenda-local-vars): Add `org-agenda-effort-filter'. (org-agenda-mode-map): Use "_" to filter by effort. (org-agenda-effort-filter, org-agenda-effort-filter-preset): New variables. (org-agenda-prepare-window, org-agenda-prepare) (org-agenda-finalize, org-agenda-redo) (org-agenda-filter-remove-all, org-agenda-filter-apply) (org-agenda-set-mode-name, org-agenda-reapply-filters): Handle effort filter. (org-agenda-finalize-entries): Use `org-sort-agenda-noeffort-is-high'. (org-agenda-limit-entries): Get the property from the correct location. (org-agenda-limit-interactively): Throw a user error on wrong input. (org-agenda-filter-by-effort): New command. (org-agenda-filter-by-tag): Don't filter by effort. (org-agenda-filter-make-matcher): Handle effort filter. (org-agenda-compare-effort): Don't handle the "?" operator. (org-agenda-filter-show-all-effort): New command. Note: This calls for some refactoring in the filter area. --- lisp/org-agenda.el | 167 ++++++++++++++++++++++++++++++--------------- 1 file changed, 113 insertions(+), 54 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index dafccc054..6f65a0c08 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -361,6 +361,12 @@ the daily/weekly agenda, see `org-agenda-skip-function'.") (const :format "" quote) (repeat (string :tag "+tag or -tag")))) + (list :tag "Effort filter preset" + (const org-agenda-effort-filter-preset) + (list + (const :format "" quote) + (repeat + (string :tag "+=10 or -=10 or +<10 or ->10")))) (list :tag "Regexp filter preset" (const org-agenda-regexp-filter-preset) (list @@ -607,15 +613,6 @@ or `C-c a #' to produce the list." (repeat :tag "Projects are *not* stuck if they have an entry with TAG being any of" (string)) (regexp :tag "Projects are *not* stuck if this regexp matches inside the subtree"))) -(defcustom org-agenda-filter-effort-default-operator "<" - "The default operator for effort estimate filtering. -If you select an effort estimate limit without first pressing an operator, -this one will be used." - :group 'org-agenda-custom-commands - :type '(choice (const :tag "less or equal" "<") - (const :tag "greater or equal"">") - (const :tag "equal" "="))) - (defgroup org-agenda-skip nil "Options concerning skipping parts of agenda files." :tag "Org Agenda Skip" @@ -2097,6 +2094,7 @@ When nil, `q' will kill the single agenda buffer." org-agenda-category-filter org-agenda-top-headline-filter org-agenda-regexp-filter + org-agenda-effort-filter org-agenda-markers org-agenda-last-search-view-search-was-boolean org-agenda-filtered-by-category @@ -2305,6 +2303,7 @@ The following commands are available: (org-defkey org-agenda-mode-map "{" 'org-agenda-manipulate-query-add-re) (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-effort) (org-defkey org-agenda-mode-map "=" 'org-agenda-filter-by-regexp) (org-defkey org-agenda-mode-map "|" 'org-agenda-filter-remove-all) (org-defkey org-agenda-mode-map "\\" 'org-agenda-filter-by-tag-refine) @@ -3534,6 +3533,7 @@ removed from the entry content. Currently only `planning' is allowed here." (defvar org-agenda-tag-filter nil) (defvar org-agenda-category-filter nil) (defvar org-agenda-regexp-filter nil) +(defvar org-agenda-effort-filter nil) (defvar org-agenda-top-headline-filter nil) (defvar org-agenda-tag-filter-while-redo nil) (defvar org-agenda-tag-filter-preset nil @@ -3566,6 +3566,16 @@ 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-effort-filter-preset nil + "A preset of the effort condition used for secondary agenda filtering. +This must be a list of strings, each string must be a single regexp +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-agenda-use-sticky-p () "Return non-nil if an agenda buffer named `org-agenda-buffer-name' exists and should be shown instead of @@ -3608,6 +3618,7 @@ FILTER-ALIST is an alist of filters we need to apply when (org-switch-to-buffer-other-window abuf))) (setq org-agenda-tag-filter (cdr (assoc 'tag filter-alist))) (setq org-agenda-category-filter (cdr (assoc 'cat filter-alist))) + (setq org-agenda-effort-filter (cdr (assoc 'effort filter-alist))) (setq org-agenda-regexp-filter (cdr (assoc 're filter-alist))) ;; Additional test in case agenda is invoked from within agenda ;; buffer via elisp link. @@ -3620,6 +3631,7 @@ FILTER-ALIST is an alist of filters we need to apply when (let ((filter-alist (if org-agenda-persistent-filter (list `(tag . ,org-agenda-tag-filter) `(re . ,org-agenda-regexp-filter) + `(effort . ,org-agenda-effort-filter) `(car . ,org-agenda-category-filter))))) (if (org-agenda-use-sticky-p) (progn @@ -3636,6 +3648,8 @@ FILTER-ALIST is an alist of filters we need to apply when 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) @@ -3746,6 +3760,11 @@ FILTER-ALIST is an alist of filters we need to apply when (when (get 'org-agenda-regexp-filter :preset-filter) (org-agenda-filter-apply (get 'org-agenda-regexp-filter :preset-filter) 'regexp)) + (when org-agenda-effort-filter + (org-agenda-filter-apply org-agenda-effort-filter 'effort)) + (when (get 'org-agenda-effort-filter :preset-filter) + (org-agenda-filter-apply + (get 'org-agenda-effort-filter :preset-filter) 'effort)) (org-add-hook 'kill-buffer-hook 'org-agenda-reset-markers 'append 'local))))) (defun org-agenda-mark-clocking-task () @@ -6801,7 +6820,9 @@ The optional argument TYPE tells the agenda type." list (mapcar 'identity (sort list 'org-entries-lessp))) (when max-effort (setq list (org-agenda-limit-entries - list 'effort-minutes max-effort 'identity))) + list 'effort-minutes max-effort + (lambda (e) (or e (if org-sort-agenda-noeffort-is-high + 32767 -1)))))) (when max-todo (setq list (org-agenda-limit-entries list 'todo-state max-todo))) (when max-tags @@ -6819,7 +6840,9 @@ The optional argument TYPE tells the agenda type." (delq nil (mapcar (lambda (e) - (let ((pval (funcall fun (get-text-property 1 prop e)))) + (let ((pval (funcall + fun (get-text-property (1- (length e)) + prop e)))) (if pval (setq lim (+ lim pval))) (cond ((and pval (<= lim (abs limit))) e) ((and include (not pval)) e)))) @@ -6839,7 +6862,8 @@ The optional argument TYPE tells the agenda type." (msg (cond ((= max ?E) "How many minutes? ") ((= max ?e) "How many entries? ") ((= max ?t) "How many TODO entries? ") - ((= max ?T) "How many tagged entries? "))) + ((= max ?T) "How many tagged entries? ") + (t (user-error "Wrong input")))) (num (string-to-number (read-from-minibuffer msg)))) (cond ((equal max ?e) (let ((org-agenda-max-entries num)) (org-agenda-redo))) @@ -7253,6 +7277,8 @@ in the agenda." (cat-preset (get 'org-agenda-category-filter :preset-filter)) (re-filter org-agenda-regexp-filter) (re-preset (get 'org-agenda-regexp-filter :preset-filter)) + (effort-filter org-agenda-effort-filter) + (effort-preset (get 'org-agenda-effort-filter :preset-filter)) (org-agenda-tag-filter-while-redo (or tag-filter tag-preset)) (cols org-agenda-columns-active) (line (org-current-line)) @@ -7271,6 +7297,7 @@ in the agenda." (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 @@ -7281,16 +7308,20 @@ in the agenda." org-agenda-tag-filter tag-filter org-agenda-category-filter cat-filter org-agenda-regexp-filter re-filter + 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)) - (re (or re-filter re-preset))) + (effort (or effort-filter effort-preset)) + (re (or re-filter re-preset))) (when tag (org-agenda-filter-apply tag 'tag)) (when cat (org-agenda-filter-apply cat 'category)) + (when effort (org-agenda-filter-apply effort 'effort)) (when re (org-agenda-filter-apply re 'regexp))) (and top-hl-filter (org-agenda-filter-top-headline-apply top-hl-filter)) (and cols (org-called-interactively-p 'any) (org-agenda-columns)) @@ -7362,6 +7393,39 @@ With two prefix arguments, remove the regexp filters." (org-agenda-filter-show-all-re) (message "Regexp filter removed"))) +(defvar org-agenda-effort-filter nil) +(defun org-agenda-filter-by-effort (strip) + "Filter agenda entries by effort. +With no prefix argument, keep entries matching the effort condition. +With one prefix argument, filter out entries matching the condition. +With two prefix arguments, remove the effort filters." + (interactive "P") + (cond ((member strip '(nil 4)) + (let ((efforts (org-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 8:00" + ""))) + (eff -1) + effort-prompt op) + (while (not (member op '(?< ?> ?=))) + (setq op (read-char-exclusive "Effort operator? (> = or <)"))) + (loop for i from 0 to 9 do + (setq effort-prompt + (concat + effort-prompt " [" + (if (= i 9) "0" (int-to-string (1+ i))) + "]" (nth i efforts)))) + (message "Effort %s%s" (char-to-string op) effort-prompt) + (while (or (< eff 0) (> eff 9)) + (setq eff (string-to-number (char-to-string (read-char-exclusive))))) + (setq org-agenda-effort-filter + (list (concat (if strip "-" "+") + (char-to-string op) (nth (1- eff) efforts)))) + (org-agenda-filter-apply org-agenda-effort-filter 'effort))) + (t (org-agenda-filter-show-all-effort) + (message "Effort filter removed")))) + (defun org-agenda-filter-remove-all () "Remove all filters from the current agenda buffer." (interactive) @@ -7373,6 +7437,8 @@ With two prefix arguments, remove the regexp filters." (org-agenda-filter-show-all-re)) (when org-agenda-top-headline-filter (org-agenda-filter-show-all-top-filter)) + (when org-agenda-effort-filter + (org-agenda-filter-show-all-effort)) (org-agenda-finalize)) (defun org-agenda-filter-by-tag (strip &optional char narrow) @@ -7390,19 +7456,12 @@ to switch to narrowing." (char-to-string (cdr x)) "")) alist "")) - (efforts (org-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 8:00" - ""))) - (effort-op org-agenda-filter-effort-default-operator) - (effort-prompt "") (inhibit-read-only t) (current org-agenda-tag-filter) maybe-refresh a n tag) (unless char (message - "%s by tag [%s ], [TAB], %s[/]:off, [+-]:narrow, [>==<]:effort: " tag-chars) + "Narrow by tag [%s ], [TAB], [/]:off" tag-chars) (setq char (read-char-exclusive))) - (when (member char '(?< ?> ?= ??)) - ;; An effort operator - (setq effort-op (char-to-string char)) - (setq alist nil) ; to make sure it will be interpreted as effort. - (unless (equal char ??) - (loop for i from 0 to 9 do - (setq effort-prompt - (concat - effort-prompt " [" - (if (= i 9) "0" (int-to-string (1+ i))) - "]" (nth i efforts)))) - (message "Effort%s: %s " effort-op effort-prompt) - (setq char (read-char-exclusive)) - (when (or (< char ?0) (> char ?9)) - (error "Need 1-9,0 to select effort")))) (when (equal char ?\t) (unless (local-variable-p 'org-global-tags-completion-table (current-buffer)) (org-set-local 'org-global-tags-completion-table @@ -7460,13 +7504,6 @@ to switch to narrowing." (setq maybe-refresh t)) ((or (equal char ?\ ) (setq a (rassoc char alist)) - (and (>= char ?0) (<= char ?9) - (setq n (if (= char ?0) 9 (- char ?0 1)) - tag (concat effort-op (nth n efforts)) - a (cons tag nil))) - (and (= char ??) - (setq tag "?eff") - a (cons tag nil)) (and tag (setq a (cons tag nil)))) (org-agenda-filter-show-all-tag) (setq tag (car a)) @@ -7513,10 +7550,8 @@ to switch to narrowing." (dolist (x fltr) (if (member x '("-" "+")) (setq nf01 (if (equal x "-") 'tags '(not tags))) - (if (string-match "[<=>?]" x) - (setq nf01 (org-agenda-filter-effort-form x)) - (setq nf01 (list 'member (downcase (substring x 1)) - 'tags))) + (setq nf01 (list 'member (downcase (substring x 1)) + 'tags)) (when (equal (string-to-char x) ?-) (setq nf01 (list 'not nf01)) (when (not notgroup) (setq op 'and)))) @@ -7550,7 +7585,15 @@ to switch to narrowing." (if (equal "-" (substring x 0 1)) (setq f1 (list 'not (list 'string-match (substring x 1) 'txt))) (setq f1 (list 'string-match (substring x 1) 'txt))) - (push f1 f)))) + (push f1 f))) + ;; Effort filter + ((eq type 'effort) + (setq filter + (delete-dups + (append (get 'org-agenda-effort-filter :preset-filter) + filter))) + (dolist (x filter) + (push (org-agenda-filter-effort-form x) f)))) (cons 'and (nreverse f)))) (defun org-agenda-filter-effort-form (e) @@ -7570,10 +7613,8 @@ E looks like \"+<2:25\"." "Compare the effort of the current line with VALUE, using OP. If the line does not have an effort defined, return nil." (let ((eff (org-get-at-eol 'effort-minutes 1))) - (if (equal op ??) - (not eff) - (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0)) - value)))) + (funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 -1)) + value))) (defun org-agenda-filter-expand-tags (filter &optional no-operator) "Expand group tags in FILTER for the agenda. @@ -7617,7 +7658,8 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags." (org-agenda-filter-expand-tags (list f) t)) (org-get-at-bol 'tags))) cat (org-get-at-eol 'org-category 1) - txt (get-text-property (point) 'txt)) + txt (org-get-at-eol 'txt 1) + effort-minutes (org-get-at-eol 'effort-minutes 1)) (if (not (eval org-agenda-filter-form)) (org-agenda-filter-hide-line type)) (beginning-of-line 2)) @@ -7670,6 +7712,8 @@ When NO-OPERATOR is non-nil, do not add the + operator to returned tags." (org-agenda-remove-filter 'tag)) (defun org-agenda-filter-show-all-re nil (org-agenda-remove-filter 'regexp)) +(defun org-agenda-filter-show-all-effort nil + (org-agenda-remove-filter 'effort)) (defun org-agenda-filter-show-all-cat nil (org-agenda-remove-filter 'category)) (defun org-agenda-filter-show-all-top-filter nil @@ -8208,6 +8252,19 @@ When called with a prefix argument, include all archive files as well." "}") 'face 'org-agenda-filter-tags 'help-echo "Tags used in filtering")) "") + (if (or org-agenda-effort-filter + (get 'org-agenda-effort-filter :preset-filter)) + '(:eval (org-propertize + (concat " {" + (mapconcat + 'identity + (append + (get 'org-agenda-effort-filter :preset-filter) + 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)) '(:eval (org-propertize @@ -9915,8 +9972,10 @@ current HH:MM time." `((,org-agenda-tag-filter tag) (,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)))) (defun org-agenda-drag-line-forward (arg &optional backward)