From 7c3e0b0fdfdc0cf1a4724cffe17b6bb160278247 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sun, 22 Jan 2017 13:53:20 +0100 Subject: [PATCH] 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 --- lisp/org-agenda.el | 68 ++++++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 35 deletions(-) diff --git a/lisp/org-agenda.el b/lisp/org-agenda.el index b5f7f9e65..6d675e928 100644 --- a/lisp/org-agenda.el +++ b/lisp/org-agenda.el @@ -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 - (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"))) + (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]*$")) + (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