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