diff options
author | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-09-10 14:10:49 +0200 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2017-09-10 14:10:49 +0200 |
commit | 1168d085d2182fed6019848d676a89a2f54fa64b (patch) | |
tree | 7f578bd14fab81ce03f107971026117405fb522c | |
parent | 27a03dd97fc7e904058dfdbf4bcdf386b3479c9f (diff) | |
download | org-mode-1168d085d2182fed6019848d676a89a2f54fa64b.tar.gz |
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.
-rw-r--r-- | lisp/org-agenda.el | 67 |
1 files changed, 30 insertions, 37 deletions
diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index 96ff7c6..03d4e37 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) |