Prechádzať zdrojové kódy

org-list: Fix checkbox update with inlinetasks

* lisp/org-list.el (org-update-checkbox-count): Change algorithm.  Use
  Element parser.

* testing/lisp/test-org-list.el (test-org-list/update-checkbox-count):
  New test.

Reported-by: Eric S Fraga <e.fraga@ucl.ac.uk>
<http://permalink.gmane.org/gmane.emacs.orgmode/97594>
Nicolas Goaziou 10 rokov pred
rodič
commit
a4cc9d82d8
2 zmenil súbory, kde vykonal 186 pridanie a 113 odobranie
  1. 105 113
      lisp/org-list.el
  2. 81 0
      testing/lisp/test-org-list.el

+ 105 - 113
lisp/org-list.el

@@ -2460,130 +2460,122 @@ in subtree, ignoring drawers."
 
 
 (defun org-update-checkbox-count (&optional all)
 (defun org-update-checkbox-count (&optional all)
   "Update the checkbox statistics in the current section.
   "Update the checkbox statistics in the current section.
+
 This will find all statistic cookies like [57%] and [6/12] and
 This will find all statistic cookies like [57%] and [6/12] and
 update them with the current numbers.
 update them with the current numbers.
 
 
 With optional prefix argument ALL, do this for the whole buffer."
 With optional prefix argument ALL, do this for the whole buffer."
   (interactive "P")
   (interactive "P")
-  (save-excursion
-    (let ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
-	  (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
+  (org-with-wide-buffer
+   (let* ((cookie-re "\\(\\(\\[[0-9]*%\\]\\)\\|\\(\\[[0-9]*/[0-9]*\\]\\)\\)")
+	  (box-re "^[ \t]*\\([-+*]\\|\\([0-9]+\\|[A-Za-z]\\)[.)]\\)[ \t]+\
+\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\][ \t]*\\)?\\(\\[[- X]\\]\\)")
 	  (recursivep
 	  (recursivep
 	   (or (not org-checkbox-hierarchical-statistics)
 	   (or (not org-checkbox-hierarchical-statistics)
 	       (string-match "\\<recursive\\>"
 	       (string-match "\\<recursive\\>"
 			     (or (org-entry-get nil "COOKIE_DATA") ""))))
 			     (or (org-entry-get nil "COOKIE_DATA") ""))))
-	  (bounds (if all
-		      (cons (point-min) (point-max))
-		    (cons (or (ignore-errors (org-back-to-heading t) (point))
-			      (point-min))
-			  (save-excursion (outline-next-heading) (point)))))
+	  (within-inlinetask (and (not all)
+				  (featurep 'org-inlinetask)
+				  (org-inlinetask-in-task-p)))
+	  (end (cond (all (point-max))
+		     (within-inlinetask
+		      (save-excursion (outline-next-heading) (point)))
+		     (t (save-excursion
+			  (org-with-limited-levels (outline-next-heading))
+			  (point)))))
 	  (count-boxes
 	  (count-boxes
-	   (function
-	    ;; Return number of checked boxes and boxes of all types
-	    ;; in all structures in STRUCTS.  If RECURSIVEP is
-	    ;; non-nil, also count boxes in sub-lists.  If ITEM is
-	    ;; nil, count across the whole structure, else count only
-	    ;; across subtree whose ancestor is ITEM.
-	    (lambda (item structs recursivep)
-	      (let ((c-on 0) (c-all 0))
-		(mapc
-		 (lambda (s)
-		   (let* ((pre (org-list-prevs-alist s))
-			  (par (org-list-parents-alist s))
-			  (items
-			   (cond
-			    ((and recursivep item) (org-list-get-subtree item s))
-			    (recursivep (mapcar #'car s))
-			    (item (org-list-get-children item s par))
-			    (t (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)
-		(cons c-on c-all)))))
-	  (backup-end 1)
-	  cookies-list structs-bak)
-      (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, and a cell whose car is
-      ;;    number of checked boxes to report, and cdr total number of
-      ;;    boxes.
-      (while (re-search-forward cookie-re (cdr bounds) t)
-	(catch 'skip
-	  (save-excursion
-	    (push
-	     (list
-	      (match-beginning 1)	; cookie start
-	      (match-end 1)		; cookie end
-	      (match-string 2)		; percent?
-	      (cond			; boxes count
-	       ;; Cookie is at an heading, but specifically for todo,
-	       ;; not for checkboxes: skip it.
-	       ((and (org-at-heading-p)
-		     (string-match "\\<todo\\>"
-				   (downcase
-				    (or (org-entry-get nil "COOKIE_DATA") ""))))
-		(throw 'skip nil))
-	       ;; Cookie is at an heading, but all lists before next
-	       ;; heading already have been read.  Use data collected
-	       ;; in STRUCTS-BAK.  This should only happen when
-	       ;; heading has more than one cookie on it.
-	       ((and (org-at-heading-p)
-		     (<= (save-excursion (outline-next-heading) (point))
-			 backup-end))
-		(funcall count-boxes nil structs-bak recursivep))
-	       ;; Cookie is at a fresh heading.  Grab structure of
-	       ;; every list containing a checkbox between point and
-	       ;; next headline, and save them in STRUCTS-BAK.
-	       ((org-at-heading-p)
-		(setq backup-end (save-excursion
-				   (outline-next-heading) (point))
-		      structs-bak nil)
-		(while (org-list-search-forward box-re backup-end 'move)
-		  (let* ((struct (org-list-struct))
-			 (bottom (org-list-get-bottom-point struct)))
-		    (push struct structs-bak)
-		    (goto-char bottom)))
-		(funcall count-boxes nil structs-bak recursivep))
-	       ;; Cookie is at an item, and we already have list
-	       ;; structure stored in STRUCTS-BAK.
-	       ((and (org-at-item-p)
-		     (< (point-at-bol) backup-end)
-		     ;; Only lists in no special context are stored.
-		     (not (nth 2 (org-list-context))))
-		(funcall count-boxes (point-at-bol) structs-bak recursivep))
-	       ;; Cookie is at an item, but we need to compute list
-	       ;; structure.
-	       ((org-at-item-p)
-		(let ((struct (org-list-struct)))
-		  (setq backup-end (org-list-get-bottom-point struct)
-			structs-bak (list struct)))
-		(funcall count-boxes (point-at-bol) structs-bak recursivep))
-	       ;; Else, cookie found is at a wrong place.  Skip it.
-	       (t (throw 'skip nil))))
-	     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 (car (nth 3 cookie)))
-		     (total (cdr (nth 3 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)))
-		(when org-auto-align-tags (org-fix-tags-on-the-fly))))
+	   (lambda (item structs recursivep)
+	     ;; Return number of checked boxes and boxes of all types
+	     ;; in all structures in STRUCTS.  If RECURSIVEP is
+	     ;; non-nil, also count boxes in sub-lists.  If ITEM is
+	     ;; nil, count across the whole structure, else count only
+	     ;; across subtree whose ancestor is ITEM.
+	     (let ((c-on 0) (c-all 0))
+	       (dolist (s structs (list c-on c-all))
+		 (let* ((pre (org-list-prevs-alist s))
+			(par (org-list-parents-alist s))
+			(items
+			 (cond
+			  ((and recursivep item) (org-list-get-subtree item s))
+			  (recursivep (mapcar #'car s))
+			  (item (org-list-get-children item s par))
+			  (t (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))))
+		   (incf c-all (length cookies))
+		   (incf c-on (org-count "[X]" cookies)))))))
+	  cookies-list cache)
+     ;; Move to start.
+     (cond (all (goto-char (point-min)))
+	   (within-inlinetask (org-back-to-heading t))
+	   (t (org-with-limited-levels (outline-previous-heading))))
+     ;; Build an alist for each cookie found.  The key is the 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 end t)
+       (let ((context (save-excursion (backward-char)
+				      (save-match-data (org-element-context)))))
+	 (when (eq (org-element-type context) 'statistics-cookie)
+	   (push
+	    (append
+	     (list (match-beginning 1) (match-end 1) (match-end 2))
+	     (let* ((container
+		     (org-element-lineage
+		      context
+		      '(drawer center-block dynamic-block inlinetask plain-list
+			       quote-block special-block verse-block)))
+		    (beg (if container (org-element-property :begin container)
+			   (save-excursion
+			     (org-with-limited-levels (outline-previous-heading))
+			     (point)))))
+	       (or (cdr (assq beg cache))
+		   (save-excursion
+		     (goto-char beg)
+		     (let ((end
+			    (if container (org-element-property :end container)
+			      (save-excursion
+				(org-with-limited-levels (outline-next-heading))
+				(point))))
+			   structs)
+		       (while (re-search-forward box-re end t)
+			 (let ((element (org-element-at-point)))
+			   (when (eq (org-element-type element) 'item)
+			     (push (org-element-property :structure element)
+				   structs)
+			     (goto-char (org-element-property
+					 :end
+					 (org-element-property :parent
+							       element))))))
+		       ;; Cache count for cookies applying to the same
+		       ;; area.  Then return it.
+		       (let ((count
+			      (funcall count-boxes
+				       (and (eq (org-element-type container)
+						'plain-list)
+					    (org-element-property
+					     :contents-begin container))
+				       structs
+				       recursivep)))
+			 (push (cons beg count) cache)
+			 count))))))
 	    cookies-list))))
 	    cookies-list))))
+     ;; Apply alist to buffer.
+     (dolist (cookie cookies-list)
+       (let* ((beg (car cookie))
+	      (end (nth 1 cookie))
+	      (percent (nth 2 cookie))
+	      (checked (nth 3 cookie))
+	      (total (nth 4 cookie)))
+	 (goto-char beg)
+	 (insert
+	  (if percent (format "[%d%%]" (/ (* 100 checked) (max 1 total)))
+	    (format "[%d/%d]" checked total)))
+	 (delete-region (point) (+ (point) (- end beg)))
+	 (when org-auto-align-tags (org-fix-tags-on-the-fly)))))))
 
 
 (defun org-get-checkbox-statistics-face ()
 (defun org-get-checkbox-statistics-face ()
   "Select the face for checkbox statistics.
   "Select the face for checkbox statistics.

+ 81 - 0
testing/lisp/test-org-list.el

@@ -795,6 +795,87 @@
       (let ((org-list-indent-offset 0)) (org-list-repair))
       (let ((org-list-indent-offset 0)) (org-list-repair))
       (buffer-string)))))
       (buffer-string)))))
 
 
+(ert-deftest test-org-list/update-checkbox-count ()
+  "Test `org-update-checkbox-count' specifications."
+  ;; From a headline.
+  (should
+   (string-match "\\[0/1\\]"
+		 (org-test-with-temp-text "* [/]\n- [ ] item"
+		   (org-update-checkbox-count)
+		   (buffer-string))))
+  (should
+   (string-match "\\[1/1\\]"
+		 (org-test-with-temp-text "* [/]\n- [X] item"
+		   (org-update-checkbox-count)
+		   (buffer-string))))
+  (should
+   (string-match "\\[100%\\]"
+		 (org-test-with-temp-text "* [%]\n- [X] item"
+		   (org-update-checkbox-count)
+		   (buffer-string))))
+  ;; From a list.
+  (should
+   (string-match "\\[0/1\\]"
+		 (org-test-with-temp-text "- [/]\n  - [ ] item"
+		   (org-update-checkbox-count)
+		   (buffer-string))))
+  (should
+   (string-match "\\[1/1\\]"
+		 (org-test-with-temp-text "- [/]\n  - [X] item"
+		   (org-update-checkbox-count)
+		   (buffer-string))))
+  (should
+   (string-match "\\[100%\\]"
+		 (org-test-with-temp-text "- [%]\n  - [X] item"
+		   (org-update-checkbox-count)
+		   (buffer-string))))
+  ;; Count do not apply to sub-lists unless count is not hierarchical.
+  ;; This state can be achieved with COOKIE_DATA node property set to
+  ;; "recursive".
+  (should
+   (string-match "\\[1/1\\]"
+		 (org-test-with-temp-text "- [/]\n  - item\n    - [X] sub-item"
+		   (let ((org-checkbox-hierarchical-statistics nil))
+		     (org-update-checkbox-count))
+		   (buffer-string))))
+  (should
+   (string-match "\\[1/1\\]"
+		 (org-test-with-temp-text "
+<point>* H
+:PROPERTIES:
+:COOKIE_DATA: recursive
+:END:
+- [/]
+  - item
+    - [X] sub-item"
+		   (org-update-checkbox-count)
+		   (buffer-string))))
+  (should
+   (string-match "\\[0/0\\]"
+		 (org-test-with-temp-text "- [/]\n  - item\n    - [ ] sub-item"
+		   (org-update-checkbox-count)
+		   (buffer-string))))
+  ;; With optional argument ALL, update all buffer.
+  (should
+   (= 2
+      (org-test-with-temp-text "* [/]\n- [X] item\n* [/]\n- [X] item"
+	(org-update-checkbox-count t)
+	(count-matches "\\[1/1\\]"))))
+  ;; Ignore boxes in drawers, blocks or inlinetasks when counting from
+  ;; outside.
+  (should
+   (string-match "\\[2/2\\]"
+		 (org-test-with-temp-text "
+- [/]
+  - [X] item1
+    :DRAWER:
+    - [X] item
+    :END:
+  - [X] item2"
+		   (let ((org-checkbox-hierarchical-statistics nil))
+		     (org-update-checkbox-count))
+		   (buffer-string)))))
+
 
 
 
 
 ;;; Radio Lists
 ;;; Radio Lists