summaryrefslogtreecommitdiff
path: root/lisp/org-element.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2015-08-25 12:27:35 +0200
committerS├ębastien Delafond <sdelafond@gmail.com>2015-08-25 12:27:35 +0200
commit1be13d57dc8357576a8285c6dadc03db9e3ed7b0 (patch)
treee35b32d4dbd60cb6cea09f3c0797cc8877352def /lisp/org-element.el
parent4dc4918d0d667f18f3d5e3dd71e6f117ddb8af8a (diff)
Imported Upstream version 8.3.1
Diffstat (limited to 'lisp/org-element.el')
-rw-r--r--lisp/org-element.el4857
1 files changed, 2919 insertions, 1938 deletions
diff --git a/lisp/org-element.el b/lisp/org-element.el
index eb8ff41..c7e76e8 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -1,6 +1,6 @@
;;; org-element.el --- Parser And Applications for Org syntax
-;; Copyright (C) 2012-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
;; Keywords: outlines, hypermedia, calendar, wp
@@ -31,7 +31,7 @@
;;
;; An element always starts and ends at the beginning of a line. With
;; a few exceptions (`clock', `headline', `inlinetask', `item',
-;; `planning', `node-property', `quote-section' `section' and
+;; `planning', `property-drawer', `node-property', `section' and
;; `table-row' types), it can also accept a fixed set of keywords as
;; attributes. Those are called "affiliated keywords" to distinguish
;; them from other keywords, which are full-fledged elements. Almost
@@ -48,10 +48,9 @@
;; Other element types are: `babel-call', `clock', `comment',
;; `comment-block', `diary-sexp', `example-block', `export-block',
;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
-;; `node-property', `paragraph', `planning', `quote-section',
-;; `src-block', `table', `table-row' and `verse-block'. Among them,
-;; `paragraph' and `verse-block' types can contain Org objects and
-;; plain text.
+;; `node-property', `paragraph', `planning', `src-block', `table',
+;; `table-row' and `verse-block'. Among them, `paragraph' and
+;; `verse-block' types can contain Org objects and plain text.
;;
;; Objects are related to document's contents. Some of them are
;; recursive. Associated types are of the following: `bold', `code',
@@ -75,9 +74,9 @@
;; refers to the element or object containing it. Greater elements,
;; elements and objects containing objects will also have
;; `:contents-begin' and `:contents-end' properties to delimit
-;; contents. Eventually, greater elements and elements accepting
-;; affiliated keywords will have a `:post-affiliated' property,
-;; referring to the buffer position after all such keywords.
+;; contents. Eventually, All elements have a `:post-affiliated'
+;; property referring to the buffer position after all affiliated
+;; keywords, if any, or to their beginning position otherwise.
;;
;; At the lowest level, a `:parent' property is also attached to any
;; string, as a text property.
@@ -111,13 +110,15 @@
;;
;; The library ends by furnishing `org-element-at-point' function, and
;; a way to give information about document structure around point
-;; with `org-element-context'.
+;; with `org-element-context'. A cache mechanism is also provided for
+;; these functions.
;;; Code:
(eval-when-compile (require 'cl))
(require 'org)
+(require 'avl-tree)
@@ -127,56 +128,111 @@
;; along with the affiliated keywords recognized. Also set up
;; restrictions on recursive objects combinations.
;;
-;; These variables really act as a control center for the parsing
-;; process.
-
-(defconst org-element-paragraph-separate
- (concat "^\\(?:"
- ;; Headlines, inlinetasks.
- org-outline-regexp "\\|"
- ;; Footnote definitions.
- "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
- ;; Diary sexps.
- "%%(" "\\|"
- "[ \t]*\\(?:"
- ;; Empty lines.
- "$" "\\|"
- ;; Tables (any type).
- "\\(?:|\\|\\+-[-+]\\)" "\\|"
- ;; Blocks (any type), Babel calls and keywords. Note: this
- ;; is only an indication and need some thorough check.
- "#\\(?:[+ ]\\|$\\)" "\\|"
- ;; Drawers (any type) and fixed-width areas. This is also
- ;; only an indication.
- ":" "\\|"
- ;; Horizontal rules.
- "-\\{5,\\}[ \t]*$" "\\|"
- ;; LaTeX environments.
- "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|"
- ;; Planning and Clock lines.
- (regexp-opt (list org-scheduled-string
- org-deadline-string
- org-closed-string
- org-clock-string))
- "\\|"
- ;; Lists.
- (let ((term (case org-plain-list-ordered-item-terminator
- (?\) ")") (?. "\\.") (otherwise "[.)]")))
- (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
- (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
- "\\(?:[ \t]\\|$\\)"))
- "\\)\\)")
+;; `org-element-update-syntax' builds proper syntax regexps according
+;; to current setup.
+
+(defvar org-element-paragraph-separate nil
"Regexp to separate paragraphs in an Org buffer.
In the case of lines starting with \"#\" and \":\", this regexp
is not sufficient to know if point is at a paragraph ending. See
`org-element-paragraph-parser' for more information.")
+(defvar org-element--object-regexp nil
+ "Regexp possibly matching the beginning of an object.
+This regexp allows false positives. Dedicated parser (e.g.,
+`org-export-bold-parser') will take care of further filtering.
+Radio links are not matched by this regexp, as they are treated
+specially in `org-element--object-lex'.")
+
+(defun org-element--set-regexps ()
+ "Build variable syntax regexps."
+ (setq org-element-paragraph-separate
+ (concat "^\\(?:"
+ ;; Headlines, inlinetasks.
+ org-outline-regexp "\\|"
+ ;; Footnote definitions.
+ "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ ;; Diary sexps.
+ "%%(" "\\|"
+ "[ \t]*\\(?:"
+ ;; Empty lines.
+ "$" "\\|"
+ ;; Tables (any type).
+ "|" "\\|"
+ "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|"
+ ;; Comments, keyword-like or block-like constructs.
+ ;; Blocks and keywords with dual values need to be
+ ;; double-checked.
+ "#\\(?: \\|$\\|\\+\\(?:"
+ "BEGIN_\\S-+" "\\|"
+ "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)"
+ "\\|"
+ ;; Drawers (any type) and fixed-width areas. Drawers
+ ;; need to be double-checked.
+ ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|"
+ ;; Horizontal rules.
+ "-\\{5,\\}[ \t]*$" "\\|"
+ ;; LaTeX environments.
+ "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|"
+ ;; Clock lines.
+ (regexp-quote org-clock-string) "\\|"
+ ;; Lists.
+ (let ((term (case org-plain-list-ordered-item-terminator
+ (?\) ")") (?. "\\.") (otherwise "[.)]")))
+ (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
+ (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
+ "\\(?:[ \t]\\|$\\)"))
+ "\\)\\)")
+ org-element--object-regexp
+ (mapconcat #'identity
+ (let ((link-types (regexp-opt org-link-types)))
+ (list
+ ;; Sub/superscript.
+ "\\(?:[_^][-{(*+.,[:alnum:]]\\)"
+ ;; Bold, code, italic, strike-through, underline
+ ;; and verbatim.
+ (concat "[*~=+_/]"
+ (format "[^%s]"
+ (nth 2 org-emphasis-regexp-components)))
+ ;; Plain links.
+ (concat "\\<" link-types ":")
+ ;; Objects starting with "[": regular link,
+ ;; footnote reference, statistics cookie,
+ ;; timestamp (inactive).
+ "\\[\\(?:fn:\\|\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)\\|\\[\\)"
+ ;; Objects starting with "@": export snippets.
+ "@@"
+ ;; Objects starting with "{": macro.
+ "{{{"
+ ;; Objects starting with "<" : timestamp
+ ;; (active, diary), target, radio target and
+ ;; angular links.
+ (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)")
+ ;; Objects starting with "$": latex fragment.
+ "\\$"
+ ;; Objects starting with "\": line break,
+ ;; entity, latex fragment.
+ "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)"
+ ;; Objects starting with raw text: inline Babel
+ ;; source block, inline Babel call.
+ "\\(?:call\\|src\\)_"))
+ "\\|")))
+
+(org-element--set-regexps)
+
+;;;###autoload
+(defun org-element-update-syntax ()
+ "Update parser internals."
+ (interactive)
+ (org-element--set-regexps)
+ (org-element-cache-reset 'all))
+
(defconst org-element-all-elements
'(babel-call center-block clock comment comment-block diary-sexp drawer
dynamic-block example-block export-block fixed-width
footnote-definition headline horizontal-rule inlinetask item
keyword latex-environment node-property paragraph plain-list
- planning property-drawer quote-block quote-section section
+ planning property-drawer quote-block section
special-block src-block table table-row verse-block)
"Complete list of element types.")
@@ -186,23 +242,6 @@ is not sufficient to know if point is at a paragraph ending. See
special-block table)
"List of recursive element types aka Greater Elements.")
-(defconst org-element-all-successors
- '(link export-snippet footnote-reference inline-babel-call
- inline-src-block latex-or-entity line-break macro plain-link
- radio-target statistics-cookie sub/superscript table-cell target
- text-markup timestamp)
- "Complete list of successors.")
-
-(defconst org-element-object-successor-alist
- '((subscript . sub/superscript) (superscript . sub/superscript)
- (bold . text-markup) (code . text-markup) (italic . text-markup)
- (strike-through . text-markup) (underline . text-markup)
- (verbatim . text-markup) (entity . latex-or-entity)
- (latex-fragment . latex-or-entity))
- "Alist of translations between object type and successor name.
-Sharing the same successor comes handy when, for example, the
-regexp matching one object can also match the other object.")
-
(defconst org-element-all-objects
'(bold code entity export-snippet footnote-reference inline-babel-call
inline-src-block italic line-break latex-fragment link macro
@@ -211,10 +250,14 @@ regexp matching one object can also match the other object.")
"Complete list of object types.")
(defconst org-element-recursive-objects
- '(bold italic link subscript radio-target strike-through superscript
- table-cell underline)
+ '(bold footnote-reference italic link subscript radio-target strike-through
+ superscript table-cell underline)
"List of recursive object types.")
+(defconst org-element-object-containers
+ (append org-element-recursive-objects '(paragraph table-row verse-block))
+ "List of object or element types that can directly contain objects.")
+
(defvar org-element-block-name-alist
'(("CENTER" . org-element-center-block-parser)
("COMMENT" . org-element-comment-block-parser)
@@ -226,12 +269,6 @@ regexp matching one object can also match the other object.")
Names must be uppercase. Any block whose name has no association
is parsed with `org-element-special-block-parser'.")
-(defconst org-element-link-type-is-file
- '("file" "file+emacs" "file+sys" "docview")
- "List of link types equivalent to \"file\".
-Only these types can accept search options and an explicit
-application to open them.")
-
(defconst org-element-affiliated-keywords
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
"RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
@@ -268,6 +305,13 @@ strings and objects.
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
+(defconst org-element--parsed-properties-alist
+ (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k)))))
+ org-element-parsed-keywords)
+ "Alist of parsed keywords and associated properties.
+This is generated from `org-element-parsed-keywords', which
+see.")
+
(defconst org-element-dual-keywords '("CAPTION" "RESULTS")
"List of affiliated keywords which can have a secondary value.
@@ -280,13 +324,8 @@ associated to a hash value with the following:
This list is checked after translations have been applied. See
`org-element-keyword-translation-alist'.")
-(defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE")
- "List of properties associated to the whole document.
-Any keyword in this list will have its value parsed and stored as
-a secondary string.")
-
(defconst org-element--affiliated-re
- (format "[ \t]*#\\+\\(?:%s\\):\\(?: \\|$\\)"
+ (format "[ \t]*#\\+\\(?:%s\\):[ \t]*"
(concat
;; Dual affiliated keywords.
(format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?"
@@ -296,8 +335,7 @@ a secondary string.")
(format "\\(?1:%s\\)"
(regexp-opt
(org-remove-if
- #'(lambda (keyword)
- (member keyword org-element-dual-keywords))
+ (lambda (k) (member k org-element-dual-keywords))
org-element-affiliated-keywords)))
"\\|"
;; Export attributes.
@@ -311,8 +349,7 @@ match group 2.
Don't modify it, set `org-element-affiliated-keywords' instead.")
(defconst org-element-object-restrictions
- (let* ((standard-set
- (remq 'plain-link (remq 'table-cell org-element-all-successors)))
+ (let* ((standard-set (remq 'table-cell org-element-all-objects))
(standard-set-no-line-break (remq 'line-break standard-set)))
`((bold ,@standard-set)
(footnote-reference ,@standard-set)
@@ -320,30 +357,33 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(inlinetask ,@standard-set-no-line-break)
(italic ,@standard-set)
(item ,@standard-set-no-line-break)
- (keyword ,@standard-set)
+ (keyword ,@(remq 'footnote-reference standard-set))
;; Ignore all links excepted plain links in a link description.
;; Also ignore radio-targets and line breaks.
- (link export-snippet inline-babel-call inline-src-block latex-or-entity
- macro plain-link statistics-cookie sub/superscript text-markup)
+ (link bold code entity export-snippet inline-babel-call inline-src-block
+ italic latex-fragment macro plain-link statistics-cookie
+ strike-through subscript superscript underline verbatim)
(paragraph ,@standard-set)
;; Remove any variable object from radio target as it would
;; prevent it from being properly recognized.
- (radio-target latex-or-entity sub/superscript text-markup)
+ (radio-target bold code entity italic latex-fragment strike-through
+ subscript superscript underline superscript)
(strike-through ,@standard-set)
(subscript ,@standard-set)
(superscript ,@standard-set)
;; Ignore inline babel call and inline src block as formulas are
;; possible. Also ignore line breaks and statistics cookies.
- (table-cell link export-snippet footnote-reference latex-or-entity macro
- radio-target sub/superscript target text-markup timestamp)
+ (table-cell bold code entity export-snippet footnote-reference italic
+ latex-fragment link macro radio-target strike-through
+ subscript superscript target timestamp underline verbatim)
(table-row table-cell)
(underline ,@standard-set)
(verse-block ,@standard-set)))
"Alist of objects restrictions.
-CAR is an element or object type containing objects and CDR is
-a list of successors that will be called within an element or
-object of such type.
+key is an element or object type containing objects and value is
+a list of types that can be contained within an element or object
+of such type.
For example, in a `radio-target' object, one can only find
entities, latex-fragments, subscript, superscript and text
@@ -354,11 +394,19 @@ This alist also applies to secondary string. For example, an
still has an entry since one of its properties (`:title') does.")
(defconst org-element-secondary-value-alist
- '((headline . :title)
- (inlinetask . :title)
- (item . :tag)
- (footnote-reference . :inline-definition))
- "Alist between element types and location of secondary value.")
+ '((headline :title)
+ (inlinetask :title)
+ (item :tag))
+ "Alist between element types and locations of secondary values.")
+
+(defconst org-element--pair-square-table
+ (let ((table (make-syntax-table)))
+ (modify-syntax-entry ?\[ "(]" table)
+ (modify-syntax-entry ?\] ")[" table)
+ (dolist (char '(?\{ ?\} ?\( ?\) ?\< ?\>) table)
+ (modify-syntax-entry char " " table)))
+ "Table used internally to pair only square brackets.
+Other brackets are treated as spaces.")
@@ -368,10 +416,16 @@ still has an entry since one of its properties (`:title') does.")
;; `org-element-contents' and `org-element-restriction'.
;;
;; Setter functions allow to modify elements by side effect. There is
-;; `org-element-put-property', `org-element-set-contents',
-;; `org-element-set-element' and `org-element-adopt-element'. Note
-;; that `org-element-set-element' and `org-element-adopt-elements' are
-;; higher level functions since also update `:parent' property.
+;; `org-element-put-property', `org-element-set-contents'. These
+;; low-level functions are useful to build a parse tree.
+;;
+;; `org-element-adopt-element', `org-element-set-element',
+;; `org-element-extract-element' and `org-element-insert-before' are
+;; high-level functions useful to modify a parse tree.
+;;
+;; `org-element-secondary-p' is a predicate used to know if a given
+;; object belongs to a secondary string. `org-element-copy' returns
+;; an element or object, stripping its parent property in the process.
(defsubst org-element-type (element)
"Return type of ELEMENT.
@@ -411,29 +465,22 @@ Return modified element."
element))
(defsubst org-element-set-contents (element &rest contents)
- "Set ELEMENT contents to CONTENTS.
-Return modified element."
+ "Set ELEMENT contents to CONTENTS."
(cond ((not element) (list contents))
((not (symbolp (car element))) contents)
((cdr element) (setcdr (cdr element) contents))
(t (nconc element contents))))
-(defsubst org-element-set-element (old new)
- "Replace element or object OLD with element or object NEW.
-The function takes care of setting `:parent' property for NEW."
- ;; Since OLD is going to be changed into NEW by side-effect, first
- ;; make sure that every element or object within NEW has OLD as
- ;; parent.
- (mapc (lambda (blob) (org-element-put-property blob :parent old))
- (org-element-contents new))
- ;; Transfer contents.
- (apply 'org-element-set-contents old (org-element-contents new))
- ;; Ensure NEW has same parent as OLD, then overwrite OLD properties
- ;; with NEW's.
- (org-element-put-property new :parent (org-element-property :parent old))
- (setcar (cdr old) (nth 1 new))
- ;; Transfer type.
- (setcar old (car new)))
+(defun org-element-secondary-p (object)
+ "Non-nil when OBJECT directly belongs to a secondary string.
+Return value is the property name, as a keyword, or nil."
+ (let* ((parent (org-element-property :parent object))
+ (properties (cdr (assq (org-element-type parent)
+ org-element-secondary-value-alist))))
+ (catch 'exit
+ (dolist (p properties)
+ (and (memq object (org-element-property p parent))
+ (throw 'exit p))))))
(defsubst org-element-adopt-elements (parent &rest children)
"Append elements to the contents of another element.
@@ -443,18 +490,109 @@ objects, or a strings.
The function takes care of setting `:parent' property for CHILD.
Return parent element."
- ;; Link every child to PARENT. If PARENT is nil, it is a secondary
- ;; string: parent is the list itself.
- (mapc (lambda (child)
- (org-element-put-property child :parent (or parent children)))
- children)
- ;; Add CHILDREN at the end of PARENT contents.
- (when parent
- (apply 'org-element-set-contents
- parent
- (nconc (org-element-contents parent) children)))
- ;; Return modified PARENT element.
- (or parent children))
+ (if (not children) parent
+ ;; Link every child to PARENT. If PARENT is nil, it is a secondary
+ ;; string: parent is the list itself.
+ (dolist (child children)
+ (org-element-put-property child :parent (or parent children)))
+ ;; Add CHILDREN at the end of PARENT contents.
+ (when parent
+ (apply #'org-element-set-contents
+ parent
+ (nconc (org-element-contents parent) children)))
+ ;; Return modified PARENT element.
+ (or parent children)))
+
+(defun org-element-extract-element (element)
+ "Extract ELEMENT from parse tree.
+Remove element from the parse tree by side-effect, and return it
+with its `:parent' property stripped out."
+ (let ((parent (org-element-property :parent element))
+ (secondary (org-element-secondary-p element)))
+ (if secondary
+ (org-element-put-property
+ parent secondary
+ (delq element (org-element-property secondary parent)))
+ (apply #'org-element-set-contents
+ parent
+ (delq element (org-element-contents parent))))
+ ;; Return ELEMENT with its :parent removed.
+ (org-element-put-property element :parent nil)))
+
+(defun org-element-insert-before (element location)
+ "Insert ELEMENT before LOCATION in parse tree.
+LOCATION is an element, object or string within the parse tree.
+Parse tree is modified by side effect."
+ (let* ((parent (org-element-property :parent location))
+ (property (org-element-secondary-p location))
+ (siblings (if property (org-element-property property parent)
+ (org-element-contents parent)))
+ ;; Special case: LOCATION is the first element of an
+ ;; independent secondary string (e.g. :title property). Add
+ ;; ELEMENT in-place.
+ (specialp (and (not property)
+ (eq siblings parent)
+ (eq (car parent) location))))
+ ;; Install ELEMENT at the appropriate POSITION within SIBLINGS.
+ (cond (specialp)
+ ((or (null siblings) (eq (car siblings) location))
+ (push element siblings))
+ ((null location) (nconc siblings (list element)))
+ (t (let ((previous (cadr (memq location (reverse siblings)))))
+ (if (not previous)
+ (error "No location found to insert element")
+ (let ((next (memq previous siblings)))
+ (setcdr next (cons element (cdr next))))))))
+ ;; Store SIBLINGS at appropriate place in parse tree.
+ (cond
+ (specialp (setcdr parent (copy-sequence parent)) (setcar parent element))
+ (property (org-element-put-property parent property siblings))
+ (t (apply #'org-element-set-contents parent siblings)))
+ ;; Set appropriate :parent property.
+ (org-element-put-property element :parent parent)))
+
+(defun org-element-set-element (old new)
+ "Replace element or object OLD with element or object NEW.
+The function takes care of setting `:parent' property for NEW."
+ ;; Ensure OLD and NEW have the same parent.
+ (org-element-put-property new :parent (org-element-property :parent old))
+ (if (or (memq (org-element-type old) '(plain-text nil))
+ (memq (org-element-type new) '(plain-text nil)))
+ ;; We cannot replace OLD with NEW since one of them is not an
+ ;; object or element. We take the long path.
+ (progn (org-element-insert-before new old)
+ (org-element-extract-element old))
+ ;; Since OLD is going to be changed into NEW by side-effect, first
+ ;; make sure that every element or object within NEW has OLD as
+ ;; parent.
+ (dolist (blob (org-element-contents new))
+ (org-element-put-property blob :parent old))
+ ;; Transfer contents.
+ (apply #'org-element-set-contents old (org-element-contents new))
+ ;; Overwrite OLD's properties with NEW's.
+ (setcar (cdr old) (nth 1 new))
+ ;; Transfer type.
+ (setcar old (car new))))
+
+(defun org-element-create (type &optional props &rest children)
+ "Create a new element of type TYPE.
+Optional argument PROPS, when non-nil, is a plist defining the
+properties of the element. CHILDREN can be elements, objects or
+strings."
+ (apply #'org-element-adopt-elements (list type props) children))
+
+(defun org-element-copy (datum)
+ "Return a copy of DATUM.
+DATUM is an element, object, string or nil. `:parent' property
+is cleared and contents are removed in the process."
+ (when datum
+ (let ((type (org-element-type datum)))
+ (case type
+ (org-data (list 'org-data nil))
+ (plain-text (substring-no-properties datum))
+ ((nil) (copy-sequence datum))
+ (otherwise
+ (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil)))))))
@@ -467,7 +605,7 @@ Return parent element."
;; Most of them accepts no argument. Though, exceptions exist. Hence
;; every element containing a secondary string (see
;; `org-element-secondary-value-alist') will accept an optional
-;; argument to toggle parsing of that secondary string. Moreover,
+;; argument to toggle parsing of these secondary strings. Moreover,
;; `item' parser requires current list's structure as its first
;; element.
;;
@@ -503,8 +641,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `center-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -520,7 +658,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -531,7 +668,6 @@ Assume point is at the beginning of the block."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -555,7 +691,7 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `drawer' and CDR is a plist containing
-`:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
+`:drawer-name', `:begin', `:end', `:contents-begin',
`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of drawer."
@@ -574,7 +710,6 @@ Assume point is at beginning of drawer."
(and (< (point) drawer-end-line)
(point))))
(contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char drawer-end-line)
(forward-line)
(point)))
@@ -585,7 +720,6 @@ Assume point is at beginning of drawer."
(list :begin begin
:end end
:drawer-name name
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -611,9 +745,9 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `dynamic-block' and CDR is a plist
-containing `:block-name', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:arguments', `:post-blank'
-and `:post-affiliated' keywords.
+containing `:block-name', `:begin', `:end', `:contents-begin',
+`:contents-end', `:arguments', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at beginning of dynamic block."
(let ((case-fold-search t))
@@ -633,7 +767,6 @@ Assume point is at beginning of dynamic block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -645,7 +778,6 @@ Assume point is at beginning of dynamic block."
:end end
:block-name name
:arguments arguments
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -722,16 +854,52 @@ CONTENTS is the contents of the footnote-definition."
;;;; Headline
+(defun org-element--get-node-properties ()
+ "Return node properties associated to headline at point.
+Upcase property names. It avoids confusion between properties
+obtained through property drawer and default properties from the
+parser (e.g. `:end' and :END:). Return value is a plist."
+ (save-excursion
+ (forward-line)
+ (when (org-looking-at-p org-planning-line-re) (forward-line))
+ (when (looking-at org-property-drawer-re)
+ (forward-line)
+ (let ((end (match-end 0)) properties)
+ (while (< (line-end-position) end)
+ (looking-at org-property-re)
+ (push (org-match-string-no-properties 3) properties)
+ (push (intern (concat ":" (upcase (match-string 2)))) properties)
+ (forward-line))
+ properties))))
+
+(defun org-element--get-time-properties ()
+ "Return time properties associated to headline at point.
+Return value is a plist."
+ (save-excursion
+ (when (progn (forward-line) (looking-at org-planning-line-re))
+ (let ((end (line-end-position)) plist)
+ (while (re-search-forward org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t")
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-scheduled-string)
+ (setq plist (plist-put plist :scheduled time)))
+ ((equal keyword org-deadline-string)
+ (setq plist (plist-put plist :deadline time)))
+ (t (setq plist (plist-put plist :closed time))))))
+ plist))))
+
(defun org-element-headline-parser (limit &optional raw-secondary-p)
"Parse a headline.
Return a list whose CAR is `headline' and CDR is a plist
-containing `:raw-value', `:title', `:alt-title', `:begin',
-`:end', `:pre-blank', `:hiddenp', `:contents-begin',
-`:contents-end', `:level', `:priority', `:tags',
-`:todo-keyword',`:todo-type', `:scheduled', `:deadline',
-`:closed', `:quotedp', `:archivedp', `:commentedp',
-`:footnote-section-p' and `:post-blank' keywords.
+containing `:raw-value', `:title', `:begin', `:end',
+`:pre-blank', `:contents-begin' and `:contents-end', `:level',
+`:priority', `:tags', `:todo-keyword',`:todo-type', `:scheduled',
+`:deadline', `:closed', `:archivedp', `:commentedp'
+`:footnote-section-p', `:post-blank' and `:post-affiliated'
+keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
@@ -744,80 +912,47 @@ parsed as a secondary string, but as a plain string instead.
Assume point is at beginning of the headline."
(save-excursion
- (let* ((components (org-heading-components))
- (level (nth 1 components))
- (todo (nth 2 components))
+ (let* ((begin (point))
+ (level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t")))
+ (todo (and org-todo-regexp
+ (let (case-fold-search) (looking-at org-todo-regexp))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 0))))
(todo-type
(and todo (if (member todo org-done-keywords) 'done 'todo)))
- (tags (let ((raw-tags (nth 5 components)))
- (and raw-tags (org-split-string raw-tags ":"))))
- (raw-value (or (nth 4 components) ""))
- (quotedp
- (let ((case-fold-search nil))
- (string-match (format "^%s\\( \\|$\\)" org-quote-string)
- raw-value)))
+ (priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2))))
(commentedp
- (let ((case-fold-search nil))
- (string-match (format "^%s\\( \\|$\\)" org-comment-string)
- raw-value)))
+ (and (let (case-fold-search) (looking-at org-comment-string))
+ (goto-char (match-end 0))))
+ (title-start (point))
+ (tags (when (re-search-forward
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":")))
+ (title-end (point))
+ (raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end)))
(archivedp (member org-archive-tag tags))
(footnote-section-p (and org-footnote-section
(string= org-footnote-section raw-value)))
- ;; Upcase property names. It avoids confusion between
- ;; properties obtained through property drawer and default
- ;; properties from the parser (e.g. `:end' and :END:)
- (standard-props
- (let (plist)
- (mapc
- (lambda (p)
- (setq plist
- (plist-put plist
- (intern (concat ":" (upcase (car p))))
- (cdr p))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props
- ;; Read time properties on the line below the headline.
- (save-excursion
- (when (progn (forward-line)
- (looking-at org-planning-or-clock-line-re))
- (let ((end (line-end-position)) plist)
- (while (re-search-forward
- org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
- (skip-chars-forward " \t")
- (let ((keyword (match-string 1))
- (time (org-element-timestamp-parser)))
- (cond ((equal keyword org-scheduled-string)
- (setq plist (plist-put plist :scheduled time)))
- ((equal keyword org-deadline-string)
- (setq plist (plist-put plist :deadline time)))
- (t (setq plist (plist-put plist :closed time))))))
- plist))))
- (begin (point))
+ (standard-props (org-element--get-node-properties))
+ (time-props (org-element--get-time-properties))
(end (min (save-excursion (org-end-of-subtree t t)) limit))
(pos-after-head (progn (forward-line) (point)))
(contents-begin (save-excursion
(skip-chars-forward " \r\t\n" end)
(and (/= (point) end) (line-beginning-position))))
- (hidden (org-invisible-p2))
(contents-end (and contents-begin
(progn (goto-char end)
(skip-chars-backward " \r\t\n")
(forward-line)
(point)))))
- ;; Clean RAW-VALUE from any quote or comment string.
- (when (or quotedp commentedp)
- (let ((case-fold-search nil))
- (setq raw-value
- (replace-regexp-in-string
- (concat
- (regexp-opt (list org-quote-string org-comment-string))
- "\\(?: \\|$\\)")
- ""
- raw-value))))
- ;; Clean TAGS from archive tag, if any.
- (when archivedp (setq tags (delete org-archive-tag tags)))
(let ((headline
(list 'headline
(nconc
@@ -827,11 +962,10 @@ Assume point is at beginning of the headline."
:pre-blank
(if (not contents-begin) 0
(count-lines pos-after-head contents-begin))
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:level level
- :priority (nth 3 components)
+ :priority priority
:tags tags
:todo-keyword todo
:todo-type todo-type
@@ -841,21 +975,23 @@ Assume point is at beginning of the headline."
:footnote-section-p footnote-section-p
:archivedp archivedp
:commentedp commentedp
- :quotedp quotedp)
+ :post-affiliated begin)
time-props
standard-props))))
- (let ((alt-title (org-element-property :ALT_TITLE headline)))
- (when alt-title
- (org-element-put-property
- headline :alt-title
- (if raw-secondary-p alt-title
- (org-element-parse-secondary-string
- alt-title (org-element-restriction 'headline) headline)))))
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
- (org-element-parse-secondary-string
- raw-value (org-element-restriction 'headline) headline)))))))
+ (let ((title (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
+ (org-element-restriction 'headline))))
+ (dolist (datum title title)
+ (org-element-put-property datum :parent headline)))))))))
(defun org-element-headline-interpreter (headline contents)
"Interpret HEADLINE element as Org syntax.
@@ -865,22 +1001,17 @@ CONTENTS is the contents of the element."
(priority (org-element-property :priority headline))
(title (org-element-interpret-data
(org-element-property :title headline)))
- (tags (let ((tag-list (if (org-element-property :archivedp headline)
- (cons org-archive-tag
- (org-element-property :tags headline))
- (org-element-property :tags headline))))
+ (tags (let ((tag-list (org-element-property :tags headline)))
(and tag-list
(format ":%s:" (mapconcat #'identity tag-list ":")))))
(commentedp (org-element-property :commentedp headline))
- (quotedp (org-element-property :quotedp headline))
(pre-blank (or (org-element-property :pre-blank headline) 0))
(heading
(concat (make-string (if org-odd-levels-only (1- (* level 2)) level)
?*)
(and todo (concat " " todo))
- (and quotedp (concat " " org-quote-string))
(and commentedp (concat " " org-comment-string))
- (and priority (format " [#%s]" (char-to-string priority)))
+ (and priority (format " [#%c]" priority))
" "
(if (and org-footnote-section
(org-element-property :footnote-section-p headline))
@@ -912,10 +1043,10 @@ CONTENTS is the contents of the element."
"Parse an inline task.
Return a list whose CAR is `inlinetask' and CDR is a plist
-containing `:title', `:begin', `:end', `:hiddenp',
-`:contents-begin' and `:contents-end', `:level', `:priority',
-`:raw-value', `:tags', `:todo-keyword', `:todo-type',
-`:scheduled', `:deadline', `:closed' and `:post-blank' keywords.
+containing `:title', `:begin', `:end', `:contents-begin' and
+`:contents-end', `:level', `:priority', `:raw-value', `:tags',
+`:todo-keyword', `:todo-type', `:scheduled', `:deadline',
+`:closed', `:post-blank' and `:post-affiliated' keywords.
The plist also contains any property set in the property drawer,
with its name in upper cases and colons added at the
@@ -928,53 +1059,37 @@ string instead.
Assume point is at beginning of the inline task."
(save-excursion
(let* ((begin (point))
- (components (org-heading-components))
- (todo (nth 2 components))
+ (level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t")))
+ (todo (and org-todo-regexp
+ (let (case-fold-search) (looking-at org-todo-regexp))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 0))))
(todo-type (and todo
(if (member todo org-done-keywords) 'done 'todo)))
- (tags (let ((raw-tags (nth 5 components)))
- (and raw-tags (org-split-string raw-tags ":"))))
- (raw-value (or (nth 4 components) ""))
- ;; Upcase property names. It avoids confusion between
- ;; properties obtained through property drawer and default
- ;; properties from the parser (e.g. `:end' and :END:)
- (standard-props
- (let (plist)
- (mapc
- (lambda (p)
- (setq plist
- (plist-put plist
- (intern (concat ":" (upcase (car p))))
- (cdr p))))
- (org-entry-properties nil 'standard))
- plist))
- (time-props
- ;; Read time properties on the line below the inlinetask
- ;; opening string.
- (save-excursion
- (when (progn (forward-line)
- (looking-at org-planning-or-clock-line-re))
- (let ((end (line-end-position)) plist)
- (while (re-search-forward
- org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
- (skip-chars-forward " \t")
- (let ((keyword (match-string 1))
- (time (org-element-timestamp-parser)))
- (cond ((equal keyword org-scheduled-string)
- (setq plist (plist-put plist :scheduled time)))
- ((equal keyword org-deadline-string)
- (setq plist (plist-put plist :deadline time)))
- (t (setq plist (plist-put plist :closed time))))))
- plist))))
+ (priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2))))
+ (title-start (point))
+ (tags (when (re-search-forward
+ (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":")))
+ (title-end (point))
+ (raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end)))
(task-end (save-excursion
(end-of-line)
(and (re-search-forward org-outline-regexp-bol limit t)
(org-looking-at-p "END[ \t]*$")
(line-beginning-position))))
+ (standard-props (and task-end (org-element--get-node-properties)))
+ (time-props (and task-end (org-element--get-time-properties)))
(contents-begin (progn (forward-line)
(and task-end (< (point) task-end) (point))))
- (hidden (and contents-begin (org-invisible-p2)))
(contents-end (and contents-begin task-end))
(before-blank (if (not task-end) (point)
(goto-char task-end)
@@ -988,24 +1103,31 @@ Assume point is at beginning of the inline task."
(list :raw-value raw-value
:begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
- :level (nth 1 components)
- :priority (nth 3 components)
+ :level level
+ :priority priority
:tags tags
:todo-keyword todo
:todo-type todo-type
- :post-blank (count-lines before-blank end))
+ :post-blank (count-lines before-blank end)
+ :post-affiliated begin)
time-props
standard-props))))
(org-element-put-property
inlinetask :title
(if raw-secondary-p raw-value
- (org-element-parse-secondary-string
- raw-value
- (org-element-restriction 'inlinetask)
- inlinetask))))))
+ (let ((title (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
+ (org-element-restriction 'inlinetask))))
+ (dolist (datum title title)
+ (org-element-put-property datum :parent inlinetask))))))))
(defun org-element-inlinetask-interpreter (inlinetask contents)
"Interpret INLINETASK element as Org syntax.
@@ -1020,8 +1142,7 @@ CONTENTS is the contents of inlinetask."
(format ":%s:" (mapconcat 'identity tag-list ":")))))
(task (concat (make-string level ?*)
(and todo (concat " " todo))
- (and priority
- (format " [#%s]" (char-to-string priority)))
+ (and priority (format " [#%c]" priority))
(and title (concat " " title)))))
(concat task
;; Align tags.
@@ -1055,8 +1176,8 @@ STRUCT is the structure of the plain list.
Return a list whose CAR is `item' and CDR is a plist containing
`:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
-`:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
-`:post-blank' keywords.
+`:checkbox', `:counter', `:tag', `:structure', `:post-blank' and
+`:post-affiliated' keywords.
When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
any, will not be parsed as a secondary string, but as a plain
@@ -1068,11 +1189,11 @@ Assume point is at the beginning of the item."
(looking-at org-list-full-item-re)
(let* ((begin (point))
(bullet (org-match-string-no-properties 1))
- (checkbox (let ((box (org-match-string-no-properties 3)))
+ (checkbox (let ((box (match-string 3)))
(cond ((equal "[ ]" box) 'off)
((equal "[X]" box) 'on)
((equal "[-]" box) 'trans))))
- (counter (let ((c (org-match-string-no-properties 2)))
+ (counter (let ((c (match-string 2)))
(save-match-data
(cond
((not c) nil)
@@ -1081,9 +1202,8 @@ Assume point is at the beginning of the item."
64))
((string-match "[0-9]+" c)
(string-to-number (match-string 0 c)))))))
- (end (save-excursion (goto-char (org-list-get-item-end begin struct))
- (unless (bolp) (forward-line))
- (point)))
+ (end (progn (goto-char (nth 6 (assq (point) struct)))
+ (if (bolp) (point) (line-beginning-position 2))))
(contents-begin
(progn (goto-char
;; Ignore tags in un-ordered lists: they are just
@@ -1092,40 +1212,38 @@ Assume point is at the beginning of the item."
(save-match-data (string-match "[.)]" bullet)))
(match-beginning 4)
(match-end 0)))
- (skip-chars-forward " \r\t\n" limit)
- ;; If first line isn't empty, contents really start
- ;; at the text after item's meta-data.
- (if (= (point-at-bol) begin) (point) (point-at-bol))))
- (hidden (progn (forward-line)
- (and (not (= (point) end)) (org-invisible-p2))))
- (contents-end (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ;; If first line isn't empty, contents really
+ ;; start at the text after item's meta-data.
+ ((= (line-beginning-position) begin) (point))
+ (t (line-beginning-position)))))
+ (contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))))
(item
(list 'item
(list :bullet bullet
:begin begin
:end end
- ;; CONTENTS-BEGIN and CONTENTS-END may be
- ;; mixed up in the case of an empty item
- ;; separated from the next by a blank line.
- ;; Thus ensure the former is always the
- ;; smallest.
- :contents-begin (min contents-begin contents-end)
- :contents-end (max contents-begin contents-end)
+ :contents-begin contents-begin
+ :contents-end contents-end
:checkbox checkbox
:counter counter
- :hiddenp hidden
:structure struct
- :post-blank (count-lines contents-end end)))))
+ :post-blank (count-lines (or contents-end begin) end)
+ :post-affiliated begin))))
(org-element-put-property
item :tag
- (let ((raw-tag (org-list-get-tag begin struct)))
- (and raw-tag
- (if raw-secondary-p raw-tag
- (org-element-parse-secondary-string
- raw-tag (org-element-restriction 'item) item))))))))
+ (let ((raw (org-list-get-tag begin struct)))
+ (when raw
+ (if raw-secondary-p raw
+ (let ((tag (org-element--parse-objects
+ (match-beginning 4) (match-end 4) nil
+ (org-element-restriction 'item))))
+ (dolist (datum tag tag)
+ (org-element-put-property datum :parent item))))))))))
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
@@ -1168,9 +1286,6 @@ CONTENTS is the contents of the element."
(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
@@ -1226,7 +1341,8 @@ CONTENTS is the contents of the element."
(goto-char origin)))))
;; At some text line. Check if it ends any previous item.
(t
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (let ((ind (save-excursion (skip-chars-forward " \t")
+ (current-column))))
(when (<= ind top-ind)
(skip-chars-backward " \r\t\n")
(forward-line))
@@ -1235,15 +1351,14 @@ CONTENTS is the contents of the element."
(setcar (nthcdr 6 item) (line-beginning-position))
(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 "#\\+BEGIN\\(:\\|_\\S-+\\)")
+ ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)")
(re-search-forward
- (format "^[ \t]*#\\+END%s[ \t]*$"
- (org-match-string-no-properties 1))
+ (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
limit t)))
- ((and (looking-at drawers-re)
+ ((and (looking-at org-drawer-regexp)
(re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
(forward-line))))))))
@@ -1264,15 +1379,20 @@ containing `:type', `:begin', `:end', `:contents-begin' and
Assume point is at the beginning of the list."
(save-excursion
(let* ((struct (or structure (org-element--list-struct limit)))
- (prevs (org-list-prevs-alist struct))
- (type (org-list-get-list-type (point) struct prevs))
+ (type (cond ((org-looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
+ ((nth 5 (assq (point) struct)) 'descriptive)
+ (t 'unordered)))
(contents-begin (point))
(begin (car affiliated))
- (contents-end
- (progn (goto-char (org-list-get-list-end (point) struct prevs))
- (unless (bolp) (forward-line))
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
+ (contents-end (let* ((item (assq contents-begin struct))
+ (ind (nth 1 item))
+ (pos (nth 6 item)))
+ (while (and (setq item (assq pos struct))
+ (= (nth 1 item) ind))
+ (setq pos (nth 6 item)))
+ pos))
+ (end (progn (goto-char contents-end)
+ (skip-chars-forward " \r\t\n" limit)
(if (= (point) limit) limit (line-beginning-position)))))
;; Return value.
(list 'plain-list
@@ -1299,49 +1419,33 @@ CONTENTS is the contents of the element."
;;;; Property Drawer
-(defun org-element-property-drawer-parser (limit affiliated)
+(defun org-element-property-drawer-parser (limit)
"Parse a property drawer.
-LIMIT bounds the search. AFFILIATED is a list of which CAR is
-the buffer position at the beginning of the first affiliated
-keyword and CDR is a plist of affiliated keywords along with
-their value.
+LIMIT bounds the search.
-Return a list whose CAR is `property-drawer' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+Return a list whose car is `property-drawer' and cdr is a plist
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the property drawer."
- (let ((case-fold-search t))
- (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
- ;; Incomplete drawer: parse it as a paragraph.
- (org-element-paragraph-parser limit affiliated)
- (save-excursion
- (let* ((drawer-end-line (match-beginning 0))
- (begin (car affiliated))
- (post-affiliated (point))
- (contents-begin
- (progn
- (forward-line)
- (and (re-search-forward org-property-re drawer-end-line t)
- (line-beginning-position))))
- (contents-end (and contents-begin drawer-end-line))
- (hidden (org-invisible-p2))
- (pos-before-blank (progn (goto-char drawer-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'property-drawer
- (nconc
- (list :begin begin
- :end end
- :hiddenp hidden
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (save-excursion
+ (let ((case-fold-search t)
+ (begin (point))
+ (contents-begin (line-beginning-position 2)))
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)
+ (let ((contents-end (and (> (match-beginning 0) contents-begin)
+ (match-beginning 0)))
+ (before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))))
+ (list 'property-drawer
+ (list :begin begin
+ :end end
+ :contents-begin (and contents-end contents-begin)
+ :contents-end contents-end
+ :post-blank (count-lines before-blank end)
+ :post-affiliated begin))))))
(defun org-element-property-drawer-interpreter (property-drawer contents)
"Interpret PROPERTY-DRAWER element as Org syntax.
@@ -1360,8 +1464,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `quote-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:contents-begin',
-`:contents-end', `:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:contents-begin', `:contents-end',
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -1378,7 +1482,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -1388,7 +1491,6 @@ Assume point is at the beginning of the block."
(nconc
(list :begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -1409,8 +1511,8 @@ CONTENTS is the contents of the element."
LIMIT bounds the search.
Return a list whose CAR is `section' and CDR is a plist
-containing `:begin', `:end', `:contents-begin', `contents-end'
-and `:post-blank' keywords."
+containing `:begin', `:end', `:contents-begin', `contents-end',
+`:post-blank' and `:post-affiliated' keywords."
(save-excursion
;; Beginning of section is the beginning of the first non-blank
;; line after previous headline.
@@ -1425,7 +1527,8 @@ and `:post-blank' keywords."
:end end
:contents-begin begin
:contents-end pos-before-blank
- :post-blank (count-lines pos-before-blank end))))))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated begin)))))
(defun org-element-section-interpreter (section contents)
"Interpret SECTION element as Org syntax.
@@ -1444,14 +1547,13 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `special-block' and CDR is a plist
-containing `:type', `:begin', `:end', `:hiddenp',
-`:contents-begin', `:contents-end', `:post-blank' and
-`:post-affiliated' keywords.
+containing `:type', `:begin', `:end', `:contents-begin',
+`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let* ((case-fold-search t)
(type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (upcase (match-string-no-properties 1)))))
+ (match-string-no-properties 1))))
(if (not (save-excursion
(re-search-forward
(format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
@@ -1467,7 +1569,6 @@ Assume point is at the beginning of the block."
(and (< (point) block-end-line)
(point))))
(contents-end (and contents-begin block-end-line))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char block-end-line)
(forward-line)
(point)))
@@ -1478,7 +1579,6 @@ Assume point is at the beginning of the block."
(list :type type
:begin begin
:end end
- :hiddenp hidden
:contents-begin contents-begin
:contents-end contents-end
:post-blank (count-lines pos-before-blank end)
@@ -1512,28 +1612,41 @@ CONTENTS is the contents of the element."
(defun org-element-babel-call-parser (limit affiliated)
"Parse a babel call.
-LIMIT bounds the search. AFFILIATED is a list of which CAR is
+LIMIT bounds the search. AFFILIATED is a list of which car is
the buffer position at the beginning of the first affiliated
-keyword and CDR is a plist of affiliated keywords along with
+keyword and cdr is a plist of affiliated keywords along with
their value.
-Return a list whose CAR is `babel-call' and CDR is a plist
-containing `:begin', `:end', `:info', `:post-blank' and
+Return a list whose car is `babel-call' and cdr is a plist
+containing `:call', `:inside-header', `:arguments',
+`:end-header', `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' as keywords."
(save-excursion
- (let ((case-fold-search t)
- (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
- (org-babel-lob-get-info)))
- (begin (car affiliated))
- (post-affiliated (point))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
+ (let* ((begin (car affiliated))
+ (post-affiliated (point))
+ (value (progn (search-forward ":" nil t)
+ (org-trim
+ (buffer-substring-no-properties
+ (point) (line-end-position)))))
+ (pos-before-blank (progn (forward-line) (point)))
+ (end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position))))
+ (valid-value
+ (string-match
+ "\\([^()\n]+?\\)\\(?:\\[\\(.*?\\)\\]\\)?(\\(.*\\))[ \t]*\\(.*\\)"
+ value)))
(list 'babel-call
(nconc
- (list :begin begin
+ (list :call (and valid-value (match-string 1 value))
+ :inside-header (and valid-value
+ (org-string-nw-p (match-string 2 value)))
+ :arguments (and valid-value
+ (org-string-nw-p (match-string 3 value)))
+ :end-header (and valid-value
+ (org-string-nw-p (match-string 4 value)))
+ :begin begin
:end end
- :info info
+ :value value
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated))))))
@@ -1541,14 +1654,13 @@ containing `:begin', `:end', `:info', `:post-blank' and
(defun org-element-babel-call-interpreter (babel-call contents)
"Interpret BABEL-CALL element as Org syntax.
CONTENTS is nil."
- (let* ((babel-info (org-element-property :info babel-call))
- (main (car babel-info))
- (post-options (nth 1 babel-info)))
- (concat "#+CALL: "
- (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
- ;; Remove redundant square brackets.
- (replace-match (match-string 1 main) nil nil main))
- (and post-options (format "[%s]" post-options)))))
+ (concat "#+CALL: "
+ (org-element-property :call babel-call)
+ (let ((h (org-element-property :inside-header babel-call)))
+ (and h (format "[%s]" h)))
+ (concat "(" (org-element-property :arguments babel-call) ")")
+ (let ((h (org-element-property :end-header babel-call)))
+ (and h (concat " " h)))))
;;;; Clock
@@ -1559,8 +1671,8 @@ CONTENTS is nil."
LIMIT bounds the search.
Return a list whose CAR is `clock' and CDR is a plist containing
-`:status', `:value', `:time', `:begin', `:end' and `:post-blank'
-as keywords."
+`:status', `:value', `:time', `:begin', `:end', `:post-blank' and
+`:post-affiliated' as keywords."
(save-excursion
(let* ((case-fold-search nil)
(begin (point))
@@ -1584,7 +1696,8 @@ as keywords."
:duration duration
:begin begin
:end end
- :post-blank post-blank)))))
+ :post-blank post-blank
+ :post-affiliated begin)))))
(defun org-element-clock-interpreter (clock contents)
"Interpret CLOCK element as Org syntax.
@@ -1664,8 +1777,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `comment-block' and CDR is a plist
-containing `:begin', `:end', `:hiddenp', `:value', `:post-blank'
-and `:post-affiliated' keywords.
+containing `:begin', `:end', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at comment block beginning."
(let ((case-fold-search t))
@@ -1678,7 +1791,6 @@ Assume point is at comment block beginning."
(let* ((begin (car affiliated))
(post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1691,7 +1803,6 @@ Assume point is at comment block beginning."
(list :begin begin
:end end
:value value
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -1700,7 +1811,9 @@ Assume point is at comment block beginning."
"Interpret COMMENT-BLOCK element as Org syntax.
CONTENTS is nil."
(format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
- (org-remove-indentation (org-element-property :value comment-block))))
+ (org-element-normalize-string
+ (org-remove-indentation
+ (org-element-property :value comment-block)))))
;;;; Diary Sexp
@@ -1741,35 +1854,6 @@ CONTENTS is nil."
;;;; Example Block
-(defun org-element--remove-indentation (s &optional n)
- "Remove maximum common indentation in string S and return it.
-When optional argument N is a positive integer, remove exactly
-that much characters from indentation, if possible, or return
-S as-is otherwise. Unlike to `org-remove-indentation', this
-function doesn't call `untabify' on S."
- (catch 'exit
- (with-temp-buffer
- (insert s)
- (goto-char (point-min))
- ;; Find maximum common indentation, if not specified.
- (setq n (or n
- (let ((min-ind (point-max)))
- (save-excursion
- (while (re-search-forward "^[ \t]*\\S-" nil t)
- (let ((ind (1- (current-column))))
- (if (zerop ind) (throw 'exit s)
- (setq min-ind (min min-ind ind))))))
- min-ind)))
- (if (zerop n) s
- ;; Remove exactly N indentation, but give up if not possible.
- (while (not (eobp))
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
- (cond ((eolp) (delete-region (line-beginning-position) (point)))
- ((< ind n) (throw 'exit s))
- (t (org-indent-line-to (- ind n))))
- (forward-line)))
- (buffer-string)))))
-
(defun org-element-example-block-parser (limit affiliated)
"Parse an example block.
@@ -1780,9 +1864,8 @@ their value.
Return a list whose CAR is `example-block' and CDR is a plist
containing `:begin', `:end', `:number-lines', `:preserve-indent',
-`:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
-`:switches', `:value', `:post-blank' and `:post-affiliated'
-keywords."
+`:retain-labels', `:use-labels', `:label-fmt', `:switches',
+`:value', `:post-blank' and `:post-affiliated' keywords."
(let ((case-fold-search t))
(if (not (save-excursion
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
@@ -1800,8 +1883,7 @@ keywords."
((string-match "-n\\>" switches) 'new)
((string-match "+n\\>" switches) 'continued)))
(preserve-indent
- (or org-src-preserve-indentation
- (and switches (string-match "-i\\>" switches))))
+ (and switches (string-match "-i\\>" switches)))
;; Should labels be retained in (or stripped from) example
;; blocks?
(retain-labels
@@ -1823,12 +1905,11 @@ keywords."
(post-affiliated (point))
(block-ind (progn (skip-chars-forward " \t") (current-column)))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
- (value (org-element--remove-indentation
+ (value (org-element-remove-indentation
(org-unescape-code-in-string
(buffer-substring-no-properties
contents-begin contents-end))
- (and preserve-indent block-ind)))
+ block-ind))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1845,7 +1926,6 @@ keywords."
:retain-labels retain-labels
:use-labels use-labels
:label-fmt label-fmt
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -1853,10 +1933,15 @@ keywords."
(defun org-element-example-block-interpreter (example-block contents)
"Interpret EXAMPLE-BLOCK element as Org syntax.
CONTENTS is nil."
- (let ((switches (org-element-property :switches example-block)))
+ (let ((switches (org-element-property :switches example-block))
+ (value (org-element-property :value example-block)))
(concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
- (org-escape-code-in-string
- (org-element-property :value example-block))
+ (org-element-normalize-string
+ (org-escape-code-in-string
+ (if (or org-src-preserve-indentation
+ (org-element-property :preserve-indent example-block))
+ value
+ (org-element-remove-indentation value))))
"#+END_EXAMPLE")))
@@ -1871,8 +1956,8 @@ keyword and CDR is a plist of affiliated keywords along with
their value.
Return a list whose CAR is `export-block' and CDR is a plist
-containing `:begin', `:end', `:type', `:hiddenp', `:value',
-`:post-blank' and `:post-affiliated' keywords.
+containing `:begin', `:end', `:type', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at export-block beginning."
(let* ((case-fold-search t)
@@ -1888,7 +1973,6 @@ Assume point is at export-block beginning."
(let* ((begin (car affiliated))
(post-affiliated (point))
(contents-begin (progn (forward-line) (point)))
- (hidden (org-invisible-p2))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -1902,7 +1986,6 @@ Assume point is at export-block beginning."
:end end
:type type
:value value
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -2015,7 +2098,10 @@ Return a list whose CAR is `keyword' and CDR is a plist
containing `:key', `:value', `:begin', `:end', `:post-blank' and
`:post-affiliated' keywords."
(save-excursion
- (let ((begin (car affiliated))
+ ;; An orphaned affiliated keyword is considered as a regular
+ ;; keyword. In this case AFFILIATED is nil, so we take care of
+ ;; this corner case.
+ (let ((begin (or (car affiliated) (point)))
(post-affiliated (point))
(key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
(upcase (org-match-string-no-properties 1))))
@@ -2044,6 +2130,18 @@ CONTENTS is nil."
;;;; Latex Environment
+(defconst org-element--latex-begin-environment
+ "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}"
+ "Regexp matching the beginning of a LaTeX environment.
+The environment is captured by the first group.
+
+See also `org-element--latex-end-environment'.")
+
+(defconst org-element--latex-end-environment
+ "\\\\end{%s}[ \t]*$"
+ "Format string matching the ending of a LaTeX environment.
+See also `org-element--latex-begin-environment'.")
+
(defun org-element-latex-environment-parser (limit affiliated)
"Parse a LaTeX environment.
@@ -2060,8 +2158,8 @@ Assume point is at the beginning of the latex environment."
(save-excursion
(let ((case-fold-search t)
(code-begin (point)))
- (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
- (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$"
+ (looking-at org-element--latex-begin-environment)
+ (if (not (re-search-forward (format org-element--latex-end-environment
(regexp-quote (match-string 1)))
limit t))
;; Incomplete latex environment: parse it as a paragraph.
@@ -2094,10 +2192,11 @@ CONTENTS is nil."
LIMIT bounds the search.
Return a list whose CAR is `node-property' and CDR is a plist
-containing `:key', `:value', `:begin', `:end' and `:post-blank'
-keywords."
+containing `:key', `:value', `:begin', `:end', `:post-blank' and
+`:post-affiliated' keywords."
(looking-at org-property-re)
- (let ((begin (point))
+ (let ((case-fold-search t)
+ (begin (point))
(key (org-match-string-no-properties 2))
(value (org-match-string-no-properties 3))
(end (save-excursion
@@ -2110,7 +2209,8 @@ keywords."
:value value
:begin begin
:end end
- :post-blank 0))))
+ :post-blank 0
+ :post-affiliated begin))))
(defun org-element-node-property-interpreter (node-property contents)
"Interpret NODE-PROPERTY element as Org syntax.
@@ -2141,66 +2241,42 @@ Assume point is at the beginning of the paragraph."
(before-blank
(let ((case-fold-search t))
(end-of-line)
- (if (not (re-search-forward
- org-element-paragraph-separate limit 'm))
- limit
- ;; A matching `org-element-paragraph-separate' is not
- ;; necessarily the end of the paragraph. In
- ;; particular, lines starting with # or : as a first
- ;; non-space character are ambiguous. We have to
- ;; check if they are valid Org syntax (e.g., not an
- ;; incomplete keyword).
- (beginning-of-line)
- (while (not
- (or
- ;; There's no ambiguity for other symbols or
- ;; empty lines: stop here.
- (looking-at "[ \t]*\\(?:[^:#]\\|$\\)")
- ;; Stop at valid fixed-width areas.
- (looking-at "[ \t]*:\\(?: \\|$\\)")
- ;; Stop at drawers.
- (and (looking-at org-drawer-regexp)
- (save-excursion
- (re-search-forward
- "^[ \t]*:END:[ \t]*$" limit t)))
- ;; Stop at valid comments.
- (looking-at "[ \t]*#\\(?: \\|$\\)")
- ;; Stop at valid dynamic blocks.
- (and (looking-at org-dblock-start-re)
- (save-excursion
- (re-search-forward
- "^[ \t]*#\\+END:?[ \t]*$" limit t)))
- ;; Stop at valid blocks.
- (and (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$"
- (regexp-quote
- (org-match-string-no-properties 1)))
- limit t)))
- ;; Stop at valid latex environments.
- (and (looking-at
- "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
- (save-excursion
- (re-search-forward
- (format "^[ \t]*\\\\end{%s}[ \t]*$"
- (regexp-quote
- (org-match-string-no-properties 1)))
- limit t)))
- ;; Stop at valid keywords.
- (looking-at "[ \t]*#\\+\\S-+:")
- ;; Skip everything else.
- (not
- (progn
- (end-of-line)
- (re-search-forward org-element-paragraph-separate
- limit 'm)))))
- (beginning-of-line)))
+ ;; A matching `org-element-paragraph-separate' is not
+ ;; necessarily the end of the paragraph. In particular,
+ ;; drawers, blocks or LaTeX environments opening lines
+ ;; must be closed. Moreover keywords with a secondary
+ ;; value must belong to "dual keywords".
+ (while (not
+ (cond
+ ((not (and (re-search-forward
+ org-element-paragraph-separate limit 'move)
+ (progn (beginning-of-line) t))))
+ ((looking-at org-drawer-regexp)
+ (save-excursion
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
+ ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (save-excursion
+ (re-search-forward
+ (format "^[ \t]*#\\+END_%s[ \t]*$"
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at org-element--latex-begin-environment)
+ (save-excursion
+ (re-search-forward
+ (format org-element--latex-end-environment
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:")
+ (member-ignore-case (match-string 1)
+ org-element-dual-keywords))
+ ;; Everything else is unambiguous.
+ (t)))
+ (end-of-line))
(if (= (point) limit) limit
(goto-char (line-beginning-position)))))
- (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin)
- (forward-line)
- (point)))
+ (contents-end (save-excursion
+ (skip-chars-backward " \r\t\n" contents-begin)
+ (line-beginning-position 2)))
(end (progn (skip-chars-forward " \r\t\n" limit)
(if (eobp) (point) (line-beginning-position)))))
(list 'paragraph
@@ -2227,8 +2303,8 @@ CONTENTS is the contents of the element."
LIMIT bounds the search.
Return a list whose CAR is `planning' and CDR is a plist
-containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
-and `:post-blank' keywords."
+containing `:closed', `:deadline', `:scheduled', `:begin',
+`:end', `:post-blank' and `:post-affiliated' keywords."
(save-excursion
(let* ((case-fold-search nil)
(begin (point))
@@ -2254,7 +2330,8 @@ and `:post-blank' keywords."
:scheduled scheduled
:begin begin
:end end
- :post-blank post-blank)))))
+ :post-blank post-blank
+ :post-affiliated begin)))))
(defun org-element-planning-interpreter (planning contents)
"Interpret PLANNING element as Org syntax.
@@ -2277,37 +2354,6 @@ CONTENTS is nil."
" "))
-;;;; Quote Section
-
-(defun org-element-quote-section-parser (limit)
- "Parse a quote section.
-
-LIMIT bounds the search.
-
-Return a list whose CAR is `quote-section' and CDR is a plist
-containing `:begin', `:end', `:value' and `:post-blank' keywords.
-
-Assume point is at beginning of the section."
- (save-excursion
- (let* ((begin (point))
- (end (progn (org-with-limited-levels (outline-next-heading))
- (point)))
- (pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (forward-line)
- (point)))
- (value (buffer-substring-no-properties begin pos-before-blank)))
- (list 'quote-section
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end))))))
-
-(defun org-element-quote-section-interpreter (quote-section contents)
- "Interpret QUOTE-SECTION element as Org syntax.
-CONTENTS is nil."
- (org-element-property :value quote-section))
-
-
;;;; Src Block
(defun org-element-src-block-parser (limit affiliated)
@@ -2320,9 +2366,9 @@ their value.
Return a list whose CAR is `src-block' and CDR is a plist
containing `:language', `:switches', `:parameters', `:begin',
-`:end', `:hiddenp', `:number-lines', `:retain-labels',
-`:use-labels', `:label-fmt', `:preserve-indent', `:value',
-`:post-blank' and `:post-affiliated' keywords.
+`:end', `:number-lines', `:retain-labels', `:use-labels',
+`:label-fmt', `:preserve-indent', `:value', `:post-blank' and
+`:post-affiliated' keywords.
Assume point is at the beginning of the block."
(let ((case-fold-search t))
@@ -2352,9 +2398,8 @@ Assume point is at the beginning of the block."
(cond ((not switches) nil)
((string-match "-n\\>" switches) 'new)
((string-match "+n\\>" switches) 'continued)))
- (preserve-indent (or org-src-preserve-indentation
- (and switches
- (string-match "-i\\>" switches))))
+ (preserve-indent (and switches
+ (string-match "-i\\>" switches)))
(label-fmt
(and switches
(string-match "-l +\"\\([^\"\n]+\\)\"" switches)
@@ -2373,14 +2418,12 @@ Assume point is at the beginning of the block."
(not (string-match "-k\\>" switches)))))
;; Indentation.
(block-ind (progn (skip-chars-forward " \t") (current-column)))
- ;; Get visibility status.
- (hidden (progn (forward-line) (org-invisible-p2)))
;; Retrieve code.
- (value (org-element--remove-indentation
+ (value (org-element-remove-indentation
(org-unescape-code-in-string
(buffer-substring-no-properties
- (point) contents-end))
- (and preserve-indent block-ind)))
+ (progn (forward-line) (point)) contents-end))
+ block-ind))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -2401,7 +2444,6 @@ Assume point is at the beginning of the block."
:retain-labels retain-labels
:use-labels use-labels
:label-fmt label-fmt
- :hiddenp hidden
:value value
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
@@ -2413,20 +2455,22 @@ CONTENTS is nil."
(let ((lang (org-element-property :language src-block))
(switches (org-element-property :switches src-block))
(params (org-element-property :parameters src-block))
- (value (let ((val (org-element-property :value src-block)))
- (cond
- ((org-element-property :preserve-indent src-block) val)
- ((zerop org-edit-src-content-indentation) val)
- (t
- (let ((ind (make-string
- org-edit-src-content-indentation 32)))
- (replace-regexp-in-string
- "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
+ (value
+ (let ((val (org-element-property :value src-block)))
+ (cond
+ ((or org-src-preserve-indentation
+ (org-element-property :preserve-indent src-block))
+ val)
+ ((zerop org-edit-src-content-indentation) val)
+ (t
+ (let ((ind (make-string org-edit-src-content-indentation ?\s)))
+ (replace-regexp-in-string
+ "\\(^\\)[ \t]*\\S-" ind val nil nil 1)))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
(and params (concat " " params))))
- (org-escape-code-in-string value)
+ (org-element-normalize-string (org-escape-code-in-string value))
"#+END_SRC")))
@@ -2449,10 +2493,12 @@ Assume point is at the beginning of the table."
(save-excursion
(let* ((case-fold-search t)
(table-begin (point))
- (type (if (org-at-table.el-p) 'table.el 'org))
+ (type (if (looking-at "[ \t]*|") 'org 'table.el))
+ (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
+ (if (eq type 'org) "" "+")))
(begin (car affiliated))
(table-end
- (if (re-search-forward org-table-any-border-regexp limit 'm)
+ (if (re-search-forward end-re limit 'move)
(goto-char (match-beginning 0))
(point)))
(tblfm (let (acc)
@@ -2503,7 +2549,7 @@ LIMIT bounds the search.
Return a list whose CAR is `table-row' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:type' and `:post-blank' keywords."
+`:type', `:post-blank' and `:post-affiliated' keywords."
(save-excursion
(let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
(begin (point))
@@ -2517,14 +2563,15 @@ containing `:begin', `:end', `:contents-begin', `:contents-end',
(end-of-line)
(skip-chars-backward " \t")
(point))))
- (end (progn (forward-line) (point))))
+ (end (line-beginning-position 2)))
(list 'table-row
(list :type type
:begin begin
:end end
:contents-begin contents-begin
:contents-end contents-end
- :post-blank 0)))))
+ :post-blank 0
+ :post-affiliated begin)))))
(defun org-element-table-row-interpreter (table-row contents)
"Interpret TABLE-ROW element as Org syntax.
@@ -2545,7 +2592,7 @@ their value.
Return a list whose CAR is `verse-block' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
-`:hiddenp', `:post-blank' and `:post-affiliated' keywords.
+`:post-blank' and `:post-affiliated' keywords.
Assume point is at beginning of the block."
(let ((case-fold-search t))
@@ -2557,8 +2604,7 @@ Assume point is at beginning of the block."
(save-excursion
(let* ((begin (car affiliated))
(post-affiliated (point))
- (hidden (progn (forward-line) (org-invisible-p2)))
- (contents-begin (point))
+ (contents-begin (progn (forward-line) (point)))
(pos-before-blank (progn (goto-char contents-end)
(forward-line)
(point)))
@@ -2570,7 +2616,6 @@ Assume point is at beginning of the block."
:end end
:contents-begin contents-begin
:contents-end contents-end
- :hiddenp hidden
:post-blank (count-lines pos-before-blank end)
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
@@ -2584,104 +2629,75 @@ CONTENTS is verse block contents."
;;; Objects
;;
-;; Unlike to elements, interstices can be found between objects.
-;; That's why, along with the parser, successor functions are provided
-;; for each object. Some objects share the same successor (e.g.,
-;; `code' and `verbatim' objects).
-;;
-;; A successor must accept a single argument bounding the search. It
-;; will return either a cons cell whose CAR is the object's type, as
-;; a symbol, and CDR the position of its next occurrence, or nil.
-;;
-;; Successors follow the naming convention:
-;; org-element-NAME-successor, where NAME is the name of the
-;; successor, as defined in `org-element-all-successors'.
+;; Unlike to elements, raw text can be found between objects. Hence,
+;; `org-element--object-lex' is provided to find the next object in
+;; buffer.
;;
;; Some object types (e.g., `italic') are recursive. Restrictions on
;; object types they can contain will be specified in
;; `org-element-object-restrictions'.
;;
-;; Adding a new type of object is simple. Implement a successor,
-;; a parser, and an interpreter for it, all following the naming
-;; convention. Register type in `org-element-all-objects' and
-;; successor in `org-element-all-successors'. Maybe tweak
-;; restrictions about it, and that's it.
-
+;; Creating a new type of object requires to alter
+;; `org-element--object-regexp' and `org-element--object-lex', add the
+;; new type in `org-element-all-objects', and possibly add
+;; restrictions in `org-element-object-restrictions'.
;;;; Bold
(defun org-element-bold-parser ()
- "Parse bold object at point.
+ "Parse bold object at point, if any.
-Return a list whose CAR is `bold' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at a bold object, return a list whose car is `bold' and cdr
+is a plist with `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords. Otherwise, return
+nil.
Assume point is at the first star marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'bold
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'bold
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-bold-interpreter (bold contents)
"Interpret BOLD object as Org syntax.
CONTENTS is the contents of the object."
(format "*%s*" contents))
-(defun org-element-text-markup-successor ()
- "Search for the next text-markup object.
-
-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 nil t)
- (let ((marker (match-string 3)))
- (cons (cond
- ((equal marker "*") 'bold)
- ((equal marker "/") 'italic)
- ((equal marker "_") 'underline)
- ((equal marker "+") 'strike-through)
- ((equal marker "~") 'code)
- ((equal marker "=") 'verbatim)
- (t (error "Unknown marker at %d" (match-beginning 3))))
- (match-beginning 2))))))
-
;;;; Code
(defun org-element-code-parser ()
- "Parse code object at point.
+ "Parse code object at point, if any.
-Return a list whose CAR is `code' and CDR is a plist with
-`:value', `:begin', `:end' and `:post-blank' keywords.
+When at a code object, return a list whose car is `code' and cdr
+is a plist with `:value', `:begin', `:end' and `:post-blank'
+keywords. Otherwise, return nil.
Assume point is at the first tilde marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'code
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'code
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-code-interpreter (code contents)
"Interpret CODE object as Org syntax.
@@ -2692,35 +2708,37 @@ CONTENTS is nil."
;;;; Entity
(defun org-element-entity-parser ()
- "Parse entity at point.
+ "Parse entity at point, if any.
-Return a list whose CAR is `entity' and CDR a plist with
-`:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
-`:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
-keywords.
+When at an entity, return a list whose car is `entity' and cdr
+a plist with `:begin', `:end', `:latex', `:latex-math-p',
+`:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the entity."
- (save-excursion
- (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
- (let* ((value (org-entity-get (match-string 1)))
- (begin (match-beginning 0))
- (bracketsp (string= (match-string 2) "{}"))
- (post-blank (progn (goto-char (match-end 1))
- (when bracketsp (forward-char 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'entity
- (list :name (car value)
- :latex (nth 1 value)
- :latex-math-p (nth 2 value)
- :html (nth 3 value)
- :ascii (nth 4 value)
- :latin1 (nth 5 value)
- :utf-8 (nth 6 value)
- :begin begin
- :end end
- :use-brackets-p bracketsp
- :post-blank post-blank)))))
+ (catch 'no-object
+ (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)")
+ (save-excursion
+ (let* ((value (or (org-entity-get (match-string 1))
+ (throw 'no-object nil)))
+ (begin (match-beginning 0))
+ (bracketsp (string= (match-string 2) "{}"))
+ (post-blank (progn (goto-char (match-end 1))
+ (when bracketsp (forward-char 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'entity
+ (list :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :post-blank post-blank)))))))
(defun org-element-entity-interpreter (entity contents)
"Interpret ENTITY object as Org syntax.
@@ -2729,59 +2747,37 @@ CONTENTS is nil."
(org-element-property :name entity)
(when (org-element-property :use-brackets-p entity) "{}")))
-(defun org-element-latex-or-entity-successor ()
- "Search for the next latex-fragment or entity object.
-
-Return value is a cons cell whose CAR is `entity' or
-`latex-fragment' and CDR is beginning position."
- (save-excursion
- (unless (bolp) (backward-char))
- (let ((matchers (cdr org-latex-regexps))
- ;; ENTITY-RE matches both LaTeX commands and Org entities.
- (entity-re
- "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
- (when (re-search-forward
- (concat (mapconcat #'cadr matchers "\\|") "\\|" entity-re) nil t)
- (goto-char (match-beginning 0))
- (if (looking-at entity-re)
- ;; Determine if it's a real entity or a LaTeX command.
- (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
- (match-beginning 0))
- ;; No entity nor command: point is at a LaTeX fragment.
- ;; Determine its type to get the correct beginning position.
- (cons 'latex-fragment
- (catch 'return
- (dolist (e matchers)
- (when (looking-at (nth 1 e))
- (throw 'return (match-beginning (nth 2 e)))))
- (point))))))))
-
;;;; Export Snippet
(defun org-element-export-snippet-parser ()
"Parse export snippet at point.
-Return a list whose CAR is `export-snippet' and CDR a plist with
-`:begin', `:end', `:back-end', `:value' and `:post-blank' as
-keywords.
+When at an export snippet, return a list whose car is
+`export-snippet' and cdr a plist with `:begin', `:end',
+`:back-end', `:value' and `:post-blank' as keywords. Otherwise,
+return nil.
Assume point is at the beginning of the snippet."
(save-excursion
- (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t)
- (let* ((begin (match-beginning 0))
- (back-end (org-match-string-no-properties 1))
- (value (buffer-substring-no-properties
- (point)
- (progn (re-search-forward "@@" nil t) (match-beginning 0))))
- (post-blank (skip-chars-forward " \t"))
- (end (point)))
- (list 'export-snippet
- (list :back-end back-end
- :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (let (contents-end)
+ (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):")
+ (setq contents-end
+ (save-match-data (goto-char (match-end 0))
+ (re-search-forward "@@" nil t)
+ (match-beginning 0))))
+ (let* ((begin (match-beginning 0))
+ (back-end (org-match-string-no-properties 1))
+ (value (buffer-substring-no-properties
+ (match-end 0) contents-end))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (list 'export-snippet
+ (list :back-end back-end
+ :value value
+ :begin begin
+ :end end
+ :post-blank post-blank)))))))
(defun org-element-export-snippet-interpreter (export-snippet contents)
"Interpret EXPORT-SNIPPET object as Org syntax.
@@ -2790,163 +2786,124 @@ CONTENTS is nil."
(org-element-property :back-end export-snippet)
(org-element-property :value export-snippet)))
-(defun org-element-export-snippet-successor ()
- "Search for the next export-snippet object.
-
-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]+:" nil t)
- (setq beg (match-beginning 0))
- (search-forward "@@" nil t))
- (cons 'export-snippet beg)))))
-
;;;; Footnote Reference
(defun org-element-footnote-reference-parser ()
- "Parse footnote reference at point.
-
-Return a list whose CAR is `footnote-reference' and CDR a plist
-with `:label', `:type', `:inline-definition', `:begin', `:end'
-and `:post-blank' as keywords."
- (save-excursion
- (looking-at org-footnote-re)
- (let* ((begin (point))
- (label (or (org-match-string-no-properties 2)
+ "Parse footnote reference at point, if any.
+
+When at a footnote reference, return a list whose car is
+`footnote-reference' and cdr a plist with `:label', `:type',
+`:begin', `:end', `:content-begin', `:contents-end' and
+`:post-blank' as keywords. Otherwise, return nil."
+ (when (looking-at org-footnote-re)
+ (let ((closing (with-syntax-table org-element--pair-square-table
+ (ignore-errors (scan-lists (point) 1 0)))))
+ (when closing
+ (save-excursion
+ (let* ((begin (point))
+ (label
+ (or (org-match-string-no-properties 2)
(org-match-string-no-properties 3)
(and (match-string 1)
(concat "fn:" (org-match-string-no-properties 1)))))
- (type (if (or (not label) (match-string 1)) 'inline 'standard))
- (inner-begin (match-end 0))
- (inner-end
- (let ((count 1))
- (forward-char)
- (while (and (> count 0) (re-search-forward "[][]" nil t))
- (if (equal (match-string 0) "[") (incf count) (decf count)))
- (1- (point))))
- (post-blank (progn (goto-char (1+ inner-end))
- (skip-chars-forward " \t")))
- (end (point))
- (footnote-reference
+ (type (if (or (not label) (match-string 1)) 'inline 'standard))
+ (inner-begin (match-end 0))
+ (inner-end (1- closing))
+ (post-blank (progn (goto-char closing)
+ (skip-chars-forward " \t")))
+ (end (point)))
(list 'footnote-reference
(list :label label
:type type
:begin begin
:end end
- :post-blank post-blank))))
- (org-element-put-property
- footnote-reference :inline-definition
- (and (eq type 'inline)
- (org-element-parse-secondary-string
- (buffer-substring inner-begin inner-end)
- (org-element-restriction 'footnote-reference)
- footnote-reference))))))
+ :contents-begin (and (eq type 'inline) inner-begin)
+ :contents-end (and (eq type 'inline) inner-end)
+ :post-blank post-blank))))))))
(defun org-element-footnote-reference-interpreter (footnote-reference contents)
"Interpret FOOTNOTE-REFERENCE object as Org syntax.
-CONTENTS is nil."
- (let ((label (or (org-element-property :label footnote-reference) "fn:"))
- (def
- (let ((inline-def
- (org-element-property :inline-definition footnote-reference)))
- (if (not inline-def) ""
- (concat ":" (org-element-interpret-data inline-def))))))
- (format "[%s]" (concat label def))))
-
-(defun org-element-footnote-reference-successor ()
- "Search for the next footnote-reference object.
-
-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 nil t)
- (save-excursion
- (let ((beg (match-beginning 0))
- (count 1))
- (backward-char)
- (while (re-search-forward "[][]" nil t)
- (if (equal (match-string 0) "[") (incf count) (decf count))
- (when (zerop count)
- (throw 'exit (cons 'footnote-reference beg))))))))))
+CONTENTS is its definition, when inline, or nil."
+ (format "[%s]"
+ (concat (or (org-element-property :label footnote-reference) "fn:")
+ (and contents (concat ":" contents)))))
;;;; Inline Babel Call
(defun org-element-inline-babel-call-parser ()
- "Parse inline babel call at point.
+ "Parse inline babel call at point, if any.
-Return a list whose CAR is `inline-babel-call' and CDR a plist
-with `:begin', `:end', `:info' and `:post-blank' as keywords.
+When at an inline babel call, return a list whose car is
+`inline-babel-call' and cdr a plist with `:call',
+`:inside-header', `:arguments', `:end-header', `:begin', `:end',
+`:value' and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the babel call."
(save-excursion
(unless (bolp) (backward-char))
- (looking-at org-babel-inline-lob-one-liner-regexp)
- (let ((info (save-match-data (org-babel-lob-get-info)))
- (begin (match-end 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-babel-call
- (list :begin begin
- :end end
- :info info
- :post-blank post-blank)))))
+ (when (let ((case-fold-search t))
+ (looking-at org-babel-inline-lob-one-liner-regexp))
+ (let ((begin (match-end 1))
+ (call (org-match-string-no-properties 2))
+ (inside-header (org-string-nw-p (org-match-string-no-properties 4)))
+ (arguments (org-string-nw-p (org-match-string-no-properties 6)))
+ (end-header (org-string-nw-p (org-match-string-no-properties 8)))
+ (value (buffer-substring-no-properties (match-end 1) (match-end 0)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'inline-babel-call
+ (list :call call
+ :inside-header inside-header
+ :arguments arguments
+ :end-header end-header
+ :begin begin
+ :end end
+ :value value
+ :post-blank post-blank))))))
(defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
"Interpret INLINE-BABEL-CALL object as Org syntax.
CONTENTS is nil."
- (let* ((babel-info (org-element-property :info inline-babel-call))
- (main-source (car babel-info))
- (post-options (nth 1 babel-info)))
- (concat "call_"
- (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
- ;; Remove redundant square brackets.
- (replace-match
- (match-string 1 main-source) nil nil main-source)
- main-source)
- (and post-options (format "[%s]" post-options)))))
-
-(defun org-element-inline-babel-call-successor ()
- "Search for the next inline-babel-call object.
-
-Return value is a cons cell whose CAR is `inline-babel-call' and
-CDR is beginning position."
- (save-excursion
- (when (re-search-forward org-babel-inline-lob-one-liner-regexp nil t)
- (cons 'inline-babel-call (match-end 1)))))
+ (concat "call_"
+ (org-element-property :call inline-babel-call)
+ (let ((h (org-element-property :inside-header inline-babel-call)))
+ (and h (format "[%s]" h)))
+ "(" (org-element-property :arguments inline-babel-call) ")"
+ (let ((h (org-element-property :end-header inline-babel-call)))
+ (and h (format "[%s]" h)))))
;;;; Inline Src Block
(defun org-element-inline-src-block-parser ()
- "Parse inline source block at point.
+ "Parse inline source block at point, if any.
-Return a list whose CAR is `inline-src-block' and CDR a plist
-with `:begin', `:end', `:language', `:value', `:parameters' and
-`:post-blank' as keywords.
+When at an inline source block, return a list whose car is
+`inline-src-block' and cdr a plist with `:begin', `:end',
+`:language', `:value', `:parameters' and `:post-blank' as
+keywords. Otherwise, return nil.
Assume point is at the beginning of the inline src block."
(save-excursion
(unless (bolp) (backward-char))
- (looking-at org-babel-inline-src-block-regexp)
- (let ((begin (match-beginning 1))
- (language (org-match-string-no-properties 2))
- (parameters (org-match-string-no-properties 4))
- (value (org-match-string-no-properties 5))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-src-block
- (list :language language
- :value value
- :parameters parameters
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (when (looking-at org-babel-inline-src-block-regexp)
+ (let ((begin (match-beginning 1))
+ (language (org-match-string-no-properties 2))
+ (parameters (org-match-string-no-properties 4))
+ (value (org-match-string-no-properties 5))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'inline-src-block
+ (list :language language
+ :value value
+ :parameters parameters
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-inline-src-block-interpreter (inline-src-block contents)
"Interpret INLINE-SRC-BLOCK object as Org syntax.
@@ -2959,41 +2916,32 @@ CONTENTS is nil."
(if arguments (format "[%s]" arguments) "")
body)))
-(defun org-element-inline-src-block-successor ()
- "Search for the next inline-babel-call element.
-
-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 nil t)
- (cons 'inline-src-block (match-beginning 1)))))
-
;;;; Italic
(defun org-element-italic-parser ()
- "Parse italic object at point.
+ "Parse italic object at point, if any.
-Return a list whose CAR is `italic' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at an italic object, return a list whose car is `italic' and
+cdr is a plist with `:begin', `:end', `:contents-begin' and
+`:contents-end' and `:post-blank' keywords. Otherwise, return
+nil.
Assume point is at the first slash marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'italic
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'italic
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-italic-interpreter (italic contents)
"Interpret ITALIC object as Org syntax.
@@ -3004,36 +2952,42 @@ CONTENTS is the contents of the object."
;;;; Latex Fragment
(defun org-element-latex-fragment-parser ()
- "Parse LaTeX fragment at point.
+ "Parse LaTeX fragment at point, if any.
-Return a list whose CAR is `latex-fragment' and CDR a plist with
-`:value', `:begin', `:end', and `:post-blank' as keywords.
+When at a LaTeX fragment, return a list whose car is
+`latex-fragment' and cdr a plist with `:value', `:begin', `:end',
+and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the LaTeX fragment."
- (save-excursion
- (let* ((begin (point))
- (substring-match
- (catch 'exit
- (dolist (e (cdr org-latex-regexps))
- (let ((latex-regexp (nth 1 e)))
- (when (or (looking-at latex-regexp)
- (and (not (bobp))
- (save-excursion
- (backward-char)
- (looking-at latex-regexp))))
- (throw 'exit (nth 2 e)))))
- ;; None found: it's a macro.
- (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
- 0))
- (value (org-match-string-no-properties substring-match))
- (post-blank (progn (goto-char (match-end substring-match))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'latex-fragment
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (catch 'no-object
+ (save-excursion
+ (let* ((begin (point))
+ (after-fragment
+ (if (eq (char-after) ?$)
+ (if (eq (char-after (1+ (point))) ?$)
+ (search-forward "$$" nil t 2)
+ (and (not (eq (char-before) ?$))
+ (search-forward "$" nil t 2)
+ (not (memq (char-before (match-beginning 0))
+ '(?\s ?\t ?\n ?, ?.)))
+ (looking-at "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|$\\)")
+ (point)))
+ (case (char-after (1+ (point)))
+ (?\( (search-forward "\\)" nil t))
+ (?\[ (search-forward "\\]" nil t))
+ (otherwise
+ ;; Macro.
+ (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
+ (match-end 0))))))
+ (post-blank (if (not after-fragment) (throw 'no-object nil)
+ (goto-char after-fragment)
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'latex-fragment
+ (list :value (buffer-substring-no-properties begin after-fragment)
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-latex-fragment-interpreter (latex-fragment contents)
"Interpret LATEX-FRAGMENT object as Org syntax.
@@ -3043,138 +2997,146 @@ CONTENTS is nil."
;;;; Line Break
(defun org-element-line-break-parser ()
- "Parse line break at point.
+ "Parse line break at point, if any.
-Return a list whose CAR is `line-break', and CDR a plist with
-`:begin', `:end' and `:post-blank' keywords.
+When at a line break, return a list whose car is `line-break',
+and cdr a plist with `:begin', `:end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the beginning of the line break."
- (list 'line-break
- (list :begin (point)
- :end (progn (forward-line) (point))
- :post-blank 0)))
+ (when (and (org-looking-at-p "\\\\\\\\[ \t]*$")
+ (not (eq (char-before) ?\\)))
+ (list 'line-break
+ (list :begin (point)
+ :end (line-beginning-position 2)
+ :post-blank 0))))
(defun org-element-line-break-interpreter (line-break contents)
"Interpret LINE-BREAK object as Org syntax.
CONTENTS is nil."
"\\\\\n")
-(defun org-element-line-break-successor ()
- "Search for the next line-break object.
-
-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]*$" 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))
- (cons 'line-break beg)))))
-
;;;; Link
(defun org-element-link-parser ()
- "Parse link at point.
+ "Parse link at point, if any.
-Return a list whose CAR is `link' and CDR a plist with `:type',
-`:path', `:raw-link', `:application', `:search-option', `:begin',
-`:end', `:contents-begin', `:contents-end' and `:post-blank' as
-keywords.
+When at a link, return a list whose car is `link' and cdr a plist
+with `:type', `:path', `:raw-link', `:application',
+`:search-option', `:begin', `:end', `:contents-begin',
+`:contents-end' and `:post-blank' as keywords. Otherwise, return
+nil.
Assume point is at the beginning of the link."
- (save-excursion
+ (catch 'no-object
(let ((begin (point))
end contents-begin contents-end link-end post-blank path type
raw-link link search-option application)
(cond
;; Type 1: Text targeted from a radio target.
- ((and org-target-link-regexp (looking-at org-target-link-regexp))
+ ((and org-target-link-regexp
+ (save-excursion (or (bolp) (backward-char))
+ (looking-at org-target-link-regexp)))
(setq type "radio"
- link-end (match-end 0)
- path (org-match-string-no-properties 0)
- contents-begin (match-beginning 0)
- contents-end (match-end 0)))
+ link-end (match-end 1)
+ path (org-match-string-no-properties 1)
+ contents-begin (match-beginning 1)
+ contents-end (match-end 1)))
;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
((looking-at org-bracket-link-regexp)
- (setq contents-begin (match-beginning 3)
- contents-end (match-end 3)
- link-end (match-end 0)
- ;; RAW-LINK is the original link. Expand any
- ;; abbreviation in it.
- raw-link (org-translate-link
+ (setq contents-begin (match-beginning 3))
+ (setq contents-end (match-end 3))
+ (setq link-end (match-end 0))
+ ;; RAW-LINK is the original link. Expand any
+ ;; abbreviation in it.
+ ;;
+ ;; Also treat any newline character and associated
+ ;; indentation as a single space character. This is not
+ ;; compatible with RFC 3986, which requires to ignore
+ ;; them altogether. However, doing so would require
+ ;; users to encode spaces on the fly when writing links
+ ;; (e.g., insert [[shell:ls%20*.org]] instead of
+ ;; [[shell:ls *.org]], which defeats Org's focus on
+ ;; simplicity.
+ (setq raw-link (org-translate-link
(org-link-expand-abbrev
- (org-match-string-no-properties 1))))
- ;; Determine TYPE of link and set PATH accordingly.
+ (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" " "
+ (org-match-string-no-properties 1)))))
+ ;; Determine TYPE of link and set PATH accordingly. According
+ ;; to RFC 3986, remove whitespaces from URI in external links.
+ ;; In internal ones, treat indentation as a single space.
(cond
;; File type.
((or (file-name-absolute-p raw-link)
(string-match "\\`\\.\\.?/" raw-link))
- (setq type "file" path raw-link))
+ (setq type "file")
+ (setq path raw-link))
;; Explicit type (http, irc, bbdb...). See `org-link-types'.
((string-match org-link-types-re raw-link)
- (setq type (match-string 1 raw-link)
- ;; According to RFC 3986, extra whitespace should be
- ;; ignored when a URI is extracted.
- path (replace-regexp-in-string
- "[ \t]*\n[ \t]*" "" (substring raw-link (match-end 0)))))
+ (setq type (match-string 1 raw-link))
+ (setq path (substring raw-link (match-end 0))))
;; Id type: PATH is the id.
- ((string-match "\\`id:\\([-a-f0-9]+\\)" raw-link)
+ ((string-match "\\`id:\\([-a-f0-9]+\\)\\'" raw-link)
(setq type "id" path (match-string 1 raw-link)))
;; Code-ref type: PATH is the name of the reference.
- ((string-match "\\`(\\(.*\\))\\'" raw-link)
- (setq type "coderef" path (match-string 1 raw-link)))
+ ((and (org-string-match-p "\\`(" raw-link)
+ (org-string-match-p ")\\'" raw-link))
+ (setq type "coderef")
+ (setq path (substring raw-link 1 -1)))
;; Custom-id type: PATH is the name of the custom id.
- ((= (aref raw-link 0) ?#)
- (setq type "custom-id" path (substring raw-link 1)))
+ ((= (string-to-char raw-link) ?#)
+ (setq type "custom-id")
+ (setq path (substring raw-link 1)))
;; Fuzzy type: Internal link either matches a target, an
;; headline name or nothing. PATH is the target or
;; headline's name.
- (t (setq type "fuzzy" path raw-link))))
+ (t
+ (setq type "fuzzy")
+ (setq path raw-link))))
;; Type 3: Plain link, e.g., http://orgmode.org
((looking-at org-plain-link-re)
(setq raw-link (org-match-string-no-properties 0)
type (org-match-string-no-properties 1)
link-end (match-end 0)
path (org-match-string-no-properties 2)))
- ;; Type 4: Angular link, e.g., <http://orgmode.org>
+ ;; Type 4: Angular link, e.g., <http://orgmode.org>. Unlike to
+ ;; bracket links, follow RFC 3986 and remove any extra
+ ;; whitespace in URI.
((looking-at org-angle-link-re)
- (setq raw-link (buffer-substring-no-properties
- (match-beginning 1) (match-end 2))
- type (org-match-string-no-properties 1)
- link-end (match-end 0)
- path (org-match-string-no-properties 2))))
+ (setq type (org-match-string-no-properties 1))
+ (setq link-end (match-end 0))
+ (setq raw-link
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 2)))
+ (setq path (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" "" (org-match-string-no-properties 2))))
+ (t (throw 'no-object nil)))
;; In any case, deduce end point after trailing white space from
;; LINK-END variable.
- (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
- end (point))
- ;; Special "file" type link processing.
- (when (member type org-element-link-type-is-file)
- ;; Extract opening application and search option.
- (cond ((string-match "^file\\+\\(.*\\)$" type)
- (setq application (match-string 1 type)))
- ((not (string-match "^file" type))
- (setq application type)))
- (when (string-match "::\\(.*\\)\\'" path)
- (setq search-option (match-string 1 path)
- path (replace-match "" nil nil path)))
- ;; Normalize URI.
- (when (and (not (org-string-match-p "\\`//" path))
- (file-name-absolute-p path))
- (setq path (concat "//" (expand-file-name path))))
- ;; Make sure TYPE always reports "file".
- (setq type "file"))
- (list 'link
- (list :type type
- :path path
- :raw-link (or raw-link path)
- :application application
- :search-option search-option
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (save-excursion
+ (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
+ end (point))
+ ;; Special "file" type link processing. Extract opening
+ ;; application and search option, if any. Also normalize URI.
+ (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
+ (setq application (match-string 1 type) type "file")
+ (when (string-match "::\\(.*\\)\\'" path)
+ (setq search-option (match-string 1 path)
+ path (replace-match "" nil nil path)))
+ (setq path (replace-regexp-in-string "\\`/+" "/" path)))
+ (list 'link
+ (list :type type
+ :path path
+ :raw-link (or raw-link path)
+ :application application
+ :search-option search-option
+ :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-link-interpreter (link contents)
"Interpret LINK object as Org syntax.
@@ -3186,188 +3148,131 @@ CONTENTS is the contents of the object, or nil."
raw-link
(if contents (format "[%s]" contents) "")))))
-(defun org-element-link-successor ()
- "Search for the next link object.
-
-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 nil t)
- (cons 'link (match-beginning 0))))))
-
-(defun org-element-plain-link-successor ()
- "Search for the next plain link object.
-
-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 nil t))
- (cons 'link (match-beginning 0))))
-
;;;; Macro
(defun org-element-macro-parser ()
- "Parse macro at point.
+ "Parse macro at point, if any.
-Return a list whose CAR is `macro' and CDR a plist with `:key',
-`:args', `:begin', `:end', `:value' and `:post-blank' as
-keywords.
+When at a macro, return a list whose car is `macro' and cdr
+a plist with `:key', `:args', `:begin', `:end', `:value' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the macro."
(save-excursion
- (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
- (let ((begin (point))
- (key (downcase (org-match-string-no-properties 1)))
- (value (org-match-string-no-properties 0))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (args (let ((args (org-match-string-no-properties 3)))
- (when args
- ;; Do not use `org-split-string' since empty
- ;; strings are meaningful here.
- (split-string
- (replace-regexp-in-string
- "\\(\\\\*\\)\\(,\\)"
- (lambda (str)
- (let ((len (length (match-string 1 str))))
- (concat (make-string (/ len 2) ?\\)
- (if (zerop (mod len 2)) "\000" ","))))
- args nil t)
- "\000")))))
- (list 'macro
- (list :key key
- :value value
- :args args
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
+ (let ((begin (point))
+ (key (downcase (org-match-string-no-properties 1)))
+ (value (org-match-string-no-properties 0))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (args (let ((args (org-match-string-no-properties 3)))
+ (and args (org-macro-extract-arguments args)))))
+ (list 'macro
+ (list :key key
+ :value value
+ :args args
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-macro-interpreter (macro contents)
"Interpret MACRO object as Org syntax.
CONTENTS is nil."
(org-element-property :value macro))
-(defun org-element-macro-successor ()
- "Search for the next macro object.
-
-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]*?\\))\\)?}}}"
- nil t)
- (cons 'macro (match-beginning 0)))))
-
;;;; Radio-target
(defun org-element-radio-target-parser ()
- "Parse radio target at point.
+ "Parse radio target at point, if any.
-Return a list whose CAR is `radio-target' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end', `:value'
-and `:post-blank' as keywords.
+When at a radio target, return a list whose car is `radio-target'
+and cdr a plist with `:begin', `:end', `:contents-begin',
+`:contents-end', `:value' and `:post-blank' as keywords.
+Otherwise, return nil.
Assume point is at the radio target."
(save-excursion
- (looking-at org-radio-target-regexp)
- (let ((begin (point))
- (contents-begin (match-beginning 1))
- (contents-end (match-end 1))
- (value (org-match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'radio-target
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank
- :value value)))))
+ (when (looking-at org-radio-target-regexp)
+ (let ((begin (point))
+ (contents-begin (match-beginning 1))
+ (contents-end (match-end 1))
+ (value (org-match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'radio-target
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank
+ :value value))))))
(defun org-element-radio-target-interpreter (target contents)
"Interpret TARGET object as Org syntax.
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
-(defun org-element-radio-target-successor ()
- "Search for the next radio-target object.
-
-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 nil t)
- (cons 'radio-target (match-beginning 0)))))
-
;;;; Statistics Cookie
(defun org-element-statistics-cookie-parser ()
- "Parse statistics cookie at point.
+ "Parse statistics cookie at point, if any.
-Return a list whose CAR is `statistics-cookie', and CDR a plist
-with `:begin', `:end', `:value' and `:post-blank' keywords.
+When at a statistics cookie, return a list whose car is
+`statistics-cookie', and cdr a plist with `:begin', `:end',
+`:value' and `:post-blank' keywords. Otherwise, return nil.
Assume point is at the beginning of the statistics-cookie."
(save-excursion
- (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
- (let* ((begin (point))
- (value (buffer-substring-no-properties
- (match-beginning 0) (match-end 0)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'statistics-cookie
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank)))))
+ (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
+ (let* ((begin (point))
+ (value (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'statistics-cookie
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank))))))
(defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
"Interpret STATISTICS-COOKIE object as Org syntax.
CONTENTS is nil."
(org-element-property :value statistics-cookie))
-(defun org-element-statistics-cookie-successor ()
- "Search for the next statistics cookie object.
-
-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]*\\)\\]" nil t)
- (cons 'statistics-cookie (match-beginning 0)))))
-
;;;; Strike-Through
(defun org-element-strike-through-parser ()
- "Parse strike-through object at point.
+ "Parse strike-through object at point, if any.
-Return a list whose CAR is `strike-through' and CDR is a plist
-with `:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at a strike-through object, return a list whose car is
+`strike-through' and cdr is a plist with `:begin', `:end',
+`:contents-begin' and `:contents-end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the first plus sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'strike-through
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'strike-through
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-strike-through-interpreter (strike-through contents)
"Interpret STRIKE-THROUGH object as Org syntax.
@@ -3378,32 +3283,32 @@ CONTENTS is the contents of the object."
;;;; Subscript
(defun org-element-subscript-parser ()
- "Parse subscript at point.
+ "Parse subscript at point, if any.
-Return a list whose CAR is `subscript' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end',
-`:use-brackets-p' and `:post-blank' as keywords.
+When at a subscript object, return a list whose car is
+`subscript' and cdr a plist with `:begin', `:end',
+`:contents-begin', `:contents-end', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the underscore."
(save-excursion
(unless (bolp) (backward-char))
- (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
- t
- (not (looking-at org-match-substring-regexp))))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 5)
- (match-beginning 3)))
- (contents-end (or (match-end 5) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'subscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-match-substring-regexp)
+ (let ((bracketsp (match-beginning 4))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 4)
+ (match-beginning 3)))
+ (contents-end (or (match-end 4) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'subscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-subscript-interpreter (subscript contents)
"Interpret SUBSCRIPT object as Org syntax.
@@ -3412,46 +3317,36 @@ CONTENTS is the contents of the object."
(if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
contents))
-(defun org-element-sub/superscript-successor ()
- "Search for the next sub/superscript object.
-
-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 nil t)
- (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
- (match-beginning 2)))))
-
;;;; Superscript
(defun org-element-superscript-parser ()
- "Parse superscript at point.
+ "Parse superscript at point, if any.
-Return a list whose CAR is `superscript' and CDR a plist with
-`:begin', `:end', `:contents-begin', `:contents-end',
-`:use-brackets-p' and `:post-blank' as keywords.
+When at a superscript object, return a list whose car is
+`superscript' and cdr a plist with `:begin', `:end',
+`:contents-begin', `:contents-end', `:use-brackets-p' and
+`:post-blank' as keywords. Otherwise, return nil.
Assume point is at the caret."
(save-excursion
(unless (bolp) (backward-char))
- (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
- (not (looking-at org-match-substring-regexp))))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 5)
- (match-beginning 3)))
- (contents-end (or (match-end 5) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'superscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-match-substring-regexp)
+ (let ((bracketsp (match-beginning 4))
+ (begin (match-beginning 2))
+ (contents-begin (or (match-beginning 4)
+ (match-beginning 3)))
+ (contents-end (or (match-end 4) (match-end 3)))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'superscript
+ (list :begin begin
+ :end end
+ :use-brackets-p bracketsp
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-superscript-interpreter (superscript contents)
"Interpret SUPERSCRIPT object as Org syntax.
@@ -3465,8 +3360,7 @@ CONTENTS is the contents of the object."
(defun org-element-table-cell-parser ()
"Parse table cell at point.
-
-Return a list whose CAR is `table-cell' and CDR is a plist
+Return a list whose car is `table-cell' and cdr is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end'
and `:post-blank' keywords."
(looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
@@ -3486,291 +3380,270 @@ and `:post-blank' keywords."
CONTENTS is the contents of the cell, or nil."
(concat " " contents " |"))
-(defun org-element-table-cell-successor ()
- "Search for the next table-cell object.
-
-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))))
-
;;;; Target
(defun org-element-target-parser ()
- "Parse target at point.
+ "Parse target at point, if any.
-Return a list whose CAR is `target' and CDR a plist with
-`:begin', `:end', `:value' and `:post-blank' as keywords.
+When at a target, return a list whose car is `target' and cdr
+a plist with `:begin', `:end', `:value' and `:post-blank' as
+keywords. Otherwise, return nil.
Assume point is at the target."
(save-excursion
- (looking-at org-target-regexp)
- (let ((begin (point))
- (value (org-match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'target
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank)))))
+ (when (looking-at org-target-regexp)
+ (let ((begin (point))
+ (value (org-match-string-no-properties 1))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'target
+ (list :begin begin
+ :end end
+ :value value
+ :post-blank post-blank))))))
(defun org-element-target-interpreter (target contents)
"Interpret TARGET object as Org syntax.
CONTENTS is nil."
(format "<<%s>>" (org-element-property :value target)))
-(defun org-element-target-successor ()
- "Search for the next target object.
-
-Return value is a cons cell whose CAR is `target' and CDR is
-beginning position."
- (save-excursion
- (when (re-search-forward org-target-regexp nil t)
- (cons 'target (match-beginning 0)))))
-
;;;; Timestamp
+(defconst org-element--timestamp-regexp
+ (concat org-ts-regexp-both
+ "\\|"
+ "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
+ "\\|"
+ "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
+ "Regexp matching any timestamp type object.")
+
(defun org-element-timestamp-parser ()
- "Parse time stamp at point.
+ "Parse time stamp at point, if any.
-Return a list whose CAR is `timestamp', and CDR a plist with
-`:type', `:raw-value', `:year-start', `:month-start',
-`:day-start', `:hour-start', `:minute-start', `:year-end',
-`:month-end', `:day-end', `:hour-end', `:minute-end',
-`:repeater-type', `:repeater-value', `:repeater-unit',
-`:warning-type', `:warning-value', `:warning-unit', `:begin',
-`:end' and `:post-blank' keywords.
+When at a time stamp, return a list whose car is `timestamp', and
+cdr a plist with `:type', `:raw-value', `:year-start',
+`:month-start', `:day-start', `:hour-start', `:minute-start',
+`:year-end', `:month-end', `:day-end', `:hour-end',
+`:minute-end', `:repeater-type', `:repeater-value',
+`:repeater-unit', `:warning-type', `:warning-value',
+`:warning-unit', `:begin', `:end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the beginning of the timestamp."
- (save-excursion
- (let* ((begin (point))
- (activep (eq (char-after) ?<))
- (raw-value
- (progn
- (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
- (match-string-no-properties 0)))
- (date-start (match-string-no-properties 1))
- (date-end (match-string 3))
- (diaryp (match-beginning 2))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (time-range
- (and (not diaryp)
- (string-match
- "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
- date-start)
- (cons (string-to-number (match-string 2 date-start))
- (string-to-number (match-string 3 date-start)))))
- (type (cond (diaryp 'diary)
- ((and activep (or date-end time-range)) 'active-range)
- (activep 'active)
- ((or date-end time-range) 'inactive-range)
- (t 'inactive)))
- (repeater-props
- (and (not diaryp)
- (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
- raw-value)
- (list
- :repeater-type
- (let ((type (match-string 1 raw-value)))
- (cond ((equal "++" type) 'catch-up)
- ((equal ".+" type) 'restart)
- (t 'cumulate)))
- :repeater-value (string-to-number (match-string 2 raw-value))
- :repeater-unit
- (case (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
- (warning-props
- (and (not diaryp)
- (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
- (list
- :warning-type (if (match-string 1 raw-value) 'first 'all)
- :warning-value (string-to-number (match-string 2 raw-value))
- :warning-unit
- (case (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
- year-start month-start day-start hour-start minute-start year-end
- month-end day-end hour-end minute-end)
- ;; Parse date-start.
- (unless diaryp
- (let ((date (org-parse-time-string date-start t)))
- (setq year-start (nth 5 date)
- month-start (nth 4 date)
- day-start (nth 3 date)
- hour-start (nth 2 date)
- minute-start (nth 1 date))))
- ;; Compute date-end. It can be provided directly in time-stamp,
- ;; or extracted from time range. Otherwise, it defaults to the
- ;; same values as date-start.
- (unless diaryp
- (let ((date (and date-end (org-parse-time-string date-end t))))
- (setq year-end (or (nth 5 date) year-start)
- month-end (or (nth 4 date) month-start)
- day-end (or (nth 3 date) day-start)
- hour-end (or (nth 2 date) (car time-range) hour-start)
- minute-end (or (nth 1 date) (cdr time-range) minute-start))))
- (list 'timestamp
- (nconc (list :type type
- :raw-value raw-value
- :year-start year-start
- :month-start month-start
- :day-start day-start
- :hour-start hour-start
- :minute-start minute-start
- :year-end year-end
- :month-end month-end
- :day-end day-end
- :hour-end hour-end
- :minute-end minute-end
- :begin begin
- :end end
- :post-blank post-blank)
- repeater-props
- warning-props)))))
+ (when (org-looking-at-p org-element--timestamp-regexp)
+ (save-excursion
+ (let* ((begin (point))
+ (activep (eq (char-after) ?<))
+ (raw-value
+ (progn
+ (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (match-string-no-properties 0)))
+ (date-start (match-string-no-properties 1))
+ (date-end (match-string 3))
+ (diaryp (match-beginning 2))
+ (post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")))
+ (end (point))
+ (time-range
+ (and (not diaryp)
+ (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start)))))
+ (type (cond (diaryp 'diary)
+ ((and activep (or date-end time-range)) 'active-range)
+ (activep 'active)
+ ((or date-end time-range) 'inactive-range)
+ (t 'inactive)))
+ (repeater-props
+ (and (not diaryp)
+ (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
+ raw-value)
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (t 'cumulate)))
+ :repeater-value (string-to-number (match-string 2 raw-value))
+ :repeater-unit
+ (case (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ (warning-props
+ (and (not diaryp)
+ (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
+ (list
+ :warning-type (if (match-string 1 raw-value) 'first 'all)
+ :warning-value (string-to-number (match-string 2 raw-value))
+ :warning-unit
+ (case (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ year-start month-start day-start hour-start minute-start year-end
+ month-end day-end hour-end minute-end)
+ ;; Parse date-start.
+ (unless diaryp
+ (let ((date (org-parse-time-string date-start t)))
+ (setq year-start (nth 5 date)
+ month-start (nth 4 date)
+ day-start (nth 3 date)
+ hour-start (nth 2 date)
+ minute-start (nth 1 date))))
+ ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; or extracted from time range. Otherwise, it defaults to the
+ ;; same values as date-start.
+ (unless diaryp
+ (let ((date (and date-end (org-parse-time-string date-end t))))
+ (setq year-end (or (nth 5 date) year-start)
+ month-end (or (nth 4 date) month-start)
+ day-end (or (nth 3 date) day-start)
+ hour-end (or (nth 2 date) (car time-range) hour-start)
+ minute-end (or (nth 1 date) (cdr time-range) minute-start))))
+ (list 'timestamp
+ (nconc (list :type type
+ :raw-value raw-value
+ :year-start year-start
+ :month-start month-start
+ :day-start day-start
+ :hour-start hour-start
+ :minute-start minute-start
+ :year-end year-end
+ :month-end month-end
+ :day-end day-end
+ :hour-end hour-end
+ :minute-end minute-end
+ :begin begin
+ :end end
+ :post-blank post-blank)
+ repeater-props
+ warning-props))))))
(defun org-element-timestamp-interpreter (timestamp contents)
"Interpret TIMESTAMP object as Org syntax.
CONTENTS is nil."
- ;; Use `:raw-value' if specified.
- (or (org-element-property :raw-value timestamp)
- ;; Otherwise, build timestamp string.
- (let* ((repeat-string
- (concat
- (case (org-element-property :repeater-type timestamp)
- (cumulate "+") (catch-up "++") (restart ".+"))
- (let ((val (org-element-property :repeater-value timestamp)))
- (and val (number-to-string val)))
- (case (org-element-property :repeater-unit timestamp)
- (hour "h") (day "d") (week "w") (month "m") (year "y"))))
- (warning-string
- (concat
- (case (org-element-property :warning-type timestamp)
- (first "--")
- (all "-"))
- (let ((val (org-element-property :warning-value timestamp)))
- (and val (number-to-string val)))
- (case (org-element-property :warning-unit timestamp)
- (hour "h") (day "d") (week "w") (month "m") (year "y"))))
- (build-ts-string
- ;; Build an Org timestamp string from TIME. ACTIVEP is
- ;; non-nil when time stamp is active. If WITH-TIME-P is
- ;; non-nil, add a time part. HOUR-END and MINUTE-END
- ;; specify a time range in the timestamp. REPEAT-STRING
- ;; is the repeater string, if any.
- (lambda (time activep &optional with-time-p hour-end minute-end)
- (let ((ts (format-time-string
- (funcall (if with-time-p 'cdr 'car)
- org-time-stamp-formats)
- time)))
- (when (and hour-end minute-end)
- (string-match "[012]?[0-9]:[0-5][0-9]" ts)
- (setq ts
- (replace-match
- (format "\\&-%02d:%02d" hour-end minute-end)
- nil nil ts)))
- (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
- (dolist (s (list repeat-string warning-string))
- (when (org-string-nw-p s)
- (setq ts (concat (substring ts 0 -1)
- " "
- s
- (substring ts -1)))))
- ;; Return value.
- ts)))
- (type (org-element-property :type timestamp)))
- (case type
- ((active inactive)
- (let* ((minute-start (org-element-property :minute-start timestamp))
- (minute-end (org-element-property :minute-end timestamp))
- (hour-start (org-element-property :hour-start timestamp))
- (hour-end (org-element-property :hour-end timestamp))
- (time-range-p (and hour-start hour-end minute-start minute-end
- (or (/= hour-start hour-end)
- (/= minute-start minute-end)))))
- (funcall
- build-ts-string
- (encode-time 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
- (eq type 'active)
- (and hour-start minute-start)
- (and time-range-p hour-end)
- (and time-range-p minute-end))))
- ((active-range inactive-range)
- (let ((minute-start (org-element-property :minute-start timestamp))
- (minute-end (org-element-property :minute-end timestamp))
- (hour-start (org-element-property :hour-start timestamp))
- (hour-end (org-element-property :hour-end timestamp)))
- (concat
- (funcall
- build-ts-string (encode-time
- 0
- (or minute-start 0)
- (or hour-start 0)
- (org-element-property :day-start timestamp)
- (org-element-property :month-start timestamp)
- (org-element-property :year-start timestamp))
- (eq type 'active-range)
- (and hour-start minute-start))
- "--"
- (funcall build-ts-string
- (encode-time 0
- (or minute-end 0)
- (or hour-end 0)
- (org-element-property :day-end timestamp)
- (org-element-property :month-end timestamp)
- (org-element-property :year-end timestamp))
- (eq type 'active-range)
- (and hour-end minute-end)))))))))
-
-(defun org-element-timestamp-successor ()
- "Search for the next timestamp object.
-
-Return value is a cons cell whose CAR is `timestamp' and CDR is
-beginning position."
- (save-excursion
- (when (re-search-forward
- (concat org-ts-regexp-both
- "\\|"
- "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
- "\\|"
- "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
- nil t)
- (cons 'timestamp (match-beginning 0)))))
+ (let* ((repeat-string
+ (concat
+ (case (org-element-property :repeater-type timestamp)
+ (cumulate "+") (catch-up "++") (restart ".+"))
+ (let ((val (org-element-property :repeater-value timestamp)))
+ (and val (number-to-string val)))
+ (case (org-element-property :repeater-unit timestamp)
+ (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (warning-string
+ (concat
+ (case (org-element-property :warning-type timestamp)
+ (first "--")
+ (all "-"))
+ (let ((val (org-element-property :warning-value timestamp)))
+ (and val (number-to-string val)))
+ (case (org-element-property :warning-unit timestamp)
+ (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (build-ts-string
+ ;; Build an Org timestamp string from TIME. ACTIVEP is
+ ;; non-nil when time stamp is active. If WITH-TIME-P is
+ ;; non-nil, add a time part. HOUR-END and MINUTE-END
+ ;; specify a time range in the timestamp. REPEAT-STRING is
+ ;; the repeater string, if any.
+ (lambda (time activep &optional with-time-p hour-end minute-end)
+ (let ((ts (format-time-string
+ (funcall (if with-time-p 'cdr 'car)
+ org-time-stamp-formats)
+ time)))
+ (when (and hour-end minute-end)
+ (string-match "[012]?[0-9]:[0-5][0-9]" ts)
+ (setq ts
+ (replace-match
+ (format "\\&-%02d:%02d" hour-end minute-end)
+ nil nil ts)))
+ (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
+ (dolist (s (list repeat-string warning-string))
+ (when (org-string-nw-p s)
+ (setq ts (concat (substring ts 0 -1)
+ " "
+ s
+ (substring ts -1)))))
+ ;; Return value.
+ ts)))
+ (type (org-element-property :type timestamp)))
+ (case type
+ ((active inactive)
+ (let* ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp))
+ (time-range-p (and hour-start hour-end minute-start minute-end
+ (or (/= hour-start hour-end)
+ (/= minute-start minute-end)))))
+ (funcall
+ build-ts-string
+ (encode-time 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active)
+ (and hour-start minute-start)
+ (and time-range-p hour-end)
+ (and time-range-p minute-end))))
+ ((active-range inactive-range)
+ (let ((minute-start (org-element-property :minute-start timestamp))
+ (minute-end (org-element-property :minute-end timestamp))
+ (hour-start (org-element-property :hour-start timestamp))
+ (hour-end (org-element-property :hour-end timestamp)))
+ (concat
+ (funcall
+ build-ts-string (encode-time
+ 0
+ (or minute-start 0)
+ (or hour-start 0)
+ (org-element-property :day-start timestamp)
+ (org-element-property :month-start timestamp)
+ (org-element-property :year-start timestamp))
+ (eq type 'active-range)
+ (and hour-start minute-start))
+ "--"
+ (funcall build-ts-string
+ (encode-time 0
+ (or minute-end 0)
+ (or hour-end 0)
+ (org-element-property :day-end timestamp)
+ (org-element-property :month-end timestamp)
+ (org-element-property :year-end timestamp))
+ (eq type 'active-range)
+ (and hour-end minute-end)))))
+ (otherwise (org-element-property :raw-value timestamp)))))
;;;; Underline
(defun org-element-underline-parser ()
- "Parse underline object at point.
+ "Parse underline object at point, if any.
-Return a list whose CAR is `underline' and CDR is a plist with
-`:begin', `:end', `:contents-begin' and `:contents-end' and
-`:post-blank' keywords.
+When at an underline object, return a list whose car is
+`underline' and cdr is a plist with `:begin', `:end',
+`:contents-begin' and `:contents-end' and `:post-blank' keywords.
+Otherwise, return nil.
Assume point is at the first underscore marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'underline
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (contents-begin (match-beginning 4))
+ (contents-end (match-end 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'underline
+ (list :begin begin
+ :end end
+ :contents-begin contents-begin
+ :contents-end contents-end
+ :post-blank post-blank))))))
(defun org-element-underline-interpreter (underline contents)
"Interpret UNDERLINE object as Org syntax.
@@ -3781,25 +3654,26 @@ CONTENTS is the contents of the object."
;;;; Verbatim
(defun org-element-verbatim-parser ()
- "Parse verbatim object at point.
+ "Parse verbatim object at point, if any.
-Return a list whose CAR is `verbatim' and CDR is a plist with
-`:value', `:begin', `:end' and `:post-blank' keywords.
+When at a verbatim object, return a list whose car is `verbatim'
+and cdr is a plist with `:value', `:begin', `:end' and
+`:post-blank' keywords. Otherwise, return nil.
Assume point is at the first equal sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
- (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'verbatim
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank)))))
+ (when (looking-at org-emph-re)
+ (let ((begin (match-beginning 2))
+ (value (org-match-string-no-properties 4))
+ (post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t")))
+ (end (point)))
+ (list 'verbatim
+ (list :value value
+ :begin begin
+ :end end
+ :post-blank post-blank))))))
(defun org-element-verbatim-interpreter (verbatim contents)
"Interpret VERBATIM object as Org syntax.
@@ -3818,10 +3692,9 @@ CONTENTS is nil."
;; are activated for fixed element chaining (e.g., `plain-list' >
;; `item') or fixed conditional element chaining (e.g., `headline' >
;; `section'). Special modes are: `first-section', `item',
-;; `node-property', `quote-section', `section' and `table-row'.
+;; `node-property', `section' and `table-row'.
-(defun org-element--current-element
- (limit &optional granularity special structure)
+(defun org-element--current-element (limit &optional granularity mode structure)
"Parse the element starting at point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -3838,12 +3711,12 @@ recursion. Allowed values are `headline', `greater-element',
nil), secondary values will not be parsed, since they only
contain objects.
-Optional argument SPECIAL, when non-nil, can be either
-`first-section', `item', `node-property', `quote-section',
-`section', and `table-row'.
+Optional argument MODE, when non-nil, can be either
+`first-section', `section', `planning', `item', `node-property'
+and `table-row'.
-If STRUCTURE isn't provided but SPECIAL is set to `item', it will
-be computed.
+If STRUCTURE isn't provided but MODE is set to `item', it will be
+computed.
This function assumes point is always at the beginning of the
element it has to parse."
@@ -3855,30 +3728,33 @@ element it has to parse."
(raw-secondary-p (and granularity (not (eq granularity 'object)))))
(cond
;; Item.
- ((eq special 'item)
+ ((eq mode 'item)
(org-element-item-parser limit structure raw-secondary-p))
;; Table Row.
- ((eq special 'table-row) (org-element-table-row-parser limit))
+ ((eq mode 'table-row) (org-element-table-row-parser limit))
;; Node Property.
- ((eq special 'node-property) (org-element-node-property-parser limit))
+ ((eq mode 'node-property) (org-element-node-property-parser limit))
;; Headline.
((org-with-limited-levels (org-at-heading-p))
(org-element-headline-parser limit raw-secondary-p))
;; Sections (must be checked after headline).
- ((eq special 'section) (org-element-section-parser limit))
- ((eq special 'quote-section) (org-element-quote-section-parser limit))
- ((eq special 'first-section)
+ ((eq mode 'section) (org-element-section-parser limit))
+ ((eq mode 'first-section)
(org-element-section-parser
(or (save-excursion (org-with-limited-levels (outline-next-heading)))
limit)))
+ ;; Planning.
+ ((and (eq mode 'planning) (looking-at org-planning-line-re))
+ (org-element-planning-parser limit))
+ ;; Property drawer.
+ ((and (memq mode '(planning property-drawer))
+ (looking-at org-property-drawer-re))
+ (org-element-property-drawer-parser limit))
;; When not at bol, point is at the beginning of an item or
;; a footnote definition: next item is always a paragraph.
((not (bolp)) (org-element-paragraph-parser limit (list (point))))
- ;; Planning and Clock.
- ((looking-at org-planning-or-clock-line-re)
- (if (equal (match-string 1) org-clock-string)
- (org-element-clock-parser limit)
- (org-element-planning-parser limit)))
+ ;; Clock.
+ ((looking-at org-clock-line-re) (org-element-clock-parser limit))
;; Inlinetask.
((org-at-heading-p)
(org-element-inlinetask-parser limit raw-secondary-p))
@@ -3891,13 +3767,11 @@ element it has to parse."
(goto-char (car affiliated))
(org-element-keyword-parser limit nil))
;; LaTeX Environment.
- ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}\\(\\[.*?\\]\\|{.*?}\\)*[ \t]*$")
+ ((looking-at org-element--latex-begin-environment)
(org-element-latex-environment-parser limit affiliated))
;; Drawer and Property Drawer.
((looking-at org-drawer-regexp)
- (if (equal (match-string 1) "PROPERTIES")
- (org-element-property-drawer-parser limit affiliated)
- (org-element-drawer-parser limit affiliated)))
+ (org-element-drawer-parser limit affiliated))
;; Fixed Width
((looking-at "[ \t]*:\\( \\|$\\)")
(org-element-fixed-width-parser limit affiliated))
@@ -3936,7 +3810,8 @@ element it has to parse."
((looking-at "%%(")
(org-element-diary-sexp-parser limit affiliated))
;; Table.
- ((org-at-table-p t) (org-element-table-parser limit affiliated))
+ ((looking-at "[ \t]*\\(|\\|\\+\\(-+\\+\\)+[ \t]*$\\)")
+ (org-element-table-parser limit affiliated))
;; List.
((looking-at (org-item-re))
(org-element-plain-list-parser
@@ -3980,7 +3855,7 @@ position of point and CDR is nil."
(save-match-data
(org-trim
(buffer-substring-no-properties
- (match-end 0) (point-at-eol)))))
+ (match-end 0) (line-end-position)))))
;; PARSEDP is non-nil when keyword should have its
;; value parsed.
(parsedp (member kwd org-element-parsed-keywords))
@@ -3991,12 +3866,17 @@ position of point and CDR is nil."
(and dualp
(let ((sec (org-match-string-no-properties 2)))
(if (or (not sec) (not parsedp)) sec
- (org-element-parse-secondary-string sec restrict)))))
+ (org-element--parse-objects
+ (match-beginning 2) (match-end 2) nil restrict)))))
;; Attribute a property name to KWD.
(kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
;; Now set final shape for VALUE.
(when parsedp
- (setq value (org-element-parse-secondary-string value restrict)))
+ (setq value
+ (org-element--parse-objects
+ (match-end 0)
+ (progn (end-of-line) (skip-chars-backward " \t") (point))
+ nil restrict)))
(when dualp
(setq value (and (or value dual-value) (cons value dual-value))))
(when (or (member kwd org-element-multiple-keywords)
@@ -4089,23 +3969,28 @@ looked after.
Optional argument PARENT, when non-nil, is the element or object
containing the secondary string. It is used to set correctly
-`:parent' property within the string."
- (let ((local-variables (buffer-local-variables)))
- (with-temp-buffer
- (dolist (v local-variables)
- (ignore-errors
- (if (symbolp v) (makunbound v)
- (org-set-local (car v) (cdr v)))))
- (insert string)
- (restore-buffer-modified-p nil)
- (let ((secondary (org-element--parse-objects
- (point-min) (point-max) nil restriction)))
- (when parent
- (dolist (o secondary) (org-element-put-property o :parent parent)))
- secondary))))
+`:parent' property within the string.
+
+If STRING is the empty string or nil, return nil."
+ (cond
+ ((not string) nil)
+ ((equal string "") nil)
+ (t (let ((local-variables (buffer-local-variables)))
+ (with-temp-buffer
+ (dolist (v local-variables)
+ (ignore-errors
+ (if (symbolp v) (makunbound v)
+ (org-set-local (car v) (cdr v)))))
+ (insert string)
+ (restore-buffer-modified-p nil)
+ (let ((data (org-element--parse-objects
+ (point-min) (point-max) nil restriction)))
+ (when parent
+ (dolist (o data) (org-element-put-property o :parent parent)))
+ data))))))
(defun org-element-map
- (data types fun &optional info first-match no-recursion with-affiliated)
+ (data types fun &optional info first-match no-recursion with-affiliated)
"Map a function on selected elements or objects.
DATA is a parse tree, an element, an object, a string, or a list
@@ -4141,7 +4026,7 @@ Assuming TREE is a variable containing an Org buffer parse tree,
the following example will return a flat list of all `src-block'
and `example-block' elements in it:
- \(org-element-map tree '(example-block src-block) 'identity)
+ \(org-element-map tree '(example-block src-block) #'identity)
The following snippet will find the first headline with a level
of 1 and a \"phone\" tag, and will return its beginning position:
@@ -4156,7 +4041,7 @@ of 1 and a \"phone\" tag, and will return its beginning position:
The next example will return a flat list of all `plain-list' type
elements in TREE that are not a sub-list themselves:
- \(org-element-map tree 'plain-list 'identity nil nil 'plain-list)
+ \(org-element-map tree 'plain-list #'identity nil nil 'plain-list)
Eventually, this example will return a flat list of all `bold'
type objects containing a `latex-snippet' type object, even
@@ -4164,112 +4049,98 @@ looking into captions:
\(org-element-map tree 'bold
\(lambda (b)
- \(and (org-element-map b 'latex-snippet 'identity nil t) b))
+ \(and (org-element-map b 'latex-snippet #'identity nil t) b))
nil nil nil t)"
;; Ensure TYPES and NO-RECURSION are a list, even of one element.
- (unless (listp types) (setq types (list types)))
- (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
- ;; Recursion depth is determined by --CATEGORY.
- (let* ((--category
+ (let* ((types (if (listp types) types (list types)))
+ (no-recursion (if (listp no-recursion) no-recursion
+ (list no-recursion)))
+ ;; Recursion depth is determined by --CATEGORY.
+ (--category
(catch 'found
- (let ((category 'greater-elements))
- (mapc (lambda (type)
- (cond ((or (memq type org-element-all-objects)
- (eq type 'plain-text))
- ;; If one object is found, the function
- ;; has to recurse into every object.
- (throw 'found 'objects))
- ((not (memq type org-element-greater-elements))
- ;; If one regular element is found, the
- ;; function has to recurse, at least,
- ;; into every element it encounters.
- (and (not (eq category 'elements))
- (setq category 'elements)))))
- types)
- category)))
- ;; Compute properties for affiliated keywords if necessary.
- (--affiliated-alist
- (and with-affiliated
- (mapcar (lambda (kwd)
- (cons kwd (intern (concat ":" (downcase kwd)))))
- org-element-affiliated-keywords)))
+ (let ((category 'greater-elements)
+ (all-objects (cons 'plain-text org-element-all-objects)))
+ (dolist (type types category)
+ (cond ((memq type all-objects)
+ ;; If one object is found, the function has to
+ ;; recurse into every object.
+ (throw 'found 'objects))
+ ((not (memq type org-element-greater-elements))
+ ;; If one regular element is found, the
+ ;; function has to recurse, at least, into
+ ;; every element it encounters.
+ (and (not (eq category 'elements))
+ (setq category 'elements))))))))
--acc
--walk-tree
(--walk-tree
- (function
- (lambda (--data)
- ;; Recursively walk DATA. INFO, if non-nil, is a plist
- ;; holding contextual information.
- (let ((--type (org-element-type --data)))
- (cond
- ((not --data))
- ;; Ignored element in an export context.
- ((and info (memq --data (plist-get info :ignore-list))))
- ;; List of elements or objects.
- ((not --type) (mapc --walk-tree --data))
- ;; Unconditionally enter parse trees.
- ((eq --type 'org-data)
- (mapc --walk-tree (org-element-contents --data)))
- (t
- ;; Check if TYPE is matching among TYPES. If so,
- ;; apply FUN to --DATA and accumulate return value
- ;; into --ACC (or exit if FIRST-MATCH is non-nil).
- (when (memq --type types)
- (let ((result (funcall fun --data)))
- (cond ((not result))
- (first-match (throw '--map-first-match result))
- (t (push result --acc)))))
- ;; If --DATA has a secondary string that can contain
- ;; objects with their type among TYPES, look into it.
- (when (and (eq --category 'objects) (not (stringp --data)))
- (let ((sec-prop
- (assq --type org-element-secondary-value-alist)))
- (when sec-prop
- (funcall --walk-tree
- (org-element-property (cdr sec-prop) --data)))))
- ;; If --DATA has any affiliated keywords and
- ;; WITH-AFFILIATED is non-nil, look for objects in
- ;; them.
- (when (and with-affiliated
- (eq --category 'objects)
- (memq --type org-element-all-elements))
- (mapc (lambda (kwd-pair)
- (let ((kwd (car kwd-pair))
- (value (org-element-property
- (cdr kwd-pair) --data)))
- ;; Pay attention to the type of value.
- ;; Preserve order for multiple keywords.
- (cond
- ((not value))
- ((and (member kwd org-element-multiple-keywords)
- (member kwd org-element-dual-keywords))
- (mapc (lambda (line)
- (funcall --walk-tree (cdr line))
- (funcall --walk-tree (car line)))
- (reverse value)))
- ((member kwd org-element-multiple-keywords)
- (mapc (lambda (line) (funcall --walk-tree line))
- (reverse value)))
- ((member kwd org-element-dual-keywords)
- (funcall --walk-tree (cdr value))
- (funcall --walk-tree (car value)))
- (t (funcall --walk-tree value)))))
- --affiliated-alist))
- ;; Determine if a recursion into --DATA is possible.
- (cond
- ;; --TYPE is explicitly removed from recursion.
- ((memq --type no-recursion))
- ;; --DATA has no contents.
- ((not (org-element-contents --data)))
- ;; Looking for greater elements but --DATA is simply
- ;; an element or an object.
- ((and (eq --category 'greater-elements)
- (not (memq --type org-element-greater-elements))))
- ;; Looking for elements but --DATA is an object.
- ((and (eq --category 'elements)
- (memq --type org-element-all-objects)))
- ;; In any other case, map contents.
- (t (mapc --walk-tree (org-element-contents --data)))))))))))
+ (lambda (--data)
+ ;; Recursively walk DATA. INFO, if non-nil, is a plist
+ ;; holding contextual information.
+ (let ((--type (org-element-type --data)))
+ (cond
+ ((not --data))
+ ;; Ignored element in an export context.
+ ((and info (memq --data (plist-get info :ignore-list))))
+ ;; List of elements or objects.
+ ((not --type) (mapc --walk-tree --data))
+ ;; Unconditionally enter parse trees.
+ ((eq --type 'org-data)
+ (mapc --walk-tree (org-element-contents --data)))
+ (t
+ ;; Check if TYPE is matching among TYPES. If so,
+ ;; apply FUN to --DATA and accumulate return value
+ ;; into --ACC (or exit if FIRST-MATCH is non-nil).
+ (when (memq --type types)
+ (let ((result (funcall fun --data)))
+ (cond ((not result))
+ (first-match (throw '--map-first-match result))
+ (t (push result --acc)))))
+ ;; If --DATA has a secondary string that can contain
+ ;; objects with their type among TYPES, look into it.
+ (when (and (eq --category 'objects) (not (stringp --data)))
+ (dolist (p (cdr (assq --type
+ org-element-secondary-value-alist)))
+ (funcall --walk-tree (org-element-property p --data))))
+ ;; If --DATA has any parsed affiliated keywords and
+ ;; WITH-AFFILIATED is non-nil, look for objects in
+ ;; them.
+ (when (and with-affiliated
+ (eq --category 'objects)
+ (memq --type org-element-all-elements))
+ (dolist (kwd-pair org-element--parsed-properties-alist)
+ (let ((kwd (car kwd-pair))
+ (value (org-element-property (cdr kwd-pair) --data)))
+ ;; Pay attention to the type of parsed keyword.
+ ;; In particular, preserve order for multiple
+ ;; keywords.
+ (cond
+ ((not value))
+ ((member kwd org-element-dual-keywords)
+ (if (member kwd org-element-multiple-keywords)
+ (dolist (line (reverse value))
+ (funcall --walk-tree (cdr line))
+ (funcall --walk-tree (car line)))
+ (funcall --walk-tree (cdr value))
+ (funcall --walk-tree (car value))))
+ ((member kwd org-element-multiple-keywords)
+ (mapc --walk-tree (reverse value)))
+ (t (funcall --walk-tree value))))))
+ ;; Determine if a recursion into --DATA is possible.
+ (cond
+ ;; --TYPE is explicitly removed from recursion.
+ ((memq --type no-recursion))
+ ;; --DATA has no contents.
+ ((not (org-element-contents --data)))
+ ;; Looking for greater elements but --DATA is simply
+ ;; an element or an object.
+ ((and (eq --category 'greater-elements)
+ (not (memq --type org-element-greater-elements))))
+ ;; Looking for elements but --DATA is an object.
+ ((and (eq --category 'elements)
+ (memq --type org-element-all-objects)))
+ ;; In any other case, map contents.
+ (t (mapc --walk-tree (org-element-contents --data))))))))))
(catch '--map-first-match
(funcall --walk-tree data)
;; Return value in a proper order.
@@ -4282,24 +4153,37 @@ looking into captions:
;; level.
;;
;; The second one, `org-element--parse-objects' applies on all objects
-;; of a paragraph or a secondary string. It uses
-;; `org-element--get-next-object-candidates' to optimize the search of
-;; the next object in the buffer.
-;;
-;; More precisely, that function looks for every allowed object type
-;; first. Then, it discards failed searches, keeps further matches,
-;; and searches again types matched behind point, for subsequent
-;; calls. Thus, searching for a given type fails only once, and every
-;; object is searched only once at top level (but sometimes more for
-;; nested types).
+;; of a paragraph or a secondary string. It calls
+;; `org-element--object-lex' to find the next object in the current
+;; container.
+
+(defsubst org-element--next-mode (type parentp)
+ "Return next special mode according to TYPE, or nil.
+TYPE is a symbol representing the type of an element or object
+containing next element if PARENTP is non-nil, or before it
+otherwise. Modes can be either `first-section', `item',
+`node-property', `planning', `property-drawer', `section',
+`table-row' or nil."
+ (if parentp
+ (case type
+ (headline 'section)
+ (plain-list 'item)
+ (property-drawer 'node-property)
+ (section 'planning)
+ (table 'table-row))
+ (case type
+ (item 'item)
+ (node-property 'node-property)
+ (planning 'property-drawer)
+ (table-row 'table-row))))
(defun org-element--parse-elements
- (beg end special structure granularity visible-only acc)
+ (beg end mode structure granularity visible-only acc)
"Parse elements between BEG and END positions.
-SPECIAL prioritize some elements over the others. It can be set
-to `first-section', `quote-section', `section' `item' or
-`table-row'.
+MODE prioritizes some elements over the others. It can be set to
+`first-section', `section', `planning', `item', `node-property'
+or `table-row'.
When value is `item', STRUCTURE will be used as the current list
structure.
@@ -4325,7 +4209,7 @@ Elements are accumulated into ACC."
;; Find current element's type and parse it accordingly to
;; its category.
(let* ((element (org-element--current-element
- end granularity special structure))
+ end granularity mode structure))
(type (org-element-type element))
(cbeg (org-element-property :contents-begin element)))
(goto-char (org-element-property :end element))
@@ -4348,13 +4232,7 @@ Elements are accumulated into ACC."
(org-element--parse-elements
cbeg (org-element-property :contents-end element)
;; Possibly switch to a special mode.
- (case type
- (headline
- (if (org-element-property :quotedp element) 'quote-section
- 'section))
- (plain-list 'item)
- (property-drawer 'node-property)
- (table 'table-row))
+ (org-element--next-mode type t)
(and (memq type '(item plain-list))
(org-element-property :structure element))
granularity visible-only element))
@@ -4364,10 +4242,99 @@ Elements are accumulated into ACC."
(org-element--parse-objects
cbeg (org-element-property :contents-end element) element
(org-element-restriction type))))
- (org-element-adopt-elements acc element)))
+ (org-element-adopt-elements acc element)
+ ;; Update mode.
+ (setq mode (org-element--next-mode type nil))))
;; Return result.
acc))
+(defun org-element--object-lex (restriction)
+ "Return next object in current buffer or nil.
+RESTRICTION is a list of object types, as symbols, that should be
+looked after. This function assumes that the buffer is narrowed
+to an appropriate container (e.g., a paragraph)."
+ (if (memq 'table-cell restriction) (org-element-table-cell-parser)
+ (save-excursion
+ (let ((limit (and org-target-link-regexp
+ (save-excursion
+ (or (bolp) (backward-char))
+ (re-search-forward org-target-link-regexp nil t))
+ (match-beginning 1)))
+ found)
+ (while (and (not found)
+ (re-search-forward org-element--object-regexp limit t))
+ (goto-char (match-beginning 0))
+ (let ((result (match-string 0)))
+ (setq found
+ (cond
+ ((eq (compare-strings result nil nil "call_" nil nil t) t)
+ (and (memq 'inline-babel-call restriction)
+ (org-element-inline-babel-call-parser)))
+ ((eq (compare-strings result nil nil "src_" nil nil t) t)
+ (and (memq 'inline-src-block restriction)
+ (org-element-inline-src-block-parser)))
+ (t
+ (case (char-after)
+ (?^ (and (memq 'superscript restriction)
+ (org-element-superscript-parser)))
+ (?_ (or (and (memq 'subscript restriction)
+ (org-element-subscript-parser))
+ (and (memq 'underline restriction)
+ (org-element-underline-parser))))
+ (?* (and (memq 'bold restriction)
+ (org-element-bold-parser)))
+ (?/ (and (memq 'italic restriction)
+ (org-element-italic-parser)))
+ (?~ (and (memq 'code restriction)
+ (org-element-code-parser)))
+ (?= (and (memq 'verbatim restriction)
+ (org-element-verbatim-parser)))
+ (?+ (and (memq 'strike-through restriction)
+ (org-element-strike-through-parser)))
+ (?@ (and (memq 'export-snippet restriction)
+ (org-element-export-snippet-parser)))
+ (?{ (and (memq 'macro restriction)
+ (org-element-macro-parser)))
+ (?$ (and (memq 'latex-fragment restriction)
+ (org-element-latex-fragment-parser)))
+ (?<
+ (if (eq (aref result 1) ?<)
+ (or (and (memq 'radio-target restriction)
+ (org-element-radio-target-parser))
+ (and (memq 'target restriction)
+ (org-element-target-parser)))
+ (or (and (memq 'timestamp restriction)
+ (org-element-timestamp-parser))
+ (and (memq 'link restriction)
+ (org-element-link-parser)))))
+ (?\\
+ (if (eq (aref result 1) ?\\)
+ (and (memq 'line-break restriction)
+ (org-element-line-break-parser))
+ (or (and (memq 'entity restriction)
+ (org-element-entity-parser))
+ (and (memq 'latex-fragment restriction)
+ (org-element-latex-fragment-parser)))))
+ (?\[
+ (if (eq (aref result 1) ?\[)
+ (and (memq 'link restriction)
+ (org-element-link-parser))
+ (or (and (memq 'footnote-reference restriction)
+ (org-element-footnote-reference-parser))
+ (and (memq 'timestamp restriction)
+ (org-element-timestamp-parser))
+ (and (memq 'statistics-cookie restriction)
+ (org-element-statistics-cookie-parser)))))
+ ;; This is probably a plain link.
+ (otherwise (and (or (memq 'link restriction)
+ (memq 'plain-link restriction))
+ (org-element-link-parser)))))))
+ (or (eobp) (forward-char))))
+ (cond (found)
+ ;; Radio link.
+ ((and limit (memq 'link restriction))
+ (goto-char limit) (org-element-link-parser)))))))
+
(defun org-element--parse-objects (beg end acc restriction)
"Parse objects between BEG and END and return recursive structure.
@@ -4375,85 +4342,44 @@ Objects are accumulated in ACC.
RESTRICTION is a list of object successors which are allowed in
the current object."
- (let ((candidates 'initial))
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (let (next-object)
(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
- 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.
-
-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
-RESTRICTION should be looked after.
-
-Return value is an alist whose CAR is the object type and CDR its
-beginning position."
- (delq
- nil
- (if (eq objects 'initial)
- ;; When searching for the first time, look for every successor
- ;; allowed in RESTRICTION.
- (mapcar
- (lambda (res)
- (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.
- (mapcar
- (lambda (obj)
- (if (>= (cdr obj) (point)) obj
- (let* ((type (car obj))
- (succ (or (cdr (assq type org-element-object-successor-alist))
- type)))
- (and succ
- (funcall (intern (format "org-element-%s-successor" succ)))))))
- objects))))
+ (setq next-object (org-element--object-lex restriction)))
+ ;; 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
+ 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)))
@@ -4468,71 +4394,77 @@ beginning position."
;; `org-element--interpret-affiliated-keywords'.
;;;###autoload
-(defun org-element-interpret-data (data &optional parent)
+(defun org-element-interpret-data (data)
"Interpret DATA as Org syntax.
-
DATA is a parse tree, an element, an object or a secondary string
-to interpret.
+to interpret. Return Org syntax as a string."
+ (org-element--interpret-data-1 data nil))
-Optional argument PARENT is used for recursive calls. It contains
+(defun org-element--interpret-data-1 (data parent)
+ "Interpret DATA as Org syntax.
+
+DATA is a parse tree, an element, an object or a secondary string
+to interpret. PARENT is used for recursive calls. It contains
the element or object containing data, or nil.
Return Org syntax as a string."
(let* ((type (org-element-type data))
+ ;; Find interpreter for current object or element. If it
+ ;; doesn't exist (e.g. this is a pseudo object or element),
+ ;; return contents, if any.
+ (interpret
+ (let ((fun (intern (format "org-element-%s-interpreter" type))))
+ (if (fboundp fun) fun (lambda (data contents) contents))))
(results
(cond
;; Secondary string.
((not type)
(mapconcat
- (lambda (obj) (org-element-interpret-data obj parent))
- data ""))
+ (lambda (obj) (org-element--interpret-data-1 obj parent)) data ""))
;; Full Org document.
((eq type 'org-data)
- (mapconcat
- (lambda (obj) (org-element-interpret-data obj parent))
- (org-element-contents data) ""))
+ (mapconcat (lambda (obj) (org-element--interpret-data-1 obj parent))
+ (org-element-contents data) ""))
;; Plain text: return it.
((stringp data) data)
- ;; Element/Object without contents.
- ((not (org-element-contents data))
- (funcall (intern (format "org-element-%s-interpreter" type))
- data nil))
- ;; Element/Object with contents.
+ ;; Element or object without contents.
+ ((not (org-element-contents data)) (funcall interpret data nil))
+ ;; Element or object with contents.
(t
- (let* ((greaterp (memq type org-element-greater-elements))
- (objectp (and (not greaterp)
- (memq type org-element-recursive-objects)))
- (contents
- (mapconcat
- (lambda (obj) (org-element-interpret-data obj data))
- (org-element-contents
- (if (or greaterp objectp) data
- ;; Elements directly containing objects must
- ;; have their indentation normalized first.
- (org-element-normalize-contents
- data
- ;; When normalizing first paragraph of an
- ;; item or a footnote-definition, ignore
- ;; first line's indentation.
- (and (eq type 'paragraph)
- (equal data (car (org-element-contents parent)))
- (memq (org-element-type parent)
- '(footnote-definition item))))))
- "")))
- (funcall (intern (format "org-element-%s-interpreter" type))
- data
- (if greaterp (org-element-normalize-contents contents)
- contents)))))))
+ (funcall interpret data
+ ;; Recursively interpret contents.
+ (mapconcat
+ (lambda (obj) (org-element--interpret-data-1 obj data))
+ (org-element-contents
+ (if (not (memq type '(paragraph verse-block)))
+ data
+ ;; Fix indentation of elements containing
+ ;; objects. We ignore `table-row' elements
+ ;; as they are one line long anyway.
+ (org-element-normalize-contents
+ data
+ ;; When normalizing first paragraph of an
+ ;; item or a footnote-definition, ignore
+ ;; first line's indentation.
+ (and (eq type 'paragraph)
+ (equal data (car (org-element-contents parent)))
+ (memq (org-element-type parent)
+ '(footnote-definition item))))))
+ ""))))))
(if (memq type '(org-data plain-text nil)) results
;; Build white spaces. If no `:post-blank' property is
;; specified, assume its value is 0.
(let ((post-blank (or (org-element-property :post-blank data) 0)))
- (if (memq type org-element-all-objects)
- (concat results (make-string post-blank 32))
+ (if (or (memq type org-element-all-objects)
+ (and parent
+ (let ((type (org-element-type parent)))
+ (or (not type)
+ (memq type org-element-object-containers)))))
+ (concat results (make-string post-blank ?\s))
(concat
(org-element--interpret-affiliated-keywords data)
(org-element-normalize-string results)
- (make-string post-blank 10)))))))
+ (make-string post-blank ?\n)))))))
(defun org-element--interpret-affiliated-keywords (element)
"Return ELEMENT's affiliated keywords as Org syntax.
@@ -4616,25 +4548,29 @@ indentation is not done with TAB characters."
(find-min-ind
;; Return minimal common indentation within BLOB. This is
;; done by walking recursively BLOB and updating MIN-IND
- ;; along the way. FIRST-FLAG is non-nil when the first
- ;; string hasn't been seen yet. It is required as this
- ;; string is the only one whose indentation doesn't happen
- ;; after a newline character.
+ ;; along the way. FIRST-FLAG is non-nil when the next
+ ;; object is expected to be a string that doesn't start with
+ ;; a newline character. It happens for strings at the
+ ;; beginnings of the contents or right after a line break.
(lambda (blob first-flag)
(dolist (object (org-element-contents blob))
- (when (and first-flag (stringp object))
+ (when first-flag
(setq first-flag nil)
- (string-match "\\` *" object)
- (let ((len (match-end 0)))
- ;; An indentation of zero means no string will be
- ;; modified. Quit the process.
- (if (zerop len) (throw 'zero (setq min-ind 0))
- (setq min-ind (min len min-ind)))))
+ ;; Objects cannot start with spaces: in this case,
+ ;; indentation is 0.
+ (if (not (stringp object)) (throw 'zero (setq min-ind 0))
+ (string-match "\\` *" object)
+ (let ((len (match-end 0)))
+ ;; An indentation of zero means no string will be
+ ;; modified. Quit the process.
+ (if (zerop len) (throw 'zero (setq min-ind 0))
+ (setq min-ind (min len min-ind))))))
(cond
((stringp object)
(dolist (line (cdr (org-split-string object " *\n")))
(unless (string= line "")
(setq min-ind (min (org-get-indentation line) min-ind)))))
+ ((eq (org-element-type object) 'line-break) (setq first-flag t))
((memq (org-element-type object) org-element-recursive-objects)
(funcall find-min-ind object first-flag)))))))
;; Find minimal indentation in ELEMENT.
@@ -4644,41 +4580,1056 @@ indentation is not done with TAB characters."
;; string minus common indentation.
(let* (build ; For byte compiler.
(build
- (function
- (lambda (blob first-flag)
- ;; Return BLOB with all its strings indentation
- ;; shortened from MIN-IND white spaces. FIRST-FLAG
- ;; is non-nil when the first string hasn't been seen
- ;; yet.
- (setcdr (cdr blob)
- (mapcar
- #'(lambda (object)
- (when (and first-flag (stringp object))
- (setq first-flag nil)
- (setq object
- (replace-regexp-in-string
- (format "\\` \\{%d\\}" min-ind)
- "" object)))
- (cond
- ((stringp object)
- (replace-regexp-in-string
- (format "\n \\{%d\\}" min-ind) "\n" object))
- ((memq (org-element-type object)
- org-element-recursive-objects)
- (funcall build object first-flag))
- (t object)))
- (org-element-contents blob)))
- blob))))
+ (lambda (blob first-flag)
+ ;; Return BLOB with all its strings indentation
+ ;; shortened from MIN-IND white spaces. FIRST-FLAG is
+ ;; non-nil when the next object is expected to be
+ ;; a string that doesn't start with a newline
+ ;; character.
+ (setcdr (cdr blob)
+ (mapcar
+ (lambda (object)
+ (when first-flag
+ (setq first-flag nil)
+ (when (stringp object)
+ (setq object
+ (replace-regexp-in-string
+ (format "\\` \\{%d\\}" min-ind)
+ "" object))))
+ (cond
+ ((stringp object)
+ (replace-regexp-in-string
+ (format "\n \\{%d\\}" min-ind) "\n" object))
+ ((memq (org-element-type object)
+ org-element-recursive-objects)
+ (funcall build object first-flag))
+ ((eq (org-element-type object) 'line-break)
+ (setq first-flag t)
+ object)
+ (t object)))
+ (org-element-contents blob)))
+ blob)))
(funcall build element (not ignore-first))))))
+;;; Cache
+;;
+;; Implement a caching mechanism for `org-element-at-point' and
+;; `org-element-context', which see.
+;;
+;; A single public function is provided: `org-element-cache-reset'.
+;;
+;; Cache is enabled by default, but can be disabled globally with
+;; `org-element-use-cache'. `org-element-cache-sync-idle-time',
+;; org-element-cache-sync-duration' and `org-element-cache-sync-break'
+;; can be tweaked to control caching behaviour.
+;;
+;; Internally, parsed elements are stored in an AVL tree,
+;; `org-element--cache'. This tree is updated lazily: whenever
+;; a change happens to the buffer, a synchronization request is
+;; registered in `org-element--cache-sync-requests' (see
+;; `org-element--cache-submit-request'). During idle time, requests
+;; are processed by `org-element--cache-sync'. Synchronization also
+;; happens when an element is required from the cache. In this case,
+;; the process stops as soon as the needed element is up-to-date.
+;;
+;; A synchronization request can only apply on a synchronized part of
+;; the cache. Therefore, the cache is updated at least to the
+;; location where the new request applies. Thus, requests are ordered
+;; from left to right and all elements starting before the first
+;; request are correct. This property is used by functions like
+;; `org-element--cache-find' to retrieve elements in the part of the
+;; cache that can be trusted.
+;;
+;; A request applies to every element, starting from its original
+;; location (or key, see below). When a request is processed, it
+;; moves forward and may collide the next one. In this case, both
+;; requests are merged into a new one that starts from that element.
+;; As a consequence, the whole synchronization complexity does not
+;; depend on the number of pending requests, but on the number of
+;; elements the very first request will be applied on.
+;;
+;; Elements cannot be accessed through their beginning position, which
+;; may or may not be up-to-date. Instead, each element in the tree is
+;; associated to a key, obtained with `org-element--cache-key'. This
+;; mechanism is robust enough to preserve total order among elements
+;; even when the tree is only partially synchronized.
+;;
+;; Objects contained in an element are stored in a hash table,
+;; `org-element--cache-objects'.
+
+
+(defvar org-element-use-cache t
+ "Non nil when Org parser should cache its results.
+This is mostly for debugging purpose.")
+
+(defvar org-element-cache-sync-idle-time 0.6
+ "Length, in seconds, of idle time before syncing cache.")
+
+(defvar org-element-cache-sync-duration (seconds-to-time 0.04)
+ "Maximum duration, as a time value, for a cache synchronization.
+If the synchronization is not over after this delay, the process
+pauses and resumes after `org-element-cache-sync-break'
+seconds.")
+
+(defvar org-element-cache-sync-break (seconds-to-time 0.3)
+ "Duration, as a time value, of the pause between synchronizations.
+See `org-element-cache-sync-duration' for more information.")
+
+
+;;;; Data Structure
+
+(defvar org-element--cache nil
+ "AVL tree used to cache elements.
+Each node of the tree contains an element. Comparison is done
+with `org-element--cache-compare'. This cache is used in
+`org-element-at-point'.")
+
+(defvar org-element--cache-objects nil
+ "Hash table used as to cache objects.
+Key is an element, as returned by `org-element-at-point', and
+value is an alist where each association is:
+
+ \(PARENT COMPLETEP . OBJECTS)
+
+where PARENT is an element or object, COMPLETEP is a boolean,
+non-nil when all direct children of parent are already cached and
+OBJECTS is a list of such children, as objects, from farthest to
+closest.
+
+In the following example, \\alpha, bold object and \\beta are
+contained within a paragraph
+
+ \\alpha *\\beta*
+
+If the paragraph is completely parsed, OBJECTS-DATA will be
+
+ \((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
+ \(BOLD-OBJECT t ENTITY-OBJECT))
+
+whereas in a partially parsed paragraph, it could be
+
+ \((PARAGRAPH nil ENTITY-OBJECT))
+
+This cache is used in `org-element-context'.")
+
+(defvar org-element--cache-sync-requests nil
+ "List of pending synchronization requests.
+
+A request is a vector with the following pattern:
+
+ \[NEXT BEG END OFFSET PARENT PHASE]
+
+Processing a synchronization request consists of three phases:
+
+ 0. Delete modified elements,
+ 1. Fill missing area in cache,
+ 2. Shift positions and re-parent elements after the changes.
+
+During phase 0, NEXT is the key of the first element to be
+removed, BEG and END is buffer position delimiting the
+modifications. Elements starting between them (inclusive) are
+removed. So are elements whose parent is removed. PARENT, when
+non-nil, is the parent of the first element to be removed.
+
+During phase 1, NEXT is the key of the next known element in
+cache and BEG its beginning position. Parse buffer between that
+element and the one before it in order to determine the parent of
+the next element. Set PARENT to the element containing NEXT.
+
+During phase 2, NEXT is the key of the next element to shift in
+the parse tree. All elements starting from this one have their
+properties relatives to buffer positions shifted by integer
+OFFSET and, if they belong to element PARENT, are adopted by it.
+
+PHASE specifies the phase number, as an integer.")
+
+(defvar org-element--cache-sync-timer nil
+ "Timer used for cache synchronization.")
+
+(defvar org-element--cache-sync-keys nil
+ "Hash table used to store keys during synchronization.
+See `org-element--cache-key' for more information.")
+
+(defsubst org-element--cache-key (element)
+ "Return a unique key for ELEMENT in cache tree.
+
+Keys are used to keep a total order among elements in the cache.
+Comparison is done with `org-element--cache-key-less-p'.
+
+When no synchronization is taking place, a key is simply the
+beginning position of the element, or that position plus one in
+the case of an first item (respectively row) in
+a list (respectively a table).
+
+During a synchronization, the key is the one the element had when
+the cache was synchronized for the last time. Elements added to
+cache during the synchronization get a new key generated with
+`org-element--cache-generate-key'.
+
+Such keys are stored in `org-element--cache-sync-keys'. The hash
+table is cleared once the synchronization is complete."
+ (or (gethash element org-element--cache-sync-keys)
+ (let* ((begin (org-element-property :begin element))
+ ;; Increase beginning position of items (respectively
+ ;; table rows) by one, so the first item can get
+ ;; a different key from its parent list (respectively
+ ;; table).
+ (key (if (memq (org-element-type element) '(item table-row))
+ (1+ begin)
+ begin)))
+ (if org-element--cache-sync-requests
+ (puthash element key org-element--cache-sync-keys)
+ key))))
+
+(defun org-element--cache-generate-key (lower upper)
+ "Generate a key between LOWER and UPPER.
+
+LOWER and UPPER are integers or lists, possibly empty.
+
+If LOWER and UPPER are equals, return LOWER. Otherwise, return
+a unique key, as an integer or a list of integers, according to
+the following rules:
+
+ - LOWER and UPPER are compared level-wise until values differ.
+
+ - If, at a given level, LOWER and UPPER differ from more than
+ 2, the new key shares all the levels above with LOWER and
+ gets a new level. Its value is the mean between LOWER and
+ UPPER:
+
+ \(1 2) + (1 4) --> (1 3)
+
+ - If LOWER has no value to compare with, it is assumed that its
+ value is `most-negative-fixnum'. E.g.,
+
+ \(1 1) + (1 1 2)
+
+ is equivalent to
+
+ \(1 1 m) + (1 1 2)
+
+ where m is `most-negative-fixnum'. Likewise, if UPPER is
+ short of levels, the current value is `most-positive-fixnum'.
+
+ - If they differ from only one, the new key inherits from
+ current LOWER level and fork it at the next level. E.g.,
+
+ \(2 1) + (3 3)
+
+ is equivalent to
+
+ \(2 1) + (2 M)
+
+ where M is `most-positive-fixnum'.
+
+ - If the key is only one level long, it is returned as an
+ integer:
+
+ \(1 2) + (3 2) --> 2
+
+When they are not equals, the function assumes that LOWER is
+lesser than UPPER, per `org-element--cache-key-less-p'."
+ (if (equal lower upper) lower
+ (let ((lower (if (integerp lower) (list lower) lower))
+ (upper (if (integerp upper) (list upper) upper))
+ skip-upper key)
+ (catch 'exit
+ (while t
+ (let ((min (or (car lower) most-negative-fixnum))
+ (max (cond (skip-upper most-positive-fixnum)
+ ((car upper))
+ (t most-positive-fixnum))))
+ (if (< (1+ min) max)
+ (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1))))
+ (throw 'exit (if key (nreverse (cons mean key)) mean)))
+ (when (and (< min max) (not skip-upper))
+ ;; When at a given level, LOWER and UPPER differ from
+ ;; 1, ignore UPPER altogether. Instead create a key
+ ;; between LOWER and the greatest key with the same
+ ;; prefix as LOWER so far.
+ (setq skip-upper t))
+ (push min key)
+ (setq lower (cdr lower) upper (cdr upper)))))))))
+
+(defsubst org-element--cache-key-less-p (a b)
+ "Non-nil if key A is less than key B.
+A and B are either integers or lists of integers, as returned by
+`org-element--cache-key'."
+ (if (integerp a) (if (integerp b) (< a b) (<= a (car b)))
+ (if (integerp b) (< (car a) b)
+ (catch 'exit
+ (while (and a b)
+ (cond ((car-less-than-car a b) (throw 'exit t))
+ ((car-less-than-car b a) (throw 'exit nil))
+ (t (setq a (cdr a) b (cdr b)))))
+ ;; If A is empty, either keys are equal (B is also empty) and
+ ;; we return nil, or A is lesser than B (B is longer) and we
+ ;; return a non-nil value.
+ ;;
+ ;; If A is not empty, B is necessarily empty and A is greater
+ ;; than B (A is longer). Therefore, return nil.
+ (and (null a) b)))))
+
+(defun org-element--cache-compare (a b)
+ "Non-nil when element A is located before element B."
+ (org-element--cache-key-less-p (org-element--cache-key a)
+ (org-element--cache-key b)))
+
+(defsubst org-element--cache-root ()
+ "Return root value in cache.
+This function assumes `org-element--cache' is a valid AVL tree."
+ (avl-tree--node-left (avl-tree--dummyroot org-element--cache)))
+
+
+;;;; Tools
+
+(defsubst org-element--cache-active-p ()
+ "Non-nil when cache is active in current buffer."
+ (and org-element-use-cache
+ (or (derived-mode-p 'org-mode) orgstruct-mode)))
+
+(defun org-element--cache-find (pos &optional side)
+ "Find element in cache starting at POS or before.
+
+POS refers to a buffer position.
+
+When optional argument SIDE is non-nil, the function checks for
+elements starting at or past POS instead. If SIDE is `both', the
+function returns a cons cell where car is the first element
+starting at or before POS and cdr the first element starting
+after POS.
+
+The function can only find elements in the synchronized part of
+the cache."
+ (let ((limit (and org-element--cache-sync-requests
+ (aref (car org-element--cache-sync-requests) 0)))
+ (node (org-element--cache-root))
+ lower upper)
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (begin (org-element-property :begin element)))
+ (cond
+ ((and limit
+ (not (org-element--cache-key-less-p
+ (org-element--cache-key element) limit)))
+ (setq node (avl-tree--node-left node)))
+ ((> begin pos)
+ (setq upper element
+ node (avl-tree--node-left node)))
+ ((< begin pos)
+ (setq lower element
+ node (avl-tree--node-right node)))
+ ;; We found an element in cache starting at POS. If `side'
+ ;; is `both' we also want the next one in order to generate
+ ;; a key in-between.
+ ;;
+ ;; If the element is the first row or item in a table or
+ ;; a plain list, we always return the table or the plain
+ ;; list.
+ ;;
+ ;; In any other case, we return the element found.
+ ((eq side 'both)
+ (setq lower element)
+ (setq node (avl-tree--node-right node)))
+ ((and (memq (org-element-type element) '(item table-row))
+ (let ((parent (org-element-property :parent element)))
+ (and (= (org-element-property :begin element)
+ (org-element-property :contents-begin parent))
+ (setq node nil
+ lower parent
+ upper parent)))))
+ (t
+ (setq node nil
+ lower element
+ upper element)))))
+ (case side
+ (both (cons lower upper))
+ ((nil) lower)
+ (otherwise upper))))
+
+(defun org-element--cache-put (element &optional data)
+ "Store ELEMENT in current buffer's cache, if allowed.
+When optional argument DATA is non-nil, assume is it object data
+relative to ELEMENT and store it in the objects cache."
+ (cond ((not (org-element--cache-active-p)) nil)
+ ((not data)
+ (when org-element--cache-sync-requests
+ ;; During synchronization, first build an appropriate key
+ ;; for the new element so `avl-tree-enter' can insert it at
+ ;; the right spot in the cache.
+ (let ((keys (org-element--cache-find
+ (org-element-property :begin element) 'both)))
+ (puthash element
+ (org-element--cache-generate-key
+ (and (car keys) (org-element--cache-key (car keys)))
+ (cond ((cdr keys) (org-element--cache-key (cdr keys)))
+ (org-element--cache-sync-requests
+ (aref (car org-element--cache-sync-requests) 0))))
+ org-element--cache-sync-keys)))
+ (avl-tree-enter org-element--cache element))
+ ;; Headlines are not stored in cache, so objects in titles are
+ ;; not stored either.
+ ((eq (org-element-type element) 'headline) nil)
+ (t (puthash element data org-element--cache-objects))))
+
+(defsubst org-element--cache-remove (element)
+ "Remove ELEMENT from cache.
+Assume ELEMENT belongs to cache and that a cache is active."
+ (avl-tree-delete org-element--cache element)
+ (remhash element org-element--cache-objects))
+
+
+;;;; Synchronization
+
+(defsubst org-element--cache-set-timer (buffer)
+ "Set idle timer for cache synchronization in BUFFER."
+ (when org-element--cache-sync-timer
+ (cancel-timer org-element--cache-sync-timer))
+ (setq org-element--cache-sync-timer
+ (run-with-idle-timer
+ (let ((idle (current-idle-time)))
+ (if idle (time-add idle org-element-cache-sync-break)
+ org-element-cache-sync-idle-time))
+ nil
+ #'org-element--cache-sync
+ buffer)))
+
+(defsubst org-element--cache-interrupt-p (time-limit)
+ "Non-nil when synchronization process should be interrupted.
+TIME-LIMIT is a time value or nil."
+ (and time-limit
+ (or (input-pending-p)
+ (time-less-p time-limit (current-time)))))
+
+(defsubst org-element--cache-shift-positions (element offset &optional props)
+ "Shift ELEMENT properties relative to buffer positions by OFFSET.
+
+Properties containing buffer positions are `:begin', `:end',
+`:contents-begin', `:contents-end' and `:structure'. When
+optional argument PROPS is a list of keywords, only shift
+properties provided in that list.
+
+Properties are modified by side-effect."
+ (let ((properties (nth 1 element)))
+ ;; Shift `:structure' property for the first plain list only: it
+ ;; is the only one that really matters and it prevents from
+ ;; shifting it more than once.
+ (when (and (or (not props) (memq :structure props))
+ (eq (org-element-type element) 'plain-list)
+ (not (eq (org-element-type (plist-get properties :parent))
+ 'item)))
+ (dolist (item (plist-get properties :structure))
+ (incf (car item) offset)
+ (incf (nth 6 item) offset)))
+ (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
+ (let ((value (and (or (not props) (memq key props))
+ (plist-get properties key))))
+ (and value (plist-put properties key (+ offset value)))))))
+
+(defun org-element--cache-sync (buffer &optional threshold future-change)
+ "Synchronize cache with recent modification in BUFFER.
+
+When optional argument THRESHOLD is non-nil, do the
+synchronization for all elements starting before or at threshold,
+then exit. Otherwise, synchronize cache for as long as
+`org-element-cache-sync-duration' or until Emacs leaves idle
+state.
+
+FUTURE-CHANGE, when non-nil, is a buffer position where changes
+not registered yet in the cache are going to happen. It is used
+in `org-element--cache-submit-request', where cache is partially
+updated before current modification are actually submitted."
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (let ((inhibit-quit t) request next)
+ (when org-element--cache-sync-timer
+ (cancel-timer org-element--cache-sync-timer))
+ (catch 'interrupt
+ (while org-element--cache-sync-requests
+ (setq request (car org-element--cache-sync-requests)
+ next (nth 1 org-element--cache-sync-requests))
+ (org-element--cache-process-request
+ request
+ (and next (aref next 0))
+ threshold
+ (and (not threshold)
+ (time-add (current-time)
+ org-element-cache-sync-duration))
+ future-change)
+ ;; Request processed. Merge current and next offsets and
+ ;; transfer ending position.
+ (when next
+ (incf (aref next 3) (aref request 3))
+ (aset next 2 (aref request 2)))
+ (setq org-element--cache-sync-requests
+ (cdr org-element--cache-sync-requests))))
+ ;; If more requests are awaiting, set idle timer accordingly.
+ ;; Otherwise, reset keys.
+ (if org-element--cache-sync-requests
+ (org-element--cache-set-timer buffer)
+ (clrhash org-element--cache-sync-keys))))))
+
+(defun org-element--cache-process-request
+ (request next threshold time-limit future-change)
+ "Process synchronization REQUEST for all entries before NEXT.
+
+REQUEST is a vector, built by `org-element--cache-submit-request'.
+
+NEXT is a cache key, as returned by `org-element--cache-key'.
+
+When non-nil, THRESHOLD is a buffer position. Synchronization
+stops as soon as a shifted element begins after it.
+
+When non-nil, TIME-LIMIT is a time value. Synchronization stops
+after this time or when Emacs exits idle state.
+
+When non-nil, FUTURE-CHANGE is a buffer position where changes
+not registered yet in the cache are going to happen. See
+`org-element--cache-submit-request' for more information.
+
+Throw `interrupt' if the process stops before completing the
+request."
+ (catch 'quit
+ (when (= (aref request 5) 0)
+ ;; Phase 0.
+ ;;
+ ;; Delete all elements starting after BEG, but not after buffer
+ ;; position END or past element with key NEXT. Also delete
+ ;; elements contained within a previously removed element
+ ;; (stored in `last-container').
+ ;;
+ ;; At each iteration, we start again at tree root since
+ ;; a deletion modifies structure of the balanced tree.
+ (catch 'end-phase
+ (while t
+ (when (org-element--cache-interrupt-p time-limit)
+ (throw 'interrupt nil))
+ ;; Find first element in cache with key BEG or after it.
+ (let ((beg (aref request 0))
+ (end (aref request 2))
+ (node (org-element--cache-root))
+ data data-key last-container)
+ (while node
+ (let* ((element (avl-tree--node-data node))
+ (key (org-element--cache-key element)))
+ (cond
+ ((org-element--cache-key-less-p key beg)
+ (setq node (avl-tree--node-right node)))
+ ((org-element--cache-key-less-p beg key)
+ (setq data element
+ data-key key
+ node (avl-tree--node-left node)))
+ (t (setq data element
+ data-key key
+ node nil)))))
+ (if data
+ (let ((pos (org-element-property :begin data)))
+ (if (if (or (not next)
+ (org-element--cache-key-less-p data-key next))
+ (<= pos end)
+ (and last-container
+ (let ((up data))
+ (while (and up (not (eq up last-container)))
+ (setq up (org-element-property :parent up)))
+ up)))
+ (progn (when (and (not last-container)
+ (> (org-element-property :end data)
+ end))
+ (setq last-container data))
+ (org-element--cache-remove data))
+ (aset request 0 data-key)
+ (aset request 1 pos)
+ (aset request 5 1)
+ (throw 'end-phase nil)))
+ ;; No element starting after modifications left in
+ ;; cache: further processing is futile.
+ (throw 'quit t))))))
+ (when (= (aref request 5) 1)
+ ;; Phase 1.
+ ;;
+ ;; Phase 0 left a hole in the cache. Some elements after it
+ ;; could have parents within. For example, in the following
+ ;; buffer:
+ ;;
+ ;; - item
+ ;;
+ ;;
+ ;; Paragraph1
+ ;;
+ ;; Paragraph2
+ ;;
+ ;; if we remove a blank line between "item" and "Paragraph1",
+ ;; everything down to "Paragraph2" is removed from cache. But
+ ;; the paragraph now belongs to the list, and its `:parent'
+ ;; property no longer is accurate.
+ ;;
+ ;; Therefore we need to parse again elements in the hole, or at
+ ;; least in its last section, so that we can re-parent
+ ;; subsequent elements, during phase 2.
+ ;;
+ ;; Note that we only need to get the parent from the first
+ ;; element in cache after the hole.
+ ;;
+ ;; When next key is lesser or equal to the current one, delegate
+ ;; phase 1 processing to next request in order to preserve key
+ ;; order among requests.
+ (let ((key (aref request 0)))
+ (when (and next (not (org-element--cache-key-less-p key next)))
+ (let ((next-request (nth 1 org-element--cache-sync-requests)))
+ (aset next-request 0 key)
+ (aset next-request 1 (aref request 1))
+ (aset next-request 5 1))
+ (throw 'quit t)))
+ ;; Next element will start at its beginning position plus
+ ;; offset, since it hasn't been shifted yet. Therefore, LIMIT
+ ;; contains the real beginning position of the first element to
+ ;; shift and re-parent.
+ (let ((limit (+ (aref request 1) (aref request 3))))
+ (cond ((and threshold (> limit threshold)) (throw 'interrupt nil))
+ ((and future-change (>= limit future-change))
+ ;; Changes are going to happen around this element and
+ ;; they will trigger another phase 1 request. Skip the
+ ;; current one.
+ (aset request 5 2))
+ (t
+ (let ((parent (org-element--parse-to limit t time-limit)))
+ (aset request 4 parent)
+ (aset request 5 2))))))
+ ;; Phase 2.
+ ;;
+ ;; Shift all elements starting from key START, but before NEXT, by
+ ;; OFFSET, and re-parent them when appropriate.
+ ;;
+ ;; Elements are modified by side-effect so the tree structure
+ ;; remains intact.
+ ;;
+ ;; Once THRESHOLD, if any, is reached, or once there is an input
+ ;; pending, exit. Before leaving, the current synchronization
+ ;; request is updated.
+ (let ((start (aref request 0))
+ (offset (aref request 3))
+ (parent (aref request 4))
+ (node (org-element--cache-root))
+ (stack (list nil))
+ (leftp t)
+ exit-flag)
+ ;; No re-parenting nor shifting planned: request is over.
+ (when (and (not parent) (zerop offset)) (throw 'quit t))
+ (while node
+ (let* ((data (avl-tree--node-data node))
+ (key (org-element--cache-key data)))
+ (if (and leftp (avl-tree--node-left node)
+ (not (org-element--cache-key-less-p key start)))
+ (progn (push node stack)
+ (setq node (avl-tree--node-left node)))
+ (unless (org-element--cache-key-less-p key start)
+ ;; We reached NEXT. Request is complete.
+ (when (equal key next) (throw 'quit t))
+ ;; Handle interruption request. Update current request.
+ (when (or exit-flag (org-element--cache-interrupt-p time-limit))
+ (aset request 0 key)
+ (aset request 4 parent)
+ (throw 'interrupt nil))
+ ;; Shift element.
+ (unless (zerop offset)
+ (org-element--cache-shift-positions data offset)
+ ;; Shift associated objects data, if any.
+ (dolist (object-data (gethash data org-element--cache-objects))
+ (dolist (object (cddr object-data))
+ (org-element--cache-shift-positions object offset))))
+ (let ((begin (org-element-property :begin data)))
+ ;; Update PARENT and re-parent DATA, only when
+ ;; necessary. Propagate new structures for lists.
+ (while (and parent
+ (<= (org-element-property :end parent) begin))
+ (setq parent (org-element-property :parent parent)))
+ (cond ((and (not parent) (zerop offset)) (throw 'quit nil))
+ ((and parent
+ (let ((p (org-element-property :parent data)))
+ (or (not p)
+ (< (org-element-property :begin p)
+ (org-element-property :begin parent)))))
+ (org-element-put-property data :parent parent)
+ (let ((s (org-element-property :structure parent)))
+ (when (and s (org-element-property :structure data))
+ (org-element-put-property data :structure s)))))
+ ;; Cache is up-to-date past THRESHOLD. Request
+ ;; interruption.
+ (when (and threshold (> begin threshold)) (setq exit-flag t))))
+ (setq node (if (setq leftp (avl-tree--node-right node))
+ (avl-tree--node-right node)
+ (pop stack))))))
+ ;; We reached end of tree: synchronization complete.
+ t)))
+
+(defun org-element--parse-to (pos &optional syncp time-limit)
+ "Parse elements in current section, down to POS.
+
+Start parsing from the closest between the last known element in
+cache or headline above. Return the smallest element containing
+POS.
+
+When optional argument SYNCP is non-nil, return the parent of the
+element containing POS instead. In that case, it is also
+possible to provide TIME-LIMIT, which is a time value specifying
+when the parsing should stop. The function throws `interrupt' if
+the process stopped before finding the expected result."
+ (catch 'exit
+ (org-with-wide-buffer
+ (goto-char pos)
+ (let* ((cached (and (org-element--cache-active-p)
+ (org-element--cache-find pos nil)))
+ (begin (org-element-property :begin cached))
+ element next mode)
+ (cond
+ ;; Nothing in cache before point: start parsing from first
+ ;; element following headline above, or first element in
+ ;; buffer.
+ ((not cached)
+ (when (org-with-limited-levels (outline-previous-heading))
+ (setq mode 'planning)
+ (forward-line))
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line))
+ ;; Cache returned exact match: return it.
+ ((= pos begin)
+ (throw 'exit (if syncp (org-element-property :parent cached) cached)))
+ ;; There's a headline between cached value and POS: cached
+ ;; value is invalid. Start parsing from first element
+ ;; following the headline.
+ ((re-search-backward
+ (org-with-limited-levels org-outline-regexp-bol) begin t)
+ (forward-line)
+ (skip-chars-forward " \r\t\n")
+ (beginning-of-line)
+ (setq mode 'planning))
+ ;; Check if CACHED or any of its ancestors contain point.
+ ;;
+ ;; If there is such an element, we inspect it in order to know
+ ;; if we return it or if we need to parse its contents.
+ ;; Otherwise, we just start parsing from current location,
+ ;; which is right after the top-most element containing
+ ;; CACHED.
+ ;;
+ ;; As a special case, if POS is at the end of the buffer, we
+ ;; want to return the innermost element ending there.
+ ;;
+ ;; Also, if we find an ancestor and discover that we need to
+ ;; parse its contents, make sure we don't start from
+ ;; `:contents-begin', as we would otherwise go past CACHED
+ ;; again. Instead, in that situation, we will resume parsing
+ ;; from NEXT, which is located after CACHED or its higher
+ ;; ancestor not containing point.
+ (t
+ (let ((up cached)
+ (pos (if (= (point-max) pos) (1- pos) pos)))
+ (goto-char (or (org-element-property :contents-begin cached) begin))
+ (while (let ((end (org-element-property :end up)))
+ (and (<= end pos)
+ (goto-char end)
+ (setq up (org-element-property :parent up)))))
+ (cond ((not up))
+ ((eobp) (setq element up))
+ (t (setq element up next (point)))))))
+ ;; Parse successively each element until we reach POS.
+ (let ((end (or (org-element-property :end element)
+ (save-excursion
+ (org-with-limited-levels (outline-next-heading))
+ (point))))
+ (parent element))
+ (while t
+ (when syncp
+ (cond ((= (point) pos) (throw 'exit parent))
+ ((org-element--cache-interrupt-p time-limit)
+ (throw 'interrupt nil))))
+ (unless element
+ (setq element (org-element--current-element
+ end 'element mode
+ (org-element-property :structure parent)))
+ (org-element-put-property element :parent parent)
+ (org-element--cache-put element))
+ (let ((elem-end (org-element-property :end element))
+ (type (org-element-type element)))
+ (cond
+ ;; Skip any element ending before point. Also skip
+ ;; element ending at point (unless it is also the end of
+ ;; buffer) since we're sure that another element begins
+ ;; after it.
+ ((and (<= elem-end pos) (/= (point-max) elem-end))
+ (goto-char elem-end)
+ (setq mode (org-element--next-mode type nil)))
+ ;; A non-greater element contains point: return it.
+ ((not (memq type org-element-greater-elements))
+ (throw 'exit element))
+ ;; Otherwise, we have to decide if ELEMENT really
+ ;; contains POS. In that case we start parsing from
+ ;; contents' beginning.
+ ;;
+ ;; If POS is at contents' beginning but it is also at
+ ;; the beginning of the first item in a list or a table.
+ ;; In that case, we need to create an anchor for that
+ ;; list or table, so return it.
+ ;;
+ ;; Also, if POS is at the end of the buffer, no element
+ ;; can start after it, but more than one may end there.
+ ;; Arbitrarily, we choose to return the innermost of
+ ;; such elements.
+ ((let ((cbeg (org-element-property :contents-begin element))
+ (cend (org-element-property :contents-end element)))
+ (when (or syncp
+ (and cbeg cend
+ (or (< cbeg pos)
+ (and (= cbeg pos)
+ (not (memq type '(plain-list table)))))
+ (or (> cend pos)
+ (and (= cend pos) (= (point-max) pos)))))
+ (goto-char (or next cbeg))
+ (setq next nil
+ mode (org-element--next-mode type t)
+ parent element
+ end cend))))
+ ;; Otherwise, return ELEMENT as it is the smallest
+ ;; element containing POS.
+ (t (throw 'exit element))))
+ (setq element nil)))))))
+
+
+;;;; Staging Buffer Changes
+
+(defconst org-element--cache-sensitive-re
+ (concat
+ org-outline-regexp-bol "\\|"
+ "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|"
+ "^[ \t]*\\(?:"
+ "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|"
+ "\\\\begin{[A-Za-z0-9*]+}" "\\|"
+ ":\\(?:\\w\\|[-_]\\)+:[ \t]*$"
+ "\\)")
+ "Regexp matching a sensitive line, structure wise.
+A sensitive line is a headline, inlinetask, block, drawer, or
+latex-environment boundary. When such a line is modified,
+structure changes in the document may propagate in the whole
+section, possibly making cache invalid.")
+
+(defvar org-element--cache-change-warning nil
+ "Non-nil when a sensitive line is about to be changed.
+It is a symbol among nil, t and `headline'.")
+
+(defun org-element--cache-before-change (beg end)
+ "Request extension of area going to be modified if needed.
+BEG and END are the beginning and end of the range of changed
+text. See `before-change-functions' for more information."
+ (when (org-element--cache-active-p)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (let ((bottom (save-excursion (goto-char end) (line-end-position))))
+ (setq org-element--cache-change-warning
+ (save-match-data
+ (if (and (org-with-limited-levels (org-at-heading-p))
+ (= (line-end-position) bottom))
+ 'headline
+ (let ((case-fold-search t))
+ (re-search-forward
+ org-element--cache-sensitive-re bottom t)))))))))
+
+(defun org-element--cache-after-change (beg end pre)
+ "Update buffer modifications for current buffer.
+BEG and END are the beginning and end of the range of changed
+text, and the length in bytes of the pre-change text replaced by
+that range. See `after-change-functions' for more information."
+ (when (org-element--cache-active-p)
+ (org-with-wide-buffer
+ (goto-char beg)
+ (beginning-of-line)
+ (save-match-data
+ (let ((top (point))
+ (bottom (save-excursion (goto-char end) (line-end-position))))
+ ;; Determine if modified area needs to be extended, according
+ ;; to both previous and current state. We make a special
+ ;; case for headline editing: if a headline is modified but
+ ;; not removed, do not extend.
+ (when (case org-element--cache-change-warning
+ ((t) t)
+ (headline
+ (not (and (org-with-limited-levels (org-at-heading-p))
+ (= (line-end-position) bottom))))
+ (otherwise
+ (let ((case-fold-search t))
+ (re-search-forward
+ org-element--cache-sensitive-re bottom t))))
+ ;; Effectively extend modified area.
+ (org-with-limited-levels
+ (setq top (progn (goto-char top)
+ (when (outline-previous-heading) (forward-line))
+ (point)))
+ (setq bottom (progn (goto-char bottom)
+ (if (outline-next-heading) (1- (point))
+ (point))))))
+ ;; Store synchronization request.
+ (let ((offset (- end beg pre)))
+ (org-element--cache-submit-request top (- bottom offset) offset)))))
+ ;; Activate a timer to process the request during idle time.
+ (org-element--cache-set-timer (current-buffer))))
+
+(defun org-element--cache-for-removal (beg end offset)
+ "Return first element to remove from cache.
+
+BEG and END are buffer positions delimiting buffer modifications.
+OFFSET is the size of the changes.
+
+Returned element is usually the first element in cache containing
+any position between BEG and END. As an exception, greater
+elements around the changes that are robust to contents
+modifications are preserved and updated according to the
+changes."
+ (let* ((elements (org-element--cache-find (1- beg) 'both))
+ (before (car elements))
+ (after (cdr elements)))
+ (if (not before) after
+ (let ((up before)
+ (robust-flag t))
+ (while up
+ (if (let ((type (org-element-type up)))
+ (and (or (memq type '(center-block dynamic-block quote-block
+ special-block))
+ ;; Drawers named "PROPERTIES" are probably
+ ;; a properties drawer being edited. Force
+ ;; parsing to check if editing is over.
+ (and (eq type 'drawer)
+ (not (string=
+ (org-element-property :drawer-name up)
+ "PROPERTIES"))))
+ (let ((cbeg (org-element-property :contents-begin up)))
+ (and cbeg
+ (<= cbeg beg)
+ (> (org-element-property :contents-end up) end)))))
+ ;; UP is a robust greater element containing changes.
+ ;; We only need to extend its ending boundaries.
+ (org-element--cache-shift-positions
+ up offset '(:contents-end :end))
+ (setq before up)
+ (when robust-flag (setq robust-flag nil)))
+ (setq up (org-element-property :parent up)))
+ ;; We're at top level element containing ELEMENT: if it's
+ ;; altered by buffer modifications, it is first element in
+ ;; cache to be removed. Otherwise, that first element is the
+ ;; following one.
+ ;;
+ ;; As a special case, do not remove BEFORE if it is a robust
+ ;; container for current changes.
+ (if (or (< (org-element-property :end before) beg) robust-flag) after
+ before)))))
+
+(defun org-element--cache-submit-request (beg end offset)
+ "Submit a new cache synchronization request for current buffer.
+BEG and END are buffer positions delimiting the minimal area
+where cache data should be removed. OFFSET is the size of the
+change, as an integer."
+ (let ((next (car org-element--cache-sync-requests))
+ delete-to delete-from)
+ (if (and next
+ (zerop (aref next 5))
+ (> (setq delete-to (+ (aref next 2) (aref next 3))) end)
+ (<= (setq delete-from (aref next 1)) end))
+ ;; Current changes can be merged with first sync request: we
+ ;; can save a partial cache synchronization.
+ (progn
+ (incf (aref next 3) offset)
+ ;; If last change happened within area to be removed, extend
+ ;; boundaries of robust parents, if any. Otherwise, find
+ ;; first element to remove and update request accordingly.
+ (if (> beg delete-from)
+ (let ((up (aref next 4)))
+ (while up
+ (org-element--cache-shift-positions
+ up offset '(:contents-end :end))
+ (setq up (org-element-property :parent up))))
+ (let ((first (org-element--cache-for-removal beg delete-to offset)))
+ (when first
+ (aset next 0 (org-element--cache-key first))
+ (aset next 1 (org-element-property :begin first))
+ (aset next 4 (org-element-property :parent first))))))
+ ;; Ensure cache is correct up to END. Also make sure that NEXT,
+ ;; if any, is no longer a 0-phase request, thus ensuring that
+ ;; phases are properly ordered. We need to provide OFFSET as
+ ;; optional parameter since current modifications are not known
+ ;; yet to the otherwise correct part of the cache (i.e, before
+ ;; the first request).
+ (when next (org-element--cache-sync (current-buffer) end beg))
+ (let ((first (org-element--cache-for-removal beg end offset)))
+ (if first
+ (push (let ((beg (org-element-property :begin first))
+ (key (org-element--cache-key first)))
+ (cond
+ ;; When changes happen before the first known
+ ;; element, re-parent and shift the rest of the
+ ;; cache.
+ ((> beg end) (vector key beg nil offset nil 1))
+ ;; Otherwise, we find the first non robust
+ ;; element containing END. All elements between
+ ;; FIRST and this one are to be removed.
+ ((let ((first-end (org-element-property :end first)))
+ (and (> first-end end)
+ (vector key beg first-end offset first 0))))
+ (t
+ (let* ((element (org-element--cache-find end))
+ (end (org-element-property :end element))
+ (up element))
+ (while (and (setq up (org-element-property :parent up))
+ (>= (org-element-property :begin up) beg))
+ (setq end (org-element-property :end up)
+ element up))
+ (vector key beg end offset element 0)))))
+ org-element--cache-sync-requests)
+ ;; No element to remove. No need to re-parent either.
+ ;; Simply shift additional elements, if any, by OFFSET.
+ (when org-element--cache-sync-requests
+ (incf (aref (car org-element--cache-sync-requests) 3) offset)))))))
+
+
+;;;; Public Functions
+
+;;;###autoload
+(defun org-element-cache-reset (&optional all)
+ "Reset cache in current buffer.
+When optional argument ALL is non-nil, reset cache in all Org
+buffers."
+ (interactive "P")
+ (dolist (buffer (if all (buffer-list) (list (current-buffer))))
+ (with-current-buffer buffer
+ (when (org-element--cache-active-p)
+ (org-set-local 'org-element--cache
+ (avl-tree-create #'org-element--cache-compare))
+ (org-set-local 'org-element--cache-objects (make-hash-table :test #'eq))
+ (org-set-local 'org-element--cache-sync-keys
+ (make-hash-table :weakness 'key :test #'eq))
+ (org-set-local 'org-element--cache-change-warning nil)
+ (org-set-local 'org-element--cache-sync-requests nil)
+ (org-set-local 'org-element--cache-sync-timer nil)
+ (add-hook 'before-change-functions
+ #'org-element--cache-before-change nil t)
+ (add-hook 'after-change-functions
+ #'org-element--cache-after-change nil t)))))
+
+;;;###autoload
+(defun org-element-cache-refresh (pos)
+ "Refresh cache at position POS."
+ (when (org-element--cache-active-p)
+ (org-element--cache-sync (current-buffer) pos)
+ (org-element--cache-submit-request pos pos 0)
+ (org-element--cache-set-timer (current-buffer))))
+
+
+
;;; The Toolbox
;;
;; The first move is to implement a way to obtain the smallest element
;; containing point. This is the job of `org-element-at-point'. It
;; basically jumps back to the beginning of section containing point
-;; and moves, element after element, with
+;; and proceed, one element after the other, with
;; `org-element--current-element' until the container is found. Note:
;; When using `org-element-at-point', secondary values are never
;; parsed since the function focuses on elements, not on objects.
@@ -4689,8 +5640,9 @@ indentation is not done with TAB characters."
;; `org-element-nested-p' and `org-element-swap-A-B' may be used
;; internally by navigation and manipulation tools.
+
;;;###autoload
-(defun org-element-at-point (&optional keep-trail)
+(defun org-element-at-point ()
"Determine closest element around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
@@ -4701,118 +5653,36 @@ Possible types are defined in `org-element-all-elements'.
Properties depend on element or object type, but always include
`:begin', `:end', `:parent' and `:post-blank' properties.
-As a special case, if point is at the very beginning of a list or
-sub-list, returned element will be that list instead of the first
-item. In the same way, if point is at the beginning of the first
-row of a table, returned element will be the table instead of the
-first row.
-
-If optional argument KEEP-TRAIL is non-nil, the function returns
-a list of elements leading to element at point. The list's CAR
-is always the element at point. The following positions contain
-element's siblings, then parents, siblings of parents, until the
-first element of current section."
+As a special case, if point is at the very beginning of the first
+item in a list or sub-list, returned element will be that list
+instead of the item. Likewise, if point is at the beginning of
+the first row of a table, returned element will be the table
+instead of the first row.
+
+When point is at the end of the buffer, return the innermost
+element ending there."
(org-with-wide-buffer
- ;; If at a headline, parse it. It is the sole element that
- ;; doesn't require to know about context. Be sure to disallow
- ;; secondary string parsing, though.
- (if (org-with-limited-levels (org-at-heading-p))
- (progn
- (beginning-of-line)
- (if (not keep-trail) (org-element-headline-parser (point-max) t)
- (list (org-element-headline-parser (point-max) t))))
- ;; Otherwise move at the beginning of the section containing
- ;; point.
- (catch 'exit
- (let ((origin (point))
- (end (save-excursion
- (org-with-limited-levels (outline-next-heading)) (point)))
- element type special-flag trail struct prevs parent)
- (org-with-limited-levels
- (if (org-before-first-heading-p)
- ;; In empty lines at buffer's beginning, return nil.
- (progn (goto-char (point-min))
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- (throw 'exit nil)))
- (org-back-to-heading)
- (forward-line)
- (org-skip-whitespace)
- (when (or (eobp) (> (line-beginning-position) origin))
- ;; In blank lines just after the headline, point still
- ;; belongs to the headline.
- (throw 'exit
- (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
- (point-max) t))))))))
- (beginning-of-line)
- ;; Parse successively each element, skipping those ending
- ;; before original position.
- (while t
- (setq element
- (org-element--current-element end 'element special-flag struct)
- type (car element))
- (org-element-put-property element :parent parent)
- (when keep-trail (push element trail))
- (cond
- ;; 1. Skip any element ending before point. Also skip
- ;; element ending at point when we're sure that another
- ;; element has started.
- ((let ((elem-end (org-element-property :end element)))
- (when (or (< elem-end origin)
- (and (= elem-end origin) (/= elem-end end)))
- (goto-char elem-end))))
- ;; 2. An element containing point is always the element at
- ;; point.
- ((not (memq type org-element-greater-elements))
- (throw 'exit (if keep-trail trail element)))
- ;; 3. At any other greater element type, if point is
- ;; within contents, move into it.
- (t
- (let ((cbeg (org-element-property :contents-begin element))
- (cend (org-element-property :contents-end element)))
- (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
- ;; Create an anchor for tables and plain lists:
- ;; when point is at the very beginning of these
- ;; elements, ignoring affiliated keywords,
- ;; target them instead of their contents.
- (and (= cbeg origin) (memq type '(plain-list table)))
- ;; When point is at contents end, do not move
- ;; into elements with an explicit ending, but
- ;; return that element instead.
- (and (= cend origin)
- (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
- (plain-list
- (setq special-flag 'item
- struct (org-element-property :structure element)))
- (item (setq special-flag nil))
- (property-drawer
- (setq special-flag 'node-property struct nil))
- (table (setq special-flag 'table-row struct nil))
- (otherwise (setq special-flag nil struct nil)))
- (setq end cend)
- (goto-char cbeg)))))))))))
+ (let ((origin (point)))
+ (end-of-line)
+ (skip-chars-backward " \r\t\n")
+ (cond
+ ;; Within blank lines at the beginning of buffer, return nil.
+ ((bobp) nil)
+ ;; Within blank lines right after a headline, return that
+ ;; headline.
+ ((org-with-limited-levels (org-at-heading-p))
+ (beginning-of-line)
+ (org-element-headline-parser (point-max) t))
+ ;; Otherwise parse until we find element containing ORIGIN.
+ (t
+ (when (org-element--cache-active-p)
+ (if (not org-element--cache) (org-element-cache-reset)
+ (org-element--cache-sync (current-buffer) origin)))
+ (org-element--parse-to origin))))))
;;;###autoload
(defun org-element-context (&optional element)
- "Return closest element or object around point.
+ "Return smallest element or object around point.
Return value is a list like (TYPE PROPS) where TYPE is the type
of the element or object and PROPS a plist of properties
@@ -4823,34 +5693,36 @@ Possible types are defined in `org-element-all-elements' and
object type, but always include `:begin', `:end', `:parent' and
`:post-blank'.
+As a special case, if point is right after an object and not at
+the beginning of any other object, return that object.
+
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."
(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.
+ (let* ((pos (point))
+ (element (or element (org-element-at-point)))
+ (type (org-element-type element)))
+ ;; If point is inside an element containing objects or
+ ;; a secondary string, narrow buffer to the container and
+ ;; proceed with parsing. 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)))
+ (and post (< pos post)))
(beginning-of-line)
(let ((case-fold-search t)) (looking-at org-element--affiliated-re))
(cond
((not (member-ignore-case (match-string 1)
org-element-parsed-keywords))
(throw 'objects-forbidden element))
- ((< (match-end 0) origin)
+ ((< (match-end 0) pos)
(narrow-to-region (match-end 0) (line-end-position)))
((and (match-beginning 2)
- (>= origin (match-beginning 2))
- (< origin (match-end 2)))
+ (>= pos (match-beginning 2))
+ (< pos (match-end 2)))
(narrow-to-region (match-beginning 2) (match-end 2)))
(t (throw 'objects-forbidden element)))
;; Also change type to retrieve correct restrictions.
@@ -4862,15 +5734,14 @@ Providing it allows for quicker computation."
(beginning-of-line)
(search-forward tag (line-end-position))
(goto-char (match-beginning 0))
- (if (and (>= origin (point)) (< origin (match-end 0)))
+ (if (and (>= pos (point)) (< pos (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.
+ ;; At an headline or inlinetask, objects are in title.
((memq type '(headline inlinetask))
(goto-char (org-element-property :begin element))
(skip-chars-forward "*")
- (if (and (> origin (point)) (< origin (line-end-position)))
+ (if (and (> pos (point)) (< pos (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
@@ -4879,67 +5750,142 @@ Providing it allows for quicker computation."
(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))
+ (if (and cbeg cend (>= pos cbeg)
+ (or (< pos cend) (and (= pos cend) (eobp))))
(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))))
;; At a planning line, if point is at a timestamp, return it,
;; otherwise, return element.
((eq type 'planning)
(dolist (p '(:closed :deadline :scheduled))
(let ((timestamp (org-element-property p element)))
(when (and timestamp
- (<= (org-element-property :begin timestamp) origin)
- (> (org-element-property :end timestamp) origin))
+ (<= (org-element-property :begin timestamp) pos)
+ (> (org-element-property :end timestamp) pos))
(throw 'objects-forbidden timestamp))))
+ ;; All other locations cannot contain objects: bail out.
(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
- 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))))))
+ (parent element)
+ (cache (cond ((not (org-element--cache-active-p)) nil)
+ (org-element--cache-objects
+ (gethash element org-element--cache-objects))
+ (t (org-element-cache-reset) nil)))
+ next object-data last)
+ (prog1
+ (catch 'exit
+ (while t
+ ;; When entering PARENT for the first time, get list
+ ;; of objects within known so far. Store it in
+ ;; OBJECT-DATA.
+ (unless next
+ (let ((data (assq parent cache)))
+ (if data (setq object-data data)
+ (push (setq object-data (list parent nil)) cache))))
+ ;; Find NEXT object for analysis.
+ (catch 'found
+ ;; If NEXT is non-nil, we already exhausted the
+ ;; cache so we can parse buffer to find the object
+ ;; after it.
+ (if next (setq next (org-element--object-lex restriction))
+ ;; Otherwise, check if cache can help us.
+ (let ((objects (cddr object-data))
+ (completep (nth 1 object-data)))
+ (cond
+ ((and (not objects) completep) (throw 'exit parent))
+ ((not objects)
+ (setq next (org-element--object-lex restriction)))
+ (t
+ (let ((cache-limit
+ (org-element-property :end (car objects))))
+ (if (>= cache-limit pos)
+ ;; Cache contains the information needed.
+ (dolist (object objects (throw 'exit parent))
+ (when (<= (org-element-property :begin object)
+ pos)
+ (if (>= (org-element-property :end object)
+ pos)
+ (throw 'found (setq next object))
+ (throw 'exit parent))))
+ (goto-char cache-limit)
+ (setq next
+ (org-element--object-lex restriction))))))))
+ ;; If we have a new object to analyze, store it in
+ ;; cache. Otherwise record that there is nothing
+ ;; more to parse in this element at this depth.
+ (if next
+ (progn (org-element-put-property next :parent parent)
+ (push next (cddr object-data)))
+ (setcar (cdr object-data) t)))
+ ;; Process NEXT, if any, in order to know if we need
+ ;; to skip it, return it or move into it.
+ (if (or (not next) (> (org-element-property :begin next) pos))
+ (throw 'exit (or last parent))
+ (let ((end (org-element-property :end next))
+ (cbeg (org-element-property :contents-begin next))
+ (cend (org-element-property :contents-end next)))
+ (cond
+ ;; Skip objects ending before point. Also skip
+ ;; objects ending at point unless it is also the
+ ;; end of buffer, since we want to return the
+ ;; innermost object.
+ ((and (<= end pos) (/= (point-max) end))
+ (goto-char end)
+ ;; For convenience, when object ends at POS,
+ ;; without any space, store it in LAST, as we
+ ;; will return it if no object starts here.
+ (when (and (= end pos)
+ (not (memq (char-before) '(?\s ?\t))))
+ (setq last next)))
+ ;; If POS is within a container object, move
+ ;; into that object.
+ ((and cbeg cend
+ (>= pos cbeg)
+ (or (< pos cend)
+ ;; At contents' end, if there is no
+ ;; space before point, also move into
+ ;; object, for consistency with
+ ;; convenience feature above.
+ (and (= pos cend)
+ (or (= (point-max) pos)
+ (not (memq (char-before pos)
+ '(?\s ?\t)))))))
+ (goto-char cbeg)
+ (narrow-to-region (point) cend)
+ (setq parent next
+ restriction (org-element-restriction next)
+ next nil
+ object-data nil))
+ ;; Otherwise, return NEXT.
+ (t (throw 'exit next)))))))
+ ;; Store results in cache, if applicable.
+ (org-element--cache-put element cache)))))))
+
+(defun org-element-lineage (blob &optional types with-self)
+ "List all ancestors of a given element or object.
+
+BLOB is an object or element.
+
+When optional argument TYPES is a list of symbols, return the
+first element or object in the lineage whose type belongs to that
+list.
+
+When optional argument WITH-SELF is non-nil, lineage includes
+BLOB itself as the first element, and TYPES, if provided, also
+apply to it.
+
+When BLOB is obtained through `org-element-context' or
+`org-element-at-point', only ancestors from its section can be
+found. There is no such limitation when BLOB belongs to a full
+parse tree."
+ (let ((up (if with-self blob (org-element-property :parent blob)))
+ ancestors)
+ (while (and up (not (memq (org-element-type up) types)))
+ (unless types (push up ancestors))
+ (setq up (org-element-property :parent up)))
+ (if types up (nreverse ancestors))))
(defun org-element-nested-p (elem-A elem-B)
"Non-nil when elements ELEM-A and ELEM-B are nested."
@@ -4982,15 +5928,23 @@ end of ELEM-A."
(goto-char (org-element-property :end elem-B))
(skip-chars-backward " \r\t\n")
(point-at-eol)))
- ;; Store overlays responsible for visibility status. We
- ;; also need to store their boundaries as they will be
+ ;; Store inner overlays responsible for visibility status.
+ ;; We also need to store their boundaries as they will be
;; removed from buffer.
(overlays
(cons
- (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-A end-A))
- (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
- (overlays-in beg-B end-B))))
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-A)
+ (<= (overlay-end o) end-A)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-A end-A)))
+ (delq nil
+ (mapcar (lambda (o)
+ (and (>= (overlay-start o) beg-B)
+ (<= (overlay-end o) end-B)
+ (list o (overlay-start o) (overlay-end o))))
+ (overlays-in beg-B end-B)))))
;; Get contents.
(body-A (buffer-substring beg-A end-A))
(body-B (delete-and-extract-region beg-B end-B)))
@@ -5001,20 +5955,47 @@ end of ELEM-A."
(insert body-A)
;; Restore ex ELEM-A overlays.
(let ((offset (- beg-B beg-A)))
- (mapc (lambda (ov)
- (move-overlay
- (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset)))
- (car overlays))
+ (dolist (o (car overlays))
+ (move-overlay (car o) (+ (nth 1 o) offset) (+ (nth 2 o) offset)))
(goto-char beg-A)
(delete-region beg-A end-A)
(insert body-B)
;; Restore ex ELEM-B overlays.
- (mapc (lambda (ov)
- (move-overlay
- (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset)))
- (cdr overlays)))
+ (dolist (o (cdr overlays))
+ (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
(goto-char (org-element-property :end elem-B)))))
+(defun org-element-remove-indentation (s &optional n)
+ "Remove maximum common indentation in string S and return it.
+When optional argument N is a positive integer, remove exactly
+that much characters from indentation, if possible, or return
+S as-is otherwise. Unlike to `org-remove-indentation', this
+function doesn't call `untabify' on S."
+ (catch 'exit
+ (with-temp-buffer
+ (insert s)
+ (goto-char (point-min))
+ ;; Find maximum common indentation, if not specified.
+ (setq n (or n
+ (let ((min-ind (point-max)))
+ (save-excursion
+ (while (re-search-forward "^[ \t]*\\S-" nil t)
+ (let ((ind (1- (current-column))))
+ (if (zerop ind) (throw 'exit s)
+ (setq min-ind (min min-ind ind))))))
+ min-ind)))
+ (if (zerop n) s
+ ;; Remove exactly N indentation, but give up if not possible.
+ (while (not (eobp))
+ (let ((ind (progn (skip-chars-forward " \t") (current-column))))
+ (cond ((eolp) (delete-region (line-beginning-position) (point)))
+ ((< ind n) (throw 'exit s))
+ (t (org-indent-line-to (- ind n))))
+ (forward-line)))
+ (buffer-string)))))
+
+
+
(provide 'org-element)
;; Local variables: