mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

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.
This commit is contained in:
Nicolas Goaziou 2017-09-10 14:10:49 +02:00
parent 27a03dd97f
commit 1168d085d2
1 changed files with 30 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
lisp/org-agenda.el
View File

@ -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)