summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2017-09-10 14:10:49 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2017-09-10 14:10:49 +0200
commit1168d085d2182fed6019848d676a89a2f54fa64b (patch)
tree7f578bd14fab81ce03f107971026117405fb522c
parent27a03dd97fc7e904058dfdbf4bcdf386b3479c9f (diff)
downloadorg-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.el67
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)