From f54ff074d2ac2a5900090f1110887cc36a9ac717 Mon Sep 17 00:00:00 2001 From: Carsten Dominik Date: Tue, 19 May 2009 23:05:01 +0200 Subject: [PATCH] TODO statistics: Allow recursive statistics Setting the new option `org-hierarchical-todo-statistics' to nil will make TODO statistics to be computed recursively. This means, not only the direct children of a node contribute to its TODO statistics, but the entire subtree. You can also set the COOKIE_DATA property and add the word "recursive" there to get recursive statistics for a specific tree. --- lisp/ChangeLog | 9 +++++ lisp/org-list.el | 23 +++++++------ lisp/org.el | 85 ++++++++++++++++++++++++++++++++---------------- 3 files changed, 79 insertions(+), 38 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 986c8d2d0..2547ad078 100755 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2009-05-20 Carsten Dominik + + * org-list.el (org-update-checkbox-count): Make property + dependent. + + * org.el (org-hierarchical-todo-statistics): New option. + (org-update-parent-todo-statistics): Modified to handle recursive + statistics. + 2009-05-19 Carsten Dominik * org-publish.el (org-publish): Make this function behave diff --git a/lisp/org-list.el b/lisp/org-list.el index 775158180..2a2906c83 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -393,6 +393,10 @@ the whole buffer." (re-find (concat re "\\|" re-box)) beg-cookie end-cookie is-percent c-on c-off lim eline curr-ind next-ind continue-from startsearch + (recursive + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\" + (or (org-entry-get nil "COOKIE_DATA") "")))) (cstat 0) ) (when all @@ -404,12 +408,11 @@ the whole buffer." (while (and (re-search-backward re-find beg t) (not (save-match-data (and (org-on-heading-p) - - (equal (downcase - (or (org-entry-get - nil "COOKIE_DATA") - "")) - "todo"))))) + (string-match "\\" + (downcase + (or (org-entry-get + nil "COOKIE_DATA") + ""))))))) (setq beg-cookie (match-beginning 1) end-cookie (match-end 1) cstat (+ cstat (if end-cookie 1 0)) @@ -432,9 +435,9 @@ the whole buffer." (setq curr-ind (org-get-indentation)) (setq next-ind curr-ind) (while (and (bolp) (org-at-item-p) - (if org-hierarchical-checkbox-statistics - (= curr-ind next-ind) - (<= curr-ind next-ind))) + (if recursive + (<= curr-ind next-ind) + (= curr-ind next-ind))) (save-excursion (end-of-line) (setq eline (point))) (if (re-search-forward re-box eline t) (if (member (match-string 2) '("[ ]" "[-]")) @@ -442,7 +445,7 @@ the whole buffer." (setq c-on (1+ c-on)) ) ) - (if org-hierarchical-checkbox-statistics + (if (not recursive) (org-end-of-item) (end-of-line) (when (re-search-forward org-list-beginning-re lim t) diff --git a/lisp/org.el b/lisp/org.el index 5ac5e81e0..3acd2e9bf 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1737,6 +1737,13 @@ entry each time a todo state is changed." :group 'org-todo :type 'boolean) +(defcustom org-hierarchical-todo-statistics t + "Non-nil means, TODO statistics covers just direct children. +When nil, all entries in the subtree are considered. +This has only an effect if `org-provide-todo-statistics' is set." + :group 'org-todo + :type 'boolean) + (defcustom org-after-todo-state-change-hook nil "Hook which is run after the state of a TODO item was changed. The new state (a string with a TODO keyword, or nil) is available in the @@ -9442,37 +9449,59 @@ changes because there are uncheckd boxes in this entry." t)) ; do not block (defun org-update-parent-todo-statistics () - "Update any statistics cookie in the parent of the current headline." + "Update any statistics cookie in the parent of the current headline. +When `org-hierarchical-todo-statistics' is nil, statistics will cover +the entire subtree and this will travel up the hierarchy and update +statistics everywhere." (interactive) - (let ((box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - level (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present) + (let* ((lim 0) prop + (recursive (or (not org-hierarchical-todo-statistics) + (string-match + "\\" + (or (setq prop (org-entry-get + nil "COOKIE_DATA" 'inherit)) "")))) + (lim (or (and prop (marker-position + org-entry-property-inherited-from)) + lim)) + (first t) + (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + level ltoggle l1 + (cnt-all 0) (cnt-done 0) is-percent kwd cookie-present) (catch 'exit (save-excursion - (setq level (org-up-heading-safe)) - (unless (and level - (not (equal (downcase - (or (org-entry-get - nil "COOKIE_DATA") - "")) - "checkbox"))) - (throw 'exit nil)) - (while (re-search-forward box-re (point-at-eol) t) - (setq cnt-all 0 cnt-done 0 cookie-present t) - (setq is-percent (match-end 2)) - (save-match-data - (unless (outline-next-heading) (throw 'exit nil)) - (while (looking-at org-todo-line-regexp) - (setq kwd (match-string 2)) - (and kwd (setq cnt-all (1+ cnt-all))) - (and (member kwd org-done-keywords) - (setq cnt-done (1+ cnt-done))) - (condition-case nil - (org-forward-same-level 1) - (error (end-of-line 1))))) - (replace-match - (if is-percent - (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) - (format "[%d/%d]" cnt-done cnt-all)))) + (beginning-of-line 1) + (if (org-at-heading-p) + (setq ltoggle (funcall outline-level)) + (error "This should not happen")) + (while (and (setq level (org-up-heading-safe)) + (or recursive first) + (>= (point) lim)) + (setq first nil) + (unless (and level + (not (string-match + "\\" + (downcase + (or (org-entry-get + nil "COOKIE_DATA") + ""))))) + (throw 'exit nil)) + (while (re-search-forward box-re (point-at-eol) t) + (setq cnt-all 0 cnt-done 0 cookie-present t) + (setq is-percent (match-end 2)) + (save-match-data + (unless (outline-next-heading) (throw 'exit nil)) + (while (and (looking-at org-complex-heading-regexp) + (> (setq l1 (length (match-string 1))) level)) + (setq kwd (and (or recursive (= l1 ltoggle)) + (match-string 2))) + (and kwd (setq cnt-all (1+ cnt-all))) + (and (member kwd org-done-keywords) + (setq cnt-done (1+ cnt-done))) + (outline-next-heading))) + (replace-match + (if is-percent + (format "[%d%%]" (/ (* 100 cnt-done) (max 1 cnt-all))) + (format "[%d/%d]" cnt-done cnt-all))))) (when cookie-present (run-hook-with-args 'org-after-todo-statistics-hook cnt-done (- cnt-all cnt-done)))))