mirrors/org-mode
0
0
Fork 1
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git synced 2024-07-16 10:46:27 +00:00
Code Releases Activity

org-list: checkbox count code cleanup

Browse source
This commit is contained in:
Nicolas Goaziou 2011-01-11 23:50:44 +01:00
parent 2c79244687
commit e5293ba347
1 changed files with 78 additions and 80 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

158
lisp/org-list.el
View file

@ -2132,101 +2132,99 @@ With optional prefix argument ALL, do this for the whole buffer."
(save-excursion (outline-next-heading) (point))))) (save-excursion (outline-next-heading) (point)))))
(count-boxes (count-boxes
(function (function
;; add checked boxes and boxes of all types in all ;; Return number of checked boxes and boxes of all types
;; structures in STRUCTS to c-on and c-all, respectively. ;; in all structures in STRUCTS. If RECURSIVEP is non-nil,
;; This looks at RECURSIVEP value. If ITEM is nil, count ;; also count boxes in sub-lists. If ITEM is nil, count
;; across the whole structure, else count only across ;; across the whole structure, else count only across
;; subtree whose ancestor is ITEM. ;; subtree whose ancestor is ITEM.
(lambda (item structs) (lambda (item structs recursivep)
(mapc (let ((c-on 0) (c-all 0))
(lambda (s) (mapc
(let* ((pre (org-list-struct-prev-alist s)) (lambda (s)
(par (org-list-struct-parent-alist s)) (let* ((pre (org-list-struct-prev-alist s))
(items (par (org-list-struct-parent-alist s))
(cond (items
((and recursivep item) (org-list-get-subtree item s)) (cond
(recursivep (mapcar 'car s)) ((and recursivep item) (org-list-get-subtree item s))
(item (org-list-get-children item s par)) (recursivep (mapcar 'car s))
(t (org-list-get-all-items (item (org-list-get-children item s par))
(org-list-get-top-point s) s pre)))) (t (org-list-get-all-items
(cookies (delq nil (mapcar (org-list-get-top-point s) s pre))))
(lambda (e) (cookies (delq nil (mapcar
(org-list-get-checkbox e s)) (lambda (e)
items)))) (org-list-get-checkbox e s))
(setq c-all (+ (length cookies) c-all) items))))
c-on (+ (org-count "[X]" cookies) c-on)))) (setq c-all (+ (length cookies) c-all)
structs)))) c-on (+ (org-count "[X]" cookies) c-on))))
structs)
(cons c-on c-all)))))
(backup-end 1) (backup-end 1)
cookies-list structs-backup) cookies-list structs-bak box-num)
(goto-char (car bounds)) (goto-char (car bounds))
;; 1. Build an alist for each cookie found within BOUNDS. The ;; 1. Build an alist for each cookie found within BOUNDS. The
;; key will be position at beginning of cookie and values ;; key will be position at beginning of cookie and values
;; ending position, format of cookie, number of checked boxes ;; ending position, format of cookie, and a cell whose car is
;; to report, and total number of boxes. ;; number of checked boxes to report, and cdr total number of
;; boxes.
(while (re-search-forward cookie-re (cdr bounds) t) (while (re-search-forward cookie-re (cdr bounds) t)
(catch 'skip (catch 'skip
(save-excursion (save-excursion
(let ((c-on 0) (c-all 0)) (push
(save-match-data (list
;; There are two types of cookies: those at headings and those (match-beginning 1) ; cookie start
;; at list items. (match-end 1) ; cookie end
(cond (match-string 2) ; percent?
;; Cookie is at an heading, but specifically for todo, (cond ; boxes count
;; not for checkboxes: skip it. ;; Cookie is at an heading, but specifically for todo,
((and (org-on-heading-p) ;; not for checkboxes: skip it.
(string-match "\\<todo\\>" ((and (org-on-heading-p)
(downcase (string-match "\\<todo\\>"
(or (org-entry-get nil "COOKIE_DATA") "")))) (downcase
(throw 'skip nil)) (or (org-entry-get nil "COOKIE_DATA") ""))))
;; Cookie is at an heading, but all lists before next (throw 'skip nil))
;; heading already have been read. Use data collected ;; Cookie is at an heading, but all lists before next
;; in STRUCTS-BACKUP. This should only happen when ;; heading already have been read. Use data collected
;; heading has more than one cookie on it. ;; in STRUCTS-BAK. This should only happen when heading
((and (org-on-heading-p) ;; has more than one cookie on it.
(<= (save-excursion (outline-next-heading) (point)) ((and (org-on-heading-p)
backup-end)) (<= (save-excursion (outline-next-heading) (point))
(funcall count-boxes nil structs-backup)) backup-end))
;; Cookie is at a fresh heading. Grab structure of (funcall count-boxes nil structs-bak recursivep))
;; every list containing a checkbox between point and ;; Cookie is at a fresh heading. Grab structure of
;; next headline, and save them in STRUCTS-BACKUP. ;; every list containing a checkbox between point and
((org-on-heading-p) ;; next headline, and save them in STRUCTS-BAK.
(setq backup-end (save-excursion ((org-on-heading-p)
(outline-next-heading) (point))) (setq backup-end (save-excursion
(while (org-list-search-forward box-re backup-end 'move) (outline-next-heading) (point)))
(let* ((struct (org-list-struct)) (while (org-list-search-forward box-re backup-end 'move)
(bottom (org-list-get-bottom-point struct))) (let* ((struct (org-list-struct))
(push struct structs-backup) (bottom (org-list-get-bottom-point struct)))
(goto-char bottom))) (push struct structs-bak)
(funcall count-boxes nil structs-backup)) (goto-char bottom)))
;; Cookie is at an item, and we already list structure (funcall count-boxes nil structs-bak recursivep))
;; stored in STRUCTS-BACKUP. ;; Cookie is at an item, and we already have list
((and (org-at-item-p) ;; structure stored in STRUCTS-BAK.
(< (point-at-bol) backup-end)) ((and (org-at-item-p)
(funcall count-boxes (point-at-bol) structs-backup)) (< (point-at-bol) backup-end))
;; Cookie is at an item, but we need to compute list (funcall count-boxes (point-at-bol) structs-bak recursivep))
;; structure. ;; Cookie is at an item, but we need to compute list
((org-at-item-p) ;; structure.
(let ((struct (org-list-struct))) ((org-at-item-p)
(setq backup-end (org-list-get-bottom-point struct) (let ((struct (org-list-struct)))
structs-backup (list struct))) (setq backup-end (org-list-get-bottom-point struct)
(funcall count-boxes (point-at-bol) structs-backup)) structs-bak (list struct)))
;; Else, cookie found is at a wrong place. Skip it. (funcall count-boxes (point-at-bol) structs-bak recursivep))
(t (throw 'skip nil)))) ;; Else, cookie found is at a wrong place. Skip it.
;; Build the cookies list, with appropriate information (t (throw 'skip nil))))
(push (list (match-beginning 1) ; cookie start cookies-list))))
(match-end 1) ; cookie end
(match-string 2) ; percent?
c-on ; checked boxes
c-all) ; total boxes
cookies-list)))))
;; 2. Apply alist to buffer, in reverse order so positions stay ;; 2. Apply alist to buffer, in reverse order so positions stay
;; unchanged after cookie modifications. ;; unchanged after cookie modifications.
(mapc (lambda (cookie) (mapc (lambda (cookie)
(let* ((beg (car cookie)) (let* ((beg (car cookie))
(end (nth 1 cookie)) (end (nth 1 cookie))
(percentp (nth 2 cookie)) (percentp (nth 2 cookie))
(checked (nth 3 cookie)) (checked (car (nth 3 cookie)))
(total (nth 4 cookie)) (total (cdr (nth 3 cookie)))
(new (if percentp (new (if percentp
(format "[%d%%]" (/ (* 100 checked) (format "[%d%%]" (/ (* 100 checked)
(max 1 total))) (max 1 total)))