Function: org-update-parent-todo-statistics

org-update-parent-todo-statistics is a byte-compiled function defined in org.el.gz.

Signature

(org-update-parent-todo-statistics)

Documentation

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.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org.el.gz
(defvar org-entry-property-inherited-from) ;; defined below
(defun org-update-parent-todo-statistics ()
  "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."
  (let* ((prop (save-excursion
                 (org-up-heading-safe)
		 (org-entry-get nil "COOKIE_DATA" 'inherit)))
	 (recursive (or (not org-hierarchical-todo-statistics)
			(and prop (string-match "\\<recursive\\>" prop))))
	 (lim (or (and prop (marker-position org-entry-property-inherited-from))
		  0))
	 (first t)
	 (box-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
	 level ltoggle l1 new ndel
	 (cnt-all 0) (cnt-done 0) is-percent kwd
	 checkbox-beg cookie-present)
    (catch 'exit
      (save-excursion
	(forward-line 0)
	(setq ltoggle (funcall outline-level))
	;; Three situations are to consider:

	;; 1. if `org-hierarchical-todo-statistics' is nil, repeat up
	;;    to the top-level ancestor on the headline;

	;; 2. If parent has "recursive" property, repeat up to the
	;;    headline setting that property, taking inheritance into
	;;    account;

	;; 3. Else, move up to direct parent and proceed only once.
	(while (and (setq level (org-up-heading-safe))
		    (or recursive first)
		    (>= (point) lim))
	  (setq first nil cookie-present 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 (line-end-position) t)
	    (setq cnt-all 0 cnt-done 0 cookie-present t)
	    (setq is-percent (match-end 2) checkbox-beg (match-beginning 0))
            (when (org-element-type-p
                   (save-excursion
                     (goto-char checkbox-beg)
                     (save-match-data (org-element-context)))
                   '(statistics-cookie
                     ;; Special case - statistics cookie inside properties.
                     keyword))
	      (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)))
                  (if (or (eq org-provide-todo-statistics 'all-headlines)
                          (and (eq org-provide-todo-statistics t)
			       (or (member kwd org-done-keywords)))
                          (and (listp org-provide-todo-statistics)
			       (stringp (car org-provide-todo-statistics))
                               (or (member kwd org-provide-todo-statistics)
				   (member kwd org-done-keywords)))
			  (and (listp org-provide-todo-statistics)
			       (listp (car org-provide-todo-statistics))
			       (or (member kwd (car org-provide-todo-statistics))
				   (and (member kwd org-done-keywords)
                                        (member kwd (cadr org-provide-todo-statistics))))))
                      (setq cnt-all (1+ cnt-all))
		    (and (eq org-provide-todo-statistics t)
                         kwd
                         (setq cnt-all (1+ cnt-all))))
		  (when (or (and (member org-provide-todo-statistics '(t all-headlines))
                                 (member kwd org-done-keywords))
			    (and (listp org-provide-todo-statistics)
                                 (listp (car org-provide-todo-statistics))
                                 (member kwd org-done-keywords)
                                 (member kwd (cadr org-provide-todo-statistics)))
			    (and (listp org-provide-todo-statistics)
                                 (stringp (car org-provide-todo-statistics))
                                 (member kwd org-done-keywords)))
		    (setq cnt-done (1+ cnt-done)))
                  (outline-next-heading)))
	      (setq new
                    (if is-percent
                        (format "[%d%%]" (floor (* 100.0 cnt-done)
                                                (max 1 cnt-all)))
                      (format "[%d/%d]" cnt-done cnt-all))
                    ndel (- (match-end 0) checkbox-beg))
              (goto-char (match-end 0))
              (unless (string-equal new (buffer-substring checkbox-beg (match-end 0)))
                (goto-char checkbox-beg)
                (insert new)
                (delete-region (point) (+ (point) ndel))
                (when org-auto-align-tags (org-fix-tags-on-the-fly)))))
	  (when cookie-present
	    (run-hook-with-args 'org-after-todo-statistics-hook
				cnt-done (- cnt-all cnt-done))))))
    (run-hooks 'org-todo-statistics-hook)))