org-list: use list structure to update checkboxes and cookies

* lisp/org-list.el (org-toggle-checkbox): use structures to fix
  checkboxes of a list
(org-update-checkbox-count): use structures to update cookies

lisp/org-list.el

@@ -1798,77 +1798,91 @@ 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, 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
-  ;; toggles on single items will return errors.
-  (let* ((bounds
-          (cond
-           ((org-region-active-p)
-            (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 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) (1+ (point-at-eol)) t))
-           (t (error "Not at an item or heading, and no active region"))))
-	 (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 beg)
-			 (org-at-item-checkbox-p)))
-         (ref-status (equal (match-string 1) "[X]"))
-         (act-on-item
-          (lambda (ref-pres ref-stat)
-            (if (equal toggle-presence '(4))
-                (cond
-                 ((and ref-pres (org-at-item-checkbox-p))
-                  (replace-match ""))
-                 ((and (not ref-pres)
-                       (not (org-at-item-checkbox-p))
-                       (org-at-item-p))
-                  (goto-char (match-end 0))
-                  ;; Ignore counter, if any
-                  (when (looking-at "\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?")
-                    (goto-char (match-end 0)))
-                  (let ((desc-p (and (org-at-item-description-p)
-                                     (cdr (assq 'checkbox org-list-automatic-rules)))))
-                    (cond
-                     ((and single-p desc-p)
-                      (error "Cannot add a checkbox in a description list"))
-                     ((not desc-p) (insert "[ ] "))))))
-              (let ((blocked (org-checkbox-blocked-p)))
-                (cond
-                 ((and blocked single-p)
-                  (error "Checkbox blocked because of unchecked box in line %d" blocked))
-                 (blocked nil)
-                 ((org-at-item-checkbox-p)
-                  (replace-match
-                   (cond ((equal toggle-presence '(16)) "[-]")
-                         (ref-stat "[ ]")
-                         (t "[X]"))
-                   t t nil 1))))))))
-    (save-excursion
-      (goto-char beg)
-      (while (< (point) end)
-        (funcall act-on-item ref-presence ref-status)
-        (org-search-forward-unenclosed org-item-beginning-re end 'move)))
+  (save-excursion
+    (let* (singlep
+	   block-item
+	   lim-up
+	   lim-down
+	   (orderedp (ignore-errors (org-entry-get nil "ORDERED")))
+	   (bounds
+	    ;; In a region, start at first item in region
+	    (cond
+	     ((org-region-active-p)
+	      (let ((limit (region-end)))
+		(goto-char (region-beginning))
+		(if (org-search-forward-unenclosed org-item-beginning-re
+						   limit t)
+		    (setq lim-up (point-at-bol))
+		  (error "No item in region"))
+		(setq lim-down (copy-marker limit))))
+	     ((org-on-heading-p)
+	      ;; On an heading, start at first item after drawers
+	      (let ((limit (save-excursion (outline-next-heading) (point))))
+		(forward-line 1)
+		(when (looking-at org-drawer-regexp)
+		  (re-search-forward "^[ \t]*:END:" limit nil))
+		(if (org-search-forward-unenclosed org-item-beginning-re
+						   limit t)
+		    (setq lim-up (point-at-bol))
+		  (error "No item in subtree"))
+		(setq lim-down (copy-marker limit))))
+	     ;; Just one item: set singlep flag
+	     ((org-at-item-p)
+	      (setq singlep t)
+	      (setq lim-up (point-at-bol)
+		    lim-down (point-at-eol)))
+	     (t (error "Not at an item or heading, and no active region"))))
+	   ;; determine the checkbox going to be applied to all items
+	   ;; within bounds
+	   (ref-checkbox
+	    (progn
+	      (goto-char lim-up)
+	      (let ((cbox (and (org-at-item-checkbox-p) (match-string 1))))
+		(cond
+		 ((equal toggle-presence '(16)) "[-]")
+		 ((equal toggle-presence '(4))
+		  (unless cbox "[ ]"))
+		 ((equal "[ ]" cbox) "[X]")
+		 (t "[ ]"))))))
+      ;; When an item is found within bounds, grab the full list at
+      ;; point structure, then: 1. set checkbox of all its items
+      ;; within bounds to ref-checkbox; 2. fix checkboxes of the whole
+      ;; list; 3. move point after the list.
+      (goto-char lim-up)
+      (while (and (< (point) lim-down)
+		  (org-search-forward-unenclosed
+		   org-item-beginning-re lim-down 'move))
+	(let* ((struct (org-list-struct))
+	       (struct-copy (mapcar (lambda (e) (copy-alist e)) struct))
+	       (parents (org-list-struct-parent-alist struct))
+	       (bottom (copy-marker (org-list-get-bottom-point struct)))
+	       (items-to-toggle (org-remove-if
+				 (lambda (e) (or (< e lim-up) (> e lim-down)))
+				 (mapcar 'car (cdr struct)))))
+	  (mapc (lambda (e) (org-list-set-checkbox
+			e struct
+			;; if there is no box at item, leave as-is
+			;; unless function was called with C-u prefix
+			(let ((cur-box (org-list-get-checkbox e struct)))
+			  (if (or cur-box (equal toggle-presence '(4)))
+			      ref-checkbox
+			    cur-box))))
+		items-to-toggle)
+	  (setq block-item (org-list-struct-fix-box struct parents orderedp))
+	  ;; Report some problems due to ORDERED status of subtree. If
+	  ;; only one box was being checked, throw an error, else,
+	  ;; only signal problems.
+	  (cond
+	   ((and singlep block-item (> lim-up block-item))
+	    (error
+	     "Checkbox blocked because of unchecked box at line %d"
+	     (org-current-line block-item)))
+	   (block-item
+	    (message
+	     "Checkboxes were removed due to unchecked box at line %d"
+	     (org-current-line block-item))))
+	  (goto-char bottom)
+	  (org-list-struct-apply-struct struct struct-copy))))
     (org-update-checkbox-count-maybe)))
 
 (defun org-reset-checkbox-state-subtree ()
@@ -1901,110 +1915,114 @@ information.")
 
 (defun org-update-checkbox-count (&optional all)
   "Update the checkbox statistics in the current section.
-This will find all statistic cookies like [57%] and [6/12] and update them
-with the current numbers.  With optional prefix argument ALL, do this for
-the whole buffer."
+This will find all statistic cookies like [57%] and [6/12] and
+update them with the current numbers.
+
+With optional prefix argument ALL, do this for the whole buffer."
   (interactive "P")
   (save-excursion
-    (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)))))
+    (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
+	  (box-re "^[ \t]*\\([-+*]\\|[0-9]+[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?[0-9]+\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
+	  (recursivep
+	   (or (not org-hierarchical-checkbox-statistics)
+	       (string-match "\\<recursive\\>"
+			     (or (ignore-errors
+				   (org-entry-get nil "COOKIE_DATA"))
+				 ""))))
+	  (bounds (if all
+		      (cons (point-min) (point-max))
+		    (cons (or (ignore-errors (org-back-to-heading) (point))
+			      (point-min))
+			  (save-excursion (outline-next-heading) (point)))))
+	  (count-boxes
+	   (function
+            ;; add checked boxes and boxes of all types in all
+            ;; structures in STRUCTS to c-on and c-all, respectively.
+            ;; This looks at RECURSIVEP value. If ITEM is nil, count
+            ;; across the whole structure, else count only across
+            ;; subtree whose ancestor is ITEM.
+	    (lambda (item structs)
+	      (mapc
+               (lambda (s)
+                 (let* ((pre (org-list-struct-prev-alist s))
+                        (items
+                         (if recursivep
+                             (or (and item (org-list-get-subtree item s pre))
+                                 (mapcar 'car s))
+                           (or (and item (org-list-get-all-children item s pre))
+                               (org-list-get-all-items
+                                (org-list-get-top-point s) s pre))))
+                        (cookies (delq nil (mapcar
+                                            (lambda (e)
+                                              (org-list-get-checkbox e s))
+                                            items))))
+                   (setq c-all (+ (length cookies) c-all)
+                         c-on (+ (org-count "[X]" cookies) c-on))))
+               structs))))
+	  cookies-list backup-end structs-backup)
+      (goto-char (car bounds))
+      ;; 1. Build an alist for each cookie found within BOUNDS. The
+      ;;    key will be position at beginning of cookie and values
+      ;;    ending position, format of cookie, number of checked boxes
+      ;;    to report, and total number of boxes.
+      (while (re-search-forward cookie-re (cdr bounds) t)
+	(save-excursion
+	  (let ((c-on 0) (c-all 0))
+	    (save-match-data
+              ;; There are two types of cookies: those at headings and those
+              ;; at list items.
+	      (cond
+	       ((and (org-on-heading-p)
+		     (string-match "\\<todo\\>"
+				   (downcase
+				    (or (org-entry-get nil "COOKIE_DATA") "")))))
+               ;; This cookie is at an heading, but specifically for
+               ;; todo, not for checkboxes: skip it.
+	       ((org-on-heading-p)
+		(setq backup-end (save-excursion
+                                   (outline-next-heading) (point)))
+                ;; This cookie is at an heading. Grab structure of
+		;; every list containing a checkbox between point and
+		;; next headline, and save them in STRUCTS-BACKUP
+		(while (org-search-forward-unenclosed box-re backup-end 'move)
+		  (let* ((struct (org-list-struct))
+			 (bottom (org-list-get-bottom-point struct)))
+		    (setq structs-backup (cons struct structs-backup))
+		    (goto-char bottom)))
+		(funcall count-boxes nil structs-backup))
+	       ((org-at-item-p)
+		;; This cookie is at an item. Look in STRUCTS-BACKUP
+                ;; to see if we have the structure of list at point in
+                ;; it. Else compute the structure.
+		(let ((item (point-at-bol)))
+		  (if (and backup-end (< item backup-end))
+		      (funcall count-boxes item structs-backup)
+		    (setq end-entry bottom
+			  structs-backup (list (org-list-struct)))
+		    (funcall count-boxes item structs-backup))))))
+	    ;; Build the cookies list, with appropriate information
+	    (setq cookies-list (cons (list (match-beginning 1) ; cookie start
+					   (match-end 1) ; cookie end
+					   (match-beginning 2) ; percent?
+					   c-on   ; checked boxes
+					   c-all) ; total boxes
+				     cookies-list)))))
+      ;; 2. Apply alist to buffer, in reverse order so positions stay
+      ;;    unchanged after cookie modifications.
+      (mapc (lambda (cookie)
+	      (let* ((beg (car cookie))
+		     (end (nth 1 cookie))
+		     (percentp (nth 2 cookie))
+		     (checked (nth 3 cookie))
+		     (total (nth 4 cookie))
+		     (new (if percentp
+			      (format "[%d%%]" (/ (* 100 checked)
+						  (max 1 total)))
+			    (format "[%d/%d]" checked total))))
+		(goto-char beg)
+		(insert new)
+		(delete-region (point) (+ (point) (- end beg)))))
+	    cookies-list))))
 
 (defun org-get-checkbox-statistics-face ()
   "Select the face for checkbox statistics.