From 1168d085d2182fed6019848d676a89a2f54fa64b Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 10 Sep 2017 14:10:49 +0200 Subject: [PATCH] org-agenda: Fix `org-agenda-skip-if-todo' * lisp/org-agenda.el (org-agenda-skip-if-todo): Make sure TODO search is case sensitive. Refactor function. --- lisp/org-agenda.el | 67 +++++++++++++++++++++------------------------- 1 file changed, 30 insertions(+), 37 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 96ff7c69d..03d4e37cf 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -4921,43 +4921,36 @@ ARGS is a list with first element either `todo', `nottodo', `todo-unblocked' or `nottodo-unblocked'. The remainder is either a list of TODO keywords, or a state symbol `todo' or `done' or `any'." - (let ((kw (car args)) - (arg (cadr args)) - todo-wds todo-re) - (setq todo-wds - (org-uniquify - (cond - ((listp arg) ;; list of keywords - (if (member "*" arg) - (mapcar 'substring-no-properties org-todo-keywords-1) - arg)) - ((symbolp arg) ;; keyword class name - (cond - ((eq arg 'todo) - (org-delete-all org-done-keywords - (mapcar 'substring-no-properties - org-todo-keywords-1))) - ((eq arg 'done) org-done-keywords) - ((eq arg 'any) - (mapcar 'substring-no-properties org-todo-keywords-1))))))) - (setq todo-re - (concat "^\\*+[ \t]+\\<\\(" - (mapconcat 'identity todo-wds "\\|") - "\\)\\>")) - (cond - ((eq kw 'todo) (re-search-forward todo-re end t)) - ((eq kw 'nottodo) (not (re-search-forward todo-re end t))) - ((eq kw 'todo-unblocked) - (catch 'unblocked - (while (re-search-forward todo-re end t) - (or (org-entry-blocked-p) (throw 'unblocked t))) - nil)) - ((eq kw 'nottodo-unblocked) - (catch 'unblocked - (while (re-search-forward todo-re end t) - (or (org-entry-blocked-p) (throw 'unblocked nil))) - t)) - ))) + (let ((todo-re + (concat "^\\*+[ \t]+" + (regexp-opt + (pcase args + (`(,_ todo) + (org-delete-all org-done-keywords + (copy-sequence org-todo-keywords-1))) + (`(,_ done) org-done-keywords) + (`(,_ any) org-todo-keywords-1) + (`(,_ ,(pred atom)) + (error "Invalid TODO class or type: %S" args)) + (`(,_ ,(pred (member "*"))) org-todo-keywords-1) + (`(,_ ,todo-list) todo-list)) + 'words)))) + (pcase args + (`(todo . ,_) + (let (case-fold-search) (re-search-forward todo-re end t))) + (`(nottodo . ,_) + (not (let (case-fold-search) (re-search-forward todo-re end t)))) + (`(todo-unblocked . ,_) + (catch :unblocked + (while (let (case-fold-search) (re-search-forward todo-re end t)) + (when (org-entry-blocked-p) (throw :unblocked t))) + nil)) + (`(nottodo-unblocked . ,_) + (catch :unblocked + (while (let (case-fold-search) (re-search-forward todo-re end t)) + (when (org-entry-blocked-p) (throw :unblocked nil))) + t)) + (`(,type . ,_) (error "Unknown TODO skip type: %S" type))))) ;;;###autoload (defun org-agenda-list-stuck-projects (&rest ignore)