summaryrefslogtreecommitdiff
path: root/lisp/org-element.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:29 +0200
committerS├ębastien Delafond <sdelafond@gmail.com>2014-07-13 13:35:29 +0200
commit40ce6b75e6245659a3a14622356e32e7dd1125dd (patch)
tree7d0051414493a78c84a3dfbec6143883c2ba8341 /lisp/org-element.el
parente32a45ed36d6000db4b39171149072d11b77af72 (diff)
Imported Upstream version 8.2.1
Diffstat (limited to 'lisp/org-element.el')
-rw-r--r--lisp/org-element.el540
1 files changed, 303 insertions, 237 deletions
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 3cf87b2..807fdb4 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -683,9 +683,12 @@ Assume point is at the beginning of the footnote definition."
"^\\([ \t]*\n\\)\\{2,\\}") limit 'move))
(match-beginning 0)
(point))))
- (contents-begin (progn (search-forward "]")
- (skip-chars-forward " \r\t\n" ending)
- (and (/= (point) ending) (point))))
+ (contents-begin (progn
+ (search-forward "]")
+ (skip-chars-forward " \r\t\n" ending)
+ (cond ((= (point) ending) nil)
+ ((= (line-beginning-position) begin) (point))
+ (t (line-beginning-position)))))
(contents-end (and contents-begin ending))
(end (progn (goto-char ending)
(skip-chars-forward " \r\t\n" limit)
@@ -1151,6 +1154,90 @@ 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)
+ (top-ind limit)
+ (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))))
+ (setq top-ind (min top-ind ind))
+ (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))))
+ (when (<= ind top-ind)
+ (skip-chars-backward " \r\t\n")
+ (forward-line))
+ (while (<= ind (nth 1 (car items)))
+ (let ((item (pop items)))
+ (setcar (nthcdr 6 item) (line-beginning-position))
+ (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.
@@ -1167,9 +1254,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))
@@ -2015,11 +2101,11 @@ Return a list whose CAR is `node-property' and CDR is a plist
containing `:key', `:value', `:begin', `:end' and `:post-blank'
keywords."
(save-excursion
+ (looking-at org-property-re)
(let ((case-fold-search t)
(begin (point))
- (key (progn (looking-at "[ \t]*:\\(.*?\\):[ \t]+\\(.*?\\)[ \t]*$")
- (org-match-string-no-properties 1)))
- (value (org-match-string-no-properties 2))
+ (key (org-match-string-no-properties 2))
+ (value (org-match-string-no-properties 3))
(pos-before-blank (progn (forward-line) (point)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (point-at-bol)))))
@@ -2089,20 +2175,21 @@ Assume point is at the beginning of the paragraph."
(re-search-forward
"^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Stop at valid blocks.
- (and (looking-at
- "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
(save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid latex environments.
(and (looking-at
- "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}[ \t]*$")
+ "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
(save-excursion
(re-search-forward
(format "^[ \t]*\\\\end{%s}[ \t]*$"
- (match-string 1))
+ (regexp-quote
+ (org-match-string-no-properties 1)))
limit t)))
;; Stop at valid keywords.
(looking-at "[ \t]*#\\+\\S-+:")
@@ -2560,17 +2647,15 @@ Assume point is at the first star marker."
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor (limit)
+(defun org-element-text-markup-successor ()
"Search for the next text-markup object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is a symbol among `bold',
`italic', `underline', `strike-through', `code' and `verbatim'
and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-emph-re limit t)
+ (when (re-search-forward org-emph-re nil t)
(let ((marker (match-string 3)))
(cons (cond
((equal marker "*") 'bold)
@@ -2652,11 +2737,9 @@ CONTENTS is nil."
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor (limit)
+(defun org-element-latex-or-entity-successor ()
"Search for the next latex-fragment or entity object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `entity' or
`latex-fragment' and CDR is beginning position."
(save-excursion
@@ -2670,7 +2753,7 @@ Return value is a cons cell whose CAR is `entity' or
(concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
matchers "\\|")
"\\|" entity-re)
- limit t)
+ nil t)
(goto-char (match-beginning 0))
(if (looking-at entity-re)
;; Determine if it's a real entity or a LaTeX command.
@@ -2722,18 +2805,16 @@ CONTENTS is nil."
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
-(defun org-element-export-snippet-successor (limit)
+(defun org-element-export-snippet-successor ()
"Search for the next export-snippet object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `export-snippet' and CDR
its beginning position."
(save-excursion
(let (beg)
- (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
+ (when (and (re-search-forward "@@[-A-Za-z0-9]+:" nil t)
(setq beg (match-beginning 0))
- (search-forward "@@" limit t))
+ (search-forward "@@" nil t))
(cons 'export-snippet beg)))))
@@ -2789,21 +2870,19 @@ CONTENTS is nil."
(concat ":" (org-element-interpret-data inline-def))))))
(format "[%s]" (concat label def))))
-(defun org-element-footnote-reference-successor (limit)
+(defun org-element-footnote-reference-successor ()
"Search for the next footnote-reference object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `footnote-reference' and
CDR is beginning position."
(save-excursion
(catch 'exit
- (while (re-search-forward org-footnote-re limit t)
+ (while (re-search-forward org-footnote-re nil t)
(save-excursion
(let ((beg (match-beginning 0))
(count 1))
(backward-char)
- (while (re-search-forward "[][]" limit t)
+ (while (re-search-forward "[][]" nil t)
(if (equal (match-string 0) "[") (incf count) (decf count))
(when (zerop count)
(throw 'exit (cons 'footnote-reference beg))))))))))
@@ -2846,11 +2925,9 @@ CONTENTS is nil."
main-source)
(and post-options (format "[%s]" post-options)))))
-(defun org-element-inline-babel-call-successor (limit)
+(defun org-element-inline-babel-call-successor ()
"Search for the next inline-babel-call object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
@@ -2858,7 +2935,7 @@ CDR is beginning position."
;; `org-babel-inline-lob-one-liner-regexp'.
(when (re-search-forward
"call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
- limit t)
+ nil t)
(cons 'inline-babel-call (match-beginning 0)))))
@@ -2867,8 +2944,6 @@ CDR is beginning position."
(defun org-element-inline-src-block-parser ()
"Parse inline source block at point.
-LIMIT bounds the search.
-
Return a list whose CAR is `inline-src-block' and CDR a plist
with `:begin', `:end', `:language', `:value', `:parameters' and
`:post-blank' as keywords.
@@ -2903,16 +2978,14 @@ CONTENTS is nil."
(if arguments (format "[%s]" arguments) "")
body)))
-(defun org-element-inline-src-block-successor (limit)
+(defun org-element-inline-src-block-successor ()
"Search for the next inline-babel-call element.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `inline-babel-call' and
CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-babel-inline-src-block-regexp limit t)
+ (when (re-search-forward org-babel-inline-src-block-regexp nil t)
(cons 'inline-src-block (match-beginning 1)))))
;;;; Italic
@@ -3006,15 +3079,13 @@ Assume point is at the beginning of the line break."
CONTENTS is nil."
"\\\\\n")
-(defun org-element-line-break-successor (limit)
+(defun org-element-line-break-successor ()
"Search for the next line-break object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `line-break' and CDR is
beginning position."
(save-excursion
- (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
+ (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" nil t)
(goto-char (match-beginning 1)))))
;; A line break can only happen on a non-empty line.
(when (and beg (re-search-backward "\\S-" (point-at-bol) t))
@@ -3127,28 +3198,24 @@ CONTENTS is the contents of the object, or nil."
raw-link
(if contents (format "[%s]" contents) "")))))
-(defun org-element-link-successor (limit)
+(defun org-element-link-successor ()
"Search for the next link object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `link' and CDR is
beginning position."
(save-excursion
(let ((link-regexp
(if (not org-target-link-regexp) org-any-link-re
(concat org-any-link-re "\\|" org-target-link-regexp))))
- (when (re-search-forward link-regexp limit t)
+ (when (re-search-forward link-regexp nil t)
(cons 'link (match-beginning 0))))))
-(defun org-element-plain-link-successor (limit)
+(defun org-element-plain-link-successor ()
"Search for the next plain link object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `link' and CDR is
beginning position."
- (and (save-excursion (re-search-forward org-plain-link-re limit t))
+ (and (save-excursion (re-search-forward org-plain-link-re nil t))
(cons 'link (match-beginning 0))))
@@ -3196,17 +3263,15 @@ Assume point is at the macro."
CONTENTS is nil."
(org-element-property :value macro))
-(defun org-element-macro-successor (limit)
+(defun org-element-macro-successor ()
"Search for the next macro object.
-LIMIT bounds the search.
-
Return value is cons cell whose CAR is `macro' and CDR is
beginning position."
(save-excursion
(when (re-search-forward
"{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
- limit t)
+ nil t)
(cons 'macro (match-beginning 0)))))
@@ -3242,15 +3307,13 @@ Assume point is at the radio target."
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
-(defun org-element-radio-target-successor (limit)
+(defun org-element-radio-target-successor ()
"Search for the next radio-target object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `radio-target' and CDR
is beginning position."
(save-excursion
- (when (re-search-forward org-radio-target-regexp limit t)
+ (when (re-search-forward org-radio-target-regexp nil t)
(cons 'radio-target (match-beginning 0)))))
@@ -3282,15 +3345,13 @@ Assume point is at the beginning of the statistics-cookie."
CONTENTS is nil."
(org-element-property :value statistics-cookie))
-(defun org-element-statistics-cookie-successor (limit)
+(defun org-element-statistics-cookie-successor ()
"Search for the next statistics cookie object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `statistics-cookie' and
CDR is beginning position."
(save-excursion
- (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
+ (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" nil t)
(cons 'statistics-cookie (match-beginning 0)))))
@@ -3363,16 +3424,14 @@ CONTENTS is the contents of the object."
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
-(defun org-element-sub/superscript-successor (limit)
+(defun org-element-sub/superscript-successor ()
"Search for the next sub/superscript object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is either `subscript' or
`superscript' and CDR is beginning position."
(save-excursion
(unless (bolp) (backward-char))
- (when (re-search-forward org-match-substring-regexp limit t)
+ (when (re-search-forward org-match-substring-regexp nil t)
(cons (if (string= (match-string 2) "_") 'subscript 'superscript)
(match-beginning 2)))))
@@ -3439,11 +3498,9 @@ and `:post-blank' keywords."
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
-(defun org-element-table-cell-successor (limit)
+(defun org-element-table-cell-successor ()
"Search for the next table-cell object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `table-cell' and CDR is
beginning position."
(when (looking-at "[ \t]*.*?[ \t]*|") (cons 'table-cell (point))))
@@ -3476,15 +3533,13 @@ Assume point is at the target."
CONTENTS is nil."
(format "<<%s>>" (org-element-property :value target)))
-(defun org-element-target-successor (limit)
+(defun org-element-target-successor ()
"Search for the next target object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `target' and CDR is
beginning position."
(save-excursion
- (when (re-search-forward org-target-regexp limit t)
+ (when (re-search-forward org-target-regexp nil t)
(cons 'target (match-beginning 0)))))
@@ -3662,11 +3717,9 @@ CONTENTS is nil."
(eq type 'active-range)
(and hour-end minute-end)))))))))
-(defun org-element-timestamp-successor (limit)
+(defun org-element-timestamp-successor ()
"Search for the next timestamp object.
-LIMIT bounds the search.
-
Return value is a cons cell whose CAR is `timestamp' and CDR is
beginning position."
(save-excursion
@@ -3676,7 +3729,7 @@ beginning position."
"\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
"\\|"
"\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
- limit t)
+ nil t)
(cons 'timestamp (match-beginning 0)))))
@@ -3758,14 +3811,14 @@ CONTENTS is nil."
(limit &optional granularity special structure)
"Parse the element starting at point.
-LIMIT bounds the search.
-
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element and PROPS a plist of properties associated to the
element.
Possible types are defined in `org-element-all-elements'.
+LIMIT bounds the search.
+
Optional argument GRANULARITY determines the depth of the
recursion. Allowed values are `headline', `greater-element',
`element', `object' or nil. When it is broader than `object' (or
@@ -3875,7 +3928,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)))))))))
@@ -4314,57 +4368,56 @@ RESTRICTION is a list of object successors which are allowed in
the current object."
(let ((candidates 'initial))
(save-excursion
- (goto-char beg)
- (while (and (< (point) end)
- (setq candidates (org-element--get-next-object-candidates
- end restriction candidates)))
- (let ((next-object
- (let ((pos (apply 'min (mapcar 'cdr candidates))))
- (save-excursion
- (goto-char pos)
- (funcall (intern (format "org-element-%s-parser"
- (car (rassq pos candidates)))))))))
- ;; 1. Text before any object. Untabify it.
- (let ((obj-beg (org-element-property :begin next-object)))
- (unless (= (point) obj-beg)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) obj-beg))))))
- ;; 2. Object...
- (let ((obj-end (org-element-property :end next-object))
- (cont-beg (org-element-property :contents-begin next-object)))
- ;; Fill contents of NEXT-OBJECT by side-effect, if it has
- ;; a recursive type.
- (when (and cont-beg
- (memq (car next-object) org-element-recursive-objects))
- (save-restriction
- (narrow-to-region
- cont-beg
- (org-element-property :contents-end next-object))
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates)))
+ (let ((next-object
+ (let ((pos (apply 'min (mapcar 'cdr candidates))))
+ (save-excursion
+ (goto-char pos)
+ (funcall (intern (format "org-element-%s-parser"
+ (car (rassq pos candidates)))))))))
+ ;; 1. Text before any object. Untabify it.
+ (let ((obj-beg (org-element-property :begin next-object)))
+ (unless (= (point) obj-beg)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) obj-beg))))))
+ ;; 2. Object...
+ (let ((obj-end (org-element-property :end next-object))
+ (cont-beg (org-element-property :contents-begin next-object)))
+ ;; Fill contents of NEXT-OBJECT by side-effect, if it has
+ ;; a recursive type.
+ (when (and cont-beg
+ (memq (car next-object) org-element-recursive-objects))
(org-element--parse-objects
- (point-min) (point-max) next-object
- (org-element-restriction next-object))))
- (setq acc (org-element-adopt-elements acc next-object))
- (goto-char obj-end))))
- ;; 3. Text after last object. Untabify it.
- (unless (= (point) end)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) end)))))
- ;; Result.
- acc)))
-
-(defun org-element--get-next-object-candidates (limit restriction objects)
+ cont-beg (org-element-property :contents-end next-object)
+ next-object (org-element-restriction next-object)))
+ (setq acc (org-element-adopt-elements acc next-object))
+ (goto-char obj-end))))
+ ;; 3. Text after last object. Untabify it.
+ (unless (eobp)
+ (setq acc
+ (org-element-adopt-elements
+ acc
+ (replace-regexp-in-string
+ "\t" (make-string tab-width ? )
+ (buffer-substring-no-properties (point) end)))))
+ ;; Result.
+ acc))))
+
+(defun org-element--get-next-object-candidates (restriction objects)
"Return an alist of candidates for the next object.
-LIMIT bounds the search, and RESTRICTION narrows candidates to
-some object successors.
+RESTRICTION is a list of object types, as symbols. Only
+candidates with such types are looked after.
OBJECTS is the previous candidates alist. If it is set to
`initial', no search has been done before, and all symbols in
@@ -4379,7 +4432,7 @@ beginning position."
;; allowed in RESTRICTION.
(mapcar
(lambda (res)
- (funcall (intern (format "org-element-%s-successor" res)) limit))
+ (funcall (intern (format "org-element-%s-successor" res))))
restriction)
;; Focus on objects returned during last search. Keep those
;; still after point. Search again objects before it.
@@ -4390,8 +4443,7 @@ beginning position."
(succ (or (cdr (assq type org-element-object-successor-alist))
type)))
(and succ
- (funcall (intern (format "org-element-%s-successor" succ))
- limit)))))
+ (funcall (intern (format "org-element-%s-successor" succ)))))))
objects))))
@@ -4683,11 +4735,12 @@ first element of current section."
(org-back-to-heading)
(forward-line)
(org-skip-whitespace)
- (when (> (line-beginning-position) origin)
+ (when (or (eobp) (> (line-beginning-position) origin))
;; In blank lines just after the headline, point still
;; belongs to the headline.
(throw 'exit
- (progn (org-back-to-heading)
+ (progn (skip-chars-backward " \r\t\n")
+ (beginning-of-line)
(if (not keep-trail)
(org-element-headline-parser (point-max) t)
(list (org-element-headline-parser
@@ -4728,11 +4781,18 @@ first element of current section."
;; into elements with an explicit ending, but
;; return that element instead.
(and (= cend origin)
- (memq type
- '(center-block
- drawer dynamic-block inlinetask item
- plain-list property-drawer quote-block
- special-block))))
+ (or (memq type
+ '(center-block
+ drawer dynamic-block inlinetask
+ property-drawer quote-block
+ special-block))
+ ;; Corner case: if a list ends at the
+ ;; end of a buffer without a final new
+ ;; line, return last element in last
+ ;; item instead.
+ (and (memq type '(item plain-list))
+ (progn (goto-char cend)
+ (or (bolp) (not (eobp))))))))
(throw 'exit (if keep-trail trail element))
(setq parent element)
(case type
@@ -4763,103 +4823,109 @@ object type, but always include `:begin', `:end', `:parent' and
Optional argument ELEMENT, when non-nil, is the closest element
containing point, as returned by `org-element-at-point'.
Providing it allows for quicker computation."
- (org-with-wide-buffer
- (let* ((origin (point))
- (element (or element (org-element-at-point)))
- (type (org-element-type element))
- end)
- ;; Check if point is inside an element containing objects or at
- ;; a secondary string. In that case, move to beginning of the
- ;; element or secondary string and set END to the other side.
- (if (not (or (let ((post (org-element-property :post-affiliated element)))
- (and post (> post origin)
- (< (org-element-property :begin element) origin)
- (progn (beginning-of-line)
- (looking-at org-element--affiliated-re)
- (member (upcase (match-string 1))
- org-element-parsed-keywords))
- ;; We're at an affiliated keyword. Change
- ;; type to retrieve correct restrictions.
- (setq type 'keyword)
- ;; Determine if we're at main or dual value.
- (if (and (match-end 2) (<= origin (match-end 2)))
- (progn (goto-char (match-beginning 2))
- (setq end (match-end 2)))
- (goto-char (match-end 0))
- (setq end (line-end-position)))))
- (and (eq type 'item)
- (let ((tag (org-element-property :tag element)))
- (and tag
- (progn
- (beginning-of-line)
- (search-forward tag (point-at-eol))
- (goto-char (match-beginning 0))
- (and (>= origin (point))
- (<= origin
- ;; `1+' is required so some
- ;; successors can match
- ;; properly their object.
- (setq end (1+ (match-end 0)))))))))
- (and (memq type '(headline inlinetask))
- (progn (beginning-of-line)
- (skip-chars-forward "* ")
- (setq end (point-at-eol))))
- (and (memq type '(paragraph table-row verse-block))
- (let ((cbeg (org-element-property
- :contents-begin element))
- (cend (org-element-property
- :contents-end element)))
- (and cbeg cend ; cbeg is nil for table rules
- (>= origin cbeg)
- (<= origin cend)
- (progn (goto-char cbeg) (setq end cend)))))
- (and (eq type 'keyword)
- (let ((key (org-element-property :key element)))
- (and (member key org-element-document-properties)
- (progn (beginning-of-line)
- (search-forward key (line-end-position) t)
- (forward-char)
- (setq end (line-end-position))))))))
- element
+ (catch 'objects-forbidden
+ (org-with-wide-buffer
+ (let* ((origin (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element))
+ context)
+ ;; Check if point is inside an element containing objects or at
+ ;; a secondary string. In that case, narrow buffer to the
+ ;; containing area. Otherwise, return ELEMENT.
+ (cond
+ ;; At a parsed affiliated keyword, check if we're inside main
+ ;; or dual value.
+ ((let ((post (org-element-property :post-affiliated element)))
+ (and post (< origin post)))
+ (beginning-of-line)
+ (looking-at org-element--affiliated-re)
+ (cond
+ ((not (member (upcase (match-string 1)) org-element-parsed-keywords))
+ (throw 'objects-forbidden element))
+ ((< (match-end 0) origin)
+ (narrow-to-region (match-end 0) (line-end-position)))
+ ((and (match-beginning 2)
+ (>= origin (match-beginning 2))
+ (< origin (match-end 2)))
+ (narrow-to-region (match-beginning 2) (match-end 2)))
+ (t (throw 'objects-forbidden element)))
+ ;; Also change type to retrieve correct restrictions.
+ (setq type 'keyword))
+ ;; At an item, objects can only be located within tag, if any.
+ ((eq type 'item)
+ (let ((tag (org-element-property :tag element)))
+ (if (not tag) (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward tag (line-end-position))
+ (goto-char (match-beginning 0))
+ (if (and (>= origin (point)) (< origin (match-end 0)))
+ (narrow-to-region (point) (match-end 0))
+ (throw 'objects-forbidden element)))))
+ ;; At an headline or inlinetask, objects are located within
+ ;; their title.
+ ((memq type '(headline inlinetask))
+ (goto-char (org-element-property :begin element))
+ (skip-chars-forward "* ")
+ (if (and (>= origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element)))
+ ;; At a paragraph, a table-row or a verse block, objects are
+ ;; located within their contents.
+ ((memq type '(paragraph table-row verse-block))
+ (let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ ;; CBEG is nil for table rules.
+ (if (and cbeg cend (>= origin cbeg) (< origin cend))
+ (narrow-to-region cbeg cend)
+ (throw 'objects-forbidden element))))
+ ;; At a parsed keyword, objects are located within value.
+ ((eq type 'keyword)
+ (if (not (member (org-element-property :key element)
+ org-element-document-properties))
+ (throw 'objects-forbidden element)
+ (beginning-of-line)
+ (search-forward ":")
+ (if (and (>= origin (point)) (< origin (line-end-position)))
+ (narrow-to-region (point) (line-end-position))
+ (throw 'objects-forbidden element))))
+ (t (throw 'objects-forbidden element)))
+ (goto-char (point-min))
(let ((restriction (org-element-restriction type))
- (parent element)
- (candidates 'initial))
- (catch 'exit
- (while (setq candidates (org-element--get-next-object-candidates
- end restriction candidates))
- (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
- candidates)))
- ;; If ORIGIN is before next object in element, there's
- ;; no point in looking further.
- (if (> (cdr closest-cand) origin) (throw 'exit parent)
- (let* ((object
- (progn (goto-char (cdr closest-cand))
- (funcall (intern (format "org-element-%s-parser"
- (car closest-cand))))))
- (cbeg (org-element-property :contents-begin object))
- (cend (org-element-property :contents-end object))
- (obj-end (org-element-property :end object)))
- (cond
- ;; ORIGIN is after OBJECT, so skip it.
- ((<= obj-end origin)
- (if (/= obj-end end) (goto-char obj-end)
- (throw 'exit
- (org-element-put-property
- object :parent parent))))
- ;; ORIGIN is within a non-recursive object or at
- ;; an object boundaries: Return that object.
- ((or (not cbeg) (> cbeg origin) (< cend origin))
- (throw 'exit
- (org-element-put-property object :parent parent)))
- ;; Otherwise, move within current object and
- ;; restrict search to the end of its contents.
- (t (goto-char cbeg)
- (org-element-put-property object :parent parent)
- (setq parent object
- restriction (org-element-restriction object)
- candidates 'initial
- end cend)))))))
- parent))))))
+ (parent element)
+ (candidates 'initial))
+ (catch 'exit
+ (while (setq candidates
+ (org-element--get-next-object-candidates
+ restriction candidates))
+ (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
+ candidates)))
+ ;; If ORIGIN is before next object in element, there's
+ ;; no point in looking further.
+ (if (> (cdr closest-cand) origin) (throw 'exit parent)
+ (let* ((object
+ (progn (goto-char (cdr closest-cand))
+ (funcall (intern (format "org-element-%s-parser"
+ (car closest-cand))))))
+ (cbeg (org-element-property :contents-begin object))
+ (cend (org-element-property :contents-end object))
+ (obj-end (org-element-property :end object)))
+ (cond
+ ;; ORIGIN is after OBJECT, so skip it.
+ ((<= obj-end origin) (goto-char obj-end))
+ ;; ORIGIN is within a non-recursive object or at
+ ;; an object boundaries: Return that object.
+ ((or (not cbeg) (< origin cbeg) (>= origin cend))
+ (throw 'exit
+ (org-element-put-property object :parent parent)))
+ ;; Otherwise, move within current object and
+ ;; restrict search to the end of its contents.
+ (t (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (org-element-put-property object :parent parent)
+ (setq parent object
+ restriction (org-element-restriction object)
+ candidates 'initial)))))))
+ parent))))))
(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."