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.
This commit is contained in:
Nicolas Goaziou 2017-11-04 21:50:11 +01:00
parent db16370c0b
commit 6186ed3a22
2 changed files with 40 additions and 23 deletions

View File

@ -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-+\\)")

View File

@ -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)