mirror of
https://git.savannah.gnu.org/git/emacs/org-mode.git
synced 2024-08-26 15:32:51 +00:00
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.
This commit is contained in:
parent
83e82f9ccd
commit
f54ff074d2
|
@ -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
|
||||
|
|
|
@ -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
85
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
|
||||
"\\<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)))))
|
||||
|
|
Loading…
Reference in a new issue