mirror/org-mode
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-11-28 07:44:49 +00:00
Code

TODO statistics: Allow recursive statistics

Browse Source 
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.
This commit is contained in:
Carsten Dominik 2009-05-19 23:05:01 +02:00
parent 83e82f9ccd
commit f54ff074d2
3 changed files with 79 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
lisp/ChangeLog
View File

@ -1,3 +1,12 @@
2009-05-20 Carsten Dominik <carsten.dominik@gmail.com>
* 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 <carsten.dominik@gmail.com>
* org-publish.el (org-publish): Make this function behave

23
lisp/org-list.el
View File

@ -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 "\\<recursive\\>"
(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 "\\<todo\\>"
(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)

85
lisp/org.el
View File

@ -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
"\\<recursive\\>"
(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
"\\<checkbox\\>"
(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)))))