Browse Source

org-element: Fix item parser

* lisp/org-element.el (org-element--list-struct): Correctly handle end
  of sub-lists and end of last item.

* testing/lisp/test-org-element.el (test-org-element/item-parser):
(test-org-element/plain-list-parser): Add tests.
Nicolas Goaziou 8 months ago
parent
commit
6186ed3a22
2 changed files with 40 additions and 23 deletions
  1. 16 19
      lisp/org-element.el
  2. 24 4
      testing/lisp/test-org-element.el

+ 16 - 19
lisp/org-element.el

@@ -1308,23 +1308,19 @@ CONTENTS is the contents of the element."
 	(inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
 	items struct)
     (save-excursion
-      (catch 'exit
+      (catch :exit
 	(while t
 	  (cond
 	   ;; At limit: end all items.
 	   ((>= (point) limit)
-	    (throw 'exit
-		   (let ((end (progn (skip-chars-backward " \r\t\n")
-				     (forward-line)
-				     (point))))
-		     (dolist (item items (sort (nconc items struct)
-					       'car-less-than-car))
-		       (setcar (nthcdr 6 item) end)))))
+	    (let ((end (progn (skip-chars-backward " \r\t\n")
+			      (line-beginning-position 2))))
+	      (dolist (item items) (setcar (nthcdr 6 item) end)))
+	    (throw :exit (sort (nconc items struct) #'car-less-than-car)))
 	   ;; At list end: end all items.
 	   ((looking-at org-list-end-re)
-	    (throw 'exit (dolist (item items (sort (nconc items struct)
-						   'car-less-than-car))
-			   (setcar (nthcdr 6 item) (point)))))
+	    (dolist (item items) (setcar (nthcdr 6 item) (point)))
+	    (throw :exit (sort (nconc items struct) #'car-less-than-car)))
 	   ;; At a new item: end previous sibling.
 	   ((looking-at item-re)
 	    (let ((ind (save-excursion (skip-chars-forward " \t")
@@ -1348,7 +1344,7 @@ CONTENTS is the contents of the element."
 				   ;; Ending position, unknown so far.
 				   nil)))
 		    items))
-	    (forward-line 1))
+	    (forward-line))
 	   ;; Skip empty lines.
 	   ((looking-at "^[ \t]*$") (forward-line))
 	   ;; Skip inline tasks and blank lines along the way.
@@ -1360,17 +1356,18 @@ CONTENTS is the contents of the element."
 		  (goto-char origin)))))
 	   ;; At some text line.  Check if it ends any previous item.
 	   (t
-	    (let ((ind (save-excursion (skip-chars-forward " \t")
-				       (current-column))))
-	      (when (<= ind top-ind)
-		(skip-chars-backward " \r\t\n")
-		(forward-line))
+	    (let ((ind (save-excursion
+			 (skip-chars-forward " \t")
+			 (current-column)))
+		  (end (save-excursion
+			 (skip-chars-backward " \r\t\n")
+			 (line-beginning-position 2))))
 	      (while (<= ind (nth 1 (car items)))
 		(let ((item (pop items)))
-		  (setcar (nthcdr 6 item) (line-beginning-position))
+		  (setcar (nthcdr 6 item) end)
 		  (push item struct)
 		  (unless items
-		    (throw 'exit (sort struct #'car-less-than-car))))))
+		    (throw :exit (sort struct #'car-less-than-car))))))
 	    ;; Skip blocks (any type) and drawers contents.
 	    (cond
 	     ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)")

+ 24 - 4
testing/lisp/test-org-element.el

@@ -1444,9 +1444,19 @@ DEADLINE: <2012-03-29 thu.>"
 	      'org-element-contents))))
   ;; Block in an item: ignore indentation within the block.
   (should
-   (org-test-with-temp-text "- item\n  #+begin_src emacs-lisp\n(+ 1 1)\n  #+end_src"
-     (forward-char)
-     (= (org-element-property :end (org-element-at-point)) (point-max)))))
+   (org-test-with-temp-text
+       "-<point> item\n  #+begin_src emacs-lisp\n(+ 1 1)\n  #+end_src"
+     (= (org-element-property :end (org-element-at-point)) (point-max))))
+  ;; Last item in a list or sub-list has no `:post-blank' lines, since
+  ;; those belong to the plain-list.
+  (should
+   (= 0
+      (org-test-with-temp-text "- A\n\n- <point>B\n\nEnd list"
+	(org-element-property :post-blank (org-element-at-point)))))
+  (should
+   (= 0
+      (org-test-with-temp-text "- A\n\n  - B\n\n<point>  - C\n\n  End sub-list"
+	(org-element-property :post-blank (org-element-at-point))))))
 
 
 ;;;; Keyword
@@ -1962,7 +1972,17 @@ e^{i\\pi}+1=0
   "Test `plain-list' parser."
   (org-test-with-temp-text "- item"
     (should (org-element-map (org-element-parse-buffer) 'plain-list 'identity)))
-  ;; Blank lines after the list only belong to outer plain list.
+  ;; Blank lines after a list or sub-list belongs to that list.
+  (should
+   (= 1
+      (org-test-with-temp-text "- A\n\n- B\n\nEnd list"
+	(org-element-property :post-blank (org-element-at-point)))))
+  (should
+   (= 1
+      (org-test-with-temp-text "- A\n\n<point>  - B\n\n  - C\n\n  End sub-list"
+	(org-element-property :post-blank (org-element-at-point)))))
+  ;; Blank lines after the list only belong to outer plain list,
+  ;; however.
   (should
    (equal
     '(t t)