diff options
author | Nicolas Goaziou <n.goaziou@gmail.com> | 2010-09-04 10:52:05 +0200 |
---|---|---|
committer | David Maus <dmaus@ictsoc.de> | 2010-09-05 17:46:01 +0200 |
commit | 045e3aea280da14a4db36d7b81d959efde4b593a (patch) | |
tree | a2a4a7fe6bf49c800d8c7bd5ccb4fadff5c3c2a4 | |
parent | a581ee00a61eb5c7e7f42bc2299eb284c035223c (diff) | |
download | org-mode-045e3aea280da14a4db36d7b81d959efde4b593a.tar.gz |
Fix checkbox statistics
* org-list.el (org-toggle-checkbox): Ignore items in drawers when used
from an heading. Send an error when no item is in region.
* org-list.el (org-update-checkbox-count): Correctly handle argument
ALL. Speed optimization.
-rw-r--r-- | lisp/org-list.el | 225 |
1 files changed, 119 insertions, 106 deletions
diff --git a/lisp/org-list.el b/lisp/org-list.el index 0421928..11aa85b 100644 --- a/lisp/org-list.el +++ b/lisp/org-list.el @@ -1689,12 +1689,12 @@ With prefix arg TOGGLE-PRESENCE, add or remove checkboxes. With double prefix, set checkbox to [-]. When there is an active region, toggle status or presence of the -checkbox in the first line, and make every item in the region -have the same status or presence, respectively. +first checkbox there, and make every item inside have the +same status or presence, respectively. If the cursor is in a headline, apply this to all checkbox items in the text below the heading, taking as reference the first item -in subtree." +in subtree, ignoring drawers." (interactive "P") ;; Bounds is a list of type (beg end single-p) where single-p is t ;; when `org-toggle-checkbox' is applied to a single item. Only @@ -1702,22 +1702,34 @@ in subtree." (let* ((bounds (cond ((org-region-active-p) - (list (region-beginning) (region-end) nil)) + (let ((rbeg (region-beginning)) + (rend (region-end))) + (save-excursion + (goto-char rbeg) + (if (org-search-forward-unenclosed org-item-beginning-re rend 'move) + (list (point-at-bol) rend nil) + (error "No item in region"))))) ((org-on-heading-p) - ;; In this case, reference line is the first item in subtree - (let ((limit (save-excursion (outline-next-heading) (point)))) + ;; In this case, reference line is the first item in + ;; subtree outside drawers + (let ((pos (point)) + (limit (save-excursion (outline-next-heading) (point)))) (save-excursion + (goto-char limit) + (org-search-backward-unenclosed ":END:" pos 'move) (org-search-forward-unenclosed org-item-beginning-re limit 'move) (list (point) limit nil)))) ((org-at-item-p) (list (point-at-bol) (point-at-eol) t)) (t (error "Not at an item or heading, and no active region")))) - ;; marker is needed because deleting checkboxes will change END + (beg (car bounds)) + ;; marker is needed because deleting or inserting checkboxes + ;; will change bottom point (end (copy-marker (nth 1 bounds))) (single-p (nth 2 bounds)) (ref-presence (save-excursion - (goto-char (car bounds)) + (goto-char beg) (org-at-item-checkbox-p))) (ref-status (equal (match-string 1) "[X]")) (act-on-item @@ -1751,7 +1763,7 @@ in subtree." (t "[X]")) t t nil 1)))))))) (save-excursion - (beginning-of-line) + (goto-char beg) (while (< (point) end) (funcall act-on-item ref-presence ref-status) (org-search-forward-unenclosed org-item-beginning-re end 'move))) @@ -1792,104 +1804,105 @@ with the current numbers. With optional prefix argument ALL, do this for the whole buffer." (interactive "P") (save-excursion - (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 - (beg (condition-case nil - (progn (org-back-to-heading) (point)) - (error (point-min)))) - (end (move-marker (make-marker) - (progn (outline-next-heading) (point)))) - (re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") - (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\) +\\(\\[[- X]\\]\\)") - (re-find (concat re "\\|" re-box)) - beg-cookie end-cookie is-percent c-on c-off lim new - eline curr-ind next-ind continue-from startsearch - (recursive - (or (not org-hierarchical-checkbox-statistics) - (string-match "\\<recursive\\>" - (or (ignore-errors - (org-entry-get nil "COOKIE_DATA")) - "")))) - (cstat 0)) - (when all - (goto-char (point-min)) - (outline-next-heading) - (setq beg (point) end (point-max))) - (goto-char end) - ;; find each statistics cookie - (while (and (org-search-backward-unenclosed re-find beg t) - (not (save-match-data - (and (org-on-heading-p) - (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)) - startsearch (point-at-eol) - continue-from (match-beginning 0) - is-percent (match-beginning 2) - lim (cond - ((org-on-heading-p) (outline-next-heading) (point)) - ((org-at-item-p) (org-end-of-item) (point)) - (t nil)) - c-on 0 - c-off 0) - (when lim - ;; find first checkbox for this cookie and gather - ;; statistics from all that are at this indentation level - (goto-char startsearch) - (if (org-search-forward-unenclosed re-box lim t) - (progn - (goto-char (org-get-item-beginning)) - (setq curr-ind (org-get-indentation)) - (setq next-ind curr-ind) - (while (and (bolp) (org-at-item-p) - (if recursive - (<= curr-ind next-ind) - (= curr-ind next-ind))) - (setq eline (point-at-eol)) - (if (org-search-forward-unenclosed re-box eline t) - (if (member (match-string 2) '("[ ]" "[-]")) - (setq c-off (1+ c-off)) - (setq c-on (1+ c-on)))) - (if (not recursive) - ;; org-get-next-item goes through list-enders - ;; with proper limit. - (goto-char (or (org-get-next-item (point) lim) lim)) - (end-of-line) - (when (org-search-forward-unenclosed - org-item-beginning-re lim t) - (beginning-of-line))) - (setq next-ind (org-get-indentation))))) - (goto-char continue-from) - ;; update cookie - (when end-cookie - (setq new (if is-percent - (format "[%d%%]" (/ (* 100 c-on) - (max 1 (+ c-on c-off)))) - (format "[%d/%d]" c-on (+ c-on c-off)))) - (goto-char beg-cookie) - (insert new) - (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) - ;; update items checkbox if it has one - (when (org-at-item-p) - (goto-char (org-get-item-beginning)) - (when (and (> (+ c-on c-off) 0) - (org-search-forward-unenclosed re-box (point-at-eol) t)) - (setq beg-cookie (match-beginning 2) - end-cookie (match-end 2)) - (delete-region beg-cookie end-cookie) - (goto-char beg-cookie) - (cond ((= c-off 0) (insert "[X]")) - ((= c-on 0) (insert "[ ]")) - (t (insert "[-]"))) - ))) - (goto-char continue-from)) + (let ((cstat 0)) + (catch 'exit + (while t + (let* ((buffer-invisibility-spec (org-inhibit-invisibility)) ; Emacs 21 + (beg (condition-case nil + (progn (org-back-to-heading) (point)) + (error (point-min)))) + (end (copy-marker (save-excursion + (outline-next-heading) (point)))) + (re-cookie "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)") + (re-box "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)") + beg-cookie end-cookie is-percent c-on c-off lim new + curr-ind next-ind continue-from startsearch list-beg list-end + (recursive + (or (not org-hierarchical-checkbox-statistics) + (string-match "\\<recursive\\>" + (or (ignore-errors + (org-entry-get nil "COOKIE_DATA")) + ""))))) + (goto-char end) + ;; find each statistics cookie + (while (and (org-search-backward-unenclosed re-cookie beg 'move) + (not (save-match-data + (and (org-on-heading-p) + (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)) + startsearch (point-at-eol) + continue-from (match-beginning 0) + is-percent (match-beginning 2) + lim (cond + ((org-on-heading-p) (outline-next-heading) (point)) + ;; Ensure many cookies in the same list won't imply + ;; computing list boundaries as many times. + ((org-at-item-p) + (unless (and list-beg (>= (point) list-beg)) + (setq list-beg (org-list-top-point) + list-end (copy-marker + (org-list-bottom-point)))) + (org-get-end-of-item list-end)) + (t nil)) + c-on 0 + c-off 0) + (when lim + ;; find first checkbox for this cookie and gather + ;; statistics from all that are at this indentation level + (goto-char startsearch) + (if (org-search-forward-unenclosed re-box lim t) + (progn + (beginning-of-line) + (setq curr-ind (org-get-indentation)) + (setq next-ind curr-ind) + (while (and (bolp) (org-at-item-p) + (if recursive + (<= curr-ind next-ind) + (= curr-ind next-ind))) + (when (org-at-item-checkbox-p) + (if (member (match-string 1) '("[ ]" "[-]")) + (setq c-off (1+ c-off)) + (setq c-on (1+ c-on)))) + (if (not recursive) + ;; org-get-next-item goes through list-enders + ;; with proper limit. + (goto-char (or (org-get-next-item (point) lim) lim)) + (end-of-line) + (when (org-search-forward-unenclosed + org-item-beginning-re lim t) + (beginning-of-line))) + (setq next-ind (org-get-indentation))))) + (goto-char continue-from) + ;; update cookie + (when end-cookie + (setq new (if is-percent + (format "[%d%%]" (/ (* 100 c-on) + (max 1 (+ c-on c-off)))) + (format "[%d/%d]" c-on (+ c-on c-off)))) + (goto-char beg-cookie) + (insert new) + (delete-region (point) (+ (point) (- end-cookie beg-cookie)))) + ;; update items checkbox if it has one + (when (and (org-at-item-checkbox-p) + (> (+ c-on c-off) 0)) + (setq beg-cookie (match-beginning 1) + end-cookie (match-end 1)) + (delete-region beg-cookie end-cookie) + (goto-char beg-cookie) + (cond ((= c-off 0) (insert "[X]")) + ((= c-on 0) (insert "[ ]")) + (t (insert "[-]"))))) + (goto-char continue-from))) + (unless (and all (outline-next-heading)) (throw 'exit nil)))) (when (interactive-p) - (message "Checkbox statistics updated %s (%d places)" - (if all "in entire file" "in current outline entry") cstat))))) + (message "Checkbox statistics updated %s (%d places)" + (if all "in entire file" "in current outline entry") cstat))))) (defun org-get-checkbox-statistics-face () "Select the face for checkbox statistics. |