org-manual: Fix typo in variable name
[org-mode/org-tableheadings.git] / lisp / org-element.el
blob3bd3a6f01cb8be567b3783ed9cc139f7bfb45b4d
1 ;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2012-2018 Free Software Foundation, Inc.
5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
6 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; See <https://orgmode.org/worg/dev/org-syntax.html> for details about
26 ;; Org syntax.
28 ;; Lisp-wise, a syntax object can be represented as a list.
29 ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
30 ;; TYPE is a symbol describing the object.
31 ;; PROPERTIES is the property list attached to it. See docstring of
32 ;; appropriate parsing function to get an exhaustive list.
33 ;; CONTENTS is a list of syntax objects or raw strings contained
34 ;; in the current object, when applicable.
36 ;; For the whole document, TYPE is `org-data' and PROPERTIES is nil.
38 ;; The first part of this file defines constants for the Org syntax,
39 ;; while the second one provide accessors and setters functions.
41 ;; The next part implements a parser and an interpreter for each
42 ;; element and object type in Org syntax.
44 ;; The following part creates a fully recursive buffer parser. It
45 ;; also provides a tool to map a function to elements or objects
46 ;; matching some criteria in the parse tree. Functions of interest
47 ;; are `org-element-parse-buffer', `org-element-map' and, to a lesser
48 ;; extent, `org-element-parse-secondary-string'.
50 ;; The penultimate part is the cradle of an interpreter for the
51 ;; obtained parse tree: `org-element-interpret-data'.
53 ;; The library ends by furnishing `org-element-at-point' function, and
54 ;; a way to give information about document structure around point
55 ;; with `org-element-context'. A cache mechanism is also provided for
56 ;; these functions.
59 ;;; Code:
61 (require 'org)
62 (require 'avl-tree)
63 (require 'cl-lib)
67 ;;; Definitions And Rules
69 ;; Define elements, greater elements and specify recursive objects,
70 ;; along with the affiliated keywords recognized. Also set up
71 ;; restrictions on recursive objects combinations.
73 ;; `org-element-update-syntax' builds proper syntax regexps according
74 ;; to current setup.
76 (defvar org-element-paragraph-separate nil
77 "Regexp to separate paragraphs in an Org buffer.
78 In the case of lines starting with \"#\" and \":\", this regexp
79 is not sufficient to know if point is at a paragraph ending. See
80 `org-element-paragraph-parser' for more information.")
82 (defvar org-element--object-regexp nil
83 "Regexp possibly matching the beginning of an object.
84 This regexp allows false positives. Dedicated parser (e.g.,
85 `org-export-bold-parser') will take care of further filtering.
86 Radio links are not matched by this regexp, as they are treated
87 specially in `org-element--object-lex'.")
89 (defun org-element--set-regexps ()
90 "Build variable syntax regexps."
91 (setq org-element-paragraph-separate
92 (concat "^\\(?:"
93 ;; Headlines, inlinetasks.
94 org-outline-regexp "\\|"
95 ;; Footnote definitions.
96 "\\[fn:[-_[:word:]]+\\]" "\\|"
97 ;; Diary sexps.
98 "%%(" "\\|"
99 "[ \t]*\\(?:"
100 ;; Empty lines.
101 "$" "\\|"
102 ;; Tables (any type).
103 "|" "\\|"
104 "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|"
105 ;; Comments, keyword-like or block-like constructs.
106 ;; Blocks and keywords with dual values need to be
107 ;; double-checked.
108 "#\\(?: \\|$\\|\\+\\(?:"
109 "BEGIN_\\S-+" "\\|"
110 "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)"
111 "\\|"
112 ;; Drawers (any type) and fixed-width areas. Drawers
113 ;; need to be double-checked.
114 ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|"
115 ;; Horizontal rules.
116 "-\\{5,\\}[ \t]*$" "\\|"
117 ;; LaTeX environments.
118 "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|"
119 ;; Clock lines.
120 (regexp-quote org-clock-string) "\\|"
121 ;; Lists.
122 (let ((term (pcase org-plain-list-ordered-item-terminator
123 (?\) ")") (?. "\\.") (_ "[.)]")))
124 (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]")))
125 (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
126 "\\(?:[ \t]\\|$\\)"))
127 "\\)\\)")
128 org-element--object-regexp
129 (mapconcat #'identity
130 (let ((link-types (regexp-opt (org-link-types))))
131 (list
132 ;; Sub/superscript.
133 "\\(?:[_^][-{(*+.,[:alnum:]]\\)"
134 ;; Bold, code, italic, strike-through, underline
135 ;; and verbatim.
136 (concat "[*~=+_/]"
137 (format "[^%s]"
138 (nth 2 org-emphasis-regexp-components)))
139 ;; Plain links.
140 (concat "\\<" link-types ":")
141 ;; Objects starting with "[": regular link,
142 ;; footnote reference, statistics cookie,
143 ;; timestamp (inactive).
144 (concat "\\[\\(?:"
145 "fn:" "\\|"
146 "\\[" "\\|"
147 "[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" "\\|"
148 "[0-9]*\\(?:%\\|/[0-9]*\\)\\]"
149 "\\)")
150 ;; Objects starting with "@": export snippets.
151 "@@"
152 ;; Objects starting with "{": macro.
153 "{{{"
154 ;; Objects starting with "<" : timestamp
155 ;; (active, diary), target, radio target and
156 ;; angular links.
157 (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)")
158 ;; Objects starting with "$": latex fragment.
159 "\\$"
160 ;; Objects starting with "\": line break,
161 ;; entity, latex fragment.
162 "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)"
163 ;; Objects starting with raw text: inline Babel
164 ;; source block, inline Babel call.
165 "\\(?:call\\|src\\)_"))
166 "\\|")))
168 (org-element--set-regexps)
170 ;;;###autoload
171 (defun org-element-update-syntax ()
172 "Update parser internals."
173 (interactive)
174 (org-element--set-regexps)
175 (org-element-cache-reset 'all))
177 (defconst org-element-all-elements
178 '(babel-call center-block clock comment comment-block diary-sexp drawer
179 dynamic-block example-block export-block fixed-width
180 footnote-definition headline horizontal-rule inlinetask item
181 keyword latex-environment node-property paragraph plain-list
182 planning property-drawer quote-block section
183 special-block src-block table table-row verse-block)
184 "Complete list of element types.")
186 (defconst org-element-greater-elements
187 '(center-block drawer dynamic-block footnote-definition headline inlinetask
188 item plain-list property-drawer quote-block section
189 special-block table)
190 "List of recursive element types aka Greater Elements.")
192 (defconst org-element-all-objects
193 '(bold code entity export-snippet footnote-reference inline-babel-call
194 inline-src-block italic line-break latex-fragment link macro
195 radio-target statistics-cookie strike-through subscript superscript
196 table-cell target timestamp underline verbatim)
197 "Complete list of object types.")
199 (defconst org-element-recursive-objects
200 '(bold footnote-reference italic link subscript radio-target strike-through
201 superscript table-cell underline)
202 "List of recursive object types.")
204 (defconst org-element-object-containers
205 (append org-element-recursive-objects '(paragraph table-row verse-block))
206 "List of object or element types that can directly contain objects.")
208 (defconst org-element-affiliated-keywords
209 '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
210 "RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
211 "List of affiliated keywords as strings.
212 By default, all keywords setting attributes (e.g., \"ATTR_LATEX\")
213 are affiliated keywords and need not to be in this list.")
215 (defconst org-element-keyword-translation-alist
216 '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
217 ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
218 ("RESULT" . "RESULTS") ("HEADERS" . "HEADER"))
219 "Alist of usual translations for keywords.
220 The key is the old name and the value the new one. The property
221 holding their value will be named after the translated name.")
223 (defconst org-element-multiple-keywords '("CAPTION" "HEADER")
224 "List of affiliated keywords that can occur more than once in an element.
226 Their value will be consed into a list of strings, which will be
227 returned as the value of the property.
229 This list is checked after translations have been applied. See
230 `org-element-keyword-translation-alist'.
232 By default, all keywords setting attributes (e.g., \"ATTR_LATEX\")
233 allow multiple occurrences and need not to be in this list.")
235 (defconst org-element-parsed-keywords '("CAPTION")
236 "List of affiliated keywords whose value can be parsed.
238 Their value will be stored as a secondary string: a list of
239 strings and objects.
241 This list is checked after translations have been applied. See
242 `org-element-keyword-translation-alist'.")
244 (defconst org-element--parsed-properties-alist
245 (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k)))))
246 org-element-parsed-keywords)
247 "Alist of parsed keywords and associated properties.
248 This is generated from `org-element-parsed-keywords', which
249 see.")
251 (defconst org-element-dual-keywords '("CAPTION" "RESULTS")
252 "List of affiliated keywords which can have a secondary value.
254 In Org syntax, they can be written with optional square brackets
255 before the colons. For example, RESULTS keyword can be
256 associated to a hash value with the following:
258 #+RESULTS[hash-string]: some-source
260 This list is checked after translations have been applied. See
261 `org-element-keyword-translation-alist'.")
263 (defconst org-element--affiliated-re
264 (format "[ \t]*#\\+\\(?:%s\\):[ \t]*"
265 (concat
266 ;; Dual affiliated keywords.
267 (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?"
268 (regexp-opt org-element-dual-keywords))
269 "\\|"
270 ;; Regular affiliated keywords.
271 (format "\\(?1:%s\\)"
272 (regexp-opt
273 (cl-remove-if
274 (lambda (k) (member k org-element-dual-keywords))
275 org-element-affiliated-keywords)))
276 "\\|"
277 ;; Export attributes.
278 "\\(?1:ATTR_[-_A-Za-z0-9]+\\)"))
279 "Regexp matching any affiliated keyword.
281 Keyword name is put in match group 1. Moreover, if keyword
282 belongs to `org-element-dual-keywords', put the dual value in
283 match group 2.
285 Don't modify it, set `org-element-affiliated-keywords' instead.")
287 (defconst org-element-object-restrictions
288 (let* ((standard-set (remq 'table-cell org-element-all-objects))
289 (standard-set-no-line-break (remq 'line-break standard-set)))
290 `((bold ,@standard-set)
291 (footnote-reference ,@standard-set)
292 (headline ,@standard-set-no-line-break)
293 (inlinetask ,@standard-set-no-line-break)
294 (italic ,@standard-set)
295 (item ,@standard-set-no-line-break)
296 (keyword ,@(remq 'footnote-reference standard-set))
297 ;; Ignore all links in a link description. Also ignore
298 ;; radio-targets and line breaks.
299 (link bold code entity export-snippet inline-babel-call inline-src-block
300 italic latex-fragment macro statistics-cookie strike-through
301 subscript superscript underline verbatim)
302 (paragraph ,@standard-set)
303 ;; Remove any variable object from radio target as it would
304 ;; prevent it from being properly recognized.
305 (radio-target bold code entity italic latex-fragment strike-through
306 subscript superscript underline superscript)
307 (strike-through ,@standard-set)
308 (subscript ,@standard-set)
309 (superscript ,@standard-set)
310 ;; Ignore inline babel call and inline src block as formulas are
311 ;; possible. Also ignore line breaks and statistics cookies.
312 (table-cell bold code entity export-snippet footnote-reference italic
313 latex-fragment link macro radio-target strike-through
314 subscript superscript target timestamp underline verbatim)
315 (table-row table-cell)
316 (underline ,@standard-set)
317 (verse-block ,@standard-set)))
318 "Alist of objects restrictions.
320 key is an element or object type containing objects and value is
321 a list of types that can be contained within an element or object
322 of such type.
324 For example, in a `radio-target' object, one can only find
325 entities, latex-fragments, subscript, superscript and text
326 markup.
328 This alist also applies to secondary string. For example, an
329 `headline' type element doesn't directly contain objects, but
330 still has an entry since one of its properties (`:title') does.")
332 (defconst org-element-secondary-value-alist
333 '((headline :title)
334 (inlinetask :title)
335 (item :tag))
336 "Alist between element types and locations of secondary values.")
338 (defconst org-element--pair-round-table
339 (let ((table (make-syntax-table)))
340 (modify-syntax-entry ?\( "()" table)
341 (modify-syntax-entry ?\) ")(" table)
342 (dolist (char '(?\{ ?\} ?\[ ?\] ?\< ?\>) table)
343 (modify-syntax-entry char " " table)))
344 "Table used internally to pair only round brackets.
345 Other brackets are treated as spaces.")
347 (defconst org-element--pair-square-table
348 (let ((table (make-syntax-table)))
349 (modify-syntax-entry ?\[ "(]" table)
350 (modify-syntax-entry ?\] ")[" table)
351 (dolist (char '(?\{ ?\} ?\( ?\) ?\< ?\>) table)
352 (modify-syntax-entry char " " table)))
353 "Table used internally to pair only square brackets.
354 Other brackets are treated as spaces.")
356 (defconst org-element--pair-curly-table
357 (let ((table (make-syntax-table)))
358 (modify-syntax-entry ?\{ "(}" table)
359 (modify-syntax-entry ?\} "){" table)
360 (dolist (char '(?\[ ?\] ?\( ?\) ?\< ?\>) table)
361 (modify-syntax-entry char " " table)))
362 "Table used internally to pair only curly brackets.
363 Other brackets are treated as spaces.")
365 (defun org-element--parse-paired-brackets (char)
366 "Parse paired brackets at point.
367 CHAR is the opening bracket to consider, as a character. Return
368 contents between brackets, as a string, or nil. Also move point
369 past the brackets."
370 (when (eq char (char-after))
371 (let ((syntax-table (pcase char
372 (?\{ org-element--pair-curly-table)
373 (?\[ org-element--pair-square-table)
374 (?\( org-element--pair-round-table)
375 (_ nil)))
376 (pos (point)))
377 (when syntax-table
378 (with-syntax-table syntax-table
379 (let ((end (ignore-errors (scan-lists pos 1 0))))
380 (when end
381 (goto-char end)
382 (buffer-substring-no-properties (1+ pos) (1- end)))))))))
385 ;;; Accessors and Setters
387 ;; Provide four accessors: `org-element-type', `org-element-property'
388 ;; `org-element-contents' and `org-element-restriction'.
390 ;; Setter functions allow modification of elements by side effect.
391 ;; There is `org-element-put-property', `org-element-set-contents'.
392 ;; These low-level functions are useful to build a parse tree.
394 ;; `org-element-adopt-elements', `org-element-set-element',
395 ;; `org-element-extract-element' and `org-element-insert-before' are
396 ;; high-level functions useful to modify a parse tree.
398 ;; `org-element-secondary-p' is a predicate used to know if a given
399 ;; object belongs to a secondary string. `org-element-class' tells if
400 ;; some parsed data is an element or an object, handling pseudo
401 ;; elements and objects. `org-element-copy' returns an element or
402 ;; object, stripping its parent property in the process.
404 (defsubst org-element-type (element)
405 "Return type of ELEMENT.
407 The function returns the type of the element or object provided.
408 It can also return the following special value:
409 `plain-text' for a string
410 `org-data' for a complete document
411 nil in any other case."
412 (cond
413 ((not (consp element)) (and (stringp element) 'plain-text))
414 ((symbolp (car element)) (car element))))
416 (defsubst org-element-property (property element)
417 "Extract the value from the PROPERTY of an ELEMENT."
418 (if (stringp element) (get-text-property 0 property element)
419 (plist-get (nth 1 element) property)))
421 (defsubst org-element-contents (element)
422 "Extract contents from an ELEMENT."
423 (cond ((not (consp element)) nil)
424 ((symbolp (car element)) (nthcdr 2 element))
425 (t element)))
427 (defsubst org-element-restriction (element)
428 "Return restriction associated to ELEMENT.
429 ELEMENT can be an element, an object or a symbol representing an
430 element or object type."
431 (cdr (assq (if (symbolp element) element (org-element-type element))
432 org-element-object-restrictions)))
434 (defsubst org-element-put-property (element property value)
435 "In ELEMENT set PROPERTY to VALUE.
436 Return modified element."
437 (if (stringp element) (org-add-props element nil property value)
438 (setcar (cdr element) (plist-put (nth 1 element) property value))
439 element))
441 (defsubst org-element-set-contents (element &rest contents)
442 "Set ELEMENT's contents to CONTENTS.
443 Return ELEMENT."
444 (cond ((null element) contents)
445 ((not (symbolp (car element))) contents)
446 ((cdr element) (setcdr (cdr element) contents) element)
447 (t (nconc element contents))))
449 (defun org-element-secondary-p (object)
450 "Non-nil when OBJECT directly belongs to a secondary string.
451 Return value is the property name, as a keyword, or nil."
452 (let* ((parent (org-element-property :parent object))
453 (properties (cdr (assq (org-element-type parent)
454 org-element-secondary-value-alist))))
455 (catch 'exit
456 (dolist (p properties)
457 (and (memq object (org-element-property p parent))
458 (throw 'exit p))))))
460 (defsubst org-element-class (datum &optional parent)
461 "Return class for ELEMENT, as a symbol.
462 Class is either `element' or `object'. Optional argument PARENT
463 is the element or object containing DATUM. It defaults to the
464 value of DATUM `:parent' property."
465 (let ((type (org-element-type datum))
466 (parent (or parent (org-element-property :parent datum))))
467 (cond
468 ;; Trivial cases.
469 ((memq type org-element-all-objects) 'object)
470 ((memq type org-element-all-elements) 'element)
471 ;; Special cases.
472 ((eq type 'org-data) 'element)
473 ((eq type 'plain-text) 'object)
474 ((not type) 'object)
475 ;; Pseudo object or elements. Make a guess about its class.
476 ;; Basically a pseudo object is contained within another object,
477 ;; a secondary string or a container element.
478 ((not parent) 'element)
480 (let ((parent-type (org-element-type parent)))
481 (cond ((not parent-type) 'object)
482 ((memq parent-type org-element-object-containers) 'object)
483 ((org-element-secondary-p datum) 'object)
484 (t 'element)))))))
486 (defsubst org-element-adopt-elements (parent &rest children)
487 "Append elements to the contents of another element.
489 PARENT is an element or object. CHILDREN can be elements,
490 objects, or a strings.
492 The function takes care of setting `:parent' property for CHILD.
493 Return parent element."
494 (declare (indent 1))
495 (if (not children) parent
496 ;; Link every child to PARENT. If PARENT is nil, it is a secondary
497 ;; string: parent is the list itself.
498 (dolist (child children)
499 (org-element-put-property child :parent (or parent children)))
500 ;; Add CHILDREN at the end of PARENT contents.
501 (when parent
502 (apply #'org-element-set-contents
503 parent
504 (nconc (org-element-contents parent) children)))
505 ;; Return modified PARENT element.
506 (or parent children)))
508 (defun org-element-extract-element (element)
509 "Extract ELEMENT from parse tree.
510 Remove element from the parse tree by side-effect, and return it
511 with its `:parent' property stripped out."
512 (let ((parent (org-element-property :parent element))
513 (secondary (org-element-secondary-p element)))
514 (if secondary
515 (org-element-put-property
516 parent secondary
517 (delq element (org-element-property secondary parent)))
518 (apply #'org-element-set-contents
519 parent
520 (delq element (org-element-contents parent))))
521 ;; Return ELEMENT with its :parent removed.
522 (org-element-put-property element :parent nil)))
524 (defun org-element-insert-before (element location)
525 "Insert ELEMENT before LOCATION in parse tree.
526 LOCATION is an element, object or string within the parse tree.
527 Parse tree is modified by side effect."
528 (let* ((parent (org-element-property :parent location))
529 (property (org-element-secondary-p location))
530 (siblings (if property (org-element-property property parent)
531 (org-element-contents parent)))
532 ;; Special case: LOCATION is the first element of an
533 ;; independent secondary string (e.g. :title property). Add
534 ;; ELEMENT in-place.
535 (specialp (and (not property)
536 (eq siblings parent)
537 (eq (car parent) location))))
538 ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS.
539 (cond (specialp)
540 ((or (null siblings) (eq (car siblings) location))
541 (push element siblings))
542 ((null location) (nconc siblings (list element)))
544 (let ((index (cl-position location siblings)))
545 (unless index (error "No location found to insert element"))
546 (push element (cdr (nthcdr (1- index) siblings))))))
547 ;; Store SIBLINGS at appropriate place in parse tree.
548 (cond
549 (specialp (setcdr parent (copy-sequence parent)) (setcar parent element))
550 (property (org-element-put-property parent property siblings))
551 (t (apply #'org-element-set-contents parent siblings)))
552 ;; Set appropriate :parent property.
553 (org-element-put-property element :parent parent)))
555 (defun org-element-set-element (old new)
556 "Replace element or object OLD with element or object NEW.
557 The function takes care of setting `:parent' property for NEW."
558 ;; Ensure OLD and NEW have the same parent.
559 (org-element-put-property new :parent (org-element-property :parent old))
560 (if (or (memq (org-element-type old) '(plain-text nil))
561 (memq (org-element-type new) '(plain-text nil)))
562 ;; We cannot replace OLD with NEW since one of them is not an
563 ;; object or element. We take the long path.
564 (progn (org-element-insert-before new old)
565 (org-element-extract-element old))
566 ;; Since OLD is going to be changed into NEW by side-effect, first
567 ;; make sure that every element or object within NEW has OLD as
568 ;; parent.
569 (dolist (blob (org-element-contents new))
570 (org-element-put-property blob :parent old))
571 ;; Transfer contents.
572 (apply #'org-element-set-contents old (org-element-contents new))
573 ;; Overwrite OLD's properties with NEW's.
574 (setcar (cdr old) (nth 1 new))
575 ;; Transfer type.
576 (setcar old (car new))))
578 (defun org-element-create (type &optional props &rest children)
579 "Create a new element of type TYPE.
580 Optional argument PROPS, when non-nil, is a plist defining the
581 properties of the element. CHILDREN can be elements, objects or
582 strings."
583 (apply #'org-element-adopt-elements (list type props) children))
585 (defun org-element-copy (datum)
586 "Return a copy of DATUM.
587 DATUM is an element, object, string or nil. `:parent' property
588 is cleared and contents are removed in the process."
589 (when datum
590 (let ((type (org-element-type datum)))
591 (pcase type
592 (`org-data (list 'org-data nil))
593 (`plain-text (substring-no-properties datum))
594 (`nil (copy-sequence datum))
596 (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil)))))))
600 ;;; Greater elements
602 ;; For each greater element type, we define a parser and an
603 ;; interpreter.
605 ;; A parser returns the element or object as the list described above.
606 ;; Most of them accepts no argument. Though, exceptions exist. Hence
607 ;; every element containing a secondary string (see
608 ;; `org-element-secondary-value-alist') will accept an optional
609 ;; argument to toggle parsing of these secondary strings. Moreover,
610 ;; `item' parser requires current list's structure as its first
611 ;; element.
613 ;; An interpreter accepts two arguments: the list representation of
614 ;; the element or object, and its contents. The latter may be nil,
615 ;; depending on the element or object considered. It returns the
616 ;; appropriate Org syntax, as a string.
618 ;; Parsing functions must follow the naming convention:
619 ;; org-element-TYPE-parser, where TYPE is greater element's type, as
620 ;; defined in `org-element-greater-elements'.
622 ;; Similarly, interpreting functions must follow the naming
623 ;; convention: org-element-TYPE-interpreter.
625 ;; With the exception of `headline' and `item' types, greater elements
626 ;; cannot contain other greater elements of their own type.
628 ;; Beside implementing a parser and an interpreter, adding a new
629 ;; greater element requires tweaking `org-element--current-element'.
630 ;; Moreover, the newly defined type must be added to both
631 ;; `org-element-all-elements' and `org-element-greater-elements'.
634 ;;;; Center Block
636 (defun org-element-center-block-parser (limit affiliated)
637 "Parse a center block.
639 LIMIT bounds the search. AFFILIATED is a list of which CAR is
640 the buffer position at the beginning of the first affiliated
641 keyword and CDR is a plist of affiliated keywords along with
642 their value.
644 Return a list whose CAR is `center-block' and CDR is a plist
645 containing `:begin', `:end', `:contents-begin', `:contents-end',
646 `:post-blank' and `:post-affiliated' keywords.
648 Assume point is at the beginning of the block."
649 (let ((case-fold-search t))
650 (if (not (save-excursion
651 (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t)))
652 ;; Incomplete block: parse it as a paragraph.
653 (org-element-paragraph-parser limit affiliated)
654 (let ((block-end-line (match-beginning 0)))
655 (let* ((begin (car affiliated))
656 (post-affiliated (point))
657 ;; Empty blocks have no contents.
658 (contents-begin (progn (forward-line)
659 (and (< (point) block-end-line)
660 (point))))
661 (contents-end (and contents-begin block-end-line))
662 (pos-before-blank (progn (goto-char block-end-line)
663 (forward-line)
664 (point)))
665 (end (save-excursion
666 (skip-chars-forward " \r\t\n" limit)
667 (if (eobp) (point) (line-beginning-position)))))
668 (list 'center-block
669 (nconc
670 (list :begin begin
671 :end end
672 :contents-begin contents-begin
673 :contents-end contents-end
674 :post-blank (count-lines pos-before-blank end)
675 :post-affiliated post-affiliated)
676 (cdr affiliated))))))))
678 (defun org-element-center-block-interpreter (_ contents)
679 "Interpret a center-block element as Org syntax.
680 CONTENTS is the contents of the element."
681 (format "#+begin_center\n%s#+end_center" contents))
684 ;;;; Drawer
686 (defun org-element-drawer-parser (limit affiliated)
687 "Parse a drawer.
689 LIMIT bounds the search. AFFILIATED is a list of which CAR is
690 the buffer position at the beginning of the first affiliated
691 keyword and CDR is a plist of affiliated keywords along with
692 their value.
694 Return a list whose CAR is `drawer' and CDR is a plist containing
695 `:drawer-name', `:begin', `:end', `:contents-begin',
696 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
698 Assume point is at beginning of drawer."
699 (let ((case-fold-search t))
700 (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
701 ;; Incomplete drawer: parse it as a paragraph.
702 (org-element-paragraph-parser limit affiliated)
703 (save-excursion
704 (let* ((drawer-end-line (match-beginning 0))
705 (name (progn (looking-at org-drawer-regexp)
706 (match-string-no-properties 1)))
707 (begin (car affiliated))
708 (post-affiliated (point))
709 ;; Empty drawers have no contents.
710 (contents-begin (progn (forward-line)
711 (and (< (point) drawer-end-line)
712 (point))))
713 (contents-end (and contents-begin drawer-end-line))
714 (pos-before-blank (progn (goto-char drawer-end-line)
715 (forward-line)
716 (point)))
717 (end (progn (skip-chars-forward " \r\t\n" limit)
718 (if (eobp) (point) (line-beginning-position)))))
719 (list 'drawer
720 (nconc
721 (list :begin begin
722 :end end
723 :drawer-name name
724 :contents-begin contents-begin
725 :contents-end contents-end
726 :post-blank (count-lines pos-before-blank end)
727 :post-affiliated post-affiliated)
728 (cdr affiliated))))))))
730 (defun org-element-drawer-interpreter (drawer contents)
731 "Interpret DRAWER element as Org syntax.
732 CONTENTS is the contents of the element."
733 (format ":%s:\n%s:END:"
734 (org-element-property :drawer-name drawer)
735 contents))
738 ;;;; Dynamic Block
740 (defun org-element-dynamic-block-parser (limit affiliated)
741 "Parse a dynamic block.
743 LIMIT bounds the search. AFFILIATED is a list of which CAR is
744 the buffer position at the beginning of the first affiliated
745 keyword and CDR is a plist of affiliated keywords along with
746 their value.
748 Return a list whose CAR is `dynamic-block' and CDR is a plist
749 containing `:block-name', `:begin', `:end', `:contents-begin',
750 `:contents-end', `:arguments', `:post-blank' and
751 `:post-affiliated' keywords.
753 Assume point is at beginning of dynamic block."
754 (let ((case-fold-search t))
755 (if (not (save-excursion
756 (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t)))
757 ;; Incomplete block: parse it as a paragraph.
758 (org-element-paragraph-parser limit affiliated)
759 (let ((block-end-line (match-beginning 0)))
760 (save-excursion
761 (let* ((name (progn (looking-at org-dblock-start-re)
762 (match-string-no-properties 1)))
763 (arguments (match-string-no-properties 3))
764 (begin (car affiliated))
765 (post-affiliated (point))
766 ;; Empty blocks have no contents.
767 (contents-begin (progn (forward-line)
768 (and (< (point) block-end-line)
769 (point))))
770 (contents-end (and contents-begin block-end-line))
771 (pos-before-blank (progn (goto-char block-end-line)
772 (forward-line)
773 (point)))
774 (end (progn (skip-chars-forward " \r\t\n" limit)
775 (if (eobp) (point) (line-beginning-position)))))
776 (list 'dynamic-block
777 (nconc
778 (list :begin begin
779 :end end
780 :block-name name
781 :arguments arguments
782 :contents-begin contents-begin
783 :contents-end contents-end
784 :post-blank (count-lines pos-before-blank end)
785 :post-affiliated post-affiliated)
786 (cdr affiliated)))))))))
788 (defun org-element-dynamic-block-interpreter (dynamic-block contents)
789 "Interpret DYNAMIC-BLOCK element as Org syntax.
790 CONTENTS is the contents of the element."
791 (format "#+begin: %s%s\n%s#+end:"
792 (org-element-property :block-name dynamic-block)
793 (let ((args (org-element-property :arguments dynamic-block)))
794 (if args (concat " " args) ""))
795 contents))
798 ;;;; Footnote Definition
800 (defconst org-element--footnote-separator
801 (concat org-outline-regexp-bol "\\|"
802 org-footnote-definition-re "\\|"
803 "^\\([ \t]*\n\\)\\{2,\\}")
804 "Regexp used as a footnote definition separator.")
806 (defun org-element-footnote-definition-parser (limit affiliated)
807 "Parse a footnote definition.
809 LIMIT bounds the search. AFFILIATED is a list of which CAR is
810 the buffer position at the beginning of the first affiliated
811 keyword and CDR is a plist of affiliated keywords along with
812 their value.
814 Return a list whose CAR is `footnote-definition' and CDR is
815 a plist containing `:label', `:begin' `:end', `:contents-begin',
816 `:contents-end', `:pre-blank',`:post-blank' and
817 `:post-affiliated' keywords.
819 Assume point is at the beginning of the footnote definition."
820 (save-excursion
821 (let* ((label (progn (looking-at org-footnote-definition-re)
822 (match-string-no-properties 1)))
823 (begin (car affiliated))
824 (post-affiliated (point))
825 (end
826 (save-excursion
827 (end-of-line)
828 (cond
829 ((not
830 (re-search-forward org-element--footnote-separator limit t))
831 limit)
832 ((eq ?\[ (char-after (match-beginning 0)))
833 ;; At a new footnote definition, make sure we end
834 ;; before any affiliated keyword above.
835 (forward-line -1)
836 (while (and (> (point) post-affiliated)
837 (looking-at-p org-element--affiliated-re))
838 (forward-line -1))
839 (line-beginning-position 2))
840 ((eq ?* (char-after (match-beginning 0))) (match-beginning 0))
841 (t (skip-chars-forward " \r\t\n" limit)
842 (if (= limit (point)) limit (line-beginning-position))))))
843 (pre-blank 0)
844 (contents-begin
845 (progn (search-forward "]")
846 (skip-chars-forward " \r\t\n" end)
847 (cond ((= (point) end) nil)
848 ((= (line-beginning-position) post-affiliated) (point))
850 (setq pre-blank
851 (count-lines (line-beginning-position) begin))
852 (line-beginning-position)))))
853 (contents-end
854 (progn (goto-char end)
855 (skip-chars-backward " \r\t\n")
856 (line-beginning-position 2))))
857 (list 'footnote-definition
858 (nconc
859 (list :label label
860 :begin begin
861 :end end
862 :contents-begin contents-begin
863 :contents-end (and contents-begin contents-end)
864 :pre-blank pre-blank
865 :post-blank (count-lines contents-end end)
866 :post-affiliated post-affiliated)
867 (cdr affiliated))))))
869 (defun org-element-footnote-definition-interpreter (footnote-definition contents)
870 "Interpret FOOTNOTE-DEFINITION element as Org syntax.
871 CONTENTS is the contents of the footnote-definition."
872 (let ((pre-blank
873 (min (or (org-element-property :pre-blank footnote-definition)
874 ;; 0 is specific to paragraphs at the beginning of
875 ;; the footnote definition, so we use 1 as
876 ;; a fall-back value, which is more universal.
878 ;; Footnote ends after more than two consecutive empty
879 ;; lines: limit ourselves to 2 newline characters.
880 2)))
881 (concat (format "[fn:%s]" (org-element-property :label footnote-definition))
882 (if (= pre-blank 0) (concat " " (org-trim contents))
883 (concat (make-string pre-blank ?\n) contents)))))
886 ;;;; Headline
888 (defun org-element--get-node-properties ()
889 "Return node properties associated to headline at point.
890 Upcase property names. It avoids confusion between properties
891 obtained through property drawer and default properties from the
892 parser (e.g. `:end' and :END:). Return value is a plist."
893 (save-excursion
894 (forward-line)
895 (when (looking-at-p org-planning-line-re) (forward-line))
896 (when (looking-at org-property-drawer-re)
897 (forward-line)
898 (let ((end (match-end 0)) properties)
899 (while (< (line-end-position) end)
900 (looking-at org-property-re)
901 (push (match-string-no-properties 3) properties)
902 (push (intern (concat ":" (upcase (match-string 2)))) properties)
903 (forward-line))
904 properties))))
906 (defun org-element--get-time-properties ()
907 "Return time properties associated to headline at point.
908 Return value is a plist."
909 (save-excursion
910 (when (progn (forward-line) (looking-at org-planning-line-re))
911 (let ((end (line-end-position)) plist)
912 (while (re-search-forward org-keyword-time-not-clock-regexp end t)
913 (goto-char (match-end 1))
914 (skip-chars-forward " \t")
915 (let ((keyword (match-string 1))
916 (time (org-element-timestamp-parser)))
917 (cond ((equal keyword org-scheduled-string)
918 (setq plist (plist-put plist :scheduled time)))
919 ((equal keyword org-deadline-string)
920 (setq plist (plist-put plist :deadline time)))
921 (t (setq plist (plist-put plist :closed time))))))
922 plist))))
924 (defun org-element-headline-parser (limit &optional raw-secondary-p)
925 "Parse a headline.
927 Return a list whose CAR is `headline' and CDR is a plist
928 containing `:raw-value', `:title', `:begin', `:end',
929 `:pre-blank', `:contents-begin' and `:contents-end', `:level',
930 `:priority', `:tags', `:todo-keyword',`:todo-type', `:scheduled',
931 `:deadline', `:closed', `:archivedp', `:commentedp'
932 `:footnote-section-p', `:post-blank' and `:post-affiliated'
933 keywords.
935 The plist also contains any property set in the property drawer,
936 with its name in upper cases and colons added at the
937 beginning (e.g., `:CUSTOM_ID').
939 LIMIT is a buffer position bounding the search.
941 When RAW-SECONDARY-P is non-nil, headline's title will not be
942 parsed as a secondary string, but as a plain string instead.
944 Assume point is at beginning of the headline."
945 (save-excursion
946 (let* ((begin (point))
947 (level (prog1 (org-reduced-level (skip-chars-forward "*"))
948 (skip-chars-forward " \t")))
949 (todo (and org-todo-regexp
950 (let (case-fold-search) (looking-at org-todo-regexp))
951 (progn (goto-char (match-end 0))
952 (skip-chars-forward " \t")
953 (match-string 0))))
954 (todo-type
955 (and todo (if (member todo org-done-keywords) 'done 'todo)))
956 (priority (and (looking-at "\\[#.\\][ \t]*")
957 (progn (goto-char (match-end 0))
958 (aref (match-string 0) 2))))
959 (commentedp
960 (and (let (case-fold-search) (looking-at org-comment-string))
961 (goto-char (match-end 0))))
962 (title-start (point))
963 (tags (when (re-search-forward
964 "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
965 (line-end-position)
966 'move)
967 (goto-char (match-beginning 0))
968 (org-split-string (match-string 1) ":")))
969 (title-end (point))
970 (raw-value (org-trim
971 (buffer-substring-no-properties title-start title-end)))
972 (archivedp (member org-archive-tag tags))
973 (footnote-section-p (and org-footnote-section
974 (string= org-footnote-section raw-value)))
975 (standard-props (org-element--get-node-properties))
976 (time-props (org-element--get-time-properties))
977 (end (min (save-excursion (org-end-of-subtree t t)) limit))
978 (contents-begin (save-excursion
979 (forward-line)
980 (skip-chars-forward " \r\t\n" end)
981 (and (/= (point) end) (line-beginning-position))))
982 (contents-end (and contents-begin
983 (progn (goto-char end)
984 (skip-chars-backward " \r\t\n")
985 (line-beginning-position 2)))))
986 (let ((headline
987 (list 'headline
988 (nconc
989 (list :raw-value raw-value
990 :begin begin
991 :end end
992 :pre-blank
993 (if (not contents-begin) 0
994 (1- (count-lines begin contents-begin)))
995 :contents-begin contents-begin
996 :contents-end contents-end
997 :level level
998 :priority priority
999 :tags tags
1000 :todo-keyword todo
1001 :todo-type todo-type
1002 :post-blank
1003 (if contents-end
1004 (count-lines contents-end end)
1005 (1- (count-lines begin end)))
1006 :footnote-section-p footnote-section-p
1007 :archivedp archivedp
1008 :commentedp commentedp
1009 :post-affiliated begin)
1010 time-props
1011 standard-props))))
1012 (org-element-put-property
1013 headline :title
1014 (if raw-secondary-p raw-value
1015 (org-element--parse-objects
1016 (progn (goto-char title-start)
1017 (skip-chars-forward " \t")
1018 (point))
1019 (progn (goto-char title-end)
1020 (skip-chars-backward " \t")
1021 (point))
1023 (org-element-restriction 'headline)
1024 headline)))))))
1026 (defun org-element-headline-interpreter (headline contents)
1027 "Interpret HEADLINE element as Org syntax.
1028 CONTENTS is the contents of the element."
1029 (let* ((level (org-element-property :level headline))
1030 (todo (org-element-property :todo-keyword headline))
1031 (priority (org-element-property :priority headline))
1032 (title (org-element-interpret-data
1033 (org-element-property :title headline)))
1034 (tags (let ((tag-list (org-element-property :tags headline)))
1035 (and tag-list
1036 (format ":%s:" (mapconcat #'identity tag-list ":")))))
1037 (commentedp (org-element-property :commentedp headline))
1038 (pre-blank (or (org-element-property :pre-blank headline) 0))
1039 (heading
1040 (concat (make-string (if org-odd-levels-only (1- (* level 2)) level)
1042 (and todo (concat " " todo))
1043 (and commentedp (concat " " org-comment-string))
1044 (and priority (format " [#%c]" priority))
1046 (if (and org-footnote-section
1047 (org-element-property :footnote-section-p headline))
1048 org-footnote-section
1049 title))))
1050 (concat
1051 heading
1052 ;; Align tags.
1053 (when tags
1054 (cond
1055 ((zerop org-tags-column) (format " %s" tags))
1056 ((< org-tags-column 0)
1057 (concat
1058 (make-string
1059 (max (- (+ org-tags-column (length heading) (length tags))) 1)
1060 ?\s)
1061 tags))
1063 (concat
1064 (make-string (max (- org-tags-column (length heading)) 1) ?\s)
1065 tags))))
1066 (make-string (1+ pre-blank) ?\n)
1067 contents)))
1070 ;;;; Inlinetask
1072 (defun org-element-inlinetask-parser (limit &optional raw-secondary-p)
1073 "Parse an inline task.
1075 Return a list whose CAR is `inlinetask' and CDR is a plist
1076 containing `:title', `:begin', `:end', `:pre-blank',
1077 `:contents-begin' and `:contents-end', `:level', `:priority',
1078 `:raw-value', `:tags', `:todo-keyword', `:todo-type',
1079 `:scheduled', `:deadline', `:closed', `:post-blank' and
1080 `:post-affiliated' keywords.
1082 The plist also contains any property set in the property drawer,
1083 with its name in upper cases and colons added at the
1084 beginning (e.g., `:CUSTOM_ID').
1086 When optional argument RAW-SECONDARY-P is non-nil, inline-task's
1087 title will not be parsed as a secondary string, but as a plain
1088 string instead.
1090 Assume point is at beginning of the inline task."
1091 (save-excursion
1092 (let* ((begin (point))
1093 (level (prog1 (org-reduced-level (skip-chars-forward "*"))
1094 (skip-chars-forward " \t")))
1095 (todo (and org-todo-regexp
1096 (let (case-fold-search) (looking-at org-todo-regexp))
1097 (progn (goto-char (match-end 0))
1098 (skip-chars-forward " \t")
1099 (match-string 0))))
1100 (todo-type (and todo
1101 (if (member todo org-done-keywords) 'done 'todo)))
1102 (priority (and (looking-at "\\[#.\\][ \t]*")
1103 (progn (goto-char (match-end 0))
1104 (aref (match-string 0) 2))))
1105 (title-start (point))
1106 (tags (when (re-search-forward
1107 "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
1108 (line-end-position)
1109 'move)
1110 (goto-char (match-beginning 0))
1111 (org-split-string (match-string 1) ":")))
1112 (title-end (point))
1113 (raw-value (org-trim
1114 (buffer-substring-no-properties title-start title-end)))
1115 (task-end (save-excursion
1116 (end-of-line)
1117 (and (re-search-forward org-outline-regexp-bol limit t)
1118 (looking-at-p "[ \t]*END[ \t]*$")
1119 (line-beginning-position))))
1120 (standard-props (and task-end (org-element--get-node-properties)))
1121 (time-props (and task-end (org-element--get-time-properties)))
1122 (contents-begin (and task-end
1123 (< (point) task-end)
1124 (progn
1125 (forward-line)
1126 (skip-chars-forward " \t\n")
1127 (line-beginning-position))))
1128 (contents-end (and contents-begin task-end))
1129 (end (progn (when task-end (goto-char task-end))
1130 (forward-line)
1131 (skip-chars-forward " \r\t\n" limit)
1132 (if (eobp) (point) (line-beginning-position))))
1133 (inlinetask
1134 (list 'inlinetask
1135 (nconc
1136 (list :raw-value raw-value
1137 :begin begin
1138 :end end
1139 :pre-blank
1140 (if (not contents-begin) 0
1141 (1- (count-lines begin contents-begin)))
1142 :contents-begin contents-begin
1143 :contents-end contents-end
1144 :level level
1145 :priority priority
1146 :tags tags
1147 :todo-keyword todo
1148 :todo-type todo-type
1149 :post-blank (1- (count-lines (or task-end begin) end))
1150 :post-affiliated begin)
1151 time-props
1152 standard-props))))
1153 (org-element-put-property
1154 inlinetask :title
1155 (if raw-secondary-p raw-value
1156 (org-element--parse-objects
1157 (progn (goto-char title-start)
1158 (skip-chars-forward " \t")
1159 (point))
1160 (progn (goto-char title-end)
1161 (skip-chars-backward " \t")
1162 (point))
1164 (org-element-restriction 'inlinetask)
1165 inlinetask))))))
1167 (defun org-element-inlinetask-interpreter (inlinetask contents)
1168 "Interpret INLINETASK element as Org syntax.
1169 CONTENTS is the contents of inlinetask."
1170 (let* ((level (org-element-property :level inlinetask))
1171 (todo (org-element-property :todo-keyword inlinetask))
1172 (priority (org-element-property :priority inlinetask))
1173 (title (org-element-interpret-data
1174 (org-element-property :title inlinetask)))
1175 (tags (let ((tag-list (org-element-property :tags inlinetask)))
1176 (and tag-list
1177 (format ":%s:" (mapconcat 'identity tag-list ":")))))
1178 (task (concat (make-string level ?*)
1179 (and todo (concat " " todo))
1180 (and priority (format " [#%c]" priority))
1181 (and title (concat " " title)))))
1182 (concat task
1183 ;; Align tags.
1184 (when tags
1185 (cond
1186 ((zerop org-tags-column) (format " %s" tags))
1187 ((< org-tags-column 0)
1188 (concat
1189 (make-string
1190 (max (- (+ org-tags-column (length task) (length tags))) 1)
1191 ?\s)
1192 tags))
1194 (concat
1195 (make-string (max (- org-tags-column (length task)) 1) ?\s)
1196 tags))))
1197 ;; Prefer degenerate inlinetasks when there are no
1198 ;; contents.
1199 (when contents
1200 (concat "\n"
1201 contents
1202 (make-string level ?*) " end")))))
1205 ;;;; Item
1207 (defun org-element-item-parser (_ struct &optional raw-secondary-p)
1208 "Parse an item.
1210 STRUCT is the structure of the plain list.
1212 Return a list whose CAR is `item' and CDR is a plist containing
1213 `:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
1214 `:checkbox', `:counter', `:tag', `:structure', `:pre-blank',
1215 `:post-blank' and `:post-affiliated' keywords.
1217 When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
1218 any, will not be parsed as a secondary string, but as a plain
1219 string instead.
1221 Assume point is at the beginning of the item."
1222 (save-excursion
1223 (beginning-of-line)
1224 (looking-at org-list-full-item-re)
1225 (let* ((begin (point))
1226 (bullet (match-string-no-properties 1))
1227 (checkbox (let ((box (match-string 3)))
1228 (cond ((equal "[ ]" box) 'off)
1229 ((equal "[X]" box) 'on)
1230 ((equal "[-]" box) 'trans))))
1231 (counter (let ((c (match-string 2)))
1232 (save-match-data
1233 (cond
1234 ((not c) nil)
1235 ((string-match "[A-Za-z]" c)
1236 (- (string-to-char (upcase (match-string 0 c)))
1237 64))
1238 ((string-match "[0-9]+" c)
1239 (string-to-number (match-string 0 c)))))))
1240 (end (progn (goto-char (nth 6 (assq (point) struct)))
1241 (if (bolp) (point) (line-beginning-position 2))))
1242 (pre-blank 0)
1243 (contents-begin
1244 (progn
1245 (goto-char
1246 ;; Ignore tags in un-ordered lists: they are just
1247 ;; a part of item's body.
1248 (if (and (match-beginning 4)
1249 (save-match-data (string-match "[.)]" bullet)))
1250 (match-beginning 4)
1251 (match-end 0)))
1252 (skip-chars-forward " \r\t\n" end)
1253 (cond ((= (point) end) nil)
1254 ;; If first line isn't empty, contents really
1255 ;; start at the text after item's meta-data.
1256 ((= (line-beginning-position) begin) (point))
1258 (setq pre-blank
1259 (count-lines (line-beginning-position) begin))
1260 (line-beginning-position)))))
1261 (contents-end (and contents-begin
1262 (progn (goto-char end)
1263 (skip-chars-backward " \r\t\n")
1264 (line-beginning-position 2))))
1265 (item
1266 (list 'item
1267 (list :bullet bullet
1268 :begin begin
1269 :end end
1270 :contents-begin contents-begin
1271 :contents-end contents-end
1272 :checkbox checkbox
1273 :counter counter
1274 :structure struct
1275 :pre-blank pre-blank
1276 :post-blank (count-lines (or contents-end begin) end)
1277 :post-affiliated begin))))
1278 (org-element-put-property
1279 item :tag
1280 (let ((raw (org-list-get-tag begin struct)))
1281 (when raw
1282 (if raw-secondary-p raw
1283 (org-element--parse-objects
1284 (match-beginning 4) (match-end 4) nil
1285 (org-element-restriction 'item)
1286 item))))))))
1288 (defun org-element-item-interpreter (item contents)
1289 "Interpret ITEM element as Org syntax.
1290 CONTENTS is the contents of the element."
1291 (let ((tag (pcase (org-element-property :tag item)
1292 (`nil nil)
1293 (tag (format "%s :: " (org-element-interpret-data tag)))))
1294 (bullet
1295 (org-list-bullet-string
1296 (cond
1297 ((not (string-match-p "[0-9a-zA-Z]"
1298 (org-element-property :bullet item))) "- ")
1299 ((eq org-plain-list-ordered-item-terminator ?\)) "1)")
1300 (t "1.")))))
1301 (concat
1302 bullet
1303 (pcase (org-element-property :counter item)
1304 (`nil nil)
1305 (counter (format "[@%d] " counter)))
1306 (pcase (org-element-property :checkbox item)
1307 (`on "[X] ")
1308 (`off "[ ] ")
1309 (`trans "[-] ")
1310 (_ nil))
1312 (when contents
1313 (let* ((ind (make-string (if tag 5 (length bullet)) ?\s))
1314 (pre-blank
1315 (min (or (org-element-property :pre-blank item)
1316 ;; 0 is specific to paragraphs at the
1317 ;; beginning of the item, so we use 1 as
1318 ;; a fall-back value, which is more universal.
1320 ;; Lists ends after more than two consecutive
1321 ;; empty lines: limit ourselves to 2 newline
1322 ;; characters.
1324 (contents (replace-regexp-in-string
1325 "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
1326 (if (= pre-blank 0) (org-trim contents)
1327 (concat (make-string pre-blank ?\n) contents)))))))
1330 ;;;; Plain List
1332 (defun org-element--list-struct (limit)
1333 ;; Return structure of list at point. Internal function. See
1334 ;; `org-list-struct' for details.
1335 (let ((case-fold-search t)
1336 (top-ind limit)
1337 (item-re (org-item-re))
1338 (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ "))
1339 items struct)
1340 (save-excursion
1341 (catch :exit
1342 (while t
1343 (cond
1344 ;; At limit: end all items.
1345 ((>= (point) limit)
1346 (let ((end (progn (skip-chars-backward " \r\t\n")
1347 (line-beginning-position 2))))
1348 (dolist (item items) (setcar (nthcdr 6 item) end)))
1349 (throw :exit (sort (nconc items struct) #'car-less-than-car)))
1350 ;; At list end: end all items.
1351 ((looking-at org-list-end-re)
1352 (dolist (item items) (setcar (nthcdr 6 item) (point)))
1353 (throw :exit (sort (nconc items struct) #'car-less-than-car)))
1354 ;; At a new item: end previous sibling.
1355 ((looking-at item-re)
1356 (let ((ind (save-excursion (skip-chars-forward " \t")
1357 (current-column))))
1358 (setq top-ind (min top-ind ind))
1359 (while (and items (<= ind (nth 1 (car items))))
1360 (let ((item (pop items)))
1361 (setcar (nthcdr 6 item) (point))
1362 (push item struct)))
1363 (push (progn (looking-at org-list-full-item-re)
1364 (let ((bullet (match-string-no-properties 1)))
1365 (list (point)
1367 bullet
1368 (match-string-no-properties 2) ; counter
1369 (match-string-no-properties 3) ; checkbox
1370 ;; Description tag.
1371 (and (save-match-data
1372 (string-match "[-+*]" bullet))
1373 (match-string-no-properties 4))
1374 ;; Ending position, unknown so far.
1375 nil)))
1376 items))
1377 (forward-line))
1378 ;; Skip empty lines.
1379 ((looking-at "^[ \t]*$") (forward-line))
1380 ;; Skip inline tasks and blank lines along the way.
1381 ((and inlinetask-re (looking-at inlinetask-re))
1382 (forward-line)
1383 (let ((origin (point)))
1384 (when (re-search-forward inlinetask-re limit t)
1385 (if (looking-at-p "END[ \t]*$") (forward-line)
1386 (goto-char origin)))))
1387 ;; At some text line. Check if it ends any previous item.
1389 (let ((ind (save-excursion
1390 (skip-chars-forward " \t")
1391 (current-column)))
1392 (end (save-excursion
1393 (skip-chars-backward " \r\t\n")
1394 (line-beginning-position 2))))
1395 (while (<= ind (nth 1 (car items)))
1396 (let ((item (pop items)))
1397 (setcar (nthcdr 6 item) end)
1398 (push item struct)
1399 (unless items
1400 (throw :exit (sort struct #'car-less-than-car))))))
1401 ;; Skip blocks (any type) and drawers contents.
1402 (cond
1403 ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)")
1404 (re-search-forward
1405 (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1))
1406 limit t)))
1407 ((and (looking-at org-drawer-regexp)
1408 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))))
1409 (forward-line))))))))
1411 (defun org-element-plain-list-parser (limit affiliated structure)
1412 "Parse a plain list.
1414 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1415 the buffer position at the beginning of the first affiliated
1416 keyword and CDR is a plist of affiliated keywords along with
1417 their value. STRUCTURE is the structure of the plain list being
1418 parsed.
1420 Return a list whose CAR is `plain-list' and CDR is a plist
1421 containing `:type', `:begin', `:end', `:contents-begin' and
1422 `:contents-end', `:structure', `:post-blank' and
1423 `:post-affiliated' keywords.
1425 Assume point is at the beginning of the list."
1426 (save-excursion
1427 (let* ((struct (or structure (org-element--list-struct limit)))
1428 (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
1429 ((nth 5 (assq (point) struct)) 'descriptive)
1430 (t 'unordered)))
1431 (contents-begin (point))
1432 (begin (car affiliated))
1433 (contents-end (let* ((item (assq contents-begin struct))
1434 (ind (nth 1 item))
1435 (pos (nth 6 item)))
1436 (while (and (setq item (assq pos struct))
1437 (= (nth 1 item) ind))
1438 (setq pos (nth 6 item)))
1439 pos))
1440 (end (progn (goto-char contents-end)
1441 (skip-chars-forward " \r\t\n" limit)
1442 (if (= (point) limit) limit (line-beginning-position)))))
1443 ;; Return value.
1444 (list 'plain-list
1445 (nconc
1446 (list :type type
1447 :begin begin
1448 :end end
1449 :contents-begin contents-begin
1450 :contents-end contents-end
1451 :structure struct
1452 :post-blank (count-lines contents-end end)
1453 :post-affiliated contents-begin)
1454 (cdr affiliated))))))
1456 (defun org-element-plain-list-interpreter (_ contents)
1457 "Interpret plain-list element as Org syntax.
1458 CONTENTS is the contents of the element."
1459 (with-temp-buffer
1460 (insert contents)
1461 (goto-char (point-min))
1462 (org-list-repair)
1463 (buffer-string)))
1466 ;;;; Property Drawer
1468 (defun org-element-property-drawer-parser (limit)
1469 "Parse a property drawer.
1471 LIMIT bounds the search.
1473 Return a list whose car is `property-drawer' and cdr is a plist
1474 containing `:begin', `:end', `:contents-begin', `:contents-end',
1475 `:post-blank' and `:post-affiliated' keywords.
1477 Assume point is at the beginning of the property drawer."
1478 (save-excursion
1479 (let ((case-fold-search t)
1480 (begin (point))
1481 (contents-begin (line-beginning-position 2)))
1482 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)
1483 (let ((contents-end (and (> (match-beginning 0) contents-begin)
1484 (match-beginning 0)))
1485 (before-blank (progn (forward-line) (point)))
1486 (end (progn (skip-chars-forward " \r\t\n" limit)
1487 (if (eobp) (point) (line-beginning-position)))))
1488 (list 'property-drawer
1489 (list :begin begin
1490 :end end
1491 :contents-begin (and contents-end contents-begin)
1492 :contents-end contents-end
1493 :post-blank (count-lines before-blank end)
1494 :post-affiliated begin))))))
1496 (defun org-element-property-drawer-interpreter (_ contents)
1497 "Interpret property-drawer element as Org syntax.
1498 CONTENTS is the properties within the drawer."
1499 (format ":PROPERTIES:\n%s:END:" contents))
1502 ;;;; Quote Block
1504 (defun org-element-quote-block-parser (limit affiliated)
1505 "Parse a quote block.
1507 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1508 the buffer position at the beginning of the first affiliated
1509 keyword and CDR is a plist of affiliated keywords along with
1510 their value.
1512 Return a list whose CAR is `quote-block' and CDR is a plist
1513 containing `:begin', `:end', `:contents-begin', `:contents-end',
1514 `:post-blank' and `:post-affiliated' keywords.
1516 Assume point is at the beginning of the block."
1517 (let ((case-fold-search t))
1518 (if (not (save-excursion
1519 (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t)))
1520 ;; Incomplete block: parse it as a paragraph.
1521 (org-element-paragraph-parser limit affiliated)
1522 (let ((block-end-line (match-beginning 0)))
1523 (save-excursion
1524 (let* ((begin (car affiliated))
1525 (post-affiliated (point))
1526 ;; Empty blocks have no contents.
1527 (contents-begin (progn (forward-line)
1528 (and (< (point) block-end-line)
1529 (point))))
1530 (contents-end (and contents-begin block-end-line))
1531 (pos-before-blank (progn (goto-char block-end-line)
1532 (forward-line)
1533 (point)))
1534 (end (progn (skip-chars-forward " \r\t\n" limit)
1535 (if (eobp) (point) (line-beginning-position)))))
1536 (list 'quote-block
1537 (nconc
1538 (list :begin begin
1539 :end end
1540 :contents-begin contents-begin
1541 :contents-end contents-end
1542 :post-blank (count-lines pos-before-blank end)
1543 :post-affiliated post-affiliated)
1544 (cdr affiliated)))))))))
1546 (defun org-element-quote-block-interpreter (_ contents)
1547 "Interpret quote-block element as Org syntax.
1548 CONTENTS is the contents of the element."
1549 (format "#+begin_quote\n%s#+end_quote" contents))
1552 ;;;; Section
1554 (defun org-element-section-parser (_)
1555 "Parse a section.
1557 Return a list whose CAR is `section' and CDR is a plist
1558 containing `:begin', `:end', `:contents-begin', `contents-end',
1559 `:post-blank' and `:post-affiliated' keywords."
1560 (save-excursion
1561 ;; Beginning of section is the beginning of the first non-blank
1562 ;; line after previous headline.
1563 (let ((begin (point))
1564 (end (progn (org-with-limited-levels (outline-next-heading))
1565 (point)))
1566 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
1567 (line-beginning-position 2))))
1568 (list 'section
1569 (list :begin begin
1570 :end end
1571 :contents-begin begin
1572 :contents-end pos-before-blank
1573 :post-blank (count-lines pos-before-blank end)
1574 :post-affiliated begin)))))
1576 (defun org-element-section-interpreter (_ contents)
1577 "Interpret section element as Org syntax.
1578 CONTENTS is the contents of the element."
1579 contents)
1582 ;;;; Special Block
1584 (defun org-element-special-block-parser (limit affiliated)
1585 "Parse a special block.
1587 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1588 the buffer position at the beginning of the first affiliated
1589 keyword and CDR is a plist of affiliated keywords along with
1590 their value.
1592 Return a list whose CAR is `special-block' and CDR is a plist
1593 containing `:type', `:begin', `:end', `:contents-begin',
1594 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
1596 Assume point is at the beginning of the block."
1597 (let* ((case-fold-search t)
1598 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
1599 (match-string-no-properties 1))))
1600 (if (not (save-excursion
1601 (re-search-forward
1602 (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type))
1603 limit t)))
1604 ;; Incomplete block: parse it as a paragraph.
1605 (org-element-paragraph-parser limit affiliated)
1606 (let ((block-end-line (match-beginning 0)))
1607 (save-excursion
1608 (let* ((begin (car affiliated))
1609 (post-affiliated (point))
1610 ;; Empty blocks have no contents.
1611 (contents-begin (progn (forward-line)
1612 (and (< (point) block-end-line)
1613 (point))))
1614 (contents-end (and contents-begin block-end-line))
1615 (pos-before-blank (progn (goto-char block-end-line)
1616 (forward-line)
1617 (point)))
1618 (end (progn (skip-chars-forward " \r\t\n" limit)
1619 (if (eobp) (point) (line-beginning-position)))))
1620 (list 'special-block
1621 (nconc
1622 (list :type type
1623 :begin begin
1624 :end end
1625 :contents-begin contents-begin
1626 :contents-end contents-end
1627 :post-blank (count-lines pos-before-blank end)
1628 :post-affiliated post-affiliated)
1629 (cdr affiliated)))))))))
1631 (defun org-element-special-block-interpreter (special-block contents)
1632 "Interpret SPECIAL-BLOCK element as Org syntax.
1633 CONTENTS is the contents of the element."
1634 (let ((block-type (org-element-property :type special-block)))
1635 (format "#+begin_%s\n%s#+end_%s" block-type contents block-type)))
1639 ;;; Elements
1641 ;; For each element, a parser and an interpreter are also defined.
1642 ;; Both follow the same naming convention used for greater elements.
1644 ;; Also, as for greater elements, adding a new element type is done
1645 ;; through the following steps: implement a parser and an interpreter,
1646 ;; tweak `org-element--current-element' so that it recognizes the new
1647 ;; type and add that new type to `org-element-all-elements'.
1650 ;;;; Babel Call
1652 (defun org-element-babel-call-parser (limit affiliated)
1653 "Parse a babel call.
1655 LIMIT bounds the search. AFFILIATED is a list of which car is
1656 the buffer position at the beginning of the first affiliated
1657 keyword and cdr is a plist of affiliated keywords along with
1658 their value.
1660 Return a list whose car is `babel-call' and cdr is a plist
1661 containing `:call', `:inside-header', `:arguments',
1662 `:end-header', `:begin', `:end', `:value', `:post-blank' and
1663 `:post-affiliated' as keywords."
1664 (save-excursion
1665 (let* ((begin (car affiliated))
1666 (post-affiliated (point))
1667 (before-blank (line-beginning-position 2))
1668 (value (progn (search-forward ":" before-blank t)
1669 (skip-chars-forward " \t")
1670 (org-trim
1671 (buffer-substring-no-properties
1672 (point) (line-end-position)))))
1673 (call
1674 (or (org-string-nw-p
1675 (buffer-substring-no-properties
1676 (point) (progn (skip-chars-forward "^[]()" before-blank)
1677 (point))))))
1678 (inside-header (org-element--parse-paired-brackets ?\[))
1679 (arguments (org-string-nw-p
1680 (org-element--parse-paired-brackets ?\()))
1681 (end-header
1682 (org-string-nw-p
1683 (org-trim
1684 (buffer-substring-no-properties (point) (line-end-position)))))
1685 (end (progn (forward-line)
1686 (skip-chars-forward " \r\t\n" limit)
1687 (if (eobp) (point) (line-beginning-position)))))
1688 (list 'babel-call
1689 (nconc
1690 (list :call call
1691 :inside-header inside-header
1692 :arguments arguments
1693 :end-header end-header
1694 :begin begin
1695 :end end
1696 :value value
1697 :post-blank (count-lines before-blank end)
1698 :post-affiliated post-affiliated)
1699 (cdr affiliated))))))
1701 (defun org-element-babel-call-interpreter (babel-call _)
1702 "Interpret BABEL-CALL element as Org syntax."
1703 (concat "#+call: "
1704 (org-element-property :call babel-call)
1705 (let ((h (org-element-property :inside-header babel-call)))
1706 (and h (format "[%s]" h)))
1707 (concat "(" (org-element-property :arguments babel-call) ")")
1708 (let ((h (org-element-property :end-header babel-call)))
1709 (and h (concat " " h)))))
1712 ;;;; Clock
1714 (defun org-element-clock-parser (limit)
1715 "Parse a clock.
1717 LIMIT bounds the search.
1719 Return a list whose CAR is `clock' and CDR is a plist containing
1720 `:status', `:value', `:time', `:begin', `:end', `:post-blank' and
1721 `:post-affiliated' as keywords."
1722 (save-excursion
1723 (let* ((case-fold-search nil)
1724 (begin (point))
1725 (value (progn (search-forward org-clock-string (line-end-position) t)
1726 (skip-chars-forward " \t")
1727 (org-element-timestamp-parser)))
1728 (duration (and (search-forward " => " (line-end-position) t)
1729 (progn (skip-chars-forward " \t")
1730 (looking-at "\\(\\S-+\\)[ \t]*$"))
1731 (match-string-no-properties 1)))
1732 (status (if duration 'closed 'running))
1733 (post-blank (let ((before-blank (progn (forward-line) (point))))
1734 (skip-chars-forward " \r\t\n" limit)
1735 (skip-chars-backward " \t")
1736 (unless (bolp) (end-of-line))
1737 (count-lines before-blank (point))))
1738 (end (point)))
1739 (list 'clock
1740 (list :status status
1741 :value value
1742 :duration duration
1743 :begin begin
1744 :end end
1745 :post-blank post-blank
1746 :post-affiliated begin)))))
1748 (defun org-element-clock-interpreter (clock _)
1749 "Interpret CLOCK element as Org syntax."
1750 (concat org-clock-string " "
1751 (org-element-timestamp-interpreter
1752 (org-element-property :value clock) nil)
1753 (let ((duration (org-element-property :duration clock)))
1754 (and duration
1755 (concat " => "
1756 (apply 'format
1757 "%2s:%02s"
1758 (org-split-string duration ":")))))))
1761 ;;;; Comment
1763 (defun org-element-comment-parser (limit affiliated)
1764 "Parse a comment.
1766 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1767 the buffer position at the beginning of the first affiliated
1768 keyword and CDR is a plist of affiliated keywords along with
1769 their value.
1771 Return a list whose CAR is `comment' and CDR is a plist
1772 containing `:begin', `:end', `:value', `:post-blank',
1773 `:post-affiliated' keywords.
1775 Assume point is at comment beginning."
1776 (save-excursion
1777 (let* ((begin (car affiliated))
1778 (post-affiliated (point))
1779 (value (prog2 (looking-at "[ \t]*# ?")
1780 (buffer-substring-no-properties
1781 (match-end 0) (line-end-position))
1782 (forward-line)))
1783 (com-end
1784 ;; Get comments ending.
1785 (progn
1786 (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)"))
1787 ;; Accumulate lines without leading hash and first
1788 ;; whitespace.
1789 (setq value
1790 (concat value
1791 "\n"
1792 (buffer-substring-no-properties
1793 (match-end 0) (line-end-position))))
1794 (forward-line))
1795 (point)))
1796 (end (progn (goto-char com-end)
1797 (skip-chars-forward " \r\t\n" limit)
1798 (if (eobp) (point) (line-beginning-position)))))
1799 (list 'comment
1800 (nconc
1801 (list :begin begin
1802 :end end
1803 :value value
1804 :post-blank (count-lines com-end end)
1805 :post-affiliated post-affiliated)
1806 (cdr affiliated))))))
1808 (defun org-element-comment-interpreter (comment _)
1809 "Interpret COMMENT element as Org syntax.
1810 CONTENTS is nil."
1811 (replace-regexp-in-string "^" "# " (org-element-property :value comment)))
1814 ;;;; Comment Block
1816 (defun org-element-comment-block-parser (limit affiliated)
1817 "Parse an export block.
1819 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1820 the buffer position at the beginning of the first affiliated
1821 keyword and CDR is a plist of affiliated keywords along with
1822 their value.
1824 Return a list whose CAR is `comment-block' and CDR is a plist
1825 containing `:begin', `:end', `:value', `:post-blank' and
1826 `:post-affiliated' keywords.
1828 Assume point is at comment block beginning."
1829 (let ((case-fold-search t))
1830 (if (not (save-excursion
1831 (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t)))
1832 ;; Incomplete block: parse it as a paragraph.
1833 (org-element-paragraph-parser limit affiliated)
1834 (let ((contents-end (match-beginning 0)))
1835 (save-excursion
1836 (let* ((begin (car affiliated))
1837 (post-affiliated (point))
1838 (contents-begin (progn (forward-line) (point)))
1839 (pos-before-blank (progn (goto-char contents-end)
1840 (forward-line)
1841 (point)))
1842 (end (progn (skip-chars-forward " \r\t\n" limit)
1843 (if (eobp) (point) (line-beginning-position))))
1844 (value (buffer-substring-no-properties
1845 contents-begin contents-end)))
1846 (list 'comment-block
1847 (nconc
1848 (list :begin begin
1849 :end end
1850 :value value
1851 :post-blank (count-lines pos-before-blank end)
1852 :post-affiliated post-affiliated)
1853 (cdr affiliated)))))))))
1855 (defun org-element-comment-block-interpreter (comment-block _)
1856 "Interpret COMMENT-BLOCK element as Org syntax."
1857 (format "#+begin_comment\n%s#+end_comment"
1858 (org-element-normalize-string
1859 (org-remove-indentation
1860 (org-element-property :value comment-block)))))
1863 ;;;; Diary Sexp
1865 (defun org-element-diary-sexp-parser (limit affiliated)
1866 "Parse a diary sexp.
1868 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1869 the buffer position at the beginning of the first affiliated
1870 keyword and CDR is a plist of affiliated keywords along with
1871 their value.
1873 Return a list whose CAR is `diary-sexp' and CDR is a plist
1874 containing `:begin', `:end', `:value', `:post-blank' and
1875 `:post-affiliated' keywords."
1876 (save-excursion
1877 (let ((begin (car affiliated))
1878 (post-affiliated (point))
1879 (value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
1880 (match-string-no-properties 1)))
1881 (pos-before-blank (progn (forward-line) (point)))
1882 (end (progn (skip-chars-forward " \r\t\n" limit)
1883 (if (eobp) (point) (line-beginning-position)))))
1884 (list 'diary-sexp
1885 (nconc
1886 (list :value value
1887 :begin begin
1888 :end end
1889 :post-blank (count-lines pos-before-blank end)
1890 :post-affiliated post-affiliated)
1891 (cdr affiliated))))))
1893 (defun org-element-diary-sexp-interpreter (diary-sexp _)
1894 "Interpret DIARY-SEXP as Org syntax."
1895 (org-element-property :value diary-sexp))
1898 ;;;; Example Block
1900 (defun org-element-example-block-parser (limit affiliated)
1901 "Parse an example block.
1903 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1904 the buffer position at the beginning of the first affiliated
1905 keyword and CDR is a plist of affiliated keywords along with
1906 their value.
1908 Return a list whose CAR is `example-block' and CDR is a plist
1909 containing `:begin', `:end', `:number-lines', `:preserve-indent',
1910 `:retain-labels', `:use-labels', `:label-fmt', `:switches',
1911 `:value', `:post-blank' and `:post-affiliated' keywords."
1912 (let ((case-fold-search t))
1913 (if (not (save-excursion
1914 (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
1915 ;; Incomplete block: parse it as a paragraph.
1916 (org-element-paragraph-parser limit affiliated)
1917 (let ((contents-end (match-beginning 0)))
1918 (save-excursion
1919 (let* ((switches
1920 (progn
1921 (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
1922 (match-string-no-properties 1)))
1923 ;; Switches analysis.
1924 (number-lines
1925 (and switches
1926 (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
1927 switches)
1928 (cons
1929 (if (equal (match-string 1 switches) "-")
1930 'new
1931 'continued)
1932 (if (not (match-end 2)) 0
1933 ;; Subtract 1 to give number of lines before
1934 ;; first line.
1935 (1- (string-to-number (match-string 2 switches)))))))
1936 (preserve-indent
1937 (and switches (string-match "-i\\>" switches)))
1938 ;; Should labels be retained in (or stripped from) example
1939 ;; blocks?
1940 (retain-labels
1941 (or (not switches)
1942 (not (string-match "-r\\>" switches))
1943 (and number-lines (string-match "-k\\>" switches))))
1944 ;; What should code-references use - labels or
1945 ;; line-numbers?
1946 (use-labels
1947 (or (not switches)
1948 (and retain-labels
1949 (not (string-match "-k\\>" switches)))))
1950 (label-fmt
1951 (and switches
1952 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
1953 (match-string 1 switches)))
1954 ;; Standard block parsing.
1955 (begin (car affiliated))
1956 (post-affiliated (point))
1957 (contents-begin (line-beginning-position 2))
1958 (value (org-unescape-code-in-string
1959 (buffer-substring-no-properties
1960 contents-begin contents-end)))
1961 (pos-before-blank (progn (goto-char contents-end)
1962 (forward-line)
1963 (point)))
1964 (end (progn (skip-chars-forward " \r\t\n" limit)
1965 (if (eobp) (point) (line-beginning-position)))))
1966 (list 'example-block
1967 (nconc
1968 (list :begin begin
1969 :end end
1970 :value value
1971 :switches switches
1972 :number-lines number-lines
1973 :preserve-indent preserve-indent
1974 :retain-labels retain-labels
1975 :use-labels use-labels
1976 :label-fmt label-fmt
1977 :post-blank (count-lines pos-before-blank end)
1978 :post-affiliated post-affiliated)
1979 (cdr affiliated)))))))))
1981 (defun org-element-example-block-interpreter (example-block _)
1982 "Interpret EXAMPLE-BLOCK element as Org syntax."
1983 (let ((switches (org-element-property :switches example-block))
1984 (value
1985 (let ((val (org-element-property :value example-block)))
1986 (cond
1987 ((or org-src-preserve-indentation
1988 (org-element-property :preserve-indent example-block))
1989 val)
1990 ((= 0 org-edit-src-content-indentation)
1991 (org-remove-indentation val))
1993 (let ((ind (make-string org-edit-src-content-indentation ?\s)))
1994 (replace-regexp-in-string "^[ \t]*\\S-"
1995 (concat ind "\\&")
1996 (org-remove-indentation val))))))))
1997 (concat "#+begin_example" (and switches (concat " " switches)) "\n"
1998 (org-element-normalize-string (org-escape-code-in-string value))
1999 "#+end_example")))
2002 ;;;; Export Block
2004 (defun org-element-export-block-parser (limit affiliated)
2005 "Parse an export block.
2007 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2008 the buffer position at the beginning of the first affiliated
2009 keyword and CDR is a plist of affiliated keywords along with
2010 their value.
2012 Return a list whose CAR is `export-block' and CDR is a plist
2013 containing `:begin', `:end', `:type', `:value', `:post-blank' and
2014 `:post-affiliated' keywords.
2016 Assume point is at export-block beginning."
2017 (let* ((case-fold-search t))
2018 (if (not (save-excursion
2019 (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t)))
2020 ;; Incomplete block: parse it as a paragraph.
2021 (org-element-paragraph-parser limit affiliated)
2022 (save-excursion
2023 (let* ((contents-end (match-beginning 0))
2024 (backend
2025 (progn
2026 (looking-at
2027 "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$")
2028 (match-string-no-properties 1)))
2029 (begin (car affiliated))
2030 (post-affiliated (point))
2031 (contents-begin (progn (forward-line) (point)))
2032 (pos-before-blank (progn (goto-char contents-end)
2033 (forward-line)
2034 (point)))
2035 (end (progn (skip-chars-forward " \r\t\n" limit)
2036 (if (eobp) (point) (line-beginning-position))))
2037 (value (org-unescape-code-in-string
2038 (buffer-substring-no-properties contents-begin
2039 contents-end))))
2040 (list 'export-block
2041 (nconc
2042 (list :type (and backend (upcase backend))
2043 :begin begin
2044 :end end
2045 :value value
2046 :post-blank (count-lines pos-before-blank end)
2047 :post-affiliated post-affiliated)
2048 (cdr affiliated))))))))
2050 (defun org-element-export-block-interpreter (export-block _)
2051 "Interpret EXPORT-BLOCK element as Org syntax."
2052 (format "#+begin_export %s\n%s#+end_export"
2053 (org-element-property :type export-block)
2054 (org-element-property :value export-block)))
2057 ;;;; Fixed-width
2059 (defun org-element-fixed-width-parser (limit affiliated)
2060 "Parse a fixed-width section.
2062 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2063 the buffer position at the beginning of the first affiliated
2064 keyword and CDR is a plist of affiliated keywords along with
2065 their value.
2067 Return a list whose CAR is `fixed-width' and CDR is a plist
2068 containing `:begin', `:end', `:value', `:post-blank' and
2069 `:post-affiliated' keywords.
2071 Assume point is at the beginning of the fixed-width area."
2072 (save-excursion
2073 (let* ((begin (car affiliated))
2074 (post-affiliated (point))
2075 value
2076 (end-area
2077 (progn
2078 (while (and (< (point) limit)
2079 (looking-at "[ \t]*:\\( \\|$\\)"))
2080 ;; Accumulate text without starting colons.
2081 (setq value
2082 (concat value
2083 (buffer-substring-no-properties
2084 (match-end 0) (point-at-eol))
2085 "\n"))
2086 (forward-line))
2087 (point)))
2088 (end (progn (skip-chars-forward " \r\t\n" limit)
2089 (if (eobp) (point) (line-beginning-position)))))
2090 (list 'fixed-width
2091 (nconc
2092 (list :begin begin
2093 :end end
2094 :value value
2095 :post-blank (count-lines end-area end)
2096 :post-affiliated post-affiliated)
2097 (cdr affiliated))))))
2099 (defun org-element-fixed-width-interpreter (fixed-width _)
2100 "Interpret FIXED-WIDTH element as Org syntax."
2101 (let ((value (org-element-property :value fixed-width)))
2102 (and value
2103 (replace-regexp-in-string
2104 "^" ": "
2105 (if (string-match "\n\\'" value) (substring value 0 -1) value)))))
2108 ;;;; Horizontal Rule
2110 (defun org-element-horizontal-rule-parser (limit affiliated)
2111 "Parse an horizontal rule.
2113 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2114 the buffer position at the beginning of the first affiliated
2115 keyword and CDR is a plist of affiliated keywords along with
2116 their value.
2118 Return a list whose CAR is `horizontal-rule' and CDR is a plist
2119 containing `:begin', `:end', `:post-blank' and `:post-affiliated'
2120 keywords."
2121 (save-excursion
2122 (let ((begin (car affiliated))
2123 (post-affiliated (point))
2124 (post-hr (progn (forward-line) (point)))
2125 (end (progn (skip-chars-forward " \r\t\n" limit)
2126 (if (eobp) (point) (line-beginning-position)))))
2127 (list 'horizontal-rule
2128 (nconc
2129 (list :begin begin
2130 :end end
2131 :post-blank (count-lines post-hr end)
2132 :post-affiliated post-affiliated)
2133 (cdr affiliated))))))
2135 (defun org-element-horizontal-rule-interpreter (&rest _)
2136 "Interpret HORIZONTAL-RULE element as Org syntax."
2137 "-----")
2140 ;;;; Keyword
2142 (defun org-element-keyword-parser (limit affiliated)
2143 "Parse a keyword at point.
2145 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2146 the buffer position at the beginning of the first affiliated
2147 keyword and CDR is a plist of affiliated keywords along with
2148 their value.
2150 Return a list whose CAR is `keyword' and CDR is a plist
2151 containing `:key', `:value', `:begin', `:end', `:post-blank' and
2152 `:post-affiliated' keywords."
2153 (save-excursion
2154 ;; An orphaned affiliated keyword is considered as a regular
2155 ;; keyword. In this case AFFILIATED is nil, so we take care of
2156 ;; this corner case.
2157 (let ((begin (or (car affiliated) (point)))
2158 (post-affiliated (point))
2159 (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
2160 (upcase (match-string-no-properties 1))))
2161 (value (org-trim (buffer-substring-no-properties
2162 (match-end 0) (point-at-eol))))
2163 (pos-before-blank (progn (forward-line) (point)))
2164 (end (progn (skip-chars-forward " \r\t\n" limit)
2165 (if (eobp) (point) (line-beginning-position)))))
2166 (list 'keyword
2167 (nconc
2168 (list :key key
2169 :value value
2170 :begin begin
2171 :end end
2172 :post-blank (count-lines pos-before-blank end)
2173 :post-affiliated post-affiliated)
2174 (cdr affiliated))))))
2176 (defun org-element-keyword-interpreter (keyword _)
2177 "Interpret KEYWORD element as Org syntax."
2178 (format "#+%s: %s"
2179 (downcase (org-element-property :key keyword))
2180 (org-element-property :value keyword)))
2183 ;;;; Latex Environment
2185 (defconst org-element--latex-begin-environment
2186 "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}"
2187 "Regexp matching the beginning of a LaTeX environment.
2188 The environment is captured by the first group.
2190 See also `org-element--latex-end-environment'.")
2192 (defconst org-element--latex-end-environment
2193 "\\\\end{%s}[ \t]*$"
2194 "Format string matching the ending of a LaTeX environment.
2195 See also `org-element--latex-begin-environment'.")
2197 (defun org-element-latex-environment-parser (limit affiliated)
2198 "Parse a LaTeX environment.
2200 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2201 the buffer position at the beginning of the first affiliated
2202 keyword and CDR is a plist of affiliated keywords along with
2203 their value.
2205 Return a list whose CAR is `latex-environment' and CDR is a plist
2206 containing `:begin', `:end', `:value', `:post-blank' and
2207 `:post-affiliated' keywords.
2209 Assume point is at the beginning of the latex environment."
2210 (save-excursion
2211 (let ((case-fold-search t)
2212 (code-begin (point)))
2213 (looking-at org-element--latex-begin-environment)
2214 (if (not (re-search-forward (format org-element--latex-end-environment
2215 (regexp-quote (match-string 1)))
2216 limit t))
2217 ;; Incomplete latex environment: parse it as a paragraph.
2218 (org-element-paragraph-parser limit affiliated)
2219 (let* ((code-end (progn (forward-line) (point)))
2220 (begin (car affiliated))
2221 (value (buffer-substring-no-properties code-begin code-end))
2222 (end (progn (skip-chars-forward " \r\t\n" limit)
2223 (if (eobp) (point) (line-beginning-position)))))
2224 (list 'latex-environment
2225 (nconc
2226 (list :begin begin
2227 :end end
2228 :value value
2229 :post-blank (count-lines code-end end)
2230 :post-affiliated code-begin)
2231 (cdr affiliated))))))))
2233 (defun org-element-latex-environment-interpreter (latex-environment _)
2234 "Interpret LATEX-ENVIRONMENT element as Org syntax."
2235 (org-element-property :value latex-environment))
2238 ;;;; Node Property
2240 (defun org-element-node-property-parser (limit)
2241 "Parse a node-property at point.
2243 LIMIT bounds the search.
2245 Return a list whose CAR is `node-property' and CDR is a plist
2246 containing `:key', `:value', `:begin', `:end', `:post-blank' and
2247 `:post-affiliated' keywords."
2248 (looking-at org-property-re)
2249 (let ((case-fold-search t)
2250 (begin (point))
2251 (key (match-string-no-properties 2))
2252 (value (match-string-no-properties 3))
2253 (end (save-excursion
2254 (end-of-line)
2255 (if (re-search-forward org-property-re limit t)
2256 (line-beginning-position)
2257 limit))))
2258 (list 'node-property
2259 (list :key key
2260 :value value
2261 :begin begin
2262 :end end
2263 :post-blank 0
2264 :post-affiliated begin))))
2266 (defun org-element-node-property-interpreter (node-property _)
2267 "Interpret NODE-PROPERTY element as Org syntax."
2268 (format org-property-format
2269 (format ":%s:" (org-element-property :key node-property))
2270 (or (org-element-property :value node-property) "")))
2273 ;;;; Paragraph
2275 (defun org-element-paragraph-parser (limit affiliated)
2276 "Parse a paragraph.
2278 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2279 the buffer position at the beginning of the first affiliated
2280 keyword and CDR is a plist of affiliated keywords along with
2281 their value.
2283 Return a list whose CAR is `paragraph' and CDR is a plist
2284 containing `:begin', `:end', `:contents-begin' and
2285 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
2287 Assume point is at the beginning of the paragraph."
2288 (save-excursion
2289 (let* ((begin (car affiliated))
2290 (contents-begin (point))
2291 (before-blank
2292 (let ((case-fold-search t))
2293 (end-of-line)
2294 ;; A matching `org-element-paragraph-separate' is not
2295 ;; necessarily the end of the paragraph. In particular,
2296 ;; drawers, blocks or LaTeX environments opening lines
2297 ;; must be closed. Moreover keywords with a secondary
2298 ;; value must belong to "dual keywords".
2299 (while (not
2300 (cond
2301 ((not (and (re-search-forward
2302 org-element-paragraph-separate limit 'move)
2303 (progn (beginning-of-line) t))))
2304 ((looking-at org-drawer-regexp)
2305 (save-excursion
2306 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
2307 ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
2308 (save-excursion
2309 (re-search-forward
2310 (format "^[ \t]*#\\+END_%s[ \t]*$"
2311 (regexp-quote (match-string 1)))
2312 limit t)))
2313 ((looking-at org-element--latex-begin-environment)
2314 (save-excursion
2315 (re-search-forward
2316 (format org-element--latex-end-environment
2317 (regexp-quote (match-string 1)))
2318 limit t)))
2319 ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:")
2320 (member-ignore-case (match-string 1)
2321 org-element-dual-keywords))
2322 ;; Everything else is unambiguous.
2323 (t)))
2324 (end-of-line))
2325 (if (= (point) limit) limit
2326 (goto-char (line-beginning-position)))))
2327 (contents-end (save-excursion
2328 (skip-chars-backward " \r\t\n" contents-begin)
2329 (line-beginning-position 2)))
2330 (end (progn (skip-chars-forward " \r\t\n" limit)
2331 (if (eobp) (point) (line-beginning-position)))))
2332 (list 'paragraph
2333 (nconc
2334 (list :begin begin
2335 :end end
2336 :contents-begin contents-begin
2337 :contents-end contents-end
2338 :post-blank (count-lines before-blank end)
2339 :post-affiliated contents-begin)
2340 (cdr affiliated))))))
2342 (defun org-element-paragraph-interpreter (_ contents)
2343 "Interpret paragraph element as Org syntax.
2344 CONTENTS is the contents of the element."
2345 contents)
2348 ;;;; Planning
2350 (defun org-element-planning-parser (limit)
2351 "Parse a planning.
2353 LIMIT bounds the search.
2355 Return a list whose CAR is `planning' and CDR is a plist
2356 containing `:closed', `:deadline', `:scheduled', `:begin',
2357 `:end', `:post-blank' and `:post-affiliated' keywords."
2358 (save-excursion
2359 (let* ((case-fold-search nil)
2360 (begin (point))
2361 (post-blank (let ((before-blank (progn (forward-line) (point))))
2362 (skip-chars-forward " \r\t\n" limit)
2363 (skip-chars-backward " \t")
2364 (unless (bolp) (end-of-line))
2365 (count-lines before-blank (point))))
2366 (end (point))
2367 closed deadline scheduled)
2368 (goto-char begin)
2369 (while (re-search-forward org-keyword-time-not-clock-regexp end t)
2370 (goto-char (match-end 1))
2371 (skip-chars-forward " \t" end)
2372 (let ((keyword (match-string 1))
2373 (time (org-element-timestamp-parser)))
2374 (cond ((equal keyword org-closed-string) (setq closed time))
2375 ((equal keyword org-deadline-string) (setq deadline time))
2376 (t (setq scheduled time)))))
2377 (list 'planning
2378 (list :closed closed
2379 :deadline deadline
2380 :scheduled scheduled
2381 :begin begin
2382 :end end
2383 :post-blank post-blank
2384 :post-affiliated begin)))))
2386 (defun org-element-planning-interpreter (planning _)
2387 "Interpret PLANNING element as Org syntax."
2388 (mapconcat
2389 #'identity
2390 (delq nil
2391 (list (let ((deadline (org-element-property :deadline planning)))
2392 (when deadline
2393 (concat org-deadline-string " "
2394 (org-element-timestamp-interpreter deadline nil))))
2395 (let ((scheduled (org-element-property :scheduled planning)))
2396 (when scheduled
2397 (concat org-scheduled-string " "
2398 (org-element-timestamp-interpreter scheduled nil))))
2399 (let ((closed (org-element-property :closed planning)))
2400 (when closed
2401 (concat org-closed-string " "
2402 (org-element-timestamp-interpreter closed nil))))))
2403 " "))
2406 ;;;; Src Block
2408 (defun org-element-src-block-parser (limit affiliated)
2409 "Parse a src block.
2411 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2412 the buffer position at the beginning of the first affiliated
2413 keyword and CDR is a plist of affiliated keywords along with
2414 their value.
2416 Return a list whose CAR is `src-block' and CDR is a plist
2417 containing `:language', `:switches', `:parameters', `:begin',
2418 `:end', `:number-lines', `:retain-labels', `:use-labels',
2419 `:label-fmt', `:preserve-indent', `:value', `:post-blank' and
2420 `:post-affiliated' keywords.
2422 Assume point is at the beginning of the block."
2423 (let ((case-fold-search t))
2424 (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$"
2425 limit t)))
2426 ;; Incomplete block: parse it as a paragraph.
2427 (org-element-paragraph-parser limit affiliated)
2428 (let ((contents-end (match-beginning 0)))
2429 (save-excursion
2430 (let* ((begin (car affiliated))
2431 (post-affiliated (point))
2432 ;; Get language as a string.
2433 (language
2434 (progn
2435 (looking-at
2436 "^[ \t]*#\\+BEGIN_SRC\
2437 \\(?: +\\(\\S-+\\)\\)?\
2438 \\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\
2439 \\(.*\\)[ \t]*$")
2440 (match-string-no-properties 1)))
2441 ;; Get switches.
2442 (switches (match-string-no-properties 2))
2443 ;; Get parameters.
2444 (parameters (match-string-no-properties 3))
2445 ;; Switches analysis.
2446 (number-lines
2447 (and switches
2448 (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
2449 switches)
2450 (cons
2451 (if (equal (match-string 1 switches) "-")
2452 'new
2453 'continued)
2454 (if (not (match-end 2)) 0
2455 ;; Subtract 1 to give number of lines before
2456 ;; first line.
2457 (1- (string-to-number (match-string 2 switches)))))))
2458 (preserve-indent (and switches
2459 (string-match "-i\\>" switches)))
2460 (label-fmt
2461 (and switches
2462 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
2463 (match-string 1 switches)))
2464 ;; Should labels be retained in (or stripped from)
2465 ;; src blocks?
2466 (retain-labels
2467 (or (not switches)
2468 (not (string-match "-r\\>" switches))
2469 (and number-lines (string-match "-k\\>" switches))))
2470 ;; What should code-references use - labels or
2471 ;; line-numbers?
2472 (use-labels
2473 (or (not switches)
2474 (and retain-labels
2475 (not (string-match "-k\\>" switches)))))
2476 ;; Retrieve code.
2477 (value (org-unescape-code-in-string
2478 (buffer-substring-no-properties
2479 (line-beginning-position 2) contents-end)))
2480 (pos-before-blank (progn (goto-char contents-end)
2481 (forward-line)
2482 (point)))
2483 ;; Get position after ending blank lines.
2484 (end (progn (skip-chars-forward " \r\t\n" limit)
2485 (if (eobp) (point) (line-beginning-position)))))
2486 (list 'src-block
2487 (nconc
2488 (list :language language
2489 :switches (and (org-string-nw-p switches)
2490 (org-trim switches))
2491 :parameters (and (org-string-nw-p parameters)
2492 (org-trim parameters))
2493 :begin begin
2494 :end end
2495 :number-lines number-lines
2496 :preserve-indent preserve-indent
2497 :retain-labels retain-labels
2498 :use-labels use-labels
2499 :label-fmt label-fmt
2500 :value value
2501 :post-blank (count-lines pos-before-blank end)
2502 :post-affiliated post-affiliated)
2503 (cdr affiliated)))))))))
2505 (defun org-element-src-block-interpreter (src-block _)
2506 "Interpret SRC-BLOCK element as Org syntax."
2507 (let ((lang (org-element-property :language src-block))
2508 (switches (org-element-property :switches src-block))
2509 (params (org-element-property :parameters src-block))
2510 (value
2511 (let ((val (org-element-property :value src-block)))
2512 (cond
2513 ((or org-src-preserve-indentation
2514 (org-element-property :preserve-indent src-block))
2515 val)
2516 ((zerop org-edit-src-content-indentation)
2517 (org-remove-indentation val))
2519 (let ((ind (make-string org-edit-src-content-indentation ?\s)))
2520 (replace-regexp-in-string "^[ \t]*\\S-"
2521 (concat ind "\\&")
2522 (org-remove-indentation val))))))))
2523 (format "#+begin_src%s\n%s#+end_src"
2524 (concat (and lang (concat " " lang))
2525 (and switches (concat " " switches))
2526 (and params (concat " " params)))
2527 (org-element-normalize-string (org-escape-code-in-string value)))))
2530 ;;;; Table
2532 (defun org-element-table-parser (limit affiliated)
2533 "Parse a table at point.
2535 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2536 the buffer position at the beginning of the first affiliated
2537 keyword and CDR is a plist of affiliated keywords along with
2538 their value.
2540 Return a list whose CAR is `table' and CDR is a plist containing
2541 `:begin', `:end', `:tblfm', `:type', `:contents-begin',
2542 `:contents-end', `:value', `:post-blank' and `:post-affiliated'
2543 keywords.
2545 Assume point is at the beginning of the table."
2546 (save-excursion
2547 (let* ((case-fold-search t)
2548 (table-begin (point))
2549 (type (if (looking-at "[ \t]*|") 'org 'table.el))
2550 (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
2551 (if (eq type 'org) "" "+")))
2552 (begin (car affiliated))
2553 (table-end
2554 (if (re-search-forward end-re limit 'move)
2555 (goto-char (match-beginning 0))
2556 (point)))
2557 (tblfm (let (acc)
2558 (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
2559 (push (match-string-no-properties 1) acc)
2560 (forward-line))
2561 acc))
2562 (pos-before-blank (point))
2563 (end (progn (skip-chars-forward " \r\t\n" limit)
2564 (if (eobp) (point) (line-beginning-position)))))
2565 (list 'table
2566 (nconc
2567 (list :begin begin
2568 :end end
2569 :type type
2570 :tblfm tblfm
2571 ;; Only `org' tables have contents. `table.el' tables
2572 ;; use a `:value' property to store raw table as
2573 ;; a string.
2574 :contents-begin (and (eq type 'org) table-begin)
2575 :contents-end (and (eq type 'org) table-end)
2576 :value (and (eq type 'table.el)
2577 (buffer-substring-no-properties
2578 table-begin table-end))
2579 :post-blank (count-lines pos-before-blank end)
2580 :post-affiliated table-begin)
2581 (cdr affiliated))))))
2583 (defun org-element-table-interpreter (table contents)
2584 "Interpret TABLE element as Org syntax.
2585 CONTENTS is a string, if table's type is `org', or nil."
2586 (if (eq (org-element-property :type table) 'table.el)
2587 (org-remove-indentation (org-element-property :value table))
2588 (concat (with-temp-buffer (insert contents)
2589 (org-table-align)
2590 (buffer-string))
2591 (mapconcat (lambda (fm) (concat "#+TBLFM: " fm))
2592 (reverse (org-element-property :tblfm table))
2593 "\n"))))
2596 ;;;; Table Row
2598 (defun org-element-table-row-parser (_)
2599 "Parse table row at point.
2601 Return a list whose CAR is `table-row' and CDR is a plist
2602 containing `:begin', `:end', `:contents-begin', `:contents-end',
2603 `:type', `:post-blank' and `:post-affiliated' keywords."
2604 (save-excursion
2605 (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
2606 (begin (point))
2607 ;; A table rule has no contents. In that case, ensure
2608 ;; CONTENTS-BEGIN matches CONTENTS-END.
2609 (contents-begin (and (eq type 'standard) (search-forward "|")))
2610 (contents-end (and (eq type 'standard)
2611 (progn
2612 (end-of-line)
2613 (skip-chars-backward " \t")
2614 (point))))
2615 (end (line-beginning-position 2)))
2616 (list 'table-row
2617 (list :type type
2618 :begin begin
2619 :end end
2620 :contents-begin contents-begin
2621 :contents-end contents-end
2622 :post-blank 0
2623 :post-affiliated begin)))))
2625 (defun org-element-table-row-interpreter (table-row contents)
2626 "Interpret TABLE-ROW element as Org syntax.
2627 CONTENTS is the contents of the table row."
2628 (if (eq (org-element-property :type table-row) 'rule) "|-"
2629 (concat "|" contents)))
2632 ;;;; Verse Block
2634 (defun org-element-verse-block-parser (limit affiliated)
2635 "Parse a verse block.
2637 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2638 the buffer position at the beginning of the first affiliated
2639 keyword and CDR is a plist of affiliated keywords along with
2640 their value.
2642 Return a list whose CAR is `verse-block' and CDR is a plist
2643 containing `:begin', `:end', `:contents-begin', `:contents-end',
2644 `:post-blank' and `:post-affiliated' keywords.
2646 Assume point is at beginning of the block."
2647 (let ((case-fold-search t))
2648 (if (not (save-excursion
2649 (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t)))
2650 ;; Incomplete block: parse it as a paragraph.
2651 (org-element-paragraph-parser limit affiliated)
2652 (let ((contents-end (match-beginning 0)))
2653 (save-excursion
2654 (let* ((begin (car affiliated))
2655 (post-affiliated (point))
2656 (contents-begin (progn (forward-line) (point)))
2657 (pos-before-blank (progn (goto-char contents-end)
2658 (forward-line)
2659 (point)))
2660 (end (progn (skip-chars-forward " \r\t\n" limit)
2661 (if (eobp) (point) (line-beginning-position)))))
2662 (list 'verse-block
2663 (nconc
2664 (list :begin begin
2665 :end end
2666 :contents-begin contents-begin
2667 :contents-end contents-end
2668 :post-blank (count-lines pos-before-blank end)
2669 :post-affiliated post-affiliated)
2670 (cdr affiliated)))))))))
2672 (defun org-element-verse-block-interpreter (_ contents)
2673 "Interpret verse-block element as Org syntax.
2674 CONTENTS is verse block contents."
2675 (format "#+begin_verse\n%s#+end_verse" contents))
2679 ;;; Objects
2681 ;; Unlike to elements, raw text can be found between objects. Hence,
2682 ;; `org-element--object-lex' is provided to find the next object in
2683 ;; buffer.
2685 ;; Some object types (e.g., `italic') are recursive. Restrictions on
2686 ;; object types they can contain will be specified in
2687 ;; `org-element-object-restrictions'.
2689 ;; Creating a new type of object requires to alter
2690 ;; `org-element--object-regexp' and `org-element--object-lex', add the
2691 ;; new type in `org-element-all-objects', and possibly add
2692 ;; restrictions in `org-element-object-restrictions'.
2694 ;;;; Bold
2696 (defun org-element-bold-parser ()
2697 "Parse bold object at point, if any.
2699 When at a bold object, return a list whose car is `bold' and cdr
2700 is a plist with `:begin', `:end', `:contents-begin' and
2701 `:contents-end' and `:post-blank' keywords. Otherwise, return
2702 nil.
2704 Assume point is at the first star marker."
2705 (save-excursion
2706 (unless (bolp) (backward-char 1))
2707 (when (looking-at org-emph-re)
2708 (let ((begin (match-beginning 2))
2709 (contents-begin (match-beginning 4))
2710 (contents-end (match-end 4))
2711 (post-blank (progn (goto-char (match-end 2))
2712 (skip-chars-forward " \t")))
2713 (end (point)))
2714 (list 'bold
2715 (list :begin begin
2716 :end end
2717 :contents-begin contents-begin
2718 :contents-end contents-end
2719 :post-blank post-blank))))))
2721 (defun org-element-bold-interpreter (_ contents)
2722 "Interpret bold object as Org syntax.
2723 CONTENTS is the contents of the object."
2724 (format "*%s*" contents))
2727 ;;;; Code
2729 (defun org-element-code-parser ()
2730 "Parse code object at point, if any.
2732 When at a code object, return a list whose car is `code' and cdr
2733 is a plist with `:value', `:begin', `:end' and `:post-blank'
2734 keywords. Otherwise, return nil.
2736 Assume point is at the first tilde marker."
2737 (save-excursion
2738 (unless (bolp) (backward-char 1))
2739 (when (looking-at org-verbatim-re)
2740 (let ((begin (match-beginning 2))
2741 (value (match-string-no-properties 4))
2742 (post-blank (progn (goto-char (match-end 2))
2743 (skip-chars-forward " \t")))
2744 (end (point)))
2745 (list 'code
2746 (list :value value
2747 :begin begin
2748 :end end
2749 :post-blank post-blank))))))
2751 (defun org-element-code-interpreter (code _)
2752 "Interpret CODE object as Org syntax."
2753 (format "~%s~" (org-element-property :value code)))
2756 ;;;; Entity
2758 (defun org-element-entity-parser ()
2759 "Parse entity at point, if any.
2761 When at an entity, return a list whose car is `entity' and cdr
2762 a plist with `:begin', `:end', `:latex', `:latex-math-p',
2763 `:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and
2764 `:post-blank' as keywords. Otherwise, return nil.
2766 Assume point is at the beginning of the entity."
2767 (catch 'no-object
2768 (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)")
2769 (save-excursion
2770 (let* ((value (or (org-entity-get (match-string 1))
2771 (throw 'no-object nil)))
2772 (begin (match-beginning 0))
2773 (bracketsp (string= (match-string 2) "{}"))
2774 (post-blank (progn (goto-char (match-end 1))
2775 (when bracketsp (forward-char 2))
2776 (skip-chars-forward " \t")))
2777 (end (point)))
2778 (list 'entity
2779 (list :name (car value)
2780 :latex (nth 1 value)
2781 :latex-math-p (nth 2 value)
2782 :html (nth 3 value)
2783 :ascii (nth 4 value)
2784 :latin1 (nth 5 value)
2785 :utf-8 (nth 6 value)
2786 :begin begin
2787 :end end
2788 :use-brackets-p bracketsp
2789 :post-blank post-blank)))))))
2791 (defun org-element-entity-interpreter (entity _)
2792 "Interpret ENTITY object as Org syntax."
2793 (concat "\\"
2794 (org-element-property :name entity)
2795 (when (org-element-property :use-brackets-p entity) "{}")))
2798 ;;;; Export Snippet
2800 (defun org-element-export-snippet-parser ()
2801 "Parse export snippet at point.
2803 When at an export snippet, return a list whose car is
2804 `export-snippet' and cdr a plist with `:begin', `:end',
2805 `:back-end', `:value' and `:post-blank' as keywords. Otherwise,
2806 return nil.
2808 Assume point is at the beginning of the snippet."
2809 (save-excursion
2810 (let (contents-end)
2811 (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):")
2812 (setq contents-end
2813 (save-match-data (goto-char (match-end 0))
2814 (re-search-forward "@@" nil t)
2815 (match-beginning 0))))
2816 (let* ((begin (match-beginning 0))
2817 (back-end (match-string-no-properties 1))
2818 (value (buffer-substring-no-properties
2819 (match-end 0) contents-end))
2820 (post-blank (skip-chars-forward " \t"))
2821 (end (point)))
2822 (list 'export-snippet
2823 (list :back-end back-end
2824 :value value
2825 :begin begin
2826 :end end
2827 :post-blank post-blank)))))))
2829 (defun org-element-export-snippet-interpreter (export-snippet _)
2830 "Interpret EXPORT-SNIPPET object as Org syntax."
2831 (format "@@%s:%s@@"
2832 (org-element-property :back-end export-snippet)
2833 (org-element-property :value export-snippet)))
2836 ;;;; Footnote Reference
2838 (defun org-element-footnote-reference-parser ()
2839 "Parse footnote reference at point, if any.
2841 When at a footnote reference, return a list whose car is
2842 `footnote-reference' and cdr a plist with `:label', `:type',
2843 `:begin', `:end', `:content-begin', `:contents-end' and
2844 `:post-blank' as keywords. Otherwise, return nil."
2845 (when (looking-at org-footnote-re)
2846 (let ((closing (with-syntax-table org-element--pair-square-table
2847 (ignore-errors (scan-lists (point) 1 0)))))
2848 (when closing
2849 (save-excursion
2850 (let* ((begin (point))
2851 (label (match-string-no-properties 1))
2852 (inner-begin (match-end 0))
2853 (inner-end (1- closing))
2854 (type (if (match-end 2) 'inline 'standard))
2855 (post-blank (progn (goto-char closing)
2856 (skip-chars-forward " \t")))
2857 (end (point)))
2858 (list 'footnote-reference
2859 (list :label label
2860 :type type
2861 :begin begin
2862 :end end
2863 :contents-begin (and (eq type 'inline) inner-begin)
2864 :contents-end (and (eq type 'inline) inner-end)
2865 :post-blank post-blank))))))))
2867 (defun org-element-footnote-reference-interpreter (footnote-reference contents)
2868 "Interpret FOOTNOTE-REFERENCE object as Org syntax.
2869 CONTENTS is its definition, when inline, or nil."
2870 (format "[fn:%s%s]"
2871 (or (org-element-property :label footnote-reference) "")
2872 (if contents (concat ":" contents) "")))
2875 ;;;; Inline Babel Call
2877 (defun org-element-inline-babel-call-parser ()
2878 "Parse inline babel call at point, if any.
2880 When at an inline babel call, return a list whose car is
2881 `inline-babel-call' and cdr a plist with `:call',
2882 `:inside-header', `:arguments', `:end-header', `:begin', `:end',
2883 `:value' and `:post-blank' as keywords. Otherwise, return nil.
2885 Assume point is at the beginning of the babel call."
2886 (save-excursion
2887 (catch :no-object
2888 (when (let ((case-fold-search nil))
2889 (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]"))
2890 (goto-char (match-end 1))
2891 (let* ((begin (match-beginning 0))
2892 (call (match-string-no-properties 1))
2893 (inside-header
2894 (let ((p (org-element--parse-paired-brackets ?\[)))
2895 (and (org-string-nw-p p)
2896 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
2897 (arguments (org-string-nw-p
2898 (or (org-element--parse-paired-brackets ?\()
2899 ;; Parenthesis are mandatory.
2900 (throw :no-object nil))))
2901 (end-header
2902 (let ((p (org-element--parse-paired-brackets ?\[)))
2903 (and (org-string-nw-p p)
2904 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
2905 (value (buffer-substring-no-properties begin (point)))
2906 (post-blank (skip-chars-forward " \t"))
2907 (end (point)))
2908 (list 'inline-babel-call
2909 (list :call call
2910 :inside-header inside-header
2911 :arguments arguments
2912 :end-header end-header
2913 :begin begin
2914 :end end
2915 :value value
2916 :post-blank post-blank)))))))
2918 (defun org-element-inline-babel-call-interpreter (inline-babel-call _)
2919 "Interpret INLINE-BABEL-CALL object as Org syntax."
2920 (concat "call_"
2921 (org-element-property :call inline-babel-call)
2922 (let ((h (org-element-property :inside-header inline-babel-call)))
2923 (and h (format "[%s]" h)))
2924 "(" (org-element-property :arguments inline-babel-call) ")"
2925 (let ((h (org-element-property :end-header inline-babel-call)))
2926 (and h (format "[%s]" h)))))
2929 ;;;; Inline Src Block
2931 (defun org-element-inline-src-block-parser ()
2932 "Parse inline source block at point, if any.
2934 When at an inline source block, return a list whose car is
2935 `inline-src-block' and cdr a plist with `:begin', `:end',
2936 `:language', `:value', `:parameters' and `:post-blank' as
2937 keywords. Otherwise, return nil.
2939 Assume point is at the beginning of the inline src block."
2940 (save-excursion
2941 (catch :no-object
2942 (when (let ((case-fold-search nil))
2943 (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]"))
2944 (goto-char (match-end 1))
2945 (let ((begin (match-beginning 0))
2946 (language (match-string-no-properties 1))
2947 (parameters
2948 (let ((p (org-element--parse-paired-brackets ?\[)))
2949 (and (org-string-nw-p p)
2950 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
2951 (value (or (org-element--parse-paired-brackets ?\{)
2952 (throw :no-object nil)))
2953 (post-blank (skip-chars-forward " \t")))
2954 (list 'inline-src-block
2955 (list :language language
2956 :value value
2957 :parameters parameters
2958 :begin begin
2959 :end (point)
2960 :post-blank post-blank)))))))
2962 (defun org-element-inline-src-block-interpreter (inline-src-block _)
2963 "Interpret INLINE-SRC-BLOCK object as Org syntax."
2964 (let ((language (org-element-property :language inline-src-block))
2965 (arguments (org-element-property :parameters inline-src-block))
2966 (body (org-element-property :value inline-src-block)))
2967 (format "src_%s%s{%s}"
2968 language
2969 (if arguments (format "[%s]" arguments) "")
2970 body)))
2972 ;;;; Italic
2974 (defun org-element-italic-parser ()
2975 "Parse italic object at point, if any.
2977 When at an italic object, return a list whose car is `italic' and
2978 cdr is a plist with `:begin', `:end', `:contents-begin' and
2979 `:contents-end' and `:post-blank' keywords. Otherwise, return
2980 nil.
2982 Assume point is at the first slash marker."
2983 (save-excursion
2984 (unless (bolp) (backward-char 1))
2985 (when (looking-at org-emph-re)
2986 (let ((begin (match-beginning 2))
2987 (contents-begin (match-beginning 4))
2988 (contents-end (match-end 4))
2989 (post-blank (progn (goto-char (match-end 2))
2990 (skip-chars-forward " \t")))
2991 (end (point)))
2992 (list 'italic
2993 (list :begin begin
2994 :end end
2995 :contents-begin contents-begin
2996 :contents-end contents-end
2997 :post-blank post-blank))))))
2999 (defun org-element-italic-interpreter (_ contents)
3000 "Interpret italic object as Org syntax.
3001 CONTENTS is the contents of the object."
3002 (format "/%s/" contents))
3005 ;;;; Latex Fragment
3007 (defun org-element-latex-fragment-parser ()
3008 "Parse LaTeX fragment at point, if any.
3010 When at a LaTeX fragment, return a list whose car is
3011 `latex-fragment' and cdr a plist with `:value', `:begin', `:end',
3012 and `:post-blank' as keywords. Otherwise, return nil.
3014 Assume point is at the beginning of the LaTeX fragment."
3015 (catch 'no-object
3016 (save-excursion
3017 (let* ((begin (point))
3018 (after-fragment
3019 (cond
3020 ((not (eq ?$ (char-after)))
3021 (pcase (char-after (1+ (point)))
3022 (?\( (search-forward "\\)" nil t))
3023 (?\[ (search-forward "\\]" nil t))
3025 ;; Macro.
3026 (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\
3027 \\|\\({[^{}\n]*}\\)\\)*")
3028 (match-end 0)))))
3029 ((eq ?$ (char-after (1+ (point))))
3030 (search-forward "$$" nil t 2))
3032 (and (not (eq ?$ (char-before)))
3033 (not (memq (char-after (1+ (point)))
3034 '(?\s ?\t ?\n ?, ?. ?\;)))
3035 (search-forward "$" nil t 2)
3036 (not (memq (char-before (match-beginning 0))
3037 '(?\s ?\t ?\n ?, ?.)))
3038 (looking-at-p
3039 "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)")
3040 (point)))))
3041 (post-blank
3042 (if (not after-fragment) (throw 'no-object nil)
3043 (goto-char after-fragment)
3044 (skip-chars-forward " \t")))
3045 (end (point)))
3046 (list 'latex-fragment
3047 (list :value (buffer-substring-no-properties begin after-fragment)
3048 :begin begin
3049 :end end
3050 :post-blank post-blank))))))
3052 (defun org-element-latex-fragment-interpreter (latex-fragment _)
3053 "Interpret LATEX-FRAGMENT object as Org syntax."
3054 (org-element-property :value latex-fragment))
3056 ;;;; Line Break
3058 (defun org-element-line-break-parser ()
3059 "Parse line break at point, if any.
3061 When at a line break, return a list whose car is `line-break',
3062 and cdr a plist with `:begin', `:end' and `:post-blank' keywords.
3063 Otherwise, return nil.
3065 Assume point is at the beginning of the line break."
3066 (when (and (looking-at-p "\\\\\\\\[ \t]*$")
3067 (not (eq (char-before) ?\\)))
3068 (list 'line-break
3069 (list :begin (point)
3070 :end (line-beginning-position 2)
3071 :post-blank 0))))
3073 (defun org-element-line-break-interpreter (&rest _)
3074 "Interpret LINE-BREAK object as Org syntax."
3075 "\\\\\n")
3078 ;;;; Link
3080 (defun org-element-link-parser ()
3081 "Parse link at point, if any.
3083 When at a link, return a list whose car is `link' and cdr a plist
3084 with `:type', `:path', `:format', `:raw-link', `:application',
3085 `:search-option', `:begin', `:end', `:contents-begin',
3086 `:contents-end' and `:post-blank' as keywords. Otherwise, return
3087 nil.
3089 Assume point is at the beginning of the link."
3090 (catch 'no-object
3091 (let ((begin (point))
3092 end contents-begin contents-end link-end post-blank path type format
3093 raw-link search-option application)
3094 (cond
3095 ;; Type 1: Text targeted from a radio target.
3096 ((and org-target-link-regexp
3097 (save-excursion (or (bolp) (backward-char))
3098 (looking-at org-target-link-regexp)))
3099 (setq type "radio")
3100 (setq format 'plain)
3101 (setq link-end (match-end 1))
3102 (setq path (match-string-no-properties 1))
3103 (setq contents-begin (match-beginning 1))
3104 (setq contents-end (match-end 1)))
3105 ;; Type 2: Standard link, i.e. [[https://orgmode.org][homepage]]
3106 ((looking-at org-bracket-link-regexp)
3107 (setq format 'bracket)
3108 (setq contents-begin (match-beginning 3))
3109 (setq contents-end (match-end 3))
3110 (setq link-end (match-end 0))
3111 ;; RAW-LINK is the original link. Expand any
3112 ;; abbreviation in it.
3114 ;; Also treat any newline character and associated
3115 ;; indentation as a single space character. This is not
3116 ;; compatible with RFC 3986, which requires to ignore
3117 ;; them altogether. However, doing so would require
3118 ;; users to encode spaces on the fly when writing links
3119 ;; (e.g., insert [[shell:ls%20*.org]] instead of
3120 ;; [[shell:ls *.org]], which defeats Org's focus on
3121 ;; simplicity.
3122 (setq raw-link (org-link-expand-abbrev
3123 (replace-regexp-in-string
3124 "[ \t]*\n[ \t]*" " "
3125 (match-string-no-properties 1))))
3126 ;; Determine TYPE of link and set PATH accordingly. According
3127 ;; to RFC 3986, remove whitespaces from URI in external links.
3128 ;; In internal ones, treat indentation as a single space.
3129 (cond
3130 ;; File type.
3131 ((or (file-name-absolute-p raw-link)
3132 (string-match "\\`\\.\\.?/" raw-link))
3133 (setq type "file")
3134 (setq path raw-link))
3135 ;; Explicit type (http, irc, bbdb...).
3136 ((string-match org-link-types-re raw-link)
3137 (setq type (match-string 1 raw-link))
3138 (setq path (substring raw-link (match-end 0))))
3139 ;; Code-ref type: PATH is the name of the reference.
3140 ((and (string-match-p "\\`(" raw-link)
3141 (string-match-p ")\\'" raw-link))
3142 (setq type "coderef")
3143 (setq path (substring raw-link 1 -1)))
3144 ;; Custom-id type: PATH is the name of the custom id.
3145 ((= (string-to-char raw-link) ?#)
3146 (setq type "custom-id")
3147 (setq path (substring raw-link 1)))
3148 ;; Fuzzy type: Internal link either matches a target, an
3149 ;; headline name or nothing. PATH is the target or
3150 ;; headline's name.
3152 (setq type "fuzzy")
3153 (setq path raw-link))))
3154 ;; Type 3: Plain link, e.g., https://orgmode.org
3155 ((looking-at org-plain-link-re)
3156 (setq format 'plain)
3157 (setq raw-link (match-string-no-properties 0))
3158 (setq type (match-string-no-properties 1))
3159 (setq link-end (match-end 0))
3160 (setq path (match-string-no-properties 2)))
3161 ;; Type 4: Angular link, e.g., <https://orgmode.org>. Unlike to
3162 ;; bracket links, follow RFC 3986 and remove any extra
3163 ;; whitespace in URI.
3164 ((looking-at org-angle-link-re)
3165 (setq format 'angle)
3166 (setq type (match-string-no-properties 1))
3167 (setq link-end (match-end 0))
3168 (setq raw-link
3169 (buffer-substring-no-properties
3170 (match-beginning 1) (match-end 2)))
3171 (setq path (replace-regexp-in-string
3172 "[ \t]*\n[ \t]*" "" (match-string-no-properties 2))))
3173 (t (throw 'no-object nil)))
3174 ;; In any case, deduce end point after trailing white space from
3175 ;; LINK-END variable.
3176 (save-excursion
3177 (setq post-blank
3178 (progn (goto-char link-end) (skip-chars-forward " \t")))
3179 (setq end (point)))
3180 ;; Special "file" type link processing. Extract opening
3181 ;; application and search option, if any. Also normalize URI.
3182 (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
3183 (setq application (match-string 1 type) type "file")
3184 (when (string-match "::\\(.*\\)\\'" path)
3185 (setq search-option (match-string 1 path))
3186 (setq path (replace-match "" nil nil path)))
3187 (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path)))
3188 ;; Translate link, if `org-link-translation-function' is set.
3189 (let ((trans (and (functionp org-link-translation-function)
3190 (funcall org-link-translation-function type path))))
3191 (when trans
3192 (setq type (car trans))
3193 (setq path (cdr trans))))
3194 (list 'link
3195 (list :type type
3196 :path path
3197 :format format
3198 :raw-link (or raw-link path)
3199 :application application
3200 :search-option search-option
3201 :begin begin
3202 :end end
3203 :contents-begin contents-begin
3204 :contents-end contents-end
3205 :post-blank post-blank)))))
3207 (defun org-element-link-interpreter (link contents)
3208 "Interpret LINK object as Org syntax.
3209 CONTENTS is the contents of the object, or nil."
3210 (let ((type (org-element-property :type link))
3211 (path (org-element-property :path link)))
3212 (if (string= type "radio") path
3213 (let ((fmt (pcase (org-element-property :format link)
3214 ;; Links with contents and internal links have to
3215 ;; use bracket syntax. Ignore `:format' in these
3216 ;; cases. This is also the default syntax when the
3217 ;; property is not defined, e.g., when the object
3218 ;; was crafted by the user.
3219 ((guard contents)
3220 (format "[[%%s][%s]]"
3221 ;; Since this is going to be used as
3222 ;; a format string, escape percent signs
3223 ;; in description.
3224 (replace-regexp-in-string "%" "%%" contents)))
3225 ((or `bracket
3226 `nil
3227 (guard (member type '("coderef" "custom-id" "fuzzy"))))
3228 "[[%s]]")
3229 ;; Otherwise, just obey to `:format'.
3230 (`angle "<%s>")
3231 (`plain "%s")
3232 (f (error "Wrong `:format' value: %s" f)))))
3233 (format fmt
3234 (pcase type
3235 ("coderef" (format "(%s)" path))
3236 ("custom-id" (concat "#" path))
3237 ("file"
3238 (let ((app (org-element-property :application link))
3239 (opt (org-element-property :search-option link)))
3240 (concat type (and app (concat "+" app)) ":"
3241 path
3242 (and opt (concat "::" opt)))))
3243 ("fuzzy" path)
3244 (_ (concat type ":" path))))))))
3247 ;;;; Macro
3249 (defun org-element-macro-parser ()
3250 "Parse macro at point, if any.
3252 When at a macro, return a list whose car is `macro' and cdr
3253 a plist with `:key', `:args', `:begin', `:end', `:value' and
3254 `:post-blank' as keywords. Otherwise, return nil.
3256 Assume point is at the macro."
3257 (save-excursion
3258 (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}")
3259 (let ((begin (point))
3260 (key (downcase (match-string-no-properties 1)))
3261 (value (match-string-no-properties 0))
3262 (post-blank (progn (goto-char (match-end 0))
3263 (skip-chars-forward " \t")))
3264 (end (point))
3265 (args (pcase (match-string-no-properties 3)
3266 (`nil nil)
3267 (a (org-macro-extract-arguments
3268 (replace-regexp-in-string
3269 "[ \t\r\n]+" " " (org-trim a)))))))
3270 (list 'macro
3271 (list :key key
3272 :value value
3273 :args args
3274 :begin begin
3275 :end end
3276 :post-blank post-blank))))))
3278 (defun org-element-macro-interpreter (macro _)
3279 "Interpret MACRO object as Org syntax."
3280 (format "{{{%s%s}}}"
3281 (org-element-property :key macro)
3282 (pcase (org-element-property :args macro)
3283 (`nil "")
3284 (args (format "(%s)" (apply #'org-macro-escape-arguments args))))))
3287 ;;;; Radio-target
3289 (defun org-element-radio-target-parser ()
3290 "Parse radio target at point, if any.
3292 When at a radio target, return a list whose car is `radio-target'
3293 and cdr a plist with `:begin', `:end', `:contents-begin',
3294 `:contents-end', `:value' and `:post-blank' as keywords.
3295 Otherwise, return nil.
3297 Assume point is at the radio target."
3298 (save-excursion
3299 (when (looking-at org-radio-target-regexp)
3300 (let ((begin (point))
3301 (contents-begin (match-beginning 1))
3302 (contents-end (match-end 1))
3303 (value (match-string-no-properties 1))
3304 (post-blank (progn (goto-char (match-end 0))
3305 (skip-chars-forward " \t")))
3306 (end (point)))
3307 (list 'radio-target
3308 (list :begin begin
3309 :end end
3310 :contents-begin contents-begin
3311 :contents-end contents-end
3312 :post-blank post-blank
3313 :value value))))))
3315 (defun org-element-radio-target-interpreter (_ contents)
3316 "Interpret target object as Org syntax.
3317 CONTENTS is the contents of the object."
3318 (concat "<<<" contents ">>>"))
3321 ;;;; Statistics Cookie
3323 (defun org-element-statistics-cookie-parser ()
3324 "Parse statistics cookie at point, if any.
3326 When at a statistics cookie, return a list whose car is
3327 `statistics-cookie', and cdr a plist with `:begin', `:end',
3328 `:value' and `:post-blank' keywords. Otherwise, return nil.
3330 Assume point is at the beginning of the statistics-cookie."
3331 (save-excursion
3332 (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
3333 (let* ((begin (point))
3334 (value (buffer-substring-no-properties
3335 (match-beginning 0) (match-end 0)))
3336 (post-blank (progn (goto-char (match-end 0))
3337 (skip-chars-forward " \t")))
3338 (end (point)))
3339 (list 'statistics-cookie
3340 (list :begin begin
3341 :end end
3342 :value value
3343 :post-blank post-blank))))))
3345 (defun org-element-statistics-cookie-interpreter (statistics-cookie _)
3346 "Interpret STATISTICS-COOKIE object as Org syntax."
3347 (org-element-property :value statistics-cookie))
3350 ;;;; Strike-Through
3352 (defun org-element-strike-through-parser ()
3353 "Parse strike-through object at point, if any.
3355 When at a strike-through object, return a list whose car is
3356 `strike-through' and cdr is a plist with `:begin', `:end',
3357 `:contents-begin' and `:contents-end' and `:post-blank' keywords.
3358 Otherwise, return nil.
3360 Assume point is at the first plus sign marker."
3361 (save-excursion
3362 (unless (bolp) (backward-char 1))
3363 (when (looking-at org-emph-re)
3364 (let ((begin (match-beginning 2))
3365 (contents-begin (match-beginning 4))
3366 (contents-end (match-end 4))
3367 (post-blank (progn (goto-char (match-end 2))
3368 (skip-chars-forward " \t")))
3369 (end (point)))
3370 (list 'strike-through
3371 (list :begin begin
3372 :end end
3373 :contents-begin contents-begin
3374 :contents-end contents-end
3375 :post-blank post-blank))))))
3377 (defun org-element-strike-through-interpreter (_ contents)
3378 "Interpret strike-through object as Org syntax.
3379 CONTENTS is the contents of the object."
3380 (format "+%s+" contents))
3383 ;;;; Subscript
3385 (defun org-element-subscript-parser ()
3386 "Parse subscript at point, if any.
3388 When at a subscript object, return a list whose car is
3389 `subscript' and cdr a plist with `:begin', `:end',
3390 `:contents-begin', `:contents-end', `:use-brackets-p' and
3391 `:post-blank' as keywords. Otherwise, return nil.
3393 Assume point is at the underscore."
3394 (save-excursion
3395 (unless (bolp) (backward-char))
3396 (when (looking-at org-match-substring-regexp)
3397 (let ((bracketsp (match-beginning 4))
3398 (begin (match-beginning 2))
3399 (contents-begin (or (match-beginning 4)
3400 (match-beginning 3)))
3401 (contents-end (or (match-end 4) (match-end 3)))
3402 (post-blank (progn (goto-char (match-end 0))
3403 (skip-chars-forward " \t")))
3404 (end (point)))
3405 (list 'subscript
3406 (list :begin begin
3407 :end end
3408 :use-brackets-p bracketsp
3409 :contents-begin contents-begin
3410 :contents-end contents-end
3411 :post-blank post-blank))))))
3413 (defun org-element-subscript-interpreter (subscript contents)
3414 "Interpret SUBSCRIPT object as Org syntax.
3415 CONTENTS is the contents of the object."
3416 (format
3417 (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
3418 contents))
3421 ;;;; Superscript
3423 (defun org-element-superscript-parser ()
3424 "Parse superscript at point, if any.
3426 When at a superscript object, return a list whose car is
3427 `superscript' and cdr a plist with `:begin', `:end',
3428 `:contents-begin', `:contents-end', `:use-brackets-p' and
3429 `:post-blank' as keywords. Otherwise, return nil.
3431 Assume point is at the caret."
3432 (save-excursion
3433 (unless (bolp) (backward-char))
3434 (when (looking-at org-match-substring-regexp)
3435 (let ((bracketsp (match-beginning 4))
3436 (begin (match-beginning 2))
3437 (contents-begin (or (match-beginning 4)
3438 (match-beginning 3)))
3439 (contents-end (or (match-end 4) (match-end 3)))
3440 (post-blank (progn (goto-char (match-end 0))
3441 (skip-chars-forward " \t")))
3442 (end (point)))
3443 (list 'superscript
3444 (list :begin begin
3445 :end end
3446 :use-brackets-p bracketsp
3447 :contents-begin contents-begin
3448 :contents-end contents-end
3449 :post-blank post-blank))))))
3451 (defun org-element-superscript-interpreter (superscript contents)
3452 "Interpret SUPERSCRIPT object as Org syntax.
3453 CONTENTS is the contents of the object."
3454 (format
3455 (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s")
3456 contents))
3459 ;;;; Table Cell
3461 (defun org-element-table-cell-parser ()
3462 "Parse table cell at point.
3463 Return a list whose car is `table-cell' and cdr is a plist
3464 containing `:begin', `:end', `:contents-begin', `:contents-end'
3465 and `:post-blank' keywords."
3466 (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
3467 (let* ((begin (match-beginning 0))
3468 (end (match-end 0))
3469 (contents-begin (match-beginning 1))
3470 (contents-end (match-end 1)))
3471 (list 'table-cell
3472 (list :begin begin
3473 :end end
3474 :contents-begin contents-begin
3475 :contents-end contents-end
3476 :post-blank 0))))
3478 (defun org-element-table-cell-interpreter (_ contents)
3479 "Interpret table-cell element as Org syntax.
3480 CONTENTS is the contents of the cell, or nil."
3481 (concat " " contents " |"))
3484 ;;;; Target
3486 (defun org-element-target-parser ()
3487 "Parse target at point, if any.
3489 When at a target, return a list whose car is `target' and cdr
3490 a plist with `:begin', `:end', `:value' and `:post-blank' as
3491 keywords. Otherwise, return nil.
3493 Assume point is at the target."
3494 (save-excursion
3495 (when (looking-at org-target-regexp)
3496 (let ((begin (point))
3497 (value (match-string-no-properties 1))
3498 (post-blank (progn (goto-char (match-end 0))
3499 (skip-chars-forward " \t")))
3500 (end (point)))
3501 (list 'target
3502 (list :begin begin
3503 :end end
3504 :value value
3505 :post-blank post-blank))))))
3507 (defun org-element-target-interpreter (target _)
3508 "Interpret TARGET object as Org syntax."
3509 (format "<<%s>>" (org-element-property :value target)))
3512 ;;;; Timestamp
3514 (defconst org-element--timestamp-regexp
3515 (concat org-ts-regexp-both
3516 "\\|"
3517 "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
3518 "\\|"
3519 "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
3520 "Regexp matching any timestamp type object.")
3522 (defun org-element-timestamp-parser ()
3523 "Parse time stamp at point, if any.
3525 When at a time stamp, return a list whose car is `timestamp', and
3526 cdr a plist with `:type', `:raw-value', `:year-start',
3527 `:month-start', `:day-start', `:hour-start', `:minute-start',
3528 `:year-end', `:month-end', `:day-end', `:hour-end',
3529 `:minute-end', `:repeater-type', `:repeater-value',
3530 `:repeater-unit', `:warning-type', `:warning-value',
3531 `:warning-unit', `:begin', `:end' and `:post-blank' keywords.
3532 Otherwise, return nil.
3534 Assume point is at the beginning of the timestamp."
3535 (when (looking-at-p org-element--timestamp-regexp)
3536 (save-excursion
3537 (let* ((begin (point))
3538 (activep (eq (char-after) ?<))
3539 (raw-value
3540 (progn
3541 (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
3542 (match-string-no-properties 0)))
3543 (date-start (match-string-no-properties 1))
3544 (date-end (match-string 3))
3545 (diaryp (match-beginning 2))
3546 (post-blank (progn (goto-char (match-end 0))
3547 (skip-chars-forward " \t")))
3548 (end (point))
3549 (time-range
3550 (and (not diaryp)
3551 (string-match
3552 "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
3553 date-start)
3554 (cons (string-to-number (match-string 2 date-start))
3555 (string-to-number (match-string 3 date-start)))))
3556 (type (cond (diaryp 'diary)
3557 ((and activep (or date-end time-range)) 'active-range)
3558 (activep 'active)
3559 ((or date-end time-range) 'inactive-range)
3560 (t 'inactive)))
3561 (repeater-props
3562 (and (not diaryp)
3563 (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
3564 raw-value)
3565 (list
3566 :repeater-type
3567 (let ((type (match-string 1 raw-value)))
3568 (cond ((equal "++" type) 'catch-up)
3569 ((equal ".+" type) 'restart)
3570 (t 'cumulate)))
3571 :repeater-value (string-to-number (match-string 2 raw-value))
3572 :repeater-unit
3573 (pcase (string-to-char (match-string 3 raw-value))
3574 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
3575 (warning-props
3576 (and (not diaryp)
3577 (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
3578 (list
3579 :warning-type (if (match-string 1 raw-value) 'first 'all)
3580 :warning-value (string-to-number (match-string 2 raw-value))
3581 :warning-unit
3582 (pcase (string-to-char (match-string 3 raw-value))
3583 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
3584 year-start month-start day-start hour-start minute-start year-end
3585 month-end day-end hour-end minute-end)
3586 ;; Parse date-start.
3587 (unless diaryp
3588 (let ((date (org-parse-time-string date-start t)))
3589 (setq year-start (nth 5 date)
3590 month-start (nth 4 date)
3591 day-start (nth 3 date)
3592 hour-start (nth 2 date)
3593 minute-start (nth 1 date))))
3594 ;; Compute date-end. It can be provided directly in time-stamp,
3595 ;; or extracted from time range. Otherwise, it defaults to the
3596 ;; same values as date-start.
3597 (unless diaryp
3598 (let ((date (and date-end (org-parse-time-string date-end t))))
3599 (setq year-end (or (nth 5 date) year-start)
3600 month-end (or (nth 4 date) month-start)
3601 day-end (or (nth 3 date) day-start)
3602 hour-end (or (nth 2 date) (car time-range) hour-start)
3603 minute-end (or (nth 1 date) (cdr time-range) minute-start))))
3604 (list 'timestamp
3605 (nconc (list :type type
3606 :raw-value raw-value
3607 :year-start year-start
3608 :month-start month-start
3609 :day-start day-start
3610 :hour-start hour-start
3611 :minute-start minute-start
3612 :year-end year-end
3613 :month-end month-end
3614 :day-end day-end
3615 :hour-end hour-end
3616 :minute-end minute-end
3617 :begin begin
3618 :end end
3619 :post-blank post-blank)
3620 repeater-props
3621 warning-props))))))
3623 (defun org-element-timestamp-interpreter (timestamp _)
3624 "Interpret TIMESTAMP object as Org syntax."
3625 (let* ((repeat-string
3626 (concat
3627 (pcase (org-element-property :repeater-type timestamp)
3628 (`cumulate "+") (`catch-up "++") (`restart ".+"))
3629 (let ((val (org-element-property :repeater-value timestamp)))
3630 (and val (number-to-string val)))
3631 (pcase (org-element-property :repeater-unit timestamp)
3632 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
3633 (warning-string
3634 (concat
3635 (pcase (org-element-property :warning-type timestamp)
3636 (`first "--") (`all "-"))
3637 (let ((val (org-element-property :warning-value timestamp)))
3638 (and val (number-to-string val)))
3639 (pcase (org-element-property :warning-unit timestamp)
3640 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
3641 (build-ts-string
3642 ;; Build an Org timestamp string from TIME. ACTIVEP is
3643 ;; non-nil when time stamp is active. If WITH-TIME-P is
3644 ;; non-nil, add a time part. HOUR-END and MINUTE-END
3645 ;; specify a time range in the timestamp. REPEAT-STRING is
3646 ;; the repeater string, if any.
3647 (lambda (time activep &optional with-time-p hour-end minute-end)
3648 (let ((ts (format-time-string
3649 (funcall (if with-time-p #'cdr #'car)
3650 org-time-stamp-formats)
3651 time)))
3652 (when (and hour-end minute-end)
3653 (string-match "[012]?[0-9]:[0-5][0-9]" ts)
3654 (setq ts
3655 (replace-match
3656 (format "\\&-%02d:%02d" hour-end minute-end)
3657 nil nil ts)))
3658 (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
3659 (dolist (s (list repeat-string warning-string))
3660 (when (org-string-nw-p s)
3661 (setq ts (concat (substring ts 0 -1)
3664 (substring ts -1)))))
3665 ;; Return value.
3666 ts)))
3667 (type (org-element-property :type timestamp)))
3668 (pcase type
3669 ((or `active `inactive)
3670 (let* ((minute-start (org-element-property :minute-start timestamp))
3671 (minute-end (org-element-property :minute-end timestamp))
3672 (hour-start (org-element-property :hour-start timestamp))
3673 (hour-end (org-element-property :hour-end timestamp))
3674 (time-range-p (and hour-start hour-end minute-start minute-end
3675 (or (/= hour-start hour-end)
3676 (/= minute-start minute-end)))))
3677 (funcall
3678 build-ts-string
3679 (encode-time 0
3680 (or minute-start 0)
3681 (or hour-start 0)
3682 (org-element-property :day-start timestamp)
3683 (org-element-property :month-start timestamp)
3684 (org-element-property :year-start timestamp))
3685 (eq type 'active)
3686 (and hour-start minute-start)
3687 (and time-range-p hour-end)
3688 (and time-range-p minute-end))))
3689 ((or `active-range `inactive-range)
3690 (let ((minute-start (org-element-property :minute-start timestamp))
3691 (minute-end (org-element-property :minute-end timestamp))
3692 (hour-start (org-element-property :hour-start timestamp))
3693 (hour-end (org-element-property :hour-end timestamp)))
3694 (concat
3695 (funcall
3696 build-ts-string (encode-time
3698 (or minute-start 0)
3699 (or hour-start 0)
3700 (org-element-property :day-start timestamp)
3701 (org-element-property :month-start timestamp)
3702 (org-element-property :year-start timestamp))
3703 (eq type 'active-range)
3704 (and hour-start minute-start))
3705 "--"
3706 (funcall build-ts-string
3707 (encode-time 0
3708 (or minute-end 0)
3709 (or hour-end 0)
3710 (org-element-property :day-end timestamp)
3711 (org-element-property :month-end timestamp)
3712 (org-element-property :year-end timestamp))
3713 (eq type 'active-range)
3714 (and hour-end minute-end)))))
3715 (_ (org-element-property :raw-value timestamp)))))
3718 ;;;; Underline
3720 (defun org-element-underline-parser ()
3721 "Parse underline object at point, if any.
3723 When at an underline object, return a list whose car is
3724 `underline' and cdr is a plist with `:begin', `:end',
3725 `:contents-begin' and `:contents-end' and `:post-blank' keywords.
3726 Otherwise, return nil.
3728 Assume point is at the first underscore marker."
3729 (save-excursion
3730 (unless (bolp) (backward-char 1))
3731 (when (looking-at org-emph-re)
3732 (let ((begin (match-beginning 2))
3733 (contents-begin (match-beginning 4))
3734 (contents-end (match-end 4))
3735 (post-blank (progn (goto-char (match-end 2))
3736 (skip-chars-forward " \t")))
3737 (end (point)))
3738 (list 'underline
3739 (list :begin begin
3740 :end end
3741 :contents-begin contents-begin
3742 :contents-end contents-end
3743 :post-blank post-blank))))))
3745 (defun org-element-underline-interpreter (_ contents)
3746 "Interpret underline object as Org syntax.
3747 CONTENTS is the contents of the object."
3748 (format "_%s_" contents))
3751 ;;;; Verbatim
3753 (defun org-element-verbatim-parser ()
3754 "Parse verbatim object at point, if any.
3756 When at a verbatim object, return a list whose car is `verbatim'
3757 and cdr is a plist with `:value', `:begin', `:end' and
3758 `:post-blank' keywords. Otherwise, return nil.
3760 Assume point is at the first equal sign marker."
3761 (save-excursion
3762 (unless (bolp) (backward-char 1))
3763 (when (looking-at org-verbatim-re)
3764 (let ((begin (match-beginning 2))
3765 (value (match-string-no-properties 4))
3766 (post-blank (progn (goto-char (match-end 2))
3767 (skip-chars-forward " \t")))
3768 (end (point)))
3769 (list 'verbatim
3770 (list :value value
3771 :begin begin
3772 :end end
3773 :post-blank post-blank))))))
3775 (defun org-element-verbatim-interpreter (verbatim _)
3776 "Interpret VERBATIM object as Org syntax."
3777 (format "=%s=" (org-element-property :value verbatim)))
3781 ;;; Parsing Element Starting At Point
3783 ;; `org-element--current-element' is the core function of this section.
3784 ;; It returns the Lisp representation of the element starting at
3785 ;; point.
3787 ;; `org-element--current-element' makes use of special modes. They
3788 ;; are activated for fixed element chaining (e.g., `plain-list' >
3789 ;; `item') or fixed conditional element chaining (e.g., `headline' >
3790 ;; `section'). Special modes are: `first-section', `item',
3791 ;; `node-property', `section' and `table-row'.
3793 (defun org-element--current-element (limit &optional granularity mode structure)
3794 "Parse the element starting at point.
3796 Return value is a list like (TYPE PROPS) where TYPE is the type
3797 of the element and PROPS a plist of properties associated to the
3798 element.
3800 Possible types are defined in `org-element-all-elements'.
3802 LIMIT bounds the search.
3804 Optional argument GRANULARITY determines the depth of the
3805 recursion. Allowed values are `headline', `greater-element',
3806 `element', `object' or nil. When it is broader than `object' (or
3807 nil), secondary values will not be parsed, since they only
3808 contain objects.
3810 Optional argument MODE, when non-nil, can be either
3811 `first-section', `section', `planning', `item', `node-property'
3812 and `table-row'.
3814 If STRUCTURE isn't provided but MODE is set to `item', it will be
3815 computed.
3817 This function assumes point is always at the beginning of the
3818 element it has to parse."
3819 (save-excursion
3820 (let ((case-fold-search t)
3821 ;; Determine if parsing depth allows for secondary strings
3822 ;; parsing. It only applies to elements referenced in
3823 ;; `org-element-secondary-value-alist'.
3824 (raw-secondary-p (and granularity (not (eq granularity 'object)))))
3825 (cond
3826 ;; Item.
3827 ((eq mode 'item)
3828 (org-element-item-parser limit structure raw-secondary-p))
3829 ;; Table Row.
3830 ((eq mode 'table-row) (org-element-table-row-parser limit))
3831 ;; Node Property.
3832 ((eq mode 'node-property) (org-element-node-property-parser limit))
3833 ;; Headline.
3834 ((org-with-limited-levels (org-at-heading-p))
3835 (org-element-headline-parser limit raw-secondary-p))
3836 ;; Sections (must be checked after headline).
3837 ((eq mode 'section) (org-element-section-parser limit))
3838 ((eq mode 'first-section)
3839 (org-element-section-parser
3840 (or (save-excursion (org-with-limited-levels (outline-next-heading)))
3841 limit)))
3842 ;; Planning.
3843 ((and (eq mode 'planning)
3844 (eq ?* (char-after (line-beginning-position 0)))
3845 (looking-at org-planning-line-re))
3846 (org-element-planning-parser limit))
3847 ;; Property drawer.
3848 ((and (memq mode '(planning property-drawer))
3849 (eq ?* (char-after (line-beginning-position
3850 (if (eq mode 'planning) 0 -1))))
3851 (looking-at org-property-drawer-re))
3852 (org-element-property-drawer-parser limit))
3853 ;; When not at bol, point is at the beginning of an item or
3854 ;; a footnote definition: next item is always a paragraph.
3855 ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
3856 ;; Clock.
3857 ((looking-at org-clock-line-re) (org-element-clock-parser limit))
3858 ;; Inlinetask.
3859 ((org-at-heading-p)
3860 (org-element-inlinetask-parser limit raw-secondary-p))
3861 ;; From there, elements can have affiliated keywords.
3862 (t (let ((affiliated (org-element--collect-affiliated-keywords limit)))
3863 (cond
3864 ;; Jumping over affiliated keywords put point off-limits.
3865 ;; Parse them as regular keywords.
3866 ((and (cdr affiliated) (>= (point) limit))
3867 (goto-char (car affiliated))
3868 (org-element-keyword-parser limit nil))
3869 ;; LaTeX Environment.
3870 ((looking-at org-element--latex-begin-environment)
3871 (org-element-latex-environment-parser limit affiliated))
3872 ;; Drawer and Property Drawer.
3873 ((looking-at org-drawer-regexp)
3874 (org-element-drawer-parser limit affiliated))
3875 ;; Fixed Width
3876 ((looking-at "[ \t]*:\\( \\|$\\)")
3877 (org-element-fixed-width-parser limit affiliated))
3878 ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
3879 ;; Keywords.
3880 ((looking-at "[ \t]*#")
3881 (goto-char (match-end 0))
3882 (cond
3883 ((looking-at "\\(?: \\|$\\)")
3884 (beginning-of-line)
3885 (org-element-comment-parser limit affiliated))
3886 ((looking-at "\\+BEGIN_\\(\\S-+\\)")
3887 (beginning-of-line)
3888 (funcall (pcase (upcase (match-string 1))
3889 ("CENTER" #'org-element-center-block-parser)
3890 ("COMMENT" #'org-element-comment-block-parser)
3891 ("EXAMPLE" #'org-element-example-block-parser)
3892 ("EXPORT" #'org-element-export-block-parser)
3893 ("QUOTE" #'org-element-quote-block-parser)
3894 ("SRC" #'org-element-src-block-parser)
3895 ("VERSE" #'org-element-verse-block-parser)
3896 (_ #'org-element-special-block-parser))
3897 limit
3898 affiliated))
3899 ((looking-at "\\+CALL:")
3900 (beginning-of-line)
3901 (org-element-babel-call-parser limit affiliated))
3902 ((looking-at "\\+BEGIN:? ")
3903 (beginning-of-line)
3904 (org-element-dynamic-block-parser limit affiliated))
3905 ((looking-at "\\+\\S-+:")
3906 (beginning-of-line)
3907 (org-element-keyword-parser limit affiliated))
3909 (beginning-of-line)
3910 (org-element-paragraph-parser limit affiliated))))
3911 ;; Footnote Definition.
3912 ((looking-at org-footnote-definition-re)
3913 (org-element-footnote-definition-parser limit affiliated))
3914 ;; Horizontal Rule.
3915 ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
3916 (org-element-horizontal-rule-parser limit affiliated))
3917 ;; Diary Sexp.
3918 ((looking-at "%%(")
3919 (org-element-diary-sexp-parser limit affiliated))
3920 ;; Table.
3921 ((looking-at "[ \t]*\\(|\\|\\+\\(-+\\+\\)+[ \t]*$\\)")
3922 (org-element-table-parser limit affiliated))
3923 ;; List.
3924 ((looking-at (org-item-re))
3925 (org-element-plain-list-parser
3926 limit affiliated
3927 (or structure (org-element--list-struct limit))))
3928 ;; Default element: Paragraph.
3929 (t (org-element-paragraph-parser limit affiliated)))))))))
3932 ;; Most elements can have affiliated keywords. When looking for an
3933 ;; element beginning, we want to move before them, as they belong to
3934 ;; that element, and, in the meantime, collect information they give
3935 ;; into appropriate properties. Hence the following function.
3937 (defun org-element--collect-affiliated-keywords (limit)
3938 "Collect affiliated keywords from point down to LIMIT.
3940 Return a list whose CAR is the position at the first of them and
3941 CDR a plist of keywords and values and move point to the
3942 beginning of the first line after them.
3944 As a special case, if element doesn't start at the beginning of
3945 the line (e.g., a paragraph starting an item), CAR is current
3946 position of point and CDR is nil."
3947 (if (not (bolp)) (list (point))
3948 (let ((case-fold-search t)
3949 (origin (point))
3950 ;; RESTRICT is the list of objects allowed in parsed
3951 ;; keywords value.
3952 (restrict (org-element-restriction 'keyword))
3953 output)
3954 (while (and (< (point) limit) (looking-at org-element--affiliated-re))
3955 (let* ((raw-kwd (upcase (match-string 1)))
3956 ;; Apply translation to RAW-KWD. From there, KWD is
3957 ;; the official keyword.
3958 (kwd (or (cdr (assoc raw-kwd
3959 org-element-keyword-translation-alist))
3960 raw-kwd))
3961 ;; Find main value for any keyword.
3962 (value
3963 (save-match-data
3964 (org-trim
3965 (buffer-substring-no-properties
3966 (match-end 0) (line-end-position)))))
3967 ;; PARSEDP is non-nil when keyword should have its
3968 ;; value parsed.
3969 (parsedp (member kwd org-element-parsed-keywords))
3970 ;; If KWD is a dual keyword, find its secondary
3971 ;; value. Maybe parse it.
3972 (dualp (member kwd org-element-dual-keywords))
3973 (dual-value
3974 (and dualp
3975 (let ((sec (match-string-no-properties 2)))
3976 (if (or (not sec) (not parsedp)) sec
3977 (save-match-data
3978 (org-element--parse-objects
3979 (match-beginning 2) (match-end 2) nil restrict))))))
3980 ;; Attribute a property name to KWD.
3981 (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
3982 ;; Now set final shape for VALUE.
3983 (when parsedp
3984 (setq value
3985 (org-element--parse-objects
3986 (match-end 0)
3987 (progn (end-of-line) (skip-chars-backward " \t") (point))
3988 nil restrict)))
3989 (when dualp
3990 (setq value (and (or value dual-value) (cons value dual-value))))
3991 (when (or (member kwd org-element-multiple-keywords)
3992 ;; Attributes can always appear on multiple lines.
3993 (string-match "^ATTR_" kwd))
3994 (setq value (cons value (plist-get output kwd-sym))))
3995 ;; Eventually store the new value in OUTPUT.
3996 (setq output (plist-put output kwd-sym value))
3997 ;; Move to next keyword.
3998 (forward-line)))
3999 ;; If affiliated keywords are orphaned: move back to first one.
4000 ;; They will be parsed as a paragraph.
4001 (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil))
4002 ;; Return value.
4003 (cons origin output))))
4007 ;;; The Org Parser
4009 ;; The two major functions here are `org-element-parse-buffer', which
4010 ;; parses Org syntax inside the current buffer, taking into account
4011 ;; region, narrowing, or even visibility if specified, and
4012 ;; `org-element-parse-secondary-string', which parses objects within
4013 ;; a given string.
4015 ;; The (almost) almighty `org-element-map' allows applying a function
4016 ;; on elements or objects matching some type, and accumulating the
4017 ;; resulting values. In an export situation, it also skips unneeded
4018 ;; parts of the parse tree.
4020 (defun org-element-parse-buffer (&optional granularity visible-only)
4021 "Recursively parse the buffer and return structure.
4022 If narrowing is in effect, only parse the visible part of the
4023 buffer.
4025 Optional argument GRANULARITY determines the depth of the
4026 recursion. It can be set to the following symbols:
4028 `headline' Only parse headlines.
4029 `greater-element' Don't recurse into greater elements except
4030 headlines and sections. Thus, elements
4031 parsed are the top-level ones.
4032 `element' Parse everything but objects and plain text.
4033 `object' Parse the complete buffer (default).
4035 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
4036 elements.
4038 An element or object is represented as a list with the
4039 pattern (TYPE PROPERTIES CONTENTS), where :
4041 TYPE is a symbol describing the element or object. See
4042 `org-element-all-elements' and `org-element-all-objects' for an
4043 exhaustive list of such symbols. One can retrieve it with
4044 `org-element-type' function.
4046 PROPERTIES is the list of attributes attached to the element or
4047 object, as a plist. Although most of them are specific to the
4048 element or object type, all types share `:begin', `:end',
4049 `:post-blank' and `:parent' properties, which respectively
4050 refer to buffer position where the element or object starts,
4051 ends, the number of white spaces or blank lines after it, and
4052 the element or object containing it. Properties values can be
4053 obtained by using `org-element-property' function.
4055 CONTENTS is a list of elements, objects or raw strings
4056 contained in the current element or object, when applicable.
4057 One can access them with `org-element-contents' function.
4059 The Org buffer has `org-data' as type and nil as properties.
4060 `org-element-map' function can be used to find specific elements
4061 or objects within the parse tree.
4063 This function assumes that current major mode is `org-mode'."
4064 (save-excursion
4065 (goto-char (point-min))
4066 (org-skip-whitespace)
4067 (org-element--parse-elements
4068 (point-at-bol) (point-max)
4069 ;; Start in `first-section' mode so text before the first
4070 ;; headline belongs to a section.
4071 'first-section nil granularity visible-only (list 'org-data nil))))
4073 (defun org-element-parse-secondary-string (string restriction &optional parent)
4074 "Recursively parse objects in STRING and return structure.
4076 RESTRICTION is a symbol limiting the object types that will be
4077 looked after.
4079 Optional argument PARENT, when non-nil, is the element or object
4080 containing the secondary string. It is used to set correctly
4081 `:parent' property within the string.
4083 If STRING is the empty string or nil, return nil."
4084 (cond
4085 ((not string) nil)
4086 ((equal string "") nil)
4087 (t (let ((local-variables (buffer-local-variables)))
4088 (with-temp-buffer
4089 (dolist (v local-variables)
4090 (ignore-errors
4091 (if (symbolp v) (makunbound v)
4092 (set (make-local-variable (car v)) (cdr v)))))
4093 (insert string)
4094 (restore-buffer-modified-p nil)
4095 (org-element--parse-objects
4096 (point-min) (point-max) nil restriction parent))))))
4098 (defun org-element-map
4099 (data types fun &optional info first-match no-recursion with-affiliated)
4100 "Map a function on selected elements or objects.
4102 DATA is a parse tree, an element, an object, a string, or a list
4103 of such constructs. TYPES is a symbol or list of symbols of
4104 elements or objects types (see `org-element-all-elements' and
4105 `org-element-all-objects' for a complete list of types). FUN is
4106 the function called on the matching element or object. It has to
4107 accept one argument: the element or object itself.
4109 When optional argument INFO is non-nil, it should be a plist
4110 holding export options. In that case, parts of the parse tree
4111 not exportable according to that property list will be skipped.
4113 When optional argument FIRST-MATCH is non-nil, stop at the first
4114 match for which FUN doesn't return nil, and return that value.
4116 Optional argument NO-RECURSION is a symbol or a list of symbols
4117 representing elements or objects types. `org-element-map' won't
4118 enter any recursive element or object whose type belongs to that
4119 list. Though, FUN can still be applied on them.
4121 When optional argument WITH-AFFILIATED is non-nil, FUN will also
4122 apply to matching objects within parsed affiliated keywords (see
4123 `org-element-parsed-keywords').
4125 Nil values returned from FUN do not appear in the results.
4128 Examples:
4129 ---------
4131 Assuming TREE is a variable containing an Org buffer parse tree,
4132 the following example will return a flat list of all `src-block'
4133 and `example-block' elements in it:
4135 (org-element-map tree \\='(example-block src-block) #\\='identity)
4137 The following snippet will find the first headline with a level
4138 of 1 and a \"phone\" tag, and will return its beginning position:
4140 (org-element-map tree \\='headline
4141 (lambda (hl)
4142 (and (= (org-element-property :level hl) 1)
4143 (member \"phone\" (org-element-property :tags hl))
4144 (org-element-property :begin hl)))
4145 nil t)
4147 The next example will return a flat list of all `plain-list' type
4148 elements in TREE that are not a sub-list themselves:
4150 (org-element-map tree \\='plain-list #\\='identity nil nil \\='plain-list)
4152 Eventually, this example will return a flat list of all `bold'
4153 type objects containing a `latex-snippet' type object, even
4154 looking into captions:
4156 (org-element-map tree \\='bold
4157 (lambda (b)
4158 (and (org-element-map b \\='latex-snippet #\\='identity nil t) b))
4159 nil nil nil t)"
4160 ;; Ensure TYPES and NO-RECURSION are a list, even of one element.
4161 (let* ((types (if (listp types) types (list types)))
4162 (no-recursion (if (listp no-recursion) no-recursion
4163 (list no-recursion)))
4164 ;; Recursion depth is determined by --CATEGORY.
4165 (--category
4166 (catch :--found
4167 (let ((category 'greater-elements)
4168 (all-objects (cons 'plain-text org-element-all-objects)))
4169 (dolist (type types category)
4170 (cond ((memq type all-objects)
4171 ;; If one object is found, the function has
4172 ;; to recurse into every object.
4173 (throw :--found 'objects))
4174 ((not (memq type org-element-greater-elements))
4175 ;; If one regular element is found, the
4176 ;; function has to recurse, at least, into
4177 ;; every element it encounters.
4178 (and (not (eq category 'elements))
4179 (setq category 'elements))))))))
4180 --acc)
4181 (letrec ((--walk-tree
4182 (lambda (--data)
4183 ;; Recursively walk DATA. INFO, if non-nil, is a plist
4184 ;; holding contextual information.
4185 (let ((--type (org-element-type --data)))
4186 (cond
4187 ((not --data))
4188 ;; Ignored element in an export context.
4189 ((and info (memq --data (plist-get info :ignore-list))))
4190 ;; List of elements or objects.
4191 ((not --type) (mapc --walk-tree --data))
4192 ;; Unconditionally enter parse trees.
4193 ((eq --type 'org-data)
4194 (mapc --walk-tree (org-element-contents --data)))
4196 ;; Check if TYPE is matching among TYPES. If so,
4197 ;; apply FUN to --DATA and accumulate return value
4198 ;; into --ACC (or exit if FIRST-MATCH is non-nil).
4199 (when (memq --type types)
4200 (let ((result (funcall fun --data)))
4201 (cond ((not result))
4202 (first-match (throw :--map-first-match result))
4203 (t (push result --acc)))))
4204 ;; If --DATA has a secondary string that can contain
4205 ;; objects with their type among TYPES, look inside.
4206 (when (and (eq --category 'objects) (not (stringp --data)))
4207 (dolist (p (cdr (assq --type
4208 org-element-secondary-value-alist)))
4209 (funcall --walk-tree (org-element-property p --data))))
4210 ;; If --DATA has any parsed affiliated keywords and
4211 ;; WITH-AFFILIATED is non-nil, look for objects in
4212 ;; them.
4213 (when (and with-affiliated
4214 (eq --category 'objects)
4215 (eq (org-element-class --data) 'element))
4216 (dolist (kwd-pair org-element--parsed-properties-alist)
4217 (let ((kwd (car kwd-pair))
4218 (value (org-element-property (cdr kwd-pair) --data)))
4219 ;; Pay attention to the type of parsed
4220 ;; keyword. In particular, preserve order for
4221 ;; multiple keywords.
4222 (cond
4223 ((not value))
4224 ((member kwd org-element-dual-keywords)
4225 (if (member kwd org-element-multiple-keywords)
4226 (dolist (line (reverse value))
4227 (funcall --walk-tree (cdr line))
4228 (funcall --walk-tree (car line)))
4229 (funcall --walk-tree (cdr value))
4230 (funcall --walk-tree (car value))))
4231 ((member kwd org-element-multiple-keywords)
4232 (mapc --walk-tree (reverse value)))
4233 (t (funcall --walk-tree value))))))
4234 ;; Determine if a recursion into --DATA is possible.
4235 (cond
4236 ;; --TYPE is explicitly removed from recursion.
4237 ((memq --type no-recursion))
4238 ;; --DATA has no contents.
4239 ((not (org-element-contents --data)))
4240 ;; Looking for greater elements but --DATA is
4241 ;; simply an element or an object.
4242 ((and (eq --category 'greater-elements)
4243 (not (memq --type org-element-greater-elements))))
4244 ;; Looking for elements but --DATA is an object.
4245 ((and (eq --category 'elements)
4246 (eq (org-element-class --data) 'object)))
4247 ;; In any other case, map contents.
4248 (t (mapc --walk-tree (org-element-contents --data))))))))))
4249 (catch :--map-first-match
4250 (funcall --walk-tree data)
4251 ;; Return value in a proper order.
4252 (nreverse --acc)))))
4253 (put 'org-element-map 'lisp-indent-function 2)
4255 ;; The following functions are internal parts of the parser.
4257 ;; The first one, `org-element--parse-elements' acts at the element's
4258 ;; level.
4260 ;; The second one, `org-element--parse-objects' applies on all objects
4261 ;; of a paragraph or a secondary string. It calls
4262 ;; `org-element--object-lex' to find the next object in the current
4263 ;; container.
4265 (defsubst org-element--next-mode (type parentp)
4266 "Return next special mode according to TYPE, or nil.
4267 TYPE is a symbol representing the type of an element or object
4268 containing next element if PARENTP is non-nil, or before it
4269 otherwise. Modes can be either `first-section', `item',
4270 `node-property', `planning', `property-drawer', `section',
4271 `table-row' or nil."
4272 (if parentp
4273 (pcase type
4274 (`headline 'section)
4275 (`inlinetask 'planning)
4276 (`plain-list 'item)
4277 (`property-drawer 'node-property)
4278 (`section 'planning)
4279 (`table 'table-row))
4280 (pcase type
4281 (`item 'item)
4282 (`node-property 'node-property)
4283 (`planning 'property-drawer)
4284 (`table-row 'table-row))))
4286 (defun org-element--parse-elements
4287 (beg end mode structure granularity visible-only acc)
4288 "Parse elements between BEG and END positions.
4290 MODE prioritizes some elements over the others. It can be set to
4291 `first-section', `section', `planning', `item', `node-property'
4292 or `table-row'.
4294 When value is `item', STRUCTURE will be used as the current list
4295 structure.
4297 GRANULARITY determines the depth of the recursion. See
4298 `org-element-parse-buffer' for more information.
4300 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
4301 elements.
4303 Elements are accumulated into ACC."
4304 (save-excursion
4305 (goto-char beg)
4306 ;; Visible only: skip invisible parts at the beginning of the
4307 ;; element.
4308 (when (and visible-only (org-invisible-p2))
4309 (goto-char (min (1+ (org-find-visible)) end)))
4310 ;; When parsing only headlines, skip any text before first one.
4311 (when (and (eq granularity 'headline) (not (org-at-heading-p)))
4312 (org-with-limited-levels (outline-next-heading)))
4313 (let (elements)
4314 (while (< (point) end)
4315 ;; Find current element's type and parse it accordingly to
4316 ;; its category.
4317 (let* ((element (org-element--current-element
4318 end granularity mode structure))
4319 (type (org-element-type element))
4320 (cbeg (org-element-property :contents-begin element)))
4321 (goto-char (org-element-property :end element))
4322 ;; Visible only: skip invisible parts between siblings.
4323 (when (and visible-only (org-invisible-p2))
4324 (goto-char (min (1+ (org-find-visible)) end)))
4325 ;; Fill ELEMENT contents by side-effect.
4326 (cond
4327 ;; If element has no contents, don't modify it.
4328 ((not cbeg))
4329 ;; Greater element: parse it between `contents-begin' and
4330 ;; `contents-end'. Make sure GRANULARITY allows the
4331 ;; recursion, or ELEMENT is a headline, in which case going
4332 ;; inside is mandatory, in order to get sub-level headings.
4333 ((and (memq type org-element-greater-elements)
4334 (or (memq granularity '(element object nil))
4335 (and (eq granularity 'greater-element)
4336 (eq type 'section))
4337 (eq type 'headline)))
4338 (org-element--parse-elements
4339 cbeg (org-element-property :contents-end element)
4340 ;; Possibly switch to a special mode.
4341 (org-element--next-mode type t)
4342 (and (memq type '(item plain-list))
4343 (org-element-property :structure element))
4344 granularity visible-only element))
4345 ;; ELEMENT has contents. Parse objects inside, if
4346 ;; GRANULARITY allows it.
4347 ((memq granularity '(object nil))
4348 (org-element--parse-objects
4349 cbeg (org-element-property :contents-end element) element
4350 (org-element-restriction type))))
4351 (push (org-element-put-property element :parent acc) elements)
4352 ;; Update mode.
4353 (setq mode (org-element--next-mode type nil))))
4354 ;; Return result.
4355 (apply #'org-element-set-contents acc (nreverse elements)))))
4357 (defun org-element--object-lex (restriction)
4358 "Return next object in current buffer or nil.
4359 RESTRICTION is a list of object types, as symbols, that should be
4360 looked after. This function assumes that the buffer is narrowed
4361 to an appropriate container (e.g., a paragraph)."
4362 (if (memq 'table-cell restriction) (org-element-table-cell-parser)
4363 (let* ((start (point))
4364 (limit
4365 ;; Object regexp sometimes needs to have a peek at
4366 ;; a character ahead. Therefore, when there is a hard
4367 ;; limit, make it one more than the true beginning of the
4368 ;; radio target.
4369 (save-excursion
4370 (cond ((not org-target-link-regexp) nil)
4371 ((not (memq 'link restriction)) nil)
4372 ((progn
4373 (unless (bolp) (forward-char -1))
4374 (not (re-search-forward org-target-link-regexp nil t)))
4375 nil)
4376 ;; Since we moved backward, we do not want to
4377 ;; match again an hypothetical 1-character long
4378 ;; radio link before us. Realizing that this can
4379 ;; only happen if such a radio link starts at
4380 ;; beginning of line, we prevent this here.
4381 ((and (= start (1+ (line-beginning-position)))
4382 (= start (match-end 1)))
4383 (and (re-search-forward org-target-link-regexp nil t)
4384 (1+ (match-beginning 1))))
4385 (t (1+ (match-beginning 1))))))
4386 found)
4387 (save-excursion
4388 (while (and (not found)
4389 (re-search-forward org-element--object-regexp limit 'move))
4390 (goto-char (match-beginning 0))
4391 (let ((result (match-string 0)))
4392 (setq found
4393 (cond
4394 ((string-prefix-p "call_" result t)
4395 (and (memq 'inline-babel-call restriction)
4396 (org-element-inline-babel-call-parser)))
4397 ((string-prefix-p "src_" result t)
4398 (and (memq 'inline-src-block restriction)
4399 (org-element-inline-src-block-parser)))
4401 (pcase (char-after)
4402 (?^ (and (memq 'superscript restriction)
4403 (org-element-superscript-parser)))
4404 (?_ (or (and (memq 'subscript restriction)
4405 (org-element-subscript-parser))
4406 (and (memq 'underline restriction)
4407 (org-element-underline-parser))))
4408 (?* (and (memq 'bold restriction)
4409 (org-element-bold-parser)))
4410 (?/ (and (memq 'italic restriction)
4411 (org-element-italic-parser)))
4412 (?~ (and (memq 'code restriction)
4413 (org-element-code-parser)))
4414 (?= (and (memq 'verbatim restriction)
4415 (org-element-verbatim-parser)))
4416 (?+ (and (memq 'strike-through restriction)
4417 (org-element-strike-through-parser)))
4418 (?@ (and (memq 'export-snippet restriction)
4419 (org-element-export-snippet-parser)))
4420 (?{ (and (memq 'macro restriction)
4421 (org-element-macro-parser)))
4422 (?$ (and (memq 'latex-fragment restriction)
4423 (org-element-latex-fragment-parser)))
4425 (if (eq (aref result 1) ?<)
4426 (or (and (memq 'radio-target restriction)
4427 (org-element-radio-target-parser))
4428 (and (memq 'target restriction)
4429 (org-element-target-parser)))
4430 (or (and (memq 'timestamp restriction)
4431 (org-element-timestamp-parser))
4432 (and (memq 'link restriction)
4433 (org-element-link-parser)))))
4434 (?\\
4435 (if (eq (aref result 1) ?\\)
4436 (and (memq 'line-break restriction)
4437 (org-element-line-break-parser))
4438 (or (and (memq 'entity restriction)
4439 (org-element-entity-parser))
4440 (and (memq 'latex-fragment restriction)
4441 (org-element-latex-fragment-parser)))))
4442 (?\[
4443 (if (eq (aref result 1) ?\[)
4444 (and (memq 'link restriction)
4445 (org-element-link-parser))
4446 (or (and (memq 'footnote-reference restriction)
4447 (org-element-footnote-reference-parser))
4448 (and (memq 'timestamp restriction)
4449 (org-element-timestamp-parser))
4450 (and (memq 'statistics-cookie restriction)
4451 (org-element-statistics-cookie-parser)))))
4452 ;; This is probably a plain link.
4453 (_ (and (memq 'link restriction)
4454 (org-element-link-parser)))))))
4455 (or (eobp) (forward-char))))
4456 (cond (found)
4457 (limit (forward-char -1)
4458 (org-element-link-parser)) ;radio link
4459 (t nil))))))
4461 (defun org-element--parse-objects (beg end acc restriction &optional parent)
4462 "Parse objects between BEG and END and return recursive structure.
4464 Objects are accumulated in ACC. RESTRICTION is a list of object
4465 successors which are allowed in the current object.
4467 ACC becomes the parent for all parsed objects. However, if ACC
4468 is nil (i.e., a secondary string is being parsed) and optional
4469 argument PARENT is non-nil, use it as the parent for all objects.
4470 Eventually, if both ACC and PARENT are nil, the common parent is
4471 the list of objects itself."
4472 (save-excursion
4473 (save-restriction
4474 (narrow-to-region beg end)
4475 (goto-char (point-min))
4476 (let (next-object contents)
4477 (while (and (not (eobp))
4478 (setq next-object (org-element--object-lex restriction)))
4479 ;; Text before any object.
4480 (let ((obj-beg (org-element-property :begin next-object)))
4481 (unless (= (point) obj-beg)
4482 (let ((text (buffer-substring-no-properties (point) obj-beg)))
4483 (push (if acc (org-element-put-property text :parent acc) text)
4484 contents))))
4485 ;; Object...
4486 (let ((obj-end (org-element-property :end next-object))
4487 (cont-beg (org-element-property :contents-begin next-object)))
4488 (when acc (org-element-put-property next-object :parent acc))
4489 (push (if cont-beg
4490 ;; Fill contents of NEXT-OBJECT if possible.
4491 (org-element--parse-objects
4492 cont-beg
4493 (org-element-property :contents-end next-object)
4494 next-object
4495 (org-element-restriction next-object))
4496 next-object)
4497 contents)
4498 (goto-char obj-end)))
4499 ;; Text after last object.
4500 (unless (eobp)
4501 (let ((text (buffer-substring-no-properties (point) end)))
4502 (push (if acc (org-element-put-property text :parent acc) text)
4503 contents)))
4504 ;; Result. Set appropriate parent.
4505 (if acc (apply #'org-element-set-contents acc (nreverse contents))
4506 (let* ((contents (nreverse contents))
4507 (parent (or parent contents)))
4508 (dolist (datum contents contents)
4509 (org-element-put-property datum :parent parent))))))))
4513 ;;; Towards A Bijective Process
4515 ;; The parse tree obtained with `org-element-parse-buffer' is really
4516 ;; a snapshot of the corresponding Org buffer. Therefore, it can be
4517 ;; interpreted and expanded into a string with canonical Org syntax.
4518 ;; Hence `org-element-interpret-data'.
4520 ;; The function relies internally on
4521 ;; `org-element--interpret-affiliated-keywords'.
4523 ;;;###autoload
4524 (defun org-element-interpret-data (data)
4525 "Interpret DATA as Org syntax.
4526 DATA is a parse tree, an element, an object or a secondary string
4527 to interpret. Return Org syntax as a string."
4528 (letrec ((fun
4529 (lambda (data parent)
4530 (let* ((type (org-element-type data))
4531 ;; Find interpreter for current object or
4532 ;; element. If it doesn't exist (e.g. this is
4533 ;; a pseudo object or element), return contents,
4534 ;; if any.
4535 (interpret
4536 (let ((fun (intern
4537 (format "org-element-%s-interpreter" type))))
4538 (if (fboundp fun) fun (lambda (_ contents) contents))))
4539 (results
4540 (cond
4541 ;; Secondary string.
4542 ((not type)
4543 (mapconcat (lambda (obj) (funcall fun obj parent))
4544 data
4545 ""))
4546 ;; Full Org document.
4547 ((eq type 'org-data)
4548 (mapconcat (lambda (obj) (funcall fun obj parent))
4549 (org-element-contents data)
4550 ""))
4551 ;; Plain text: return it.
4552 ((stringp data) data)
4553 ;; Element or object without contents.
4554 ((not (org-element-contents data))
4555 (funcall interpret data nil))
4556 ;; Element or object with contents.
4558 (funcall
4559 interpret
4560 data
4561 ;; Recursively interpret contents.
4562 (mapconcat
4563 (lambda (datum) (funcall fun datum data))
4564 (org-element-contents
4565 (if (not (memq type '(paragraph verse-block)))
4566 data
4567 ;; Fix indentation of elements containing
4568 ;; objects. We ignore `table-row'
4569 ;; elements as they are one line long
4570 ;; anyway.
4571 (org-element-normalize-contents
4572 data
4573 ;; When normalizing first paragraph of
4574 ;; an item or a footnote-definition,
4575 ;; ignore first line's indentation.
4576 (and (eq type 'paragraph)
4577 (memq (org-element-type parent)
4578 '(footnote-definition item))
4579 (eq data (car (org-element-contents parent)))
4580 (eq (org-element-property :pre-blank parent)
4581 0)))))
4582 ""))))))
4583 (if (memq type '(org-data plain-text nil)) results
4584 ;; Build white spaces. If no `:post-blank' property
4585 ;; is specified, assume its value is 0.
4586 (let ((blank (or (org-element-property :post-blank data) 0)))
4587 (if (eq (org-element-class data parent) 'object)
4588 (concat results (make-string blank ?\s))
4589 (concat (org-element--interpret-affiliated-keywords data)
4590 (org-element-normalize-string results)
4591 (make-string blank ?\n)))))))))
4592 (funcall fun data nil)))
4594 (defun org-element--interpret-affiliated-keywords (element)
4595 "Return ELEMENT's affiliated keywords as Org syntax.
4596 If there is no affiliated keyword, return the empty string."
4597 (let ((keyword-to-org
4598 (function
4599 (lambda (key value)
4600 (let (dual)
4601 (when (member key org-element-dual-keywords)
4602 (setq dual (cdr value) value (car value)))
4603 (concat "#+" (downcase key)
4604 (and dual
4605 (format "[%s]" (org-element-interpret-data dual)))
4606 ": "
4607 (if (member key org-element-parsed-keywords)
4608 (org-element-interpret-data value)
4609 value)
4610 "\n"))))))
4611 (mapconcat
4612 (lambda (prop)
4613 (let ((value (org-element-property prop element))
4614 (keyword (upcase (substring (symbol-name prop) 1))))
4615 (when value
4616 (if (or (member keyword org-element-multiple-keywords)
4617 ;; All attribute keywords can have multiple lines.
4618 (string-match "^ATTR_" keyword))
4619 (mapconcat (lambda (line) (funcall keyword-to-org keyword line))
4620 (reverse value)
4622 (funcall keyword-to-org keyword value)))))
4623 ;; List all ELEMENT's properties matching an attribute line or an
4624 ;; affiliated keyword, but ignore translated keywords since they
4625 ;; cannot belong to the property list.
4626 (cl-loop for prop in (nth 1 element) by 'cddr
4627 when (let ((keyword (upcase (substring (symbol-name prop) 1))))
4628 (or (string-match "^ATTR_" keyword)
4629 (and
4630 (member keyword org-element-affiliated-keywords)
4631 (not (assoc keyword
4632 org-element-keyword-translation-alist)))))
4633 collect prop)
4634 "")))
4636 ;; Because interpretation of the parse tree must return the same
4637 ;; number of blank lines between elements and the same number of white
4638 ;; space after objects, some special care must be given to white
4639 ;; spaces.
4641 ;; The first function, `org-element-normalize-string', ensures any
4642 ;; string different from the empty string will end with a single
4643 ;; newline character.
4645 ;; The second function, `org-element-normalize-contents', removes
4646 ;; global indentation from the contents of the current element.
4648 (defun org-element-normalize-string (s)
4649 "Ensure string S ends with a single newline character.
4651 If S isn't a string return it unchanged. If S is the empty
4652 string, return it. Otherwise, return a new string with a single
4653 newline character at its end."
4654 (cond
4655 ((not (stringp s)) s)
4656 ((string= "" s) "")
4657 (t (and (string-match "\\(\n[ \t]*\\)*\\'" s)
4658 (replace-match "\n" nil nil s)))))
4660 (defun org-element-normalize-contents (element &optional ignore-first)
4661 "Normalize plain text in ELEMENT's contents.
4663 ELEMENT must only contain plain text and objects.
4665 If optional argument IGNORE-FIRST is non-nil, ignore first line's
4666 indentation to compute maximal common indentation.
4668 Return the normalized element that is element with global
4669 indentation removed from its contents."
4670 (letrec ((find-min-ind
4671 ;; Return minimal common indentation within BLOB. This is
4672 ;; done by walking recursively BLOB and updating MIN-IND
4673 ;; along the way. FIRST-FLAG is non-nil when the next
4674 ;; object is expected to be a string that doesn't start
4675 ;; with a newline character. It happens for strings at
4676 ;; the beginnings of the contents or right after a line
4677 ;; break.
4678 (lambda (blob first-flag min-ind)
4679 (dolist (datum (org-element-contents blob) min-ind)
4680 (when first-flag
4681 (setq first-flag nil)
4682 (cond
4683 ;; Objects cannot start with spaces: in this
4684 ;; case, indentation is 0.
4685 ((not (stringp datum)) (throw :zero 0))
4686 ((not (string-match
4687 "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum))
4688 (throw :zero 0))
4689 ((equal (match-string 2 datum) "\n")
4690 (put-text-property
4691 (match-beginning 1) (match-end 1) 'org-ind 'empty datum))
4693 (let ((i (string-width (match-string 1 datum))))
4694 (put-text-property
4695 (match-beginning 1) (match-end 1) 'org-ind i datum)
4696 (setq min-ind (min i min-ind))))))
4697 (cond
4698 ((stringp datum)
4699 (let ((s 0))
4700 (while (string-match
4701 "\n\\([ \t]*\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s)
4702 (setq s (match-end 1))
4703 (cond
4704 ((equal (match-string 1 datum) "")
4705 (unless (member (match-string 2 datum) '("" "\n"))
4706 (throw :zero 0)))
4707 ((equal (match-string 2 datum) "\n")
4708 (put-text-property (match-beginning 1) (match-end 1)
4709 'org-ind 'empty datum))
4711 (let ((i (string-width (match-string 1 datum))))
4712 (put-text-property (match-beginning 1) (match-end 1)
4713 'org-ind i datum)
4714 (setq min-ind (min i min-ind))))))))
4715 ((eq (org-element-type datum) 'line-break)
4716 (setq first-flag t))
4717 ((memq (org-element-type datum) org-element-recursive-objects)
4718 (setq min-ind
4719 (funcall find-min-ind datum first-flag min-ind)))))))
4720 (min-ind
4721 (catch :zero
4722 (funcall find-min-ind
4723 element (not ignore-first) most-positive-fixnum))))
4724 (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element
4725 ;; Build ELEMENT back, replacing each string with the same
4726 ;; string minus common indentation.
4727 (letrec ((build
4728 (lambda (datum)
4729 ;; Return DATUM with all its strings indentation
4730 ;; shortened from MIN-IND white spaces.
4731 (setcdr
4732 (cdr datum)
4733 (mapcar
4734 (lambda (object)
4735 (cond
4736 ((stringp object)
4737 (with-temp-buffer
4738 (insert object)
4739 (let ((s (point-min)))
4740 (while (setq s (text-property-not-all
4741 s (point-max) 'org-ind nil))
4742 (goto-char s)
4743 (let ((i (get-text-property s 'org-ind)))
4744 (delete-region s (progn
4745 (skip-chars-forward " \t")
4746 (point)))
4747 (when (integerp i) (indent-to (- i min-ind))))))
4748 (buffer-string)))
4749 ((memq (org-element-type object)
4750 org-element-recursive-objects)
4751 (funcall build object))
4752 (t object)))
4753 (org-element-contents datum)))
4754 datum)))
4755 (funcall build element)))))
4759 ;;; Cache
4761 ;; Implement a caching mechanism for `org-element-at-point' and
4762 ;; `org-element-context', which see.
4764 ;; A single public function is provided: `org-element-cache-reset'.
4766 ;; Cache is enabled by default, but can be disabled globally with
4767 ;; `org-element-use-cache'. `org-element-cache-sync-idle-time',
4768 ;; org-element-cache-sync-duration' and `org-element-cache-sync-break'
4769 ;; can be tweaked to control caching behavior.
4771 ;; Internally, parsed elements are stored in an AVL tree,
4772 ;; `org-element--cache'. This tree is updated lazily: whenever
4773 ;; a change happens to the buffer, a synchronization request is
4774 ;; registered in `org-element--cache-sync-requests' (see
4775 ;; `org-element--cache-submit-request'). During idle time, requests
4776 ;; are processed by `org-element--cache-sync'. Synchronization also
4777 ;; happens when an element is required from the cache. In this case,
4778 ;; the process stops as soon as the needed element is up-to-date.
4780 ;; A synchronization request can only apply on a synchronized part of
4781 ;; the cache. Therefore, the cache is updated at least to the
4782 ;; location where the new request applies. Thus, requests are ordered
4783 ;; from left to right and all elements starting before the first
4784 ;; request are correct. This property is used by functions like
4785 ;; `org-element--cache-find' to retrieve elements in the part of the
4786 ;; cache that can be trusted.
4788 ;; A request applies to every element, starting from its original
4789 ;; location (or key, see below). When a request is processed, it
4790 ;; moves forward and may collide the next one. In this case, both
4791 ;; requests are merged into a new one that starts from that element.
4792 ;; As a consequence, the whole synchronization complexity does not
4793 ;; depend on the number of pending requests, but on the number of
4794 ;; elements the very first request will be applied on.
4796 ;; Elements cannot be accessed through their beginning position, which
4797 ;; may or may not be up-to-date. Instead, each element in the tree is
4798 ;; associated to a key, obtained with `org-element--cache-key'. This
4799 ;; mechanism is robust enough to preserve total order among elements
4800 ;; even when the tree is only partially synchronized.
4803 (defvar org-element-use-cache nil
4804 "Non-nil when Org parser should cache its results.
4806 WARNING: for the time being, using cache sometimes triggers
4807 freezes. Therefore, it is disabled by default. Activate it if
4808 you want to help debugging the issue.")
4810 (defvar org-element-cache-sync-idle-time 0.6
4811 "Length, in seconds, of idle time before syncing cache.")
4813 (defvar org-element-cache-sync-duration (seconds-to-time 0.04)
4814 "Maximum duration, as a time value, for a cache synchronization.
4815 If the synchronization is not over after this delay, the process
4816 pauses and resumes after `org-element-cache-sync-break'
4817 seconds.")
4819 (defvar org-element-cache-sync-break (seconds-to-time 0.3)
4820 "Duration, as a time value, of the pause between synchronizations.
4821 See `org-element-cache-sync-duration' for more information.")
4824 ;;;; Data Structure
4826 (defvar org-element--cache nil
4827 "AVL tree used to cache elements.
4828 Each node of the tree contains an element. Comparison is done
4829 with `org-element--cache-compare'. This cache is used in
4830 `org-element-at-point'.")
4832 (defvar org-element--cache-sync-requests nil
4833 "List of pending synchronization requests.
4835 A request is a vector with the following pattern:
4837 \[NEXT BEG END OFFSET PARENT PHASE]
4839 Processing a synchronization request consists of three phases:
4841 0. Delete modified elements,
4842 1. Fill missing area in cache,
4843 2. Shift positions and re-parent elements after the changes.
4845 During phase 0, NEXT is the key of the first element to be
4846 removed, BEG and END is buffer position delimiting the
4847 modifications. Elements starting between them (inclusive) are
4848 removed. So are elements whose parent is removed. PARENT, when
4849 non-nil, is the parent of the first element to be removed.
4851 During phase 1, NEXT is the key of the next known element in
4852 cache and BEG its beginning position. Parse buffer between that
4853 element and the one before it in order to determine the parent of
4854 the next element. Set PARENT to the element containing NEXT.
4856 During phase 2, NEXT is the key of the next element to shift in
4857 the parse tree. All elements starting from this one have their
4858 properties relatives to buffer positions shifted by integer
4859 OFFSET and, if they belong to element PARENT, are adopted by it.
4861 PHASE specifies the phase number, as an integer.")
4863 (defvar org-element--cache-sync-timer nil
4864 "Timer used for cache synchronization.")
4866 (defvar org-element--cache-sync-keys nil
4867 "Hash table used to store keys during synchronization.
4868 See `org-element--cache-key' for more information.")
4870 (defsubst org-element--cache-key (element)
4871 "Return a unique key for ELEMENT in cache tree.
4873 Keys are used to keep a total order among elements in the cache.
4874 Comparison is done with `org-element--cache-key-less-p'.
4876 When no synchronization is taking place, a key is simply the
4877 beginning position of the element, or that position plus one in
4878 the case of an first item (respectively row) in
4879 a list (respectively a table).
4881 During a synchronization, the key is the one the element had when
4882 the cache was synchronized for the last time. Elements added to
4883 cache during the synchronization get a new key generated with
4884 `org-element--cache-generate-key'.
4886 Such keys are stored in `org-element--cache-sync-keys'. The hash
4887 table is cleared once the synchronization is complete."
4888 (or (gethash element org-element--cache-sync-keys)
4889 (let* ((begin (org-element-property :begin element))
4890 ;; Increase beginning position of items (respectively
4891 ;; table rows) by one, so the first item can get
4892 ;; a different key from its parent list (respectively
4893 ;; table).
4894 (key (if (memq (org-element-type element) '(item table-row))
4895 (1+ begin)
4896 begin)))
4897 (if org-element--cache-sync-requests
4898 (puthash element key org-element--cache-sync-keys)
4899 key))))
4901 (defun org-element--cache-generate-key (lower upper)
4902 "Generate a key between LOWER and UPPER.
4904 LOWER and UPPER are integers or lists, possibly empty.
4906 If LOWER and UPPER are equals, return LOWER. Otherwise, return
4907 a unique key, as an integer or a list of integers, according to
4908 the following rules:
4910 - LOWER and UPPER are compared level-wise until values differ.
4912 - If, at a given level, LOWER and UPPER differ from more than
4913 2, the new key shares all the levels above with LOWER and
4914 gets a new level. Its value is the mean between LOWER and
4915 UPPER:
4917 (1 2) + (1 4) --> (1 3)
4919 - If LOWER has no value to compare with, it is assumed that its
4920 value is `most-negative-fixnum'. E.g.,
4922 (1 1) + (1 1 2)
4924 is equivalent to
4926 (1 1 m) + (1 1 2)
4928 where m is `most-negative-fixnum'. Likewise, if UPPER is
4929 short of levels, the current value is `most-positive-fixnum'.
4931 - If they differ from only one, the new key inherits from
4932 current LOWER level and fork it at the next level. E.g.,
4934 (2 1) + (3 3)
4936 is equivalent to
4938 (2 1) + (2 M)
4940 where M is `most-positive-fixnum'.
4942 - If the key is only one level long, it is returned as an
4943 integer:
4945 (1 2) + (3 2) --> 2
4947 When they are not equals, the function assumes that LOWER is
4948 lesser than UPPER, per `org-element--cache-key-less-p'."
4949 (if (equal lower upper) lower
4950 (let ((lower (if (integerp lower) (list lower) lower))
4951 (upper (if (integerp upper) (list upper) upper))
4952 skip-upper key)
4953 (catch 'exit
4954 (while t
4955 (let ((min (or (car lower) most-negative-fixnum))
4956 (max (cond (skip-upper most-positive-fixnum)
4957 ((car upper))
4958 (t most-positive-fixnum))))
4959 (if (< (1+ min) max)
4960 (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1))))
4961 (throw 'exit (if key (nreverse (cons mean key)) mean)))
4962 (when (and (< min max) (not skip-upper))
4963 ;; When at a given level, LOWER and UPPER differ from
4964 ;; 1, ignore UPPER altogether. Instead create a key
4965 ;; between LOWER and the greatest key with the same
4966 ;; prefix as LOWER so far.
4967 (setq skip-upper t))
4968 (push min key)
4969 (setq lower (cdr lower) upper (cdr upper)))))))))
4971 (defsubst org-element--cache-key-less-p (a b)
4972 "Non-nil if key A is less than key B.
4973 A and B are either integers or lists of integers, as returned by
4974 `org-element--cache-key'."
4975 (if (integerp a) (if (integerp b) (< a b) (<= a (car b)))
4976 (if (integerp b) (< (car a) b)
4977 (catch 'exit
4978 (while (and a b)
4979 (cond ((car-less-than-car a b) (throw 'exit t))
4980 ((car-less-than-car b a) (throw 'exit nil))
4981 (t (setq a (cdr a) b (cdr b)))))
4982 ;; If A is empty, either keys are equal (B is also empty) and
4983 ;; we return nil, or A is lesser than B (B is longer) and we
4984 ;; return a non-nil value.
4986 ;; If A is not empty, B is necessarily empty and A is greater
4987 ;; than B (A is longer). Therefore, return nil.
4988 (and (null a) b)))))
4990 (defun org-element--cache-compare (a b)
4991 "Non-nil when element A is located before element B."
4992 (org-element--cache-key-less-p (org-element--cache-key a)
4993 (org-element--cache-key b)))
4995 (defsubst org-element--cache-root ()
4996 "Return root value in cache.
4997 This function assumes `org-element--cache' is a valid AVL tree."
4998 (avl-tree--node-left (avl-tree--dummyroot org-element--cache)))
5001 ;;;; Tools
5003 (defsubst org-element--cache-active-p ()
5004 "Non-nil when cache is active in current buffer."
5005 (and org-element-use-cache
5006 org-element--cache
5007 (derived-mode-p 'org-mode)))
5009 (defun org-element--cache-find (pos &optional side)
5010 "Find element in cache starting at POS or before.
5012 POS refers to a buffer position.
5014 When optional argument SIDE is non-nil, the function checks for
5015 elements starting at or past POS instead. If SIDE is `both', the
5016 function returns a cons cell where car is the first element
5017 starting at or before POS and cdr the first element starting
5018 after POS.
5020 The function can only find elements in the synchronized part of
5021 the cache."
5022 (let ((limit (and org-element--cache-sync-requests
5023 (aref (car org-element--cache-sync-requests) 0)))
5024 (node (org-element--cache-root))
5025 lower upper)
5026 (while node
5027 (let* ((element (avl-tree--node-data node))
5028 (begin (org-element-property :begin element)))
5029 (cond
5030 ((and limit
5031 (not (org-element--cache-key-less-p
5032 (org-element--cache-key element) limit)))
5033 (setq node (avl-tree--node-left node)))
5034 ((> begin pos)
5035 (setq upper element
5036 node (avl-tree--node-left node)))
5037 ((< begin pos)
5038 (setq lower element
5039 node (avl-tree--node-right node)))
5040 ;; We found an element in cache starting at POS. If `side'
5041 ;; is `both' we also want the next one in order to generate
5042 ;; a key in-between.
5044 ;; If the element is the first row or item in a table or
5045 ;; a plain list, we always return the table or the plain
5046 ;; list.
5048 ;; In any other case, we return the element found.
5049 ((eq side 'both)
5050 (setq lower element)
5051 (setq node (avl-tree--node-right node)))
5052 ((and (memq (org-element-type element) '(item table-row))
5053 (let ((parent (org-element-property :parent element)))
5054 (and (= (org-element-property :begin element)
5055 (org-element-property :contents-begin parent))
5056 (setq node nil
5057 lower parent
5058 upper parent)))))
5060 (setq node nil
5061 lower element
5062 upper element)))))
5063 (pcase side
5064 (`both (cons lower upper))
5065 (`nil lower)
5066 (_ upper))))
5068 (defun org-element--cache-put (element)
5069 "Store ELEMENT in current buffer's cache, if allowed."
5070 (when (org-element--cache-active-p)
5071 (when org-element--cache-sync-requests
5072 ;; During synchronization, first build an appropriate key for
5073 ;; the new element so `avl-tree-enter' can insert it at the
5074 ;; right spot in the cache.
5075 (let ((keys (org-element--cache-find
5076 (org-element-property :begin element) 'both)))
5077 (puthash element
5078 (org-element--cache-generate-key
5079 (and (car keys) (org-element--cache-key (car keys)))
5080 (cond ((cdr keys) (org-element--cache-key (cdr keys)))
5081 (org-element--cache-sync-requests
5082 (aref (car org-element--cache-sync-requests) 0))))
5083 org-element--cache-sync-keys)))
5084 (avl-tree-enter org-element--cache element)))
5086 (defsubst org-element--cache-remove (element)
5087 "Remove ELEMENT from cache.
5088 Assume ELEMENT belongs to cache and that a cache is active."
5089 (avl-tree-delete org-element--cache element))
5092 ;;;; Synchronization
5094 (defsubst org-element--cache-set-timer (buffer)
5095 "Set idle timer for cache synchronization in BUFFER."
5096 (when org-element--cache-sync-timer
5097 (cancel-timer org-element--cache-sync-timer))
5098 (setq org-element--cache-sync-timer
5099 (run-with-idle-timer
5100 (let ((idle (current-idle-time)))
5101 (if idle (time-add idle org-element-cache-sync-break)
5102 org-element-cache-sync-idle-time))
5104 #'org-element--cache-sync
5105 buffer)))
5107 (defsubst org-element--cache-interrupt-p (time-limit)
5108 "Non-nil when synchronization process should be interrupted.
5109 TIME-LIMIT is a time value or nil."
5110 (and time-limit
5111 (or (input-pending-p)
5112 (time-less-p time-limit (current-time)))))
5114 (defsubst org-element--cache-shift-positions (element offset &optional props)
5115 "Shift ELEMENT properties relative to buffer positions by OFFSET.
5117 Properties containing buffer positions are `:begin', `:end',
5118 `:contents-begin', `:contents-end' and `:structure'. When
5119 optional argument PROPS is a list of keywords, only shift
5120 properties provided in that list.
5122 Properties are modified by side-effect."
5123 (let ((properties (nth 1 element)))
5124 ;; Shift `:structure' property for the first plain list only: it
5125 ;; is the only one that really matters and it prevents from
5126 ;; shifting it more than once.
5127 (when (and (or (not props) (memq :structure props))
5128 (eq (org-element-type element) 'plain-list)
5129 (not (eq (org-element-type (plist-get properties :parent))
5130 'item)))
5131 (dolist (item (plist-get properties :structure))
5132 (cl-incf (car item) offset)
5133 (cl-incf (nth 6 item) offset)))
5134 (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated))
5135 (let ((value (and (or (not props) (memq key props))
5136 (plist-get properties key))))
5137 (and value (plist-put properties key (+ offset value)))))))
5139 (defun org-element--cache-sync (buffer &optional threshold future-change)
5140 "Synchronize cache with recent modification in BUFFER.
5142 When optional argument THRESHOLD is non-nil, do the
5143 synchronization for all elements starting before or at threshold,
5144 then exit. Otherwise, synchronize cache for as long as
5145 `org-element-cache-sync-duration' or until Emacs leaves idle
5146 state.
5148 FUTURE-CHANGE, when non-nil, is a buffer position where changes
5149 not registered yet in the cache are going to happen. It is used
5150 in `org-element--cache-submit-request', where cache is partially
5151 updated before current modification are actually submitted."
5152 (when (buffer-live-p buffer)
5153 (with-current-buffer buffer
5154 (let ((inhibit-quit t) request next)
5155 (when org-element--cache-sync-timer
5156 (cancel-timer org-element--cache-sync-timer))
5157 (catch 'interrupt
5158 (while org-element--cache-sync-requests
5159 (setq request (car org-element--cache-sync-requests)
5160 next (nth 1 org-element--cache-sync-requests))
5161 (org-element--cache-process-request
5162 request
5163 (and next (aref next 0))
5164 threshold
5165 (and (not threshold)
5166 (time-add (current-time)
5167 org-element-cache-sync-duration))
5168 future-change)
5169 ;; Request processed. Merge current and next offsets and
5170 ;; transfer ending position.
5171 (when next
5172 (cl-incf (aref next 3) (aref request 3))
5173 (aset next 2 (aref request 2)))
5174 (setq org-element--cache-sync-requests
5175 (cdr org-element--cache-sync-requests))))
5176 ;; If more requests are awaiting, set idle timer accordingly.
5177 ;; Otherwise, reset keys.
5178 (if org-element--cache-sync-requests
5179 (org-element--cache-set-timer buffer)
5180 (clrhash org-element--cache-sync-keys))))))
5182 (defun org-element--cache-process-request
5183 (request next threshold time-limit future-change)
5184 "Process synchronization REQUEST for all entries before NEXT.
5186 REQUEST is a vector, built by `org-element--cache-submit-request'.
5188 NEXT is a cache key, as returned by `org-element--cache-key'.
5190 When non-nil, THRESHOLD is a buffer position. Synchronization
5191 stops as soon as a shifted element begins after it.
5193 When non-nil, TIME-LIMIT is a time value. Synchronization stops
5194 after this time or when Emacs exits idle state.
5196 When non-nil, FUTURE-CHANGE is a buffer position where changes
5197 not registered yet in the cache are going to happen. See
5198 `org-element--cache-submit-request' for more information.
5200 Throw `interrupt' if the process stops before completing the
5201 request."
5202 (catch 'quit
5203 (when (= (aref request 5) 0)
5204 ;; Phase 0.
5206 ;; Delete all elements starting after BEG, but not after buffer
5207 ;; position END or past element with key NEXT. Also delete
5208 ;; elements contained within a previously removed element
5209 ;; (stored in `last-container').
5211 ;; At each iteration, we start again at tree root since
5212 ;; a deletion modifies structure of the balanced tree.
5213 (catch 'end-phase
5214 (while t
5215 (when (org-element--cache-interrupt-p time-limit)
5216 (throw 'interrupt nil))
5217 ;; Find first element in cache with key BEG or after it.
5218 (let ((beg (aref request 0))
5219 (end (aref request 2))
5220 (node (org-element--cache-root))
5221 data data-key last-container)
5222 (while node
5223 (let* ((element (avl-tree--node-data node))
5224 (key (org-element--cache-key element)))
5225 (cond
5226 ((org-element--cache-key-less-p key beg)
5227 (setq node (avl-tree--node-right node)))
5228 ((org-element--cache-key-less-p beg key)
5229 (setq data element
5230 data-key key
5231 node (avl-tree--node-left node)))
5232 (t (setq data element
5233 data-key key
5234 node nil)))))
5235 (if data
5236 (let ((pos (org-element-property :begin data)))
5237 (if (if (or (not next)
5238 (org-element--cache-key-less-p data-key next))
5239 (<= pos end)
5240 (and last-container
5241 (let ((up data))
5242 (while (and up (not (eq up last-container)))
5243 (setq up (org-element-property :parent up)))
5244 up)))
5245 (progn (when (and (not last-container)
5246 (> (org-element-property :end data)
5247 end))
5248 (setq last-container data))
5249 (org-element--cache-remove data))
5250 (aset request 0 data-key)
5251 (aset request 1 pos)
5252 (aset request 5 1)
5253 (throw 'end-phase nil)))
5254 ;; No element starting after modifications left in
5255 ;; cache: further processing is futile.
5256 (throw 'quit t))))))
5257 (when (= (aref request 5) 1)
5258 ;; Phase 1.
5260 ;; Phase 0 left a hole in the cache. Some elements after it
5261 ;; could have parents within. For example, in the following
5262 ;; buffer:
5264 ;; - item
5267 ;; Paragraph1
5269 ;; Paragraph2
5271 ;; if we remove a blank line between "item" and "Paragraph1",
5272 ;; everything down to "Paragraph2" is removed from cache. But
5273 ;; the paragraph now belongs to the list, and its `:parent'
5274 ;; property no longer is accurate.
5276 ;; Therefore we need to parse again elements in the hole, or at
5277 ;; least in its last section, so that we can re-parent
5278 ;; subsequent elements, during phase 2.
5280 ;; Note that we only need to get the parent from the first
5281 ;; element in cache after the hole.
5283 ;; When next key is lesser or equal to the current one, delegate
5284 ;; phase 1 processing to next request in order to preserve key
5285 ;; order among requests.
5286 (let ((key (aref request 0)))
5287 (when (and next (not (org-element--cache-key-less-p key next)))
5288 (let ((next-request (nth 1 org-element--cache-sync-requests)))
5289 (aset next-request 0 key)
5290 (aset next-request 1 (aref request 1))
5291 (aset next-request 5 1))
5292 (throw 'quit t)))
5293 ;; Next element will start at its beginning position plus
5294 ;; offset, since it hasn't been shifted yet. Therefore, LIMIT
5295 ;; contains the real beginning position of the first element to
5296 ;; shift and re-parent.
5297 (let ((limit (+ (aref request 1) (aref request 3))))
5298 (cond ((and threshold (> limit threshold)) (throw 'interrupt nil))
5299 ((and future-change (>= limit future-change))
5300 ;; Changes are going to happen around this element and
5301 ;; they will trigger another phase 1 request. Skip the
5302 ;; current one.
5303 (aset request 5 2))
5305 (let ((parent (org-element--parse-to limit t time-limit)))
5306 (aset request 4 parent)
5307 (aset request 5 2))))))
5308 ;; Phase 2.
5310 ;; Shift all elements starting from key START, but before NEXT, by
5311 ;; OFFSET, and re-parent them when appropriate.
5313 ;; Elements are modified by side-effect so the tree structure
5314 ;; remains intact.
5316 ;; Once THRESHOLD, if any, is reached, or once there is an input
5317 ;; pending, exit. Before leaving, the current synchronization
5318 ;; request is updated.
5319 (let ((start (aref request 0))
5320 (offset (aref request 3))
5321 (parent (aref request 4))
5322 (node (org-element--cache-root))
5323 (stack (list nil))
5324 (leftp t)
5325 exit-flag)
5326 ;; No re-parenting nor shifting planned: request is over.
5327 (when (and (not parent) (zerop offset)) (throw 'quit t))
5328 (while node
5329 (let* ((data (avl-tree--node-data node))
5330 (key (org-element--cache-key data)))
5331 (if (and leftp (avl-tree--node-left node)
5332 (not (org-element--cache-key-less-p key start)))
5333 (progn (push node stack)
5334 (setq node (avl-tree--node-left node)))
5335 (unless (org-element--cache-key-less-p key start)
5336 ;; We reached NEXT. Request is complete.
5337 (when (equal key next) (throw 'quit t))
5338 ;; Handle interruption request. Update current request.
5339 (when (or exit-flag (org-element--cache-interrupt-p time-limit))
5340 (aset request 0 key)
5341 (aset request 4 parent)
5342 (throw 'interrupt nil))
5343 ;; Shift element.
5344 (unless (zerop offset)
5345 (org-element--cache-shift-positions data offset))
5346 (let ((begin (org-element-property :begin data)))
5347 ;; Update PARENT and re-parent DATA, only when
5348 ;; necessary. Propagate new structures for lists.
5349 (while (and parent
5350 (<= (org-element-property :end parent) begin))
5351 (setq parent (org-element-property :parent parent)))
5352 (cond ((and (not parent) (zerop offset)) (throw 'quit nil))
5353 ((and parent
5354 (let ((p (org-element-property :parent data)))
5355 (or (not p)
5356 (< (org-element-property :begin p)
5357 (org-element-property :begin parent)))))
5358 (org-element-put-property data :parent parent)
5359 (let ((s (org-element-property :structure parent)))
5360 (when (and s (org-element-property :structure data))
5361 (org-element-put-property data :structure s)))))
5362 ;; Cache is up-to-date past THRESHOLD. Request
5363 ;; interruption.
5364 (when (and threshold (> begin threshold)) (setq exit-flag t))))
5365 (setq node (if (setq leftp (avl-tree--node-right node))
5366 (avl-tree--node-right node)
5367 (pop stack))))))
5368 ;; We reached end of tree: synchronization complete.
5369 t)))
5371 (defun org-element--parse-to (pos &optional syncp time-limit)
5372 "Parse elements in current section, down to POS.
5374 Start parsing from the closest between the last known element in
5375 cache or headline above. Return the smallest element containing
5376 POS.
5378 When optional argument SYNCP is non-nil, return the parent of the
5379 element containing POS instead. In that case, it is also
5380 possible to provide TIME-LIMIT, which is a time value specifying
5381 when the parsing should stop. The function throws `interrupt' if
5382 the process stopped before finding the expected result."
5383 (catch 'exit
5384 (org-with-wide-buffer
5385 (goto-char pos)
5386 (let* ((cached (and (org-element--cache-active-p)
5387 (org-element--cache-find pos nil)))
5388 (begin (org-element-property :begin cached))
5389 element next mode)
5390 (cond
5391 ;; Nothing in cache before point: start parsing from first
5392 ;; element following headline above, or first element in
5393 ;; buffer.
5394 ((not cached)
5395 (when (org-with-limited-levels (outline-previous-heading))
5396 (setq mode 'planning)
5397 (forward-line))
5398 (skip-chars-forward " \r\t\n")
5399 (beginning-of-line))
5400 ;; Cache returned exact match: return it.
5401 ((= pos begin)
5402 (throw 'exit (if syncp (org-element-property :parent cached) cached)))
5403 ;; There's a headline between cached value and POS: cached
5404 ;; value is invalid. Start parsing from first element
5405 ;; following the headline.
5406 ((re-search-backward
5407 (org-with-limited-levels org-outline-regexp-bol) begin t)
5408 (forward-line)
5409 (skip-chars-forward " \r\t\n")
5410 (beginning-of-line)
5411 (setq mode 'planning))
5412 ;; Check if CACHED or any of its ancestors contain point.
5414 ;; If there is such an element, we inspect it in order to know
5415 ;; if we return it or if we need to parse its contents.
5416 ;; Otherwise, we just start parsing from current location,
5417 ;; which is right after the top-most element containing
5418 ;; CACHED.
5420 ;; As a special case, if POS is at the end of the buffer, we
5421 ;; want to return the innermost element ending there.
5423 ;; Also, if we find an ancestor and discover that we need to
5424 ;; parse its contents, make sure we don't start from
5425 ;; `:contents-begin', as we would otherwise go past CACHED
5426 ;; again. Instead, in that situation, we will resume parsing
5427 ;; from NEXT, which is located after CACHED or its higher
5428 ;; ancestor not containing point.
5430 (let ((up cached)
5431 (pos (if (= (point-max) pos) (1- pos) pos)))
5432 (goto-char (or (org-element-property :contents-begin cached) begin))
5433 (while (let ((end (org-element-property :end up)))
5434 (and (<= end pos)
5435 (goto-char end)
5436 (setq up (org-element-property :parent up)))))
5437 (cond ((not up))
5438 ((eobp) (setq element up))
5439 (t (setq element up next (point)))))))
5440 ;; Parse successively each element until we reach POS.
5441 (let ((end (or (org-element-property :end element)
5442 (save-excursion
5443 (org-with-limited-levels (outline-next-heading))
5444 (point))))
5445 (parent element))
5446 (while t
5447 (when syncp
5448 (cond ((= (point) pos) (throw 'exit parent))
5449 ((org-element--cache-interrupt-p time-limit)
5450 (throw 'interrupt nil))))
5451 (unless element
5452 (setq element (org-element--current-element
5453 end 'element mode
5454 (org-element-property :structure parent)))
5455 (org-element-put-property element :parent parent)
5456 (org-element--cache-put element))
5457 (let ((elem-end (org-element-property :end element))
5458 (type (org-element-type element)))
5459 (cond
5460 ;; Skip any element ending before point. Also skip
5461 ;; element ending at point (unless it is also the end of
5462 ;; buffer) since we're sure that another element begins
5463 ;; after it.
5464 ((and (<= elem-end pos) (/= (point-max) elem-end))
5465 (goto-char elem-end)
5466 (setq mode (org-element--next-mode type nil)))
5467 ;; A non-greater element contains point: return it.
5468 ((not (memq type org-element-greater-elements))
5469 (throw 'exit element))
5470 ;; Otherwise, we have to decide if ELEMENT really
5471 ;; contains POS. In that case we start parsing from
5472 ;; contents' beginning.
5474 ;; If POS is at contents' beginning but it is also at
5475 ;; the beginning of the first item in a list or a table.
5476 ;; In that case, we need to create an anchor for that
5477 ;; list or table, so return it.
5479 ;; Also, if POS is at the end of the buffer, no element
5480 ;; can start after it, but more than one may end there.
5481 ;; Arbitrarily, we choose to return the innermost of
5482 ;; such elements.
5483 ((let ((cbeg (org-element-property :contents-begin element))
5484 (cend (org-element-property :contents-end element)))
5485 (when (or syncp
5486 (and cbeg cend
5487 (or (< cbeg pos)
5488 (and (= cbeg pos)
5489 (not (memq type '(plain-list table)))))
5490 (or (> cend pos)
5491 (and (= cend pos) (= (point-max) pos)))))
5492 (goto-char (or next cbeg))
5493 (setq next nil
5494 mode (org-element--next-mode type t)
5495 parent element
5496 end cend))))
5497 ;; Otherwise, return ELEMENT as it is the smallest
5498 ;; element containing POS.
5499 (t (throw 'exit element))))
5500 (setq element nil)))))))
5503 ;;;; Staging Buffer Changes
5505 (defconst org-element--cache-sensitive-re
5506 (concat
5507 org-outline-regexp-bol "\\|"
5508 "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|"
5509 "^[ \t]*\\(?:"
5510 "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|"
5511 "\\\\begin{[A-Za-z0-9*]+}" "\\|"
5512 ":\\(?:\\w\\|[-_]\\)+:[ \t]*$"
5513 "\\)")
5514 "Regexp matching a sensitive line, structure wise.
5515 A sensitive line is a headline, inlinetask, block, drawer, or
5516 latex-environment boundary. When such a line is modified,
5517 structure changes in the document may propagate in the whole
5518 section, possibly making cache invalid.")
5520 (defvar org-element--cache-change-warning nil
5521 "Non-nil when a sensitive line is about to be changed.
5522 It is a symbol among nil, t and `headline'.")
5524 (defun org-element--cache-before-change (beg end)
5525 "Request extension of area going to be modified if needed.
5526 BEG and END are the beginning and end of the range of changed
5527 text. See `before-change-functions' for more information."
5528 (when (org-element--cache-active-p)
5529 (org-with-wide-buffer
5530 (goto-char beg)
5531 (beginning-of-line)
5532 (let ((bottom (save-excursion (goto-char end) (line-end-position))))
5533 (setq org-element--cache-change-warning
5534 (save-match-data
5535 (if (and (org-with-limited-levels (org-at-heading-p))
5536 (= (line-end-position) bottom))
5537 'headline
5538 (let ((case-fold-search t))
5539 (re-search-forward
5540 org-element--cache-sensitive-re bottom t)))))))))
5542 (defun org-element--cache-after-change (beg end pre)
5543 "Update buffer modifications for current buffer.
5544 BEG and END are the beginning and end of the range of changed
5545 text, and the length in bytes of the pre-change text replaced by
5546 that range. See `after-change-functions' for more information."
5547 (when (org-element--cache-active-p)
5548 (org-with-wide-buffer
5549 (goto-char beg)
5550 (beginning-of-line)
5551 (save-match-data
5552 (let ((top (point))
5553 (bottom (save-excursion (goto-char end) (line-end-position))))
5554 ;; Determine if modified area needs to be extended, according
5555 ;; to both previous and current state. We make a special
5556 ;; case for headline editing: if a headline is modified but
5557 ;; not removed, do not extend.
5558 (when (pcase org-element--cache-change-warning
5559 (`t t)
5560 (`headline
5561 (not (and (org-with-limited-levels (org-at-heading-p))
5562 (= (line-end-position) bottom))))
5564 (let ((case-fold-search t))
5565 (re-search-forward
5566 org-element--cache-sensitive-re bottom t))))
5567 ;; Effectively extend modified area.
5568 (org-with-limited-levels
5569 (setq top (progn (goto-char top)
5570 (when (outline-previous-heading) (forward-line))
5571 (point)))
5572 (setq bottom (progn (goto-char bottom)
5573 (if (outline-next-heading) (1- (point))
5574 (point))))))
5575 ;; Store synchronization request.
5576 (let ((offset (- end beg pre)))
5577 (org-element--cache-submit-request top (- bottom offset) offset)))))
5578 ;; Activate a timer to process the request during idle time.
5579 (org-element--cache-set-timer (current-buffer))))
5581 (defun org-element--cache-for-removal (beg end offset)
5582 "Return first element to remove from cache.
5584 BEG and END are buffer positions delimiting buffer modifications.
5585 OFFSET is the size of the changes.
5587 Returned element is usually the first element in cache containing
5588 any position between BEG and END. As an exception, greater
5589 elements around the changes that are robust to contents
5590 modifications are preserved and updated according to the
5591 changes."
5592 (let* ((elements (org-element--cache-find (1- beg) 'both))
5593 (before (car elements))
5594 (after (cdr elements)))
5595 (if (not before) after
5596 (let ((up before)
5597 (robust-flag t))
5598 (while up
5599 (if (let ((type (org-element-type up)))
5600 (and (or (memq type '(center-block dynamic-block quote-block
5601 special-block))
5602 ;; Drawers named "PROPERTIES" are probably
5603 ;; a properties drawer being edited. Force
5604 ;; parsing to check if editing is over.
5605 (and (eq type 'drawer)
5606 (not (string=
5607 (org-element-property :drawer-name up)
5608 "PROPERTIES"))))
5609 (let ((cbeg (org-element-property :contents-begin up)))
5610 (and cbeg
5611 (<= cbeg beg)
5612 (> (org-element-property :contents-end up) end)))))
5613 ;; UP is a robust greater element containing changes.
5614 ;; We only need to extend its ending boundaries.
5615 (org-element--cache-shift-positions
5616 up offset '(:contents-end :end))
5617 (setq before up)
5618 (when robust-flag (setq robust-flag nil)))
5619 (setq up (org-element-property :parent up)))
5620 ;; We're at top level element containing ELEMENT: if it's
5621 ;; altered by buffer modifications, it is first element in
5622 ;; cache to be removed. Otherwise, that first element is the
5623 ;; following one.
5625 ;; As a special case, do not remove BEFORE if it is a robust
5626 ;; container for current changes.
5627 (if (or (< (org-element-property :end before) beg) robust-flag) after
5628 before)))))
5630 (defun org-element--cache-submit-request (beg end offset)
5631 "Submit a new cache synchronization request for current buffer.
5632 BEG and END are buffer positions delimiting the minimal area
5633 where cache data should be removed. OFFSET is the size of the
5634 change, as an integer."
5635 (let ((next (car org-element--cache-sync-requests))
5636 delete-to delete-from)
5637 (if (and next
5638 (zerop (aref next 5))
5639 (> (setq delete-to (+ (aref next 2) (aref next 3))) end)
5640 (<= (setq delete-from (aref next 1)) end))
5641 ;; Current changes can be merged with first sync request: we
5642 ;; can save a partial cache synchronization.
5643 (progn
5644 (cl-incf (aref next 3) offset)
5645 ;; If last change happened within area to be removed, extend
5646 ;; boundaries of robust parents, if any. Otherwise, find
5647 ;; first element to remove and update request accordingly.
5648 (if (> beg delete-from)
5649 (let ((up (aref next 4)))
5650 (while up
5651 (org-element--cache-shift-positions
5652 up offset '(:contents-end :end))
5653 (setq up (org-element-property :parent up))))
5654 (let ((first (org-element--cache-for-removal beg delete-to offset)))
5655 (when first
5656 (aset next 0 (org-element--cache-key first))
5657 (aset next 1 (org-element-property :begin first))
5658 (aset next 4 (org-element-property :parent first))))))
5659 ;; Ensure cache is correct up to END. Also make sure that NEXT,
5660 ;; if any, is no longer a 0-phase request, thus ensuring that
5661 ;; phases are properly ordered. We need to provide OFFSET as
5662 ;; optional parameter since current modifications are not known
5663 ;; yet to the otherwise correct part of the cache (i.e, before
5664 ;; the first request).
5665 (when next (org-element--cache-sync (current-buffer) end beg))
5666 (let ((first (org-element--cache-for-removal beg end offset)))
5667 (if first
5668 (push (let ((beg (org-element-property :begin first))
5669 (key (org-element--cache-key first)))
5670 (cond
5671 ;; When changes happen before the first known
5672 ;; element, re-parent and shift the rest of the
5673 ;; cache.
5674 ((> beg end) (vector key beg nil offset nil 1))
5675 ;; Otherwise, we find the first non robust
5676 ;; element containing END. All elements between
5677 ;; FIRST and this one are to be removed.
5678 ((let ((first-end (org-element-property :end first)))
5679 (and (> first-end end)
5680 (vector key beg first-end offset first 0))))
5682 (let* ((element (org-element--cache-find end))
5683 (end (org-element-property :end element))
5684 (up element))
5685 (while (and (setq up (org-element-property :parent up))
5686 (>= (org-element-property :begin up) beg))
5687 (setq end (org-element-property :end up)
5688 element up))
5689 (vector key beg end offset element 0)))))
5690 org-element--cache-sync-requests)
5691 ;; No element to remove. No need to re-parent either.
5692 ;; Simply shift additional elements, if any, by OFFSET.
5693 (when org-element--cache-sync-requests
5694 (cl-incf (aref (car org-element--cache-sync-requests) 3)
5695 offset)))))))
5698 ;;;; Public Functions
5700 ;;;###autoload
5701 (defun org-element-cache-reset (&optional all)
5702 "Reset cache in current buffer.
5703 When optional argument ALL is non-nil, reset cache in all Org
5704 buffers."
5705 (interactive "P")
5706 (dolist (buffer (if all (buffer-list) (list (current-buffer))))
5707 (with-current-buffer buffer
5708 (when (and org-element-use-cache (derived-mode-p 'org-mode))
5709 (setq-local org-element--cache
5710 (avl-tree-create #'org-element--cache-compare))
5711 (setq-local org-element--cache-sync-keys
5712 (make-hash-table :weakness 'key :test #'eq))
5713 (setq-local org-element--cache-change-warning nil)
5714 (setq-local org-element--cache-sync-requests nil)
5715 (setq-local org-element--cache-sync-timer nil)
5716 (add-hook 'before-change-functions
5717 #'org-element--cache-before-change nil t)
5718 (add-hook 'after-change-functions
5719 #'org-element--cache-after-change nil t)))))
5721 ;;;###autoload
5722 (defun org-element-cache-refresh (pos)
5723 "Refresh cache at position POS."
5724 (when (org-element--cache-active-p)
5725 (org-element--cache-sync (current-buffer) pos)
5726 (org-element--cache-submit-request pos pos 0)
5727 (org-element--cache-set-timer (current-buffer))))
5731 ;;; The Toolbox
5733 ;; The first move is to implement a way to obtain the smallest element
5734 ;; containing point. This is the job of `org-element-at-point'. It
5735 ;; basically jumps back to the beginning of section containing point
5736 ;; and proceed, one element after the other, with
5737 ;; `org-element--current-element' until the container is found. Note:
5738 ;; When using `org-element-at-point', secondary values are never
5739 ;; parsed since the function focuses on elements, not on objects.
5741 ;; At a deeper level, `org-element-context' lists all elements and
5742 ;; objects containing point.
5744 ;; `org-element-nested-p' and `org-element-swap-A-B' may be used
5745 ;; internally by navigation and manipulation tools.
5748 ;;;###autoload
5749 (defun org-element-at-point ()
5750 "Determine closest element around point.
5752 Return value is a list like (TYPE PROPS) where TYPE is the type
5753 of the element and PROPS a plist of properties associated to the
5754 element.
5756 Possible types are defined in `org-element-all-elements'.
5757 Properties depend on element or object type, but always include
5758 `:begin', `:end', `:parent' and `:post-blank' properties.
5760 As a special case, if point is at the very beginning of the first
5761 item in a list or sub-list, returned element will be that list
5762 instead of the item. Likewise, if point is at the beginning of
5763 the first row of a table, returned element will be the table
5764 instead of the first row.
5766 When point is at the end of the buffer, return the innermost
5767 element ending there."
5768 (org-with-wide-buffer
5769 (let ((origin (point)))
5770 (end-of-line)
5771 (skip-chars-backward " \r\t\n")
5772 (cond
5773 ;; Within blank lines at the beginning of buffer, return nil.
5774 ((bobp) nil)
5775 ;; Within blank lines right after a headline, return that
5776 ;; headline.
5777 ((org-with-limited-levels (org-at-heading-p))
5778 (beginning-of-line)
5779 (org-element-headline-parser (point-max) t))
5780 ;; Otherwise parse until we find element containing ORIGIN.
5782 (when (org-element--cache-active-p)
5783 (if (not org-element--cache) (org-element-cache-reset)
5784 (org-element--cache-sync (current-buffer) origin)))
5785 (org-element--parse-to origin))))))
5787 ;;;###autoload
5788 (defun org-element-context (&optional element)
5789 "Return smallest element or object around point.
5791 Return value is a list like (TYPE PROPS) where TYPE is the type
5792 of the element or object and PROPS a plist of properties
5793 associated to it.
5795 Possible types are defined in `org-element-all-elements' and
5796 `org-element-all-objects'. Properties depend on element or
5797 object type, but always include `:begin', `:end', `:parent' and
5798 `:post-blank'.
5800 As a special case, if point is right after an object and not at
5801 the beginning of any other object, return that object.
5803 Optional argument ELEMENT, when non-nil, is the closest element
5804 containing point, as returned by `org-element-at-point'.
5805 Providing it allows for quicker computation."
5806 (catch 'objects-forbidden
5807 (org-with-wide-buffer
5808 (let* ((pos (point))
5809 (element (or element (org-element-at-point)))
5810 (type (org-element-type element))
5811 (post (org-element-property :post-affiliated element)))
5812 ;; If point is inside an element containing objects or
5813 ;; a secondary string, narrow buffer to the container and
5814 ;; proceed with parsing. Otherwise, return ELEMENT.
5815 (cond
5816 ;; At a parsed affiliated keyword, check if we're inside main
5817 ;; or dual value.
5818 ((and post (< pos post))
5819 (beginning-of-line)
5820 (let ((case-fold-search t)) (looking-at org-element--affiliated-re))
5821 (cond
5822 ((not (member-ignore-case (match-string 1)
5823 org-element-parsed-keywords))
5824 (throw 'objects-forbidden element))
5825 ((< (match-end 0) pos)
5826 (narrow-to-region (match-end 0) (line-end-position)))
5827 ((and (match-beginning 2)
5828 (>= pos (match-beginning 2))
5829 (< pos (match-end 2)))
5830 (narrow-to-region (match-beginning 2) (match-end 2)))
5831 (t (throw 'objects-forbidden element)))
5832 ;; Also change type to retrieve correct restrictions.
5833 (setq type 'keyword))
5834 ;; At an item, objects can only be located within tag, if any.
5835 ((eq type 'item)
5836 (let ((tag (org-element-property :tag element)))
5837 (if (or (not tag) (/= (line-beginning-position) post))
5838 (throw 'objects-forbidden element)
5839 (beginning-of-line)
5840 (search-forward tag (line-end-position))
5841 (goto-char (match-beginning 0))
5842 (if (and (>= pos (point)) (< pos (match-end 0)))
5843 (narrow-to-region (point) (match-end 0))
5844 (throw 'objects-forbidden element)))))
5845 ;; At an headline or inlinetask, objects are in title.
5846 ((memq type '(headline inlinetask))
5847 (let ((case-fold-search nil))
5848 (goto-char (org-element-property :begin element))
5849 (looking-at org-complex-heading-regexp)
5850 (let ((end (match-end 4)))
5851 (if (not end) (throw 'objects-forbidden element)
5852 (goto-char (match-beginning 4))
5853 (when (looking-at org-comment-string)
5854 (goto-char (match-end 0)))
5855 (if (>= (point) end) (throw 'objects-forbidden element)
5856 (narrow-to-region (point) end))))))
5857 ;; At a paragraph, a table-row or a verse block, objects are
5858 ;; located within their contents.
5859 ((memq type '(paragraph table-row verse-block))
5860 (let ((cbeg (org-element-property :contents-begin element))
5861 (cend (org-element-property :contents-end element)))
5862 ;; CBEG is nil for table rules.
5863 (if (and cbeg cend (>= pos cbeg)
5864 (or (< pos cend) (and (= pos cend) (eobp))))
5865 (narrow-to-region cbeg cend)
5866 (throw 'objects-forbidden element))))
5867 (t (throw 'objects-forbidden element)))
5868 (goto-char (point-min))
5869 (let ((restriction (org-element-restriction type))
5870 (parent element)
5871 last)
5872 (catch 'exit
5873 (while t
5874 (let ((next (org-element--object-lex restriction)))
5875 (when next (org-element-put-property next :parent parent))
5876 ;; Process NEXT, if any, in order to know if we need to
5877 ;; skip it, return it or move into it.
5878 (if (or (not next) (> (org-element-property :begin next) pos))
5879 (throw 'exit (or last parent))
5880 (let ((end (org-element-property :end next))
5881 (cbeg (org-element-property :contents-begin next))
5882 (cend (org-element-property :contents-end next)))
5883 (cond
5884 ;; Skip objects ending before point. Also skip
5885 ;; objects ending at point unless it is also the
5886 ;; end of buffer, since we want to return the
5887 ;; innermost object.
5888 ((and (<= end pos) (/= (point-max) end))
5889 (goto-char end)
5890 ;; For convenience, when object ends at POS,
5891 ;; without any space, store it in LAST, as we
5892 ;; will return it if no object starts here.
5893 (when (and (= end pos)
5894 (not (memq (char-before) '(?\s ?\t))))
5895 (setq last next)))
5896 ;; If POS is within a container object, move into
5897 ;; that object.
5898 ((and cbeg cend
5899 (>= pos cbeg)
5900 (or (< pos cend)
5901 ;; At contents' end, if there is no
5902 ;; space before point, also move into
5903 ;; object, for consistency with
5904 ;; convenience feature above.
5905 (and (= pos cend)
5906 (or (= (point-max) pos)
5907 (not (memq (char-before pos)
5908 '(?\s ?\t)))))))
5909 (goto-char cbeg)
5910 (narrow-to-region (point) cend)
5911 (setq parent next)
5912 (setq restriction (org-element-restriction next)))
5913 ;; Otherwise, return NEXT.
5914 (t (throw 'exit next)))))))))))))
5916 (defun org-element-lineage (datum &optional types with-self)
5917 "List all ancestors of a given element or object.
5919 DATUM is an object or element.
5921 Return ancestors from the closest to the farthest. When optional
5922 argument TYPES is a list of symbols, return the first element or
5923 object in the lineage whose type belongs to that list instead.
5925 When optional argument WITH-SELF is non-nil, lineage includes
5926 DATUM itself as the first element, and TYPES, if provided, also
5927 apply to it.
5929 When DATUM is obtained through `org-element-context' or
5930 `org-element-at-point', only ancestors from its section can be
5931 found. There is no such limitation when DATUM belongs to a full
5932 parse tree."
5933 (let ((up (if with-self datum (org-element-property :parent datum)))
5934 ancestors)
5935 (while (and up (not (memq (org-element-type up) types)))
5936 (unless types (push up ancestors))
5937 (setq up (org-element-property :parent up)))
5938 (if types up (nreverse ancestors))))
5940 (defun org-element-nested-p (elem-A elem-B)
5941 "Non-nil when elements ELEM-A and ELEM-B are nested."
5942 (let ((beg-A (org-element-property :begin elem-A))
5943 (beg-B (org-element-property :begin elem-B))
5944 (end-A (org-element-property :end elem-A))
5945 (end-B (org-element-property :end elem-B)))
5946 (or (and (>= beg-A beg-B) (<= end-A end-B))
5947 (and (>= beg-B beg-A) (<= end-B end-A)))))
5949 (defun org-element-swap-A-B (elem-A elem-B)
5950 "Swap elements ELEM-A and ELEM-B.
5951 Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
5952 end of ELEM-A."
5953 (goto-char (org-element-property :begin elem-A))
5954 ;; There are two special cases when an element doesn't start at bol:
5955 ;; the first paragraph in an item or in a footnote definition.
5956 (let ((specialp (not (bolp))))
5957 ;; Only a paragraph without any affiliated keyword can be moved at
5958 ;; ELEM-A position in such a situation. Note that the case of
5959 ;; a footnote definition is impossible: it cannot contain two
5960 ;; paragraphs in a row because it cannot contain a blank line.
5961 (if (and specialp
5962 (or (not (eq (org-element-type elem-B) 'paragraph))
5963 (/= (org-element-property :begin elem-B)
5964 (org-element-property :contents-begin elem-B))))
5965 (error "Cannot swap elements"))
5966 ;; In a special situation, ELEM-A will have no indentation. We'll
5967 ;; give it ELEM-B's (which will in, in turn, have no indentation).
5968 (let* ((ind-B (when specialp
5969 (goto-char (org-element-property :begin elem-B))
5970 (org-get-indentation)))
5971 (beg-A (org-element-property :begin elem-A))
5972 (end-A (save-excursion
5973 (goto-char (org-element-property :end elem-A))
5974 (skip-chars-backward " \r\t\n")
5975 (point-at-eol)))
5976 (beg-B (org-element-property :begin elem-B))
5977 (end-B (save-excursion
5978 (goto-char (org-element-property :end elem-B))
5979 (skip-chars-backward " \r\t\n")
5980 (point-at-eol)))
5981 ;; Store inner overlays responsible for visibility status.
5982 ;; We also need to store their boundaries as they will be
5983 ;; removed from buffer.
5984 (overlays
5985 (cons
5986 (delq nil
5987 (mapcar (lambda (o)
5988 (and (>= (overlay-start o) beg-A)
5989 (<= (overlay-end o) end-A)
5990 (list o (overlay-start o) (overlay-end o))))
5991 (overlays-in beg-A end-A)))
5992 (delq nil
5993 (mapcar (lambda (o)
5994 (and (>= (overlay-start o) beg-B)
5995 (<= (overlay-end o) end-B)
5996 (list o (overlay-start o) (overlay-end o))))
5997 (overlays-in beg-B end-B)))))
5998 ;; Get contents.
5999 (body-A (buffer-substring beg-A end-A))
6000 (body-B (delete-and-extract-region beg-B end-B)))
6001 (goto-char beg-B)
6002 (when specialp
6003 (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
6004 (indent-to-column ind-B))
6005 (insert body-A)
6006 ;; Restore ex ELEM-A overlays.
6007 (let ((offset (- beg-B beg-A)))
6008 (dolist (o (car overlays))
6009 (move-overlay (car o) (+ (nth 1 o) offset) (+ (nth 2 o) offset)))
6010 (goto-char beg-A)
6011 (delete-region beg-A end-A)
6012 (insert body-B)
6013 ;; Restore ex ELEM-B overlays.
6014 (dolist (o (cdr overlays))
6015 (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
6016 (goto-char (org-element-property :end elem-B)))))
6019 (provide 'org-element)
6021 ;; Local variables:
6022 ;; generated-autoload-file: "org-loaddefs.el"
6023 ;; End:
6025 ;;; org-element.el ends here