org-agenda: TODO keywords are case sensitive in stuck projects

* lisp/org-agenda.el (org-agenda-list-stuck-projects): Search for
  stuck projects is case sensitive since TODO keywords are.

Reported-by: Guy Mayraz <guy.mayraz@unimelb.edu.au>
<http://permalink.gmane.org/gmane.emacs.orgmode/111529>
This commit is contained in:
Nicolas Goaziou 2017-01-22 13:53:20 +01:00
parent 2950be040d
commit 7c3e0b0fdf
1 changed files with 33 additions and 35 deletions

View File

@ -5089,45 +5089,43 @@ Stuck projects are project that have no next actions. For the definitions
of what a project is and how to check if it stuck, customize the variable
`org-stuck-projects'."
(interactive)
(let* ((org-agenda-skip-function
'org-agenda-skip-entry-when-regexp-matches-in-subtree)
;; We could have used org-agenda-skip-if here.
(org-agenda-overriding-header
(let* ((org-agenda-overriding-header
(or org-agenda-overriding-header "List of stuck projects: "))
(matcher (nth 0 org-stuck-projects))
(todo (nth 1 org-stuck-projects))
(todo-wds (if (member "*" todo)
(progn
(org-agenda-prepare-buffers (org-agenda-files
nil 'ifmode))
(org-delete-all
org-done-keywords-for-agenda
(copy-sequence org-todo-keywords-for-agenda)))
todo))
(todo-re (concat "^\\*+[ \t]+\\("
(mapconcat 'identity todo-wds "\\|")
"\\)\\>"))
(tags (nth 2 org-stuck-projects))
(tags-re (if (member "*" tags)
(concat org-outline-regexp-bol
".*:[[:alnum:]_@#%]+:[ \t]*$")
(if tags
(gen-re (org-string-nw-p (nth 3 org-stuck-projects)))
(todo-wds
(if (not (member "*" todo)) todo
(org-agenda-prepare-buffers (org-agenda-files nil 'ifmode))
(org-delete-all org-done-keywords-for-agenda
(copy-sequence org-todo-keywords-for-agenda))))
(todo-re (and todo
(format "^\\*+[ \t]+\\(%s\\)\\>"
(mapconcat #'identity todo-wds "\\|"))))
(tags-re (cond ((null tags) nil)
((member "*" tags)
(eval-when-compile
(concat org-outline-regexp-bol
".*:[[:alnum:]_@#%]+:[ \t]*$")))
(tags (concat org-outline-regexp-bol
".*:\\("
(mapconcat #'identity tags "\\|")
"\\):[[:alnum:]_@#%:]*[ \t]*$"))))
(gen-re (nth 3 org-stuck-projects))
(re-list
(delq nil
(list
(if todo todo-re)
(if tags tags-re)
(and gen-re (stringp gen-re) (string-match "\\S-" gen-re)
gen-re)))))
(setq org-agenda-skip-regexp
(if re-list
(mapconcat 'identity re-list "\\|")
(error "No information how to identify unstuck projects")))
"\\):[[:alnum:]_@#%:]*[ \t]*$"))
(t nil)))
(re-list (delq nil (list todo-re tags-re gen-re)))
(skip-re
(if (null re-list)
(error "Missing information to identify unstuck projects")
(mapconcat #'identity re-list "\\|")))
(org-agenda-skip-function
;; Skip entry if `org-agenda-skip-regexp' matches anywhere
;; in the subtree.
`(lambda ()
(and (save-excursion
(let ((case-fold-search nil))
(re-search-forward ,skip-re (org-end-of-subtree t) t)))
(progn (outline-next-heading) (point))))))
(org-tags-view nil matcher)
(setq org-agenda-buffer-name (buffer-name))
(with-current-buffer org-agenda-buffer-name