org-element: Use internal version of `org-list-struct'

* lisp/org-element.el (org-element--list-struct): New function.
(org-element-plain-list-parser, org-element--current-element): Use new
function.

This patch removes dependency on org-list.el to parsing lists. For
now, it leads to code duplication, but, ultimately (i.e., when parsing
will be faster), org-list.el will delegate the parsing job to
org-element. The new implementation is also faster than the previous one.
This commit is contained in:
Nicolas Goaziou 2013-05-31 20:13:29 +02:00
parent 1399c34e2a
commit ca99372d83
1 changed files with 86 additions and 3 deletions

View File

@ -1146,6 +1146,89 @@ CONTENTS is the contents of the element."
;;;; Plain List
(defun org-element--list-struct (limit)
;; Return structure of list at point. Internal function. See
;; `org-list-struct' for details.
(let ((case-fold-search t)
(item-re (org-item-re))
(drawers-re (concat ":\\("
(mapconcat 'regexp-quote org-drawers "\\|")
"\\):[ \t]*$"))
(inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
items struct)
(save-excursion
(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)))))
;; 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)))))
;; At a new item: end previous sibling.
((looking-at item-re)
(let ((ind (save-excursion (skip-chars-forward " \t")
(current-column))))
(while (and items (<= ind (nth 1 (car items))))
(let ((item (pop items)))
(setcar (nthcdr 6 item) (point))
(push item struct)))
(push (progn (looking-at org-list-full-item-re)
(let ((bullet (match-string-no-properties 1)))
(list (point)
ind
bullet
(match-string-no-properties 2) ; counter
(match-string-no-properties 3) ; checkbox
;; Description tag.
(and (save-match-data
(string-match "[-+*]" bullet))
(match-string-no-properties 4))
;; Ending position, unknown so far.
nil)))
items))
(forward-line 1))
;; Skip empty lines.
((looking-at "^[ \t]*$") (forward-line))
;; Skip inline tasks and blank lines along the way.
((and inlinetask-re (looking-at inlinetask-re))
(forward-line)
(let ((origin (point)))
(when (re-search-forward inlinetask-re limit t)
(if (looking-at "^\\*+ END[ \t]*$") (forward-line)
(goto-char origin)))))
;; At some text line. Check if it ends any previous item.
(t
(let ((ind (progn (skip-chars-forward " \t") (current-column))))
(while (<= ind (nth 1 (car items)))
(let ((item (pop items)))
(setcar (nthcdr 6 item)
(if items (line-beginning-position)
(skip-chars-backward " \r\t\n")
(forward-line)
(point)))
(push item struct)
(unless items
(throw 'exit (sort struct 'car-less-than-car))))))
;; Skip blocks (any type) and drawers contents.
(cond
((and (looking-at "#\\+BEGIN\\(:[ \t]*$\\|_\\S-\\)+")
(re-search-forward
(format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
limit t)))
((and (looking-at drawers-re)
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
(forward-line))))))))
(defun org-element-plain-list-parser (limit affiliated structure)
"Parse a plain list.
@ -1162,9 +1245,8 @@ containing `:type', `:begin', `:end', `:contents-begin' and
Assume point is at the beginning of the list."
(save-excursion
(let* ((struct (or structure (org-list-struct)))
(let* ((struct (or structure (org-element--list-struct limit)))
(prevs (org-list-prevs-alist struct))
(parents (org-list-parents-alist struct))
(type (org-list-get-list-type (point) struct prevs))
(contents-begin (point))
(begin (car affiliated))
@ -3870,7 +3952,8 @@ element it has to parse."
;; List.
((looking-at (org-item-re))
(org-element-plain-list-parser
limit affiliated (or structure (org-list-struct))))
limit affiliated
(or structure (org-element--list-struct limit))))
;; Default element: Paragraph.
(t (org-element-paragraph-parser limit affiliated)))))))))