org-element: Only allow plain links in links
[org-mode.git] / lisp / org-element.el
blobfb12b419ff505e2fecf6ff9ecb0e94f96a52605a
1 ;;; org-element.el --- Parser And Applications for Org syntax
3 ;; Copyright (C) 2012-2013 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 <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; Org syntax can be divided into three categories: "Greater
26 ;; elements", "Elements" and "Objects".
28 ;; Elements are related to the structure of the document. Indeed, all
29 ;; elements are a cover for the document: each position within belongs
30 ;; to at least one element.
32 ;; An element always starts and ends at the beginning of a line. With
33 ;; a few exceptions (`clock', `headline', `inlinetask', `item',
34 ;; `planning', `node-property', `quote-section' `section' and
35 ;; `table-row' types), it can also accept a fixed set of keywords as
36 ;; attributes. Those are called "affiliated keywords" to distinguish
37 ;; them from other keywords, which are full-fledged elements. Almost
38 ;; all affiliated keywords are referenced in
39 ;; `org-element-affiliated-keywords'; the others are export attributes
40 ;; and start with "ATTR_" prefix.
42 ;; Element containing other elements (and only elements) are called
43 ;; greater elements. Concerned types are: `center-block', `drawer',
44 ;; `dynamic-block', `footnote-definition', `headline', `inlinetask',
45 ;; `item', `plain-list', `property-drawer', `quote-block', `section'
46 ;; and `special-block'.
48 ;; Other element types are: `babel-call', `clock', `comment',
49 ;; `comment-block', `diary-sexp', `example-block', `export-block',
50 ;; `fixed-width', `horizontal-rule', `keyword', `latex-environment',
51 ;; `node-property', `paragraph', `planning', `quote-section',
52 ;; `src-block', `table', `table-row' and `verse-block'. Among them,
53 ;; `paragraph' and `verse-block' types can contain Org objects and
54 ;; plain text.
56 ;; Objects are related to document's contents. Some of them are
57 ;; recursive. Associated types are of the following: `bold', `code',
58 ;; `entity', `export-snippet', `footnote-reference',
59 ;; `inline-babel-call', `inline-src-block', `italic',
60 ;; `latex-fragment', `line-break', `link', `macro', `radio-target',
61 ;; `statistics-cookie', `strike-through', `subscript', `superscript',
62 ;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
64 ;; Some elements also have special properties whose value can hold
65 ;; objects themselves (i.e. an item tag or a headline name). Such
66 ;; values are called "secondary strings". Any object belongs to
67 ;; either an element or a secondary string.
69 ;; Notwithstanding affiliated keywords, each greater element, element
70 ;; and object has a fixed set of properties attached to it. Among
71 ;; them, four are shared by all types: `:begin' and `:end', which
72 ;; refer to the beginning and ending buffer positions of the
73 ;; considered element or object, `:post-blank', which holds the number
74 ;; of blank lines, or white spaces, at its end and `:parent' which
75 ;; refers to the element or object containing it. Greater elements,
76 ;; elements and objects containing objects will also have
77 ;; `:contents-begin' and `:contents-end' properties to delimit
78 ;; contents. Eventually, greater elements and elements accepting
79 ;; affiliated keywords will have a `:post-affiliated' property,
80 ;; referring to the buffer position after all such keywords.
82 ;; At the lowest level, a `:parent' property is also attached to any
83 ;; string, as a text property.
85 ;; Lisp-wise, an element or an object can be represented as a list.
86 ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
87 ;; TYPE is a symbol describing the Org element or object.
88 ;; PROPERTIES is the property list attached to it. See docstring of
89 ;; appropriate parsing function to get an exhaustive
90 ;; list.
91 ;; CONTENTS is a list of elements, objects or raw strings contained
92 ;; in the current element or object, when applicable.
94 ;; An Org buffer is a nested list of such elements and objects, whose
95 ;; type is `org-data' and properties is nil.
97 ;; The first part of this file defines Org syntax, while the second
98 ;; one provide accessors and setters functions.
100 ;; The next part implements a parser and an interpreter for each
101 ;; element and object type in Org syntax.
103 ;; The following part creates a fully recursive buffer parser. It
104 ;; also provides a tool to map a function to elements or objects
105 ;; matching some criteria in the parse tree. Functions of interest
106 ;; are `org-element-parse-buffer', `org-element-map' and, to a lesser
107 ;; extent, `org-element-parse-secondary-string'.
109 ;; The penultimate part is the cradle of an interpreter for the
110 ;; obtained parse tree: `org-element-interpret-data'.
112 ;; The library ends by furnishing `org-element-at-point' function, and
113 ;; a way to give information about document structure around point
114 ;; with `org-element-context'.
117 ;;; Code:
119 (eval-when-compile (require 'cl))
120 (require 'org)
124 ;;; Definitions And Rules
126 ;; Define elements, greater elements and specify recursive objects,
127 ;; along with the affiliated keywords recognized. Also set up
128 ;; restrictions on recursive objects combinations.
130 ;; These variables really act as a control center for the parsing
131 ;; process.
133 (defconst org-element-paragraph-separate
134 (concat "^\\(?:"
135 ;; Headlines, inlinetasks.
136 org-outline-regexp "\\|"
137 ;; Footnote definitions.
138 "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
139 ;; Diary sexps.
140 "%%(" "\\|"
141 "[ \t]*\\(?:"
142 ;; Empty lines.
143 "$" "\\|"
144 ;; Tables (any type).
145 "\\(?:|\\|\\+-[-+]\\)" "\\|"
146 ;; Blocks (any type), Babel calls, drawers (any type),
147 ;; fixed-width areas and keywords. Note: this is only an
148 ;; indication and need some thorough check.
149 "[#:]" "\\|"
150 ;; Horizontal rules.
151 "-\\{5,\\}[ \t]*$" "\\|"
152 ;; LaTeX environments.
153 "\\\\begin{\\([A-Za-z0-9]+\\*?\\)}" "\\|"
154 ;; Planning and Clock lines.
155 (regexp-opt (list org-scheduled-string
156 org-deadline-string
157 org-closed-string
158 org-clock-string))
159 "\\|"
160 ;; Lists.
161 (let ((term (case org-plain-list-ordered-item-terminator
162 (?\) ")") (?. "\\.") (otherwise "[.)]")))
163 (alpha (and org-alphabetical-lists "\\|[A-Za-z]")))
164 (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)"
165 "\\(?:[ \t]\\|$\\)"))
166 "\\)\\)")
167 "Regexp to separate paragraphs in an Org buffer.
168 In the case of lines starting with \"#\" and \":\", this regexp
169 is not sufficient to know if point is at a paragraph ending. See
170 `org-element-paragraph-parser' for more information.")
172 (defconst org-element-all-elements
173 '(babel-call center-block clock comment comment-block diary-sexp drawer
174 dynamic-block example-block export-block fixed-width
175 footnote-definition headline horizontal-rule inlinetask item
176 keyword latex-environment node-property paragraph plain-list
177 planning property-drawer quote-block quote-section section
178 special-block src-block table table-row verse-block)
179 "Complete list of element types.")
181 (defconst org-element-greater-elements
182 '(center-block drawer dynamic-block footnote-definition headline inlinetask
183 item plain-list property-drawer quote-block section
184 special-block table)
185 "List of recursive element types aka Greater Elements.")
187 (defconst org-element-all-successors
188 '(export-snippet footnote-reference inline-babel-call inline-src-block
189 latex-or-entity line-break link macro plain-link radio-target
190 statistics-cookie sub/superscript table-cell target
191 text-markup timestamp)
192 "Complete list of successors.")
194 (defconst org-element-object-successor-alist
195 '((subscript . sub/superscript) (superscript . sub/superscript)
196 (bold . text-markup) (code . text-markup) (italic . text-markup)
197 (strike-through . text-markup) (underline . text-markup)
198 (verbatim . text-markup) (entity . latex-or-entity)
199 (latex-fragment . latex-or-entity))
200 "Alist of translations between object type and successor name.
201 Sharing the same successor comes handy when, for example, the
202 regexp matching one object can also match the other object.")
204 (defconst org-element-all-objects
205 '(bold code entity export-snippet footnote-reference inline-babel-call
206 inline-src-block italic line-break latex-fragment link macro
207 radio-target statistics-cookie strike-through subscript superscript
208 table-cell target timestamp underline verbatim)
209 "Complete list of object types.")
211 (defconst org-element-recursive-objects
212 '(bold italic link subscript radio-target strike-through superscript
213 table-cell underline)
214 "List of recursive object types.")
216 (defvar org-element-block-name-alist
217 '(("CENTER" . org-element-center-block-parser)
218 ("COMMENT" . org-element-comment-block-parser)
219 ("EXAMPLE" . org-element-example-block-parser)
220 ("QUOTE" . org-element-quote-block-parser)
221 ("SRC" . org-element-src-block-parser)
222 ("VERSE" . org-element-verse-block-parser))
223 "Alist between block names and the associated parsing function.
224 Names must be uppercase. Any block whose name has no association
225 is parsed with `org-element-special-block-parser'.")
227 (defconst org-element-link-type-is-file
228 '("file" "file+emacs" "file+sys" "docview")
229 "List of link types equivalent to \"file\".
230 Only these types can accept search options and an explicit
231 application to open them.")
233 (defconst org-element-affiliated-keywords
234 '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
235 "RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
236 "List of affiliated keywords as strings.
237 By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
238 are affiliated keywords and need not to be in this list.")
240 (defconst org-element--affiliated-re
241 (format "[ \t]*#\\+%s:"
242 ;; Regular affiliated keywords.
243 (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?"
244 (regexp-opt org-element-affiliated-keywords)))
245 "Regexp matching any affiliated keyword.
247 Keyword name is put in match group 1. Moreover, if keyword
248 belongs to `org-element-dual-keywords', put the dual value in
249 match group 2.
251 Don't modify it, set `org-element-affiliated-keywords' instead.")
253 (defconst org-element-keyword-translation-alist
254 '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
255 ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
256 ("RESULT" . "RESULTS") ("HEADERS" . "HEADER"))
257 "Alist of usual translations for keywords.
258 The key is the old name and the value the new one. The property
259 holding their value will be named after the translated name.")
261 (defconst org-element-multiple-keywords '("CAPTION" "HEADER")
262 "List of affiliated keywords that can occur more than once in an element.
264 Their value will be consed into a list of strings, which will be
265 returned as the value of the property.
267 This list is checked after translations have been applied. See
268 `org-element-keyword-translation-alist'.
270 By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
271 allow multiple occurrences and need not to be in this list.")
273 (defconst org-element-parsed-keywords '("CAPTION")
274 "List of affiliated keywords whose value can be parsed.
276 Their value will be stored as a secondary string: a list of
277 strings and objects.
279 This list is checked after translations have been applied. See
280 `org-element-keyword-translation-alist'.")
282 (defconst org-element-dual-keywords '("CAPTION" "RESULTS")
283 "List of affiliated keywords which can have a secondary value.
285 In Org syntax, they can be written with optional square brackets
286 before the colons. For example, RESULTS keyword can be
287 associated to a hash value with the following:
289 #+RESULTS[hash-string]: some-source
291 This list is checked after translations have been applied. See
292 `org-element-keyword-translation-alist'.")
294 (defconst org-element-document-properties '("AUTHOR" "DATE" "TITLE")
295 "List of properties associated to the whole document.
296 Any keyword in this list will have its value parsed and stored as
297 a secondary string.")
299 (defconst org-element-object-restrictions
300 '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link
301 radio-target sub/superscript target text-markup timestamp)
302 (footnote-reference export-snippet footnote-reference inline-babel-call
303 inline-src-block latex-or-entity line-break link macro
304 radio-target sub/superscript target text-markup
305 timestamp)
306 (headline inline-babel-call inline-src-block latex-or-entity link macro
307 radio-target statistics-cookie sub/superscript target text-markup
308 timestamp)
309 (inlinetask inline-babel-call inline-src-block latex-or-entity link macro
310 radio-target sub/superscript target text-markup timestamp)
311 (italic export-snippet inline-babel-call inline-src-block latex-or-entity
312 link radio-target sub/superscript target text-markup timestamp)
313 (item export-snippet footnote-reference inline-babel-call latex-or-entity
314 link macro radio-target sub/superscript target text-markup)
315 (keyword inline-babel-call inline-src-block latex-or-entity link macro
316 sub/superscript text-markup timestamp)
317 (link export-snippet inline-babel-call inline-src-block latex-or-entity
318 plain-link sub/superscript text-markup)
319 (paragraph export-snippet footnote-reference inline-babel-call
320 inline-src-block latex-or-entity line-break link macro
321 radio-target statistics-cookie sub/superscript target text-markup
322 timestamp)
323 (radio-target export-snippet latex-or-entity sub/superscript)
324 (strike-through export-snippet inline-babel-call inline-src-block
325 latex-or-entity link radio-target sub/superscript target
326 text-markup timestamp)
327 (subscript export-snippet inline-babel-call inline-src-block latex-or-entity
328 sub/superscript target text-markup)
329 (superscript export-snippet inline-babel-call inline-src-block
330 latex-or-entity sub/superscript target text-markup)
331 (table-cell export-snippet footnote-reference latex-or-entity link macro
332 radio-target sub/superscript target text-markup timestamp)
333 (table-row table-cell)
334 (underline export-snippet inline-babel-call inline-src-block latex-or-entity
335 link radio-target sub/superscript target text-markup timestamp)
336 (verse-block footnote-reference inline-babel-call inline-src-block
337 latex-or-entity line-break link macro radio-target
338 sub/superscript target text-markup timestamp))
339 "Alist of objects restrictions.
341 CAR is an element or object type containing objects and CDR is
342 a list of successors that will be called within an element or
343 object of such type.
345 For example, in a `radio-target' object, one can only find
346 entities, export snippets, latex-fragments, subscript and
347 superscript.
349 This alist also applies to secondary string. For example, an
350 `headline' type element doesn't directly contain objects, but
351 still has an entry since one of its properties (`:title') does.")
353 (defconst org-element-secondary-value-alist
354 '((headline . :title)
355 (inlinetask . :title)
356 (item . :tag)
357 (footnote-reference . :inline-definition))
358 "Alist between element types and location of secondary value.")
360 (defconst org-element-object-variables '(org-link-abbrev-alist-local)
361 "List of buffer-local variables used when parsing objects.
362 These variables are copied to the temporary buffer created by
363 `org-export-secondary-string'.")
367 ;;; Accessors and Setters
369 ;; Provide four accessors: `org-element-type', `org-element-property'
370 ;; `org-element-contents' and `org-element-restriction'.
372 ;; Setter functions allow to modify elements by side effect. There is
373 ;; `org-element-put-property', `org-element-set-contents',
374 ;; `org-element-set-element' and `org-element-adopt-element'. Note
375 ;; that `org-element-set-element' and `org-element-adopt-elements' are
376 ;; higher level functions since also update `:parent' property.
378 (defsubst org-element-type (element)
379 "Return type of ELEMENT.
381 The function returns the type of the element or object provided.
382 It can also return the following special value:
383 `plain-text' for a string
384 `org-data' for a complete document
385 nil in any other case."
386 (cond
387 ((not (consp element)) (and (stringp element) 'plain-text))
388 ((symbolp (car element)) (car element))))
390 (defsubst org-element-property (property element)
391 "Extract the value from the PROPERTY of an ELEMENT."
392 (if (stringp element) (get-text-property 0 property element)
393 (plist-get (nth 1 element) property)))
395 (defsubst org-element-contents (element)
396 "Extract contents from an ELEMENT."
397 (cond ((not (consp element)) nil)
398 ((symbolp (car element)) (nthcdr 2 element))
399 (t element)))
401 (defsubst org-element-restriction (element)
402 "Return restriction associated to ELEMENT.
403 ELEMENT can be an element, an object or a symbol representing an
404 element or object type."
405 (cdr (assq (if (symbolp element) element (org-element-type element))
406 org-element-object-restrictions)))
408 (defsubst org-element-put-property (element property value)
409 "In ELEMENT set PROPERTY to VALUE.
410 Return modified element."
411 (if (stringp element) (org-add-props element nil property value)
412 (setcar (cdr element) (plist-put (nth 1 element) property value))
413 element))
415 (defsubst org-element-set-contents (element &rest contents)
416 "Set ELEMENT contents to CONTENTS.
417 Return modified element."
418 (cond ((not element) (list contents))
419 ((not (symbolp (car element))) contents)
420 ((cdr element) (setcdr (cdr element) contents))
421 (t (nconc element contents))))
423 (defsubst org-element-set-element (old new)
424 "Replace element or object OLD with element or object NEW.
425 The function takes care of setting `:parent' property for NEW."
426 ;; Since OLD is going to be changed into NEW by side-effect, first
427 ;; make sure that every element or object within NEW has OLD as
428 ;; parent.
429 (mapc (lambda (blob) (org-element-put-property blob :parent old))
430 (org-element-contents new))
431 ;; Transfer contents.
432 (apply 'org-element-set-contents old (org-element-contents new))
433 ;; Ensure NEW has same parent as OLD, then overwrite OLD properties
434 ;; with NEW's.
435 (org-element-put-property new :parent (org-element-property :parent old))
436 (setcar (cdr old) (nth 1 new))
437 ;; Transfer type.
438 (setcar old (car new)))
440 (defsubst org-element-adopt-elements (parent &rest children)
441 "Append elements to the contents of another element.
443 PARENT is an element or object. CHILDREN can be elements,
444 objects, or a strings.
446 The function takes care of setting `:parent' property for CHILD.
447 Return parent element."
448 ;; Link every child to PARENT. If PARENT is nil, it is a secondary
449 ;; string: parent is the list itself.
450 (mapc (lambda (child)
451 (org-element-put-property child :parent (or parent children)))
452 children)
453 ;; Add CHILDREN at the end of PARENT contents.
454 (when parent
455 (apply 'org-element-set-contents
456 parent
457 (nconc (org-element-contents parent) children)))
458 ;; Return modified PARENT element.
459 (or parent children))
463 ;;; Greater elements
465 ;; For each greater element type, we define a parser and an
466 ;; interpreter.
468 ;; A parser returns the element or object as the list described above.
469 ;; Most of them accepts no argument. Though, exceptions exist. Hence
470 ;; every element containing a secondary string (see
471 ;; `org-element-secondary-value-alist') will accept an optional
472 ;; argument to toggle parsing of that secondary string. Moreover,
473 ;; `item' parser requires current list's structure as its first
474 ;; element.
476 ;; An interpreter accepts two arguments: the list representation of
477 ;; the element or object, and its contents. The latter may be nil,
478 ;; depending on the element or object considered. It returns the
479 ;; appropriate Org syntax, as a string.
481 ;; Parsing functions must follow the naming convention:
482 ;; org-element-TYPE-parser, where TYPE is greater element's type, as
483 ;; defined in `org-element-greater-elements'.
485 ;; Similarly, interpreting functions must follow the naming
486 ;; convention: org-element-TYPE-interpreter.
488 ;; With the exception of `headline' and `item' types, greater elements
489 ;; cannot contain other greater elements of their own type.
491 ;; Beside implementing a parser and an interpreter, adding a new
492 ;; greater element requires to tweak `org-element--current-element'.
493 ;; Moreover, the newly defined type must be added to both
494 ;; `org-element-all-elements' and `org-element-greater-elements'.
497 ;;;; Center Block
499 (defun org-element-center-block-parser (limit affiliated)
500 "Parse a center block.
502 LIMIT bounds the search. AFFILIATED is a list of which CAR is
503 the buffer position at the beginning of the first affiliated
504 keyword and CDR is a plist of affiliated keywords along with
505 their value.
507 Return a list whose CAR is `center-block' and CDR is a plist
508 containing `:begin', `:end', `:hiddenp', `:contents-begin',
509 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
511 Assume point is at the beginning of the block."
512 (let ((case-fold-search t))
513 (if (not (save-excursion
514 (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t)))
515 ;; Incomplete block: parse it as a paragraph.
516 (org-element-paragraph-parser limit affiliated)
517 (let ((block-end-line (match-beginning 0)))
518 (let* ((begin (car affiliated))
519 (post-affiliated (point))
520 ;; Empty blocks have no contents.
521 (contents-begin (progn (forward-line)
522 (and (< (point) block-end-line)
523 (point))))
524 (contents-end (and contents-begin block-end-line))
525 (hidden (org-invisible-p2))
526 (pos-before-blank (progn (goto-char block-end-line)
527 (forward-line)
528 (point)))
529 (end (save-excursion (skip-chars-forward " \r\t\n" limit)
530 (skip-chars-backward " \t")
531 (if (bolp) (point) (line-end-position)))))
532 (list 'center-block
533 (nconc
534 (list :begin begin
535 :end end
536 :hiddenp hidden
537 :contents-begin contents-begin
538 :contents-end contents-end
539 :post-blank (count-lines pos-before-blank end)
540 :post-affiliated post-affiliated)
541 (cdr affiliated))))))))
543 (defun org-element-center-block-interpreter (center-block contents)
544 "Interpret CENTER-BLOCK element as Org syntax.
545 CONTENTS is the contents of the element."
546 (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
549 ;;;; Drawer
551 (defun org-element-drawer-parser (limit affiliated)
552 "Parse a drawer.
554 LIMIT bounds the search. AFFILIATED is a list of which CAR is
555 the buffer position at the beginning of the first affiliated
556 keyword and CDR is a plist of affiliated keywords along with
557 their value.
559 Return a list whose CAR is `drawer' and CDR is a plist containing
560 `:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
561 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
563 Assume point is at beginning of drawer."
564 (let ((case-fold-search t))
565 (if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
566 ;; Incomplete drawer: parse it as a paragraph.
567 (org-element-paragraph-parser limit affiliated)
568 (save-excursion
569 (let* ((drawer-end-line (match-beginning 0))
570 (name (progn (looking-at org-drawer-regexp)
571 (org-match-string-no-properties 1)))
572 (begin (car affiliated))
573 (post-affiliated (point))
574 ;; Empty drawers have no contents.
575 (contents-begin (progn (forward-line)
576 (and (< (point) drawer-end-line)
577 (point))))
578 (contents-end (and contents-begin drawer-end-line))
579 (hidden (org-invisible-p2))
580 (pos-before-blank (progn (goto-char drawer-end-line)
581 (forward-line)
582 (point)))
583 (end (progn (skip-chars-forward " \r\t\n" limit)
584 (skip-chars-backward " \t")
585 (if (bolp) (point) (line-end-position)))))
586 (list 'drawer
587 (nconc
588 (list :begin begin
589 :end end
590 :drawer-name name
591 :hiddenp hidden
592 :contents-begin contents-begin
593 :contents-end contents-end
594 :post-blank (count-lines pos-before-blank end)
595 :post-affiliated post-affiliated)
596 (cdr affiliated))))))))
598 (defun org-element-drawer-interpreter (drawer contents)
599 "Interpret DRAWER element as Org syntax.
600 CONTENTS is the contents of the element."
601 (format ":%s:\n%s:END:"
602 (org-element-property :drawer-name drawer)
603 contents))
606 ;;;; Dynamic Block
608 (defun org-element-dynamic-block-parser (limit affiliated)
609 "Parse a dynamic block.
611 LIMIT bounds the search. AFFILIATED is a list of which CAR is
612 the buffer position at the beginning of the first affiliated
613 keyword and CDR is a plist of affiliated keywords along with
614 their value.
616 Return a list whose CAR is `dynamic-block' and CDR is a plist
617 containing `:block-name', `:begin', `:end', `:hiddenp',
618 `:contents-begin', `:contents-end', `:arguments', `:post-blank'
619 and `:post-affiliated' keywords.
621 Assume point is at beginning of dynamic block."
622 (let ((case-fold-search t))
623 (if (not (save-excursion
624 (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t)))
625 ;; Incomplete block: parse it as a paragraph.
626 (org-element-paragraph-parser limit affiliated)
627 (let ((block-end-line (match-beginning 0)))
628 (save-excursion
629 (let* ((name (progn (looking-at org-dblock-start-re)
630 (org-match-string-no-properties 1)))
631 (arguments (org-match-string-no-properties 3))
632 (begin (car affiliated))
633 (post-affiliated (point))
634 ;; Empty blocks have no contents.
635 (contents-begin (progn (forward-line)
636 (and (< (point) block-end-line)
637 (point))))
638 (contents-end (and contents-begin block-end-line))
639 (hidden (org-invisible-p2))
640 (pos-before-blank (progn (goto-char block-end-line)
641 (forward-line)
642 (point)))
643 (end (progn (skip-chars-forward " \r\t\n" limit)
644 (skip-chars-backward " \t")
645 (if (bolp) (point) (line-end-position)))))
646 (list 'dynamic-block
647 (nconc
648 (list :begin begin
649 :end end
650 :block-name name
651 :arguments arguments
652 :hiddenp hidden
653 :contents-begin contents-begin
654 :contents-end contents-end
655 :post-blank (count-lines pos-before-blank end)
656 :post-affiliated post-affiliated)
657 (cdr affiliated)))))))))
659 (defun org-element-dynamic-block-interpreter (dynamic-block contents)
660 "Interpret DYNAMIC-BLOCK element as Org syntax.
661 CONTENTS is the contents of the element."
662 (format "#+BEGIN: %s%s\n%s#+END:"
663 (org-element-property :block-name dynamic-block)
664 (let ((args (org-element-property :arguments dynamic-block)))
665 (and args (concat " " args)))
666 contents))
669 ;;;; Footnote Definition
671 (defun org-element-footnote-definition-parser (limit affiliated)
672 "Parse a footnote definition.
674 LIMIT bounds the search. AFFILIATED is a list of which CAR is
675 the buffer position at the beginning of the first affiliated
676 keyword and CDR is a plist of affiliated keywords along with
677 their value.
679 Return a list whose CAR is `footnote-definition' and CDR is
680 a plist containing `:label', `:begin' `:end', `:contents-begin',
681 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
683 Assume point is at the beginning of the footnote definition."
684 (save-excursion
685 (let* ((label (progn (looking-at org-footnote-definition-re)
686 (org-match-string-no-properties 1)))
687 (begin (car affiliated))
688 (post-affiliated (point))
689 (ending (save-excursion
690 (if (progn
691 (end-of-line)
692 (re-search-forward
693 (concat org-outline-regexp-bol "\\|"
694 org-footnote-definition-re "\\|"
695 "^\\([ \t]*\n\\)\\{2,\\}") limit 'move))
696 (match-beginning 0)
697 (point))))
698 (contents-begin (progn (search-forward "]")
699 (skip-chars-forward " \r\t\n" ending)
700 (and (/= (point) ending) (point))))
701 (contents-end (and contents-begin ending))
702 (end (progn (goto-char ending)
703 (skip-chars-forward " \r\t\n" limit)
704 (skip-chars-backward " \t")
705 (if (bolp) (point) (line-end-position)))))
706 (list 'footnote-definition
707 (nconc
708 (list :label label
709 :begin begin
710 :end end
711 :contents-begin contents-begin
712 :contents-end contents-end
713 :post-blank (count-lines ending end)
714 :post-affiliated post-affiliated)
715 (cdr affiliated))))))
717 (defun org-element-footnote-definition-interpreter (footnote-definition contents)
718 "Interpret FOOTNOTE-DEFINITION element as Org syntax.
719 CONTENTS is the contents of the footnote-definition."
720 (concat (format "[%s]" (org-element-property :label footnote-definition))
722 contents))
725 ;;;; Headline
727 (defun org-element-headline-parser (limit &optional raw-secondary-p)
728 "Parse a headline.
730 Return a list whose CAR is `headline' and CDR is a plist
731 containing `:raw-value', `:title', `:optional-title', `:begin',
732 `:end', `:pre-blank', `:hiddenp', `:contents-begin' and
733 `:contents-end', `:level', `:priority', `:tags',
734 `:todo-keyword',`:todo-type', `:scheduled', `:deadline',
735 `:closed', `:quotedp', `:archivedp', `:commentedp' and
736 `:footnote-section-p' keywords.
738 The plist also contains any property set in the property drawer,
739 with its name in upper cases and colons added at the
740 beginning (i.e. `:CUSTOM_ID').
742 When RAW-SECONDARY-P is non-nil, headline's title will not be
743 parsed as a secondary string, but as a plain string instead.
745 Assume point is at beginning of the headline."
746 (save-excursion
747 (let* ((components (org-heading-components))
748 (level (nth 1 components))
749 (todo (nth 2 components))
750 (todo-type
751 (and todo (if (member todo org-done-keywords) 'done 'todo)))
752 (tags (let ((raw-tags (nth 5 components)))
753 (and raw-tags (org-split-string raw-tags ":"))))
754 (raw-value (or (nth 4 components) ""))
755 (quotedp
756 (let ((case-fold-search nil))
757 (string-match (format "^%s\\( \\|$\\)" org-quote-string)
758 raw-value)))
759 (commentedp
760 (let ((case-fold-search nil))
761 (string-match (format "^%s\\( \\|$\\)" org-comment-string)
762 raw-value)))
763 (archivedp (member org-archive-tag tags))
764 (footnote-section-p (and org-footnote-section
765 (string= org-footnote-section raw-value)))
766 ;; Upcase property names. It avoids confusion between
767 ;; properties obtained through property drawer and default
768 ;; properties from the parser (e.g. `:end' and :END:)
769 (standard-props
770 (let (plist)
771 (mapc
772 (lambda (p)
773 (setq plist
774 (plist-put plist
775 (intern (concat ":" (upcase (car p))))
776 (cdr p))))
777 (org-entry-properties nil 'standard))
778 plist))
779 (time-props
780 ;; Read time properties on the line below the headline.
781 (save-excursion
782 (when (progn (forward-line)
783 (looking-at org-planning-or-clock-line-re))
784 (let ((end (line-end-position)) plist)
785 (while (re-search-forward
786 org-keyword-time-not-clock-regexp end t)
787 (goto-char (match-end 1))
788 (skip-chars-forward " \t")
789 (let ((keyword (match-string 1))
790 (time (org-element-timestamp-parser)))
791 (cond ((equal keyword org-scheduled-string)
792 (setq plist (plist-put plist :scheduled time)))
793 ((equal keyword org-deadline-string)
794 (setq plist (plist-put plist :deadline time)))
795 (t (setq plist (plist-put plist :closed time))))))
796 plist))))
797 (begin (point))
798 (end (save-excursion (goto-char (org-end-of-subtree t t))))
799 (pos-after-head (progn (forward-line) (point)))
800 (contents-begin (save-excursion
801 (skip-chars-forward " \r\t\n" end)
802 (and (/= (point) end) (line-beginning-position))))
803 (hidden (org-invisible-p2))
804 (contents-end (and contents-begin
805 (progn (goto-char end)
806 (skip-chars-backward " \r\t\n")
807 (forward-line)
808 (point)))))
809 ;; Clean RAW-VALUE from any quote or comment string.
810 (when (or quotedp commentedp)
811 (let ((case-fold-search nil))
812 (setq raw-value
813 (replace-regexp-in-string
814 (concat
815 (regexp-opt (list org-quote-string org-comment-string))
816 "\\(?: \\|$\\)")
818 raw-value))))
819 ;; Clean TAGS from archive tag, if any.
820 (when archivedp (setq tags (delete org-archive-tag tags)))
821 (let ((headline
822 (list 'headline
823 (nconc
824 (list :raw-value raw-value
825 :begin begin
826 :end end
827 :pre-blank
828 (if (not contents-begin) 0
829 (count-lines pos-after-head contents-begin))
830 :hiddenp hidden
831 :contents-begin contents-begin
832 :contents-end contents-end
833 :level level
834 :priority (nth 3 components)
835 :tags tags
836 :todo-keyword todo
837 :todo-type todo-type
838 :post-blank (count-lines
839 (if (not contents-end) pos-after-head
840 (goto-char contents-end)
841 (forward-line)
842 (point))
843 end)
844 :footnote-section-p footnote-section-p
845 :archivedp archivedp
846 :commentedp commentedp
847 :quotedp quotedp)
848 time-props
849 standard-props))))
850 (let ((opt-title (org-element-property :OPTIONAL_TITLE headline)))
851 (when opt-title
852 (org-element-put-property
853 headline :optional-title
854 (if raw-secondary-p opt-title
855 (org-element-parse-secondary-string
856 opt-title (org-element-restriction 'headline) headline)))))
857 (org-element-put-property
858 headline :title
859 (if raw-secondary-p raw-value
860 (org-element-parse-secondary-string
861 raw-value (org-element-restriction 'headline) headline)))))))
863 (defun org-element-headline-interpreter (headline contents)
864 "Interpret HEADLINE element as Org syntax.
865 CONTENTS is the contents of the element."
866 (let* ((level (org-element-property :level headline))
867 (todo (org-element-property :todo-keyword headline))
868 (priority (org-element-property :priority headline))
869 (title (org-element-interpret-data
870 (org-element-property :title headline)))
871 (tags (let ((tag-list (if (org-element-property :archivedp headline)
872 (cons org-archive-tag
873 (org-element-property :tags headline))
874 (org-element-property :tags headline))))
875 (and tag-list
876 (format ":%s:" (mapconcat 'identity tag-list ":")))))
877 (commentedp (org-element-property :commentedp headline))
878 (quotedp (org-element-property :quotedp headline))
879 (pre-blank (or (org-element-property :pre-blank headline) 0))
880 (heading (concat (make-string level ?*)
881 (and todo (concat " " todo))
882 (and quotedp (concat " " org-quote-string))
883 (and commentedp (concat " " org-comment-string))
884 (and priority
885 (format " [#%s]" (char-to-string priority)))
886 (cond ((and org-footnote-section
887 (org-element-property
888 :footnote-section-p headline))
889 (concat " " org-footnote-section))
890 (title (concat " " title))))))
891 (concat heading
892 ;; Align tags.
893 (when tags
894 (cond
895 ((zerop org-tags-column) (format " %s" tags))
896 ((< org-tags-column 0)
897 (concat
898 (make-string
899 (max (- (+ org-tags-column (length heading) (length tags))) 1)
901 tags))
903 (concat
904 (make-string (max (- org-tags-column (length heading)) 1) ? )
905 tags))))
906 (make-string (1+ pre-blank) 10)
907 contents)))
910 ;;;; Inlinetask
912 (defun org-element-inlinetask-parser (limit &optional raw-secondary-p)
913 "Parse an inline task.
915 Return a list whose CAR is `inlinetask' and CDR is a plist
916 containing `:title', `:begin', `:end', `:hiddenp',
917 `:contents-begin' and `:contents-end', `:level', `:priority',
918 `:raw-value', `:tags', `:todo-keyword', `:todo-type',
919 `:scheduled', `:deadline', `:closed' and `:post-blank' keywords.
921 The plist also contains any property set in the property drawer,
922 with its name in upper cases and colons added at the
923 beginning (i.e. `:CUSTOM_ID').
925 When optional argument RAW-SECONDARY-P is non-nil, inline-task's
926 title will not be parsed as a secondary string, but as a plain
927 string instead.
929 Assume point is at beginning of the inline task."
930 (save-excursion
931 (let* ((begin (point))
932 (components (org-heading-components))
933 (todo (nth 2 components))
934 (todo-type (and todo
935 (if (member todo org-done-keywords) 'done 'todo)))
936 (tags (let ((raw-tags (nth 5 components)))
937 (and raw-tags (org-split-string raw-tags ":"))))
938 (raw-value (or (nth 4 components) ""))
939 ;; Upcase property names. It avoids confusion between
940 ;; properties obtained through property drawer and default
941 ;; properties from the parser (e.g. `:end' and :END:)
942 (standard-props
943 (let (plist)
944 (mapc
945 (lambda (p)
946 (setq plist
947 (plist-put plist
948 (intern (concat ":" (upcase (car p))))
949 (cdr p))))
950 (org-entry-properties nil 'standard))
951 plist))
952 (time-props
953 ;; Read time properties on the line below the inlinetask
954 ;; opening string.
955 (save-excursion
956 (when (progn (forward-line)
957 (looking-at org-planning-or-clock-line-re))
958 (let ((end (line-end-position)) plist)
959 (while (re-search-forward
960 org-keyword-time-not-clock-regexp end t)
961 (goto-char (match-end 1))
962 (skip-chars-forward " \t")
963 (let ((keyword (match-string 1))
964 (time (org-element-timestamp-parser)))
965 (cond ((equal keyword org-scheduled-string)
966 (setq plist (plist-put plist :scheduled time)))
967 ((equal keyword org-deadline-string)
968 (setq plist (plist-put plist :deadline time)))
969 (t (setq plist (plist-put plist :closed time))))))
970 plist))))
971 (task-end (save-excursion
972 (end-of-line)
973 (and (re-search-forward "^\\*+ END" limit t)
974 (match-beginning 0))))
975 (contents-begin (progn (forward-line)
976 (and task-end (< (point) task-end) (point))))
977 (hidden (and contents-begin (org-invisible-p2)))
978 (contents-end (and contents-begin task-end))
979 (before-blank (if (not task-end) (point)
980 (goto-char task-end)
981 (forward-line)
982 (point)))
983 (end (progn (skip-chars-forward " \r\t\n" limit)
984 (skip-chars-backward " \t")
985 (if (bolp) (point) (line-end-position))))
986 (inlinetask
987 (list 'inlinetask
988 (nconc
989 (list :raw-value raw-value
990 :begin begin
991 :end end
992 :hiddenp hidden
993 :contents-begin contents-begin
994 :contents-end contents-end
995 :level (nth 1 components)
996 :priority (nth 3 components)
997 :tags tags
998 :todo-keyword todo
999 :todo-type todo-type
1000 :post-blank (count-lines before-blank end))
1001 time-props
1002 standard-props))))
1003 (org-element-put-property
1004 inlinetask :title
1005 (if raw-secondary-p raw-value
1006 (org-element-parse-secondary-string
1007 raw-value
1008 (org-element-restriction 'inlinetask)
1009 inlinetask))))))
1011 (defun org-element-inlinetask-interpreter (inlinetask contents)
1012 "Interpret INLINETASK element as Org syntax.
1013 CONTENTS is the contents of inlinetask."
1014 (let* ((level (org-element-property :level inlinetask))
1015 (todo (org-element-property :todo-keyword inlinetask))
1016 (priority (org-element-property :priority inlinetask))
1017 (title (org-element-interpret-data
1018 (org-element-property :title inlinetask)))
1019 (tags (let ((tag-list (org-element-property :tags inlinetask)))
1020 (and tag-list
1021 (format ":%s:" (mapconcat 'identity tag-list ":")))))
1022 (task (concat (make-string level ?*)
1023 (and todo (concat " " todo))
1024 (and priority
1025 (format " [#%s]" (char-to-string priority)))
1026 (and title (concat " " title)))))
1027 (concat task
1028 ;; Align tags.
1029 (when tags
1030 (cond
1031 ((zerop org-tags-column) (format " %s" tags))
1032 ((< org-tags-column 0)
1033 (concat
1034 (make-string
1035 (max (- (+ org-tags-column (length task) (length tags))) 1)
1037 tags))
1039 (concat
1040 (make-string (max (- org-tags-column (length task)) 1) ? )
1041 tags))))
1042 ;; Prefer degenerate inlinetasks when there are no
1043 ;; contents.
1044 (when contents
1045 (concat "\n"
1046 contents
1047 (make-string level ?*) " END")))))
1050 ;;;; Item
1052 (defun org-element-item-parser (limit struct &optional raw-secondary-p)
1053 "Parse an item.
1055 STRUCT is the structure of the plain list.
1057 Return a list whose CAR is `item' and CDR is a plist containing
1058 `:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
1059 `:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
1060 `:post-blank' keywords.
1062 When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
1063 any, will not be parsed as a secondary string, but as a plain
1064 string instead.
1066 Assume point is at the beginning of the item."
1067 (save-excursion
1068 (beginning-of-line)
1069 (looking-at org-list-full-item-re)
1070 (let* ((begin (point))
1071 (bullet (org-match-string-no-properties 1))
1072 (checkbox (let ((box (org-match-string-no-properties 3)))
1073 (cond ((equal "[ ]" box) 'off)
1074 ((equal "[X]" box) 'on)
1075 ((equal "[-]" box) 'trans))))
1076 (counter (let ((c (org-match-string-no-properties 2)))
1077 (save-match-data
1078 (cond
1079 ((not c) nil)
1080 ((string-match "[A-Za-z]" c)
1081 (- (string-to-char (upcase (match-string 0 c)))
1082 64))
1083 ((string-match "[0-9]+" c)
1084 (string-to-number (match-string 0 c)))))))
1085 (end (save-excursion (goto-char (org-list-get-item-end begin struct))
1086 (unless (bolp) (forward-line))
1087 (point)))
1088 (contents-begin
1089 (progn (goto-char
1090 ;; Ignore tags in un-ordered lists: they are just
1091 ;; a part of item's body.
1092 (if (and (match-beginning 4)
1093 (save-match-data (string-match "[.)]" bullet)))
1094 (match-beginning 4)
1095 (match-end 0)))
1096 (skip-chars-forward " \r\t\n" limit)
1097 ;; If first line isn't empty, contents really start
1098 ;; at the text after item's meta-data.
1099 (if (= (point-at-bol) begin) (point) (point-at-bol))))
1100 (hidden (progn (forward-line)
1101 (and (not (= (point) end)) (org-invisible-p2))))
1102 (contents-end (progn (goto-char end)
1103 (skip-chars-backward " \r\t\n")
1104 (forward-line)
1105 (point)))
1106 (item
1107 (list 'item
1108 (list :bullet bullet
1109 :begin begin
1110 :end end
1111 ;; CONTENTS-BEGIN and CONTENTS-END may be
1112 ;; mixed up in the case of an empty item
1113 ;; separated from the next by a blank line.
1114 ;; Thus ensure the former is always the
1115 ;; smallest.
1116 :contents-begin (min contents-begin contents-end)
1117 :contents-end (max contents-begin contents-end)
1118 :checkbox checkbox
1119 :counter counter
1120 :hiddenp hidden
1121 :structure struct
1122 :post-blank (count-lines contents-end end)))))
1123 (org-element-put-property
1124 item :tag
1125 (let ((raw-tag (org-list-get-tag begin struct)))
1126 (and raw-tag
1127 (if raw-secondary-p raw-tag
1128 (org-element-parse-secondary-string
1129 raw-tag (org-element-restriction 'item) item))))))))
1131 (defun org-element-item-interpreter (item contents)
1132 "Interpret ITEM element as Org syntax.
1133 CONTENTS is the contents of the element."
1134 (let* ((bullet (org-list-bullet-string (org-element-property :bullet item)))
1135 (checkbox (org-element-property :checkbox item))
1136 (counter (org-element-property :counter item))
1137 (tag (let ((tag (org-element-property :tag item)))
1138 (and tag (org-element-interpret-data tag))))
1139 ;; Compute indentation.
1140 (ind (make-string (length bullet) 32))
1141 (item-starts-with-par-p
1142 (eq (org-element-type (car (org-element-contents item)))
1143 'paragraph)))
1144 ;; Indent contents.
1145 (concat
1146 bullet
1147 (and counter (format "[@%d] " counter))
1148 (case checkbox
1149 (on "[X] ")
1150 (off "[ ] ")
1151 (trans "[-] "))
1152 (and tag (format "%s :: " tag))
1153 (let ((contents (replace-regexp-in-string
1154 "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
1155 (if item-starts-with-par-p (org-trim contents)
1156 (concat "\n" contents))))))
1159 ;;;; Plain List
1161 (defun org-element-plain-list-parser (limit affiliated structure)
1162 "Parse a plain list.
1164 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1165 the buffer position at the beginning of the first affiliated
1166 keyword and CDR is a plist of affiliated keywords along with
1167 their value. STRUCTURE is the structure of the plain list being
1168 parsed.
1170 Return a list whose CAR is `plain-list' and CDR is a plist
1171 containing `:type', `:begin', `:end', `:contents-begin' and
1172 `:contents-end', `:structure', `:post-blank' and
1173 `:post-affiliated' keywords.
1175 Assume point is at the beginning of the list."
1176 (save-excursion
1177 (let* ((struct (or structure (org-list-struct)))
1178 (prevs (org-list-prevs-alist struct))
1179 (parents (org-list-parents-alist struct))
1180 (type (org-list-get-list-type (point) struct prevs))
1181 (contents-begin (point))
1182 (begin (car affiliated))
1183 (contents-end
1184 (progn (goto-char (org-list-get-list-end (point) struct prevs))
1185 (unless (bolp) (forward-line))
1186 (point)))
1187 (end (progn (skip-chars-forward " \r\t\n" limit)
1188 (skip-chars-backward " \t")
1189 (if (bolp) (point) (line-end-position)))))
1190 ;; Return value.
1191 (list 'plain-list
1192 (nconc
1193 (list :type type
1194 :begin begin
1195 :end end
1196 :contents-begin contents-begin
1197 :contents-end contents-end
1198 :structure struct
1199 :post-blank (count-lines contents-end end)
1200 :post-affiliated contents-begin)
1201 (cdr affiliated))))))
1203 (defun org-element-plain-list-interpreter (plain-list contents)
1204 "Interpret PLAIN-LIST element as Org syntax.
1205 CONTENTS is the contents of the element."
1206 (with-temp-buffer
1207 (insert contents)
1208 (goto-char (point-min))
1209 (org-list-repair)
1210 (buffer-string)))
1213 ;;;; Property Drawer
1215 (defun org-element-property-drawer-parser (limit affiliated)
1216 "Parse a property drawer.
1218 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1219 the buffer position at the beginning of the first affiliated
1220 keyword and CDR is a plist of affiliated keywords along with
1221 their value.
1223 Return a list whose CAR is `property-drawer' and CDR is a plist
1224 containing `:begin', `:end', `:hiddenp', `:contents-begin',
1225 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
1227 Assume point is at the beginning of the property drawer."
1228 (save-excursion
1229 (let ((case-fold-search t))
1230 (if (not (save-excursion
1231 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
1232 ;; Incomplete drawer: parse it as a paragraph.
1233 (org-element-paragraph-parser limit affiliated)
1234 (save-excursion
1235 (let* ((drawer-end-line (match-beginning 0))
1236 (begin (car affiliated))
1237 (post-affiliated (point))
1238 (contents-begin (progn (forward-line)
1239 (and (< (point) drawer-end-line)
1240 (point))))
1241 (contents-end (and contents-begin drawer-end-line))
1242 (hidden (org-invisible-p2))
1243 (pos-before-blank (progn (goto-char drawer-end-line)
1244 (forward-line)
1245 (point)))
1246 (end (progn (skip-chars-forward " \r\t\n" limit)
1247 (skip-chars-backward " \t")
1248 (if (bolp) (point) (line-end-position)))))
1249 (list 'property-drawer
1250 (nconc
1251 (list :begin begin
1252 :end end
1253 :hiddenp hidden
1254 :contents-begin contents-begin
1255 :contents-end contents-end
1256 :post-blank (count-lines pos-before-blank end)
1257 :post-affiliated post-affiliated)
1258 (cdr affiliated)))))))))
1260 (defun org-element-property-drawer-interpreter (property-drawer contents)
1261 "Interpret PROPERTY-DRAWER element as Org syntax.
1262 CONTENTS is the properties within the drawer."
1263 (format ":PROPERTIES:\n%s:END:" contents))
1266 ;;;; Quote Block
1268 (defun org-element-quote-block-parser (limit affiliated)
1269 "Parse a quote block.
1271 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1272 the buffer position at the beginning of the first affiliated
1273 keyword and CDR is a plist of affiliated keywords along with
1274 their value.
1276 Return a list whose CAR is `quote-block' and CDR is a plist
1277 containing `:begin', `:end', `:hiddenp', `:contents-begin',
1278 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
1280 Assume point is at the beginning of the block."
1281 (let ((case-fold-search t))
1282 (if (not (save-excursion
1283 (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t)))
1284 ;; Incomplete block: parse it as a paragraph.
1285 (org-element-paragraph-parser limit affiliated)
1286 (let ((block-end-line (match-beginning 0)))
1287 (save-excursion
1288 (let* ((begin (car affiliated))
1289 (post-affiliated (point))
1290 ;; Empty blocks have no contents.
1291 (contents-begin (progn (forward-line)
1292 (and (< (point) block-end-line)
1293 (point))))
1294 (contents-end (and contents-begin block-end-line))
1295 (hidden (org-invisible-p2))
1296 (pos-before-blank (progn (goto-char block-end-line)
1297 (forward-line)
1298 (point)))
1299 (end (progn (skip-chars-forward " \r\t\n" limit)
1300 (skip-chars-backward " \t")
1301 (if (bolp) (point) (line-end-position)))))
1302 (list 'quote-block
1303 (nconc
1304 (list :begin begin
1305 :end end
1306 :hiddenp hidden
1307 :contents-begin contents-begin
1308 :contents-end contents-end
1309 :post-blank (count-lines pos-before-blank end)
1310 :post-affiliated post-affiliated)
1311 (cdr affiliated)))))))))
1313 (defun org-element-quote-block-interpreter (quote-block contents)
1314 "Interpret QUOTE-BLOCK element as Org syntax.
1315 CONTENTS is the contents of the element."
1316 (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
1319 ;;;; Section
1321 (defun org-element-section-parser (limit)
1322 "Parse a section.
1324 LIMIT bounds the search.
1326 Return a list whose CAR is `section' and CDR is a plist
1327 containing `:begin', `:end', `:contents-begin', `contents-end'
1328 and `:post-blank' keywords."
1329 (save-excursion
1330 ;; Beginning of section is the beginning of the first non-blank
1331 ;; line after previous headline.
1332 (let ((begin (point))
1333 (end (progn (org-with-limited-levels (outline-next-heading))
1334 (point)))
1335 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
1336 (forward-line)
1337 (point))))
1338 (list 'section
1339 (list :begin begin
1340 :end end
1341 :contents-begin begin
1342 :contents-end pos-before-blank
1343 :post-blank (count-lines pos-before-blank end))))))
1345 (defun org-element-section-interpreter (section contents)
1346 "Interpret SECTION element as Org syntax.
1347 CONTENTS is the contents of the element."
1348 contents)
1351 ;;;; Special Block
1353 (defun org-element-special-block-parser (limit affiliated)
1354 "Parse a special block.
1356 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1357 the buffer position at the beginning of the first affiliated
1358 keyword and CDR is a plist of affiliated keywords along with
1359 their value.
1361 Return a list whose CAR is `special-block' and CDR is a plist
1362 containing `:type', `:begin', `:end', `:hiddenp',
1363 `:contents-begin', `:contents-end', `:post-blank' and
1364 `:post-affiliated' keywords.
1366 Assume point is at the beginning of the block."
1367 (let* ((case-fold-search t)
1368 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)")
1369 (upcase (match-string-no-properties 1)))))
1370 (if (not (save-excursion
1371 (re-search-forward
1372 (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
1373 ;; Incomplete block: parse it as a paragraph.
1374 (org-element-paragraph-parser limit affiliated)
1375 (let ((block-end-line (match-beginning 0)))
1376 (save-excursion
1377 (let* ((begin (car affiliated))
1378 (post-affiliated (point))
1379 ;; Empty blocks have no contents.
1380 (contents-begin (progn (forward-line)
1381 (and (< (point) block-end-line)
1382 (point))))
1383 (contents-end (and contents-begin block-end-line))
1384 (hidden (org-invisible-p2))
1385 (pos-before-blank (progn (goto-char block-end-line)
1386 (forward-line)
1387 (point)))
1388 (end (progn (skip-chars-forward " \r\t\n" limit)
1389 (skip-chars-backward " \t")
1390 (if (bolp) (point) (line-end-position)))))
1391 (list 'special-block
1392 (nconc
1393 (list :type type
1394 :begin begin
1395 :end end
1396 :hiddenp hidden
1397 :contents-begin contents-begin
1398 :contents-end contents-end
1399 :post-blank (count-lines pos-before-blank end)
1400 :post-affiliated post-affiliated)
1401 (cdr affiliated)))))))))
1403 (defun org-element-special-block-interpreter (special-block contents)
1404 "Interpret SPECIAL-BLOCK element as Org syntax.
1405 CONTENTS is the contents of the element."
1406 (let ((block-type (org-element-property :type special-block)))
1407 (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type)))
1411 ;;; Elements
1413 ;; For each element, a parser and an interpreter are also defined.
1414 ;; Both follow the same naming convention used for greater elements.
1416 ;; Also, as for greater elements, adding a new element type is done
1417 ;; through the following steps: implement a parser and an interpreter,
1418 ;; tweak `org-element--current-element' so that it recognizes the new
1419 ;; type and add that new type to `org-element-all-elements'.
1421 ;; As a special case, when the newly defined type is a block type,
1422 ;; `org-element-block-name-alist' has to be modified accordingly.
1425 ;;;; Babel Call
1427 (defun org-element-babel-call-parser (limit affiliated)
1428 "Parse a babel call.
1430 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1431 the buffer position at the beginning of the first affiliated
1432 keyword and CDR is a plist of affiliated keywords along with
1433 their value.
1435 Return a list whose CAR is `babel-call' and CDR is a plist
1436 containing `:begin', `:end', `:info', `:post-blank' and
1437 `:post-affiliated' as keywords."
1438 (save-excursion
1439 (let ((case-fold-search t)
1440 (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
1441 (org-babel-lob-get-info)))
1442 (begin (car affiliated))
1443 (post-affiliated (point))
1444 (pos-before-blank (progn (forward-line) (point)))
1445 (end (progn (skip-chars-forward " \r\t\n" limit)
1446 (skip-chars-backward " \t")
1447 (if (bolp) (point) (line-end-position)))))
1448 (list 'babel-call
1449 (nconc
1450 (list :begin begin
1451 :end end
1452 :info info
1453 :post-blank (count-lines pos-before-blank end)
1454 :post-affiliated post-affiliated)
1455 (cdr affiliated))))))
1457 (defun org-element-babel-call-interpreter (babel-call contents)
1458 "Interpret BABEL-CALL element as Org syntax.
1459 CONTENTS is nil."
1460 (let* ((babel-info (org-element-property :info babel-call))
1461 (main (car babel-info))
1462 (post-options (nth 1 babel-info)))
1463 (concat "#+CALL: "
1464 (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
1465 ;; Remove redundant square brackets.
1466 (replace-match (match-string 1 main) nil nil main))
1467 (and post-options (format "[%s]" post-options)))))
1470 ;;;; Clock
1472 (defun org-element-clock-parser (limit)
1473 "Parse a clock.
1475 LIMIT bounds the search.
1477 Return a list whose CAR is `clock' and CDR is a plist containing
1478 `:status', `:value', `:time', `:begin', `:end' and `:post-blank'
1479 as keywords."
1480 (save-excursion
1481 (let* ((case-fold-search nil)
1482 (begin (point))
1483 (value (progn (search-forward org-clock-string (line-end-position) t)
1484 (skip-chars-forward " \t")
1485 (org-element-timestamp-parser)))
1486 (duration (and (search-forward " => " (line-end-position) t)
1487 (progn (skip-chars-forward " \t")
1488 (looking-at "\\(\\S-+\\)[ \t]*$"))
1489 (org-match-string-no-properties 1)))
1490 (status (if duration 'closed 'running))
1491 (post-blank (let ((before-blank (progn (forward-line) (point))))
1492 (skip-chars-forward " \r\t\n" limit)
1493 (skip-chars-backward " \t")
1494 (unless (bolp) (end-of-line))
1495 (count-lines before-blank (point))))
1496 (end (point)))
1497 (list 'clock
1498 (list :status status
1499 :value value
1500 :duration duration
1501 :begin begin
1502 :end end
1503 :post-blank post-blank)))))
1505 (defun org-element-clock-interpreter (clock contents)
1506 "Interpret CLOCK element as Org syntax.
1507 CONTENTS is nil."
1508 (concat org-clock-string " "
1509 (org-element-timestamp-interpreter
1510 (org-element-property :value clock) nil)
1511 (let ((duration (org-element-property :duration clock)))
1512 (and duration
1513 (concat " => "
1514 (apply 'format
1515 "%2s:%02s"
1516 (org-split-string duration ":")))))))
1519 ;;;; Comment
1521 (defun org-element-comment-parser (limit affiliated)
1522 "Parse a comment.
1524 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1525 the buffer position at the beginning of the first affiliated
1526 keyword and CDR is a plist of affiliated keywords along with
1527 their value.
1529 Return a list whose CAR is `comment' and CDR is a plist
1530 containing `:begin', `:end', `:value', `:post-blank',
1531 `:post-affiliated' keywords.
1533 Assume point is at comment beginning."
1534 (save-excursion
1535 (let* ((begin (car affiliated))
1536 (post-affiliated (point))
1537 (value (prog2 (looking-at "[ \t]*# ?")
1538 (buffer-substring-no-properties
1539 (match-end 0) (line-end-position))
1540 (forward-line)))
1541 (com-end
1542 ;; Get comments ending.
1543 (progn
1544 (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)"))
1545 ;; Accumulate lines without leading hash and first
1546 ;; whitespace.
1547 (setq value
1548 (concat value
1549 "\n"
1550 (buffer-substring-no-properties
1551 (match-end 0) (line-end-position))))
1552 (forward-line))
1553 (point)))
1554 (end (progn (goto-char com-end)
1555 (skip-chars-forward " \r\t\n" limit)
1556 (skip-chars-backward " \t")
1557 (if (bolp) (point) (line-end-position)))))
1558 (list 'comment
1559 (nconc
1560 (list :begin begin
1561 :end end
1562 :value value
1563 :post-blank (count-lines com-end end)
1564 :post-affiliated post-affiliated)
1565 (cdr affiliated))))))
1567 (defun org-element-comment-interpreter (comment contents)
1568 "Interpret COMMENT element as Org syntax.
1569 CONTENTS is nil."
1570 (replace-regexp-in-string "^" "# " (org-element-property :value comment)))
1573 ;;;; Comment Block
1575 (defun org-element-comment-block-parser (limit affiliated)
1576 "Parse an export block.
1578 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1579 the buffer position at the beginning of the first affiliated
1580 keyword and CDR is a plist of affiliated keywords along with
1581 their value.
1583 Return a list whose CAR is `comment-block' and CDR is a plist
1584 containing `:begin', `:end', `:hiddenp', `:value', `:post-blank'
1585 and `:post-affiliated' keywords.
1587 Assume point is at comment block beginning."
1588 (let ((case-fold-search t))
1589 (if (not (save-excursion
1590 (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t)))
1591 ;; Incomplete block: parse it as a paragraph.
1592 (org-element-paragraph-parser limit affiliated)
1593 (let ((contents-end (match-beginning 0)))
1594 (save-excursion
1595 (let* ((begin (car affiliated))
1596 (post-affiliated (point))
1597 (contents-begin (progn (forward-line) (point)))
1598 (hidden (org-invisible-p2))
1599 (pos-before-blank (progn (goto-char contents-end)
1600 (forward-line)
1601 (point)))
1602 (end (progn (skip-chars-forward " \r\t\n" limit)
1603 (skip-chars-backward " \t")
1604 (if (bolp) (point) (line-end-position))))
1605 (value (buffer-substring-no-properties
1606 contents-begin contents-end)))
1607 (list 'comment-block
1608 (nconc
1609 (list :begin begin
1610 :end end
1611 :value value
1612 :hiddenp hidden
1613 :post-blank (count-lines pos-before-blank end)
1614 :post-affiliated post-affiliated)
1615 (cdr affiliated)))))))))
1617 (defun org-element-comment-block-interpreter (comment-block contents)
1618 "Interpret COMMENT-BLOCK element as Org syntax.
1619 CONTENTS is nil."
1620 (format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
1621 (org-remove-indentation (org-element-property :value comment-block))))
1624 ;;;; Diary Sexp
1626 (defun org-element-diary-sexp-parser (limit affiliated)
1627 "Parse a diary sexp.
1629 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1630 the buffer position at the beginning of the first affiliated
1631 keyword and CDR is a plist of affiliated keywords along with
1632 their value.
1634 Return a list whose CAR is `diary-sexp' and CDR is a plist
1635 containing `:begin', `:end', `:value', `:post-blank' and
1636 `:post-affiliated' keywords."
1637 (save-excursion
1638 (let ((begin (car affiliated))
1639 (post-affiliated (point))
1640 (value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
1641 (org-match-string-no-properties 1)))
1642 (pos-before-blank (progn (forward-line) (point)))
1643 (end (progn (skip-chars-forward " \r\t\n" limit)
1644 (skip-chars-backward " \t")
1645 (if (bolp) (point) (line-end-position)))))
1646 (list 'diary-sexp
1647 (nconc
1648 (list :value value
1649 :begin begin
1650 :end end
1651 :post-blank (count-lines pos-before-blank end)
1652 :post-affiliated post-affiliated)
1653 (cdr affiliated))))))
1655 (defun org-element-diary-sexp-interpreter (diary-sexp contents)
1656 "Interpret DIARY-SEXP as Org syntax.
1657 CONTENTS is nil."
1658 (org-element-property :value diary-sexp))
1661 ;;;; Example Block
1663 (defun org-element-example-block-parser (limit affiliated)
1664 "Parse an example block.
1666 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1667 the buffer position at the beginning of the first affiliated
1668 keyword and CDR is a plist of affiliated keywords along with
1669 their value.
1671 Return a list whose CAR is `example-block' and CDR is a plist
1672 containing `:begin', `:end', `:number-lines', `:preserve-indent',
1673 `:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
1674 `:switches', `:value', `:post-blank' and `:post-affiliated'
1675 keywords."
1676 (let ((case-fold-search t))
1677 (if (not (save-excursion
1678 (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
1679 ;; Incomplete block: parse it as a paragraph.
1680 (org-element-paragraph-parser limit affiliated)
1681 (let ((contents-end (match-beginning 0)))
1682 (save-excursion
1683 (let* ((switches
1684 (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
1685 (org-match-string-no-properties 1)))
1686 ;; Switches analysis
1687 (number-lines (cond ((not switches) nil)
1688 ((string-match "-n\\>" switches) 'new)
1689 ((string-match "+n\\>" switches) 'continued)))
1690 (preserve-indent (and switches (string-match "-i\\>" switches)))
1691 ;; Should labels be retained in (or stripped from) example
1692 ;; blocks?
1693 (retain-labels
1694 (or (not switches)
1695 (not (string-match "-r\\>" switches))
1696 (and number-lines (string-match "-k\\>" switches))))
1697 ;; What should code-references use - labels or
1698 ;; line-numbers?
1699 (use-labels
1700 (or (not switches)
1701 (and retain-labels (not (string-match "-k\\>" switches)))))
1702 (label-fmt (and switches
1703 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
1704 (match-string 1 switches)))
1705 ;; Standard block parsing.
1706 (begin (car affiliated))
1707 (post-affiliated (point))
1708 (contents-begin (progn (forward-line) (point)))
1709 (hidden (org-invisible-p2))
1710 (value (org-unescape-code-in-string
1711 (buffer-substring-no-properties
1712 contents-begin contents-end)))
1713 (pos-before-blank (progn (goto-char contents-end)
1714 (forward-line)
1715 (point)))
1716 (end (progn (skip-chars-forward " \r\t\n" limit)
1717 (skip-chars-backward " \t")
1718 (if (bolp) (point) (line-end-position)))))
1719 (list 'example-block
1720 (nconc
1721 (list :begin begin
1722 :end end
1723 :value value
1724 :switches switches
1725 :number-lines number-lines
1726 :preserve-indent preserve-indent
1727 :retain-labels retain-labels
1728 :use-labels use-labels
1729 :label-fmt label-fmt
1730 :hiddenp hidden
1731 :post-blank (count-lines pos-before-blank end)
1732 :post-affiliated post-affiliated)
1733 (cdr affiliated)))))))))
1735 (defun org-element-example-block-interpreter (example-block contents)
1736 "Interpret EXAMPLE-BLOCK element as Org syntax.
1737 CONTENTS is nil."
1738 (let ((switches (org-element-property :switches example-block)))
1739 (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
1740 (org-remove-indentation
1741 (org-escape-code-in-string
1742 (org-element-property :value example-block)))
1743 "#+END_EXAMPLE")))
1746 ;;;; Export Block
1748 (defun org-element-export-block-parser (limit affiliated)
1749 "Parse an export block.
1751 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1752 the buffer position at the beginning of the first affiliated
1753 keyword and CDR is a plist of affiliated keywords along with
1754 their value.
1756 Return a list whose CAR is `export-block' and CDR is a plist
1757 containing `:begin', `:end', `:type', `:hiddenp', `:value',
1758 `:post-blank' and `:post-affiliated' keywords.
1760 Assume point is at export-block beginning."
1761 (let* ((case-fold-search t)
1762 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
1763 (upcase (org-match-string-no-properties 1)))))
1764 (if (not (save-excursion
1765 (re-search-forward
1766 (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
1767 ;; Incomplete block: parse it as a paragraph.
1768 (org-element-paragraph-parser limit affiliated)
1769 (let ((contents-end (match-beginning 0)))
1770 (save-excursion
1771 (let* ((begin (car affiliated))
1772 (post-affiliated (point))
1773 (contents-begin (progn (forward-line) (point)))
1774 (hidden (org-invisible-p2))
1775 (pos-before-blank (progn (goto-char contents-end)
1776 (forward-line)
1777 (point)))
1778 (end (progn (skip-chars-forward " \r\t\n" limit)
1779 (skip-chars-backward " \t")
1780 (if (bolp) (point) (line-end-position))))
1781 (value (buffer-substring-no-properties contents-begin
1782 contents-end)))
1783 (list 'export-block
1784 (nconc
1785 (list :begin begin
1786 :end end
1787 :type type
1788 :value value
1789 :hiddenp hidden
1790 :post-blank (count-lines pos-before-blank end)
1791 :post-affiliated post-affiliated)
1792 (cdr affiliated)))))))))
1794 (defun org-element-export-block-interpreter (export-block contents)
1795 "Interpret EXPORT-BLOCK element as Org syntax.
1796 CONTENTS is nil."
1797 (let ((type (org-element-property :type export-block)))
1798 (concat (format "#+BEGIN_%s\n" type)
1799 (org-element-property :value export-block)
1800 (format "#+END_%s" type))))
1803 ;;;; Fixed-width
1805 (defun org-element-fixed-width-parser (limit affiliated)
1806 "Parse a fixed-width section.
1808 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1809 the buffer position at the beginning of the first affiliated
1810 keyword and CDR is a plist of affiliated keywords along with
1811 their value.
1813 Return a list whose CAR is `fixed-width' and CDR is a plist
1814 containing `:begin', `:end', `:value', `:post-blank' and
1815 `:post-affiliated' keywords.
1817 Assume point is at the beginning of the fixed-width area."
1818 (save-excursion
1819 (let* ((begin (car affiliated))
1820 (post-affiliated (point))
1821 value
1822 (end-area
1823 (progn
1824 (while (and (< (point) limit)
1825 (looking-at "[ \t]*:\\( \\|$\\)"))
1826 ;; Accumulate text without starting colons.
1827 (setq value
1828 (concat value
1829 (buffer-substring-no-properties
1830 (match-end 0) (point-at-eol))
1831 "\n"))
1832 (forward-line))
1833 (point)))
1834 (end (progn (skip-chars-forward " \r\t\n" limit)
1835 (skip-chars-backward " \t")
1836 (if (bolp) (point) (line-end-position)))))
1837 (list 'fixed-width
1838 (nconc
1839 (list :begin begin
1840 :end end
1841 :value value
1842 :post-blank (count-lines end-area end)
1843 :post-affiliated post-affiliated)
1844 (cdr affiliated))))))
1846 (defun org-element-fixed-width-interpreter (fixed-width contents)
1847 "Interpret FIXED-WIDTH element as Org syntax.
1848 CONTENTS is nil."
1849 (replace-regexp-in-string
1850 "^" ": " (substring (org-element-property :value fixed-width) 0 -1)))
1853 ;;;; Horizontal Rule
1855 (defun org-element-horizontal-rule-parser (limit affiliated)
1856 "Parse an horizontal rule.
1858 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1859 the buffer position at the beginning of the first affiliated
1860 keyword and CDR is a plist of affiliated keywords along with
1861 their value.
1863 Return a list whose CAR is `horizontal-rule' and CDR is a plist
1864 containing `:begin', `:end', `:post-blank' and `:post-affiliated'
1865 keywords."
1866 (save-excursion
1867 (let ((begin (car affiliated))
1868 (post-affiliated (point))
1869 (post-hr (progn (forward-line) (point)))
1870 (end (progn (skip-chars-forward " \r\t\n" limit)
1871 (skip-chars-backward " \t")
1872 (if (bolp) (point) (line-end-position)))))
1873 (list 'horizontal-rule
1874 (nconc
1875 (list :begin begin
1876 :end end
1877 :post-blank (count-lines post-hr end)
1878 :post-affiliated post-affiliated)
1879 (cdr affiliated))))))
1881 (defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
1882 "Interpret HORIZONTAL-RULE element as Org syntax.
1883 CONTENTS is nil."
1884 "-----")
1887 ;;;; Keyword
1889 (defun org-element-keyword-parser (limit affiliated)
1890 "Parse a keyword at point.
1892 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1893 the buffer position at the beginning of the first affiliated
1894 keyword and CDR is a plist of affiliated keywords along with
1895 their value.
1897 Return a list whose CAR is `keyword' and CDR is a plist
1898 containing `:key', `:value', `:begin', `:end', `:post-blank' and
1899 `:post-affiliated' keywords."
1900 (save-excursion
1901 (let ((begin (car affiliated))
1902 (post-affiliated (point))
1903 (key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
1904 (upcase (org-match-string-no-properties 1))))
1905 (value (org-trim (buffer-substring-no-properties
1906 (match-end 0) (point-at-eol))))
1907 (pos-before-blank (progn (forward-line) (point)))
1908 (end (progn (skip-chars-forward " \r\t\n" limit)
1909 (skip-chars-backward " \t")
1910 (if (bolp) (point) (line-end-position)))))
1911 (list 'keyword
1912 (nconc
1913 (list :key key
1914 :value value
1915 :begin begin
1916 :end end
1917 :post-blank (count-lines pos-before-blank end)
1918 :post-affiliated post-affiliated)
1919 (cdr affiliated))))))
1921 (defun org-element-keyword-interpreter (keyword contents)
1922 "Interpret KEYWORD element as Org syntax.
1923 CONTENTS is nil."
1924 (format "#+%s: %s"
1925 (org-element-property :key keyword)
1926 (org-element-property :value keyword)))
1929 ;;;; Latex Environment
1931 (defun org-element-latex-environment-parser (limit affiliated)
1932 "Parse a LaTeX environment.
1934 LIMIT bounds the search. AFFILIATED is a list of which CAR is
1935 the buffer position at the beginning of the first affiliated
1936 keyword and CDR is a plist of affiliated keywords along with
1937 their value.
1939 Return a list whose CAR is `latex-environment' and CDR is a plist
1940 containing `:begin', `:end', `:value', `:post-blank' and
1941 `:post-affiliated' keywords.
1943 Assume point is at the beginning of the latex environment."
1944 (save-excursion
1945 (let ((case-fold-search t)
1946 (code-begin (point)))
1947 (looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}")
1948 (if (not (re-search-forward (format "^[ \t]*\\\\end{%s}[ \t]*$"
1949 (regexp-quote (match-string 1)))
1950 limit t))
1951 ;; Incomplete latex environment: parse it as a paragraph.
1952 (org-element-paragraph-parser limit affiliated)
1953 (let* ((code-end (progn (forward-line) (point)))
1954 (begin (car affiliated))
1955 (value (buffer-substring-no-properties code-begin code-end))
1956 (end (progn (skip-chars-forward " \r\t\n" limit)
1957 (skip-chars-backward " \t")
1958 (if (bolp) (point) (line-end-position)))))
1959 (list 'latex-environment
1960 (nconc
1961 (list :begin begin
1962 :end end
1963 :value value
1964 :post-blank (count-lines code-end end)
1965 :post-affiliated code-begin)
1966 (cdr affiliated))))))))
1968 (defun org-element-latex-environment-interpreter (latex-environment contents)
1969 "Interpret LATEX-ENVIRONMENT element as Org syntax.
1970 CONTENTS is nil."
1971 (org-element-property :value latex-environment))
1974 ;;;; Node Property
1976 (defun org-element-node-property-parser (limit)
1977 "Parse a node-property at point.
1979 LIMIT bounds the search.
1981 Return a list whose CAR is `node-property' and CDR is a plist
1982 containing `:key', `:value', `:begin', `:end' and `:post-blank'
1983 keywords."
1984 (save-excursion
1985 (let ((case-fold-search t)
1986 (begin (point))
1987 (key (progn (looking-at "[ \t]*:\\(.*?\\):[ \t]+\\(.*?\\)[ \t]*$")
1988 (org-match-string-no-properties 1)))
1989 (value (org-match-string-no-properties 2))
1990 (pos-before-blank (progn (forward-line) (point)))
1991 (end (progn (skip-chars-forward " \r\t\n" limit)
1992 (if (eobp) (point) (point-at-bol)))))
1993 (list 'node-property
1994 (list :key key
1995 :value value
1996 :begin begin
1997 :end end
1998 :post-blank (count-lines pos-before-blank end))))))
2000 (defun org-element-node-property-interpreter (node-property contents)
2001 "Interpret NODE-PROPERTY element as Org syntax.
2002 CONTENTS is nil."
2003 (format org-property-format
2004 (format ":%s:" (org-element-property :key node-property))
2005 (org-element-property :value node-property)))
2008 ;;;; Paragraph
2010 (defun org-element-paragraph-parser (limit affiliated)
2011 "Parse a paragraph.
2013 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2014 the buffer position at the beginning of the first affiliated
2015 keyword and CDR is a plist of affiliated keywords along with
2016 their value.
2018 Return a list whose CAR is `paragraph' and CDR is a plist
2019 containing `:begin', `:end', `:contents-begin' and
2020 `:contents-end', `:post-blank' and `:post-affiliated' keywords.
2022 Assume point is at the beginning of the paragraph."
2023 (save-excursion
2024 (let* ((begin (car affiliated))
2025 (contents-begin (point))
2026 (before-blank
2027 (let ((case-fold-search t))
2028 (end-of-line)
2029 (if (not (re-search-forward
2030 org-element-paragraph-separate limit 'm))
2031 limit
2032 ;; A matching `org-element-paragraph-separate' is not
2033 ;; necessarily the end of the paragraph. In
2034 ;; particular, lines starting with # or : as a first
2035 ;; non-space character are ambiguous. We have check
2036 ;; if they are valid Org syntax (i.e. not an
2037 ;; incomplete keyword).
2038 (beginning-of-line)
2039 (while (not
2041 ;; There's no ambiguity for other symbols or
2042 ;; empty lines: stop here.
2043 (looking-at "[ \t]*\\(?:[^:#]\\|$\\)")
2044 ;; Stop at valid fixed-width areas.
2045 (looking-at "[ \t]*:\\(?: \\|$\\)")
2046 ;; Stop at drawers.
2047 (and (looking-at org-drawer-regexp)
2048 (save-excursion
2049 (re-search-forward
2050 "^[ \t]*:END:[ \t]*$" limit t)))
2051 ;; Stop at valid comments.
2052 (looking-at "[ \t]*#\\(?: \\|$\\)")
2053 ;; Stop at valid dynamic blocks.
2054 (and (looking-at org-dblock-start-re)
2055 (save-excursion
2056 (re-search-forward
2057 "^[ \t]*#\\+END:?[ \t]*$" limit t)))
2058 ;; Stop at valid blocks.
2059 (and (looking-at
2060 "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
2061 (save-excursion
2062 (re-search-forward
2063 (format "^[ \t]*#\\+END_%s[ \t]*$"
2064 (match-string 1))
2065 limit t)))
2066 ;; Stop at valid latex environments.
2067 (and (looking-at
2068 "^[ \t]*\\\\begin{\\([A-Za-z0-9]+\\*?\\)}[ \t]*$")
2069 (save-excursion
2070 (re-search-forward
2071 (format "^[ \t]*\\\\end{%s}[ \t]*$"
2072 (match-string 1))
2073 limit t)))
2074 ;; Stop at valid keywords.
2075 (looking-at "[ \t]*#\\+\\S-+:")
2076 ;; Skip everything else.
2077 (not
2078 (progn
2079 (end-of-line)
2080 (re-search-forward org-element-paragraph-separate
2081 limit 'm)))))
2082 (beginning-of-line)))
2083 (if (= (point) limit) limit
2084 (goto-char (line-beginning-position)))))
2085 (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin)
2086 (forward-line)
2087 (point)))
2088 (end (progn (skip-chars-forward " \r\t\n" limit)
2089 (skip-chars-backward " \t")
2090 (if (bolp) (point) (line-end-position)))))
2091 (list 'paragraph
2092 (nconc
2093 (list :begin begin
2094 :end end
2095 :contents-begin contents-begin
2096 :contents-end contents-end
2097 :post-blank (count-lines before-blank end)
2098 :post-affiliated contents-begin)
2099 (cdr affiliated))))))
2101 (defun org-element-paragraph-interpreter (paragraph contents)
2102 "Interpret PARAGRAPH element as Org syntax.
2103 CONTENTS is the contents of the element."
2104 contents)
2107 ;;;; Planning
2109 (defun org-element-planning-parser (limit)
2110 "Parse a planning.
2112 LIMIT bounds the search.
2114 Return a list whose CAR is `planning' and CDR is a plist
2115 containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
2116 and `:post-blank' keywords."
2117 (save-excursion
2118 (let* ((case-fold-search nil)
2119 (begin (point))
2120 (post-blank (let ((before-blank (progn (forward-line) (point))))
2121 (skip-chars-forward " \r\t\n" limit)
2122 (skip-chars-backward " \t")
2123 (unless (bolp) (end-of-line))
2124 (count-lines before-blank (point))))
2125 (end (point))
2126 closed deadline scheduled)
2127 (goto-char begin)
2128 (while (re-search-forward org-keyword-time-not-clock-regexp end t)
2129 (goto-char (match-end 1))
2130 (skip-chars-forward " \t" end)
2131 (let ((keyword (match-string 1))
2132 (time (org-element-timestamp-parser)))
2133 (cond ((equal keyword org-closed-string) (setq closed time))
2134 ((equal keyword org-deadline-string) (setq deadline time))
2135 (t (setq scheduled time)))))
2136 (list 'planning
2137 (list :closed closed
2138 :deadline deadline
2139 :scheduled scheduled
2140 :begin begin
2141 :end end
2142 :post-blank post-blank)))))
2144 (defun org-element-planning-interpreter (planning contents)
2145 "Interpret PLANNING element as Org syntax.
2146 CONTENTS is nil."
2147 (mapconcat
2148 'identity
2149 (delq nil
2150 (list (let ((deadline (org-element-property :deadline planning)))
2151 (when deadline
2152 (concat org-deadline-string " "
2153 (org-element-timestamp-interpreter deadline nil))))
2154 (let ((scheduled (org-element-property :scheduled planning)))
2155 (when scheduled
2156 (concat org-scheduled-string " "
2157 (org-element-timestamp-interpreter scheduled nil))))
2158 (let ((closed (org-element-property :closed planning)))
2159 (when closed
2160 (concat org-closed-string " "
2161 (org-element-timestamp-interpreter closed nil))))))
2162 " "))
2165 ;;;; Quote Section
2167 (defun org-element-quote-section-parser (limit)
2168 "Parse a quote section.
2170 LIMIT bounds the search.
2172 Return a list whose CAR is `quote-section' and CDR is a plist
2173 containing `:begin', `:end', `:value' and `:post-blank' keywords.
2175 Assume point is at beginning of the section."
2176 (save-excursion
2177 (let* ((begin (point))
2178 (end (progn (org-with-limited-levels (outline-next-heading))
2179 (point)))
2180 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
2181 (forward-line)
2182 (point)))
2183 (value (buffer-substring-no-properties begin pos-before-blank)))
2184 (list 'quote-section
2185 (list :begin begin
2186 :end end
2187 :value value
2188 :post-blank (count-lines pos-before-blank end))))))
2190 (defun org-element-quote-section-interpreter (quote-section contents)
2191 "Interpret QUOTE-SECTION element as Org syntax.
2192 CONTENTS is nil."
2193 (org-element-property :value quote-section))
2196 ;;;; Src Block
2198 (defun org-element-src-block-parser (limit affiliated)
2199 "Parse a src block.
2201 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2202 the buffer position at the beginning of the first affiliated
2203 keyword and CDR is a plist of affiliated keywords along with
2204 their value.
2206 Return a list whose CAR is `src-block' and CDR is a plist
2207 containing `:language', `:switches', `:parameters', `:begin',
2208 `:end', `:hiddenp', `:number-lines', `:retain-labels',
2209 `:use-labels', `:label-fmt', `:preserve-indent', `:value',
2210 `:post-blank' and `:post-affiliated' keywords.
2212 Assume point is at the beginning of the block."
2213 (let ((case-fold-search t))
2214 (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$"
2215 limit t)))
2216 ;; Incomplete block: parse it as a paragraph.
2217 (org-element-paragraph-parser limit affiliated)
2218 (let ((contents-end (match-beginning 0)))
2219 (save-excursion
2220 (let* ((begin (car affiliated))
2221 (post-affiliated (point))
2222 ;; Get language as a string.
2223 (language
2224 (progn
2225 (looking-at
2226 (concat "^[ \t]*#\\+BEGIN_SRC"
2227 "\\(?: +\\(\\S-+\\)\\)?"
2228 "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
2229 "\\(.*\\)[ \t]*$"))
2230 (org-match-string-no-properties 1)))
2231 ;; Get switches.
2232 (switches (org-match-string-no-properties 2))
2233 ;; Get parameters.
2234 (parameters (org-match-string-no-properties 3))
2235 ;; Switches analysis
2236 (number-lines (cond ((not switches) nil)
2237 ((string-match "-n\\>" switches) 'new)
2238 ((string-match "+n\\>" switches) 'continued)))
2239 (preserve-indent (and switches (string-match "-i\\>" switches)))
2240 (label-fmt (and switches
2241 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
2242 (match-string 1 switches)))
2243 ;; Should labels be retained in (or stripped from)
2244 ;; src blocks?
2245 (retain-labels
2246 (or (not switches)
2247 (not (string-match "-r\\>" switches))
2248 (and number-lines (string-match "-k\\>" switches))))
2249 ;; What should code-references use - labels or
2250 ;; line-numbers?
2251 (use-labels
2252 (or (not switches)
2253 (and retain-labels (not (string-match "-k\\>" switches)))))
2254 ;; Get visibility status.
2255 (hidden (progn (forward-line) (org-invisible-p2)))
2256 ;; Retrieve code.
2257 (value (org-unescape-code-in-string
2258 (buffer-substring-no-properties (point) contents-end)))
2259 (pos-before-blank (progn (goto-char contents-end)
2260 (forward-line)
2261 (point)))
2262 ;; Get position after ending blank lines.
2263 (end (progn (skip-chars-forward " \r\t\n" limit)
2264 (skip-chars-backward " \t")
2265 (if (bolp) (point) (line-end-position)))))
2266 (list 'src-block
2267 (nconc
2268 (list :language language
2269 :switches (and (org-string-nw-p switches)
2270 (org-trim switches))
2271 :parameters (and (org-string-nw-p parameters)
2272 (org-trim parameters))
2273 :begin begin
2274 :end end
2275 :number-lines number-lines
2276 :preserve-indent preserve-indent
2277 :retain-labels retain-labels
2278 :use-labels use-labels
2279 :label-fmt label-fmt
2280 :hiddenp hidden
2281 :value value
2282 :post-blank (count-lines pos-before-blank end)
2283 :post-affiliated post-affiliated)
2284 (cdr affiliated)))))))))
2286 (defun org-element-src-block-interpreter (src-block contents)
2287 "Interpret SRC-BLOCK element as Org syntax.
2288 CONTENTS is nil."
2289 (let ((lang (org-element-property :language src-block))
2290 (switches (org-element-property :switches src-block))
2291 (params (org-element-property :parameters src-block))
2292 (value (let ((val (org-element-property :value src-block)))
2293 (cond
2294 (org-src-preserve-indentation val)
2295 ((zerop org-edit-src-content-indentation)
2296 (org-remove-indentation val))
2298 (let ((ind (make-string
2299 org-edit-src-content-indentation 32)))
2300 (replace-regexp-in-string
2301 "\\(^\\)[ \t]*\\S-" ind
2302 (org-remove-indentation val) nil nil 1)))))))
2303 (concat (format "#+BEGIN_SRC%s\n"
2304 (concat (and lang (concat " " lang))
2305 (and switches (concat " " switches))
2306 (and params (concat " " params))))
2307 (org-escape-code-in-string value)
2308 "#+END_SRC")))
2311 ;;;; Table
2313 (defun org-element-table-parser (limit affiliated)
2314 "Parse a table at point.
2316 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2317 the buffer position at the beginning of the first affiliated
2318 keyword and CDR is a plist of affiliated keywords along with
2319 their value.
2321 Return a list whose CAR is `table' and CDR is a plist containing
2322 `:begin', `:end', `:tblfm', `:type', `:contents-begin',
2323 `:contents-end', `:value', `:post-blank' and `:post-affiliated'
2324 keywords.
2326 Assume point is at the beginning of the table."
2327 (save-excursion
2328 (let* ((case-fold-search t)
2329 (table-begin (point))
2330 (type (if (org-at-table.el-p) 'table.el 'org))
2331 (begin (car affiliated))
2332 (table-end
2333 (if (re-search-forward org-table-any-border-regexp limit 'm)
2334 (goto-char (match-beginning 0))
2335 (point)))
2336 (tblfm (let (acc)
2337 (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
2338 (push (org-match-string-no-properties 1) acc)
2339 (forward-line))
2340 acc))
2341 (pos-before-blank (point))
2342 (end (progn (skip-chars-forward " \r\t\n" limit)
2343 (skip-chars-backward " \t")
2344 (if (bolp) (point) (line-end-position)))))
2345 (list 'table
2346 (nconc
2347 (list :begin begin
2348 :end end
2349 :type type
2350 :tblfm tblfm
2351 ;; Only `org' tables have contents. `table.el' tables
2352 ;; use a `:value' property to store raw table as
2353 ;; a string.
2354 :contents-begin (and (eq type 'org) table-begin)
2355 :contents-end (and (eq type 'org) table-end)
2356 :value (and (eq type 'table.el)
2357 (buffer-substring-no-properties
2358 table-begin table-end))
2359 :post-blank (count-lines pos-before-blank end)
2360 :post-affiliated table-begin)
2361 (cdr affiliated))))))
2363 (defun org-element-table-interpreter (table contents)
2364 "Interpret TABLE element as Org syntax.
2365 CONTENTS is nil."
2366 (if (eq (org-element-property :type table) 'table.el)
2367 (org-remove-indentation (org-element-property :value table))
2368 (concat (with-temp-buffer (insert contents)
2369 (org-table-align)
2370 (buffer-string))
2371 (mapconcat (lambda (fm) (concat "#+TBLFM: " fm))
2372 (reverse (org-element-property :tblfm table))
2373 "\n"))))
2376 ;;;; Table Row
2378 (defun org-element-table-row-parser (limit)
2379 "Parse table row at point.
2381 LIMIT bounds the search.
2383 Return a list whose CAR is `table-row' and CDR is a plist
2384 containing `:begin', `:end', `:contents-begin', `:contents-end',
2385 `:type' and `:post-blank' keywords."
2386 (save-excursion
2387 (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
2388 (begin (point))
2389 ;; A table rule has no contents. In that case, ensure
2390 ;; CONTENTS-BEGIN matches CONTENTS-END.
2391 (contents-begin (and (eq type 'standard)
2392 (search-forward "|")
2393 (point)))
2394 (contents-end (and (eq type 'standard)
2395 (progn
2396 (end-of-line)
2397 (skip-chars-backward " \t")
2398 (point))))
2399 (end (progn (forward-line) (point))))
2400 (list 'table-row
2401 (list :type type
2402 :begin begin
2403 :end end
2404 :contents-begin contents-begin
2405 :contents-end contents-end
2406 :post-blank 0)))))
2408 (defun org-element-table-row-interpreter (table-row contents)
2409 "Interpret TABLE-ROW element as Org syntax.
2410 CONTENTS is the contents of the table row."
2411 (if (eq (org-element-property :type table-row) 'rule) "|-"
2412 (concat "| " contents)))
2415 ;;;; Verse Block
2417 (defun org-element-verse-block-parser (limit affiliated)
2418 "Parse a verse block.
2420 LIMIT bounds the search. AFFILIATED is a list of which CAR is
2421 the buffer position at the beginning of the first affiliated
2422 keyword and CDR is a plist of affiliated keywords along with
2423 their value.
2425 Return a list whose CAR is `verse-block' and CDR is a plist
2426 containing `:begin', `:end', `:contents-begin', `:contents-end',
2427 `:hiddenp', `:post-blank' and `:post-affiliated' keywords.
2429 Assume point is at beginning of the block."
2430 (let ((case-fold-search t))
2431 (if (not (save-excursion
2432 (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t)))
2433 ;; Incomplete block: parse it as a paragraph.
2434 (org-element-paragraph-parser limit affiliated)
2435 (let ((contents-end (match-beginning 0)))
2436 (save-excursion
2437 (let* ((begin (car affiliated))
2438 (post-affiliated (point))
2439 (hidden (progn (forward-line) (org-invisible-p2)))
2440 (contents-begin (point))
2441 (pos-before-blank (progn (goto-char contents-end)
2442 (forward-line)
2443 (point)))
2444 (end (progn (skip-chars-forward " \r\t\n" limit)
2445 (skip-chars-backward " \t")
2446 (if (bolp) (point) (line-end-position)))))
2447 (list 'verse-block
2448 (nconc
2449 (list :begin begin
2450 :end end
2451 :contents-begin contents-begin
2452 :contents-end contents-end
2453 :hiddenp hidden
2454 :post-blank (count-lines pos-before-blank end)
2455 :post-affiliated post-affiliated)
2456 (cdr affiliated)))))))))
2458 (defun org-element-verse-block-interpreter (verse-block contents)
2459 "Interpret VERSE-BLOCK element as Org syntax.
2460 CONTENTS is verse block contents."
2461 (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
2465 ;;; Objects
2467 ;; Unlike to elements, interstices can be found between objects.
2468 ;; That's why, along with the parser, successor functions are provided
2469 ;; for each object. Some objects share the same successor (i.e. `code'
2470 ;; and `verbatim' objects).
2472 ;; A successor must accept a single argument bounding the search. It
2473 ;; will return either a cons cell whose CAR is the object's type, as
2474 ;; a symbol, and CDR the position of its next occurrence, or nil.
2476 ;; Successors follow the naming convention:
2477 ;; org-element-NAME-successor, where NAME is the name of the
2478 ;; successor, as defined in `org-element-all-successors'.
2480 ;; Some object types (i.e. `italic') are recursive. Restrictions on
2481 ;; object types they can contain will be specified in
2482 ;; `org-element-object-restrictions'.
2484 ;; Adding a new type of object is simple. Implement a successor,
2485 ;; a parser, and an interpreter for it, all following the naming
2486 ;; convention. Register type in `org-element-all-objects' and
2487 ;; successor in `org-element-all-successors'. Maybe tweak
2488 ;; restrictions about it, and that's it.
2491 ;;;; Bold
2493 (defun org-element-bold-parser ()
2494 "Parse bold object at point.
2496 Return a list whose CAR is `bold' and CDR is a plist with
2497 `:begin', `:end', `:contents-begin' and `:contents-end' and
2498 `:post-blank' keywords.
2500 Assume point is at the first star marker."
2501 (save-excursion
2502 (unless (bolp) (backward-char 1))
2503 (looking-at org-emph-re)
2504 (let ((begin (match-beginning 2))
2505 (contents-begin (match-beginning 4))
2506 (contents-end (match-end 4))
2507 (post-blank (progn (goto-char (match-end 2))
2508 (skip-chars-forward " \t")))
2509 (end (point)))
2510 (list 'bold
2511 (list :begin begin
2512 :end end
2513 :contents-begin contents-begin
2514 :contents-end contents-end
2515 :post-blank post-blank)))))
2517 (defun org-element-bold-interpreter (bold contents)
2518 "Interpret BOLD object as Org syntax.
2519 CONTENTS is the contents of the object."
2520 (format "*%s*" contents))
2522 (defun org-element-text-markup-successor (limit)
2523 "Search for the next text-markup object.
2525 LIMIT bounds the search.
2527 Return value is a cons cell whose CAR is a symbol among `bold',
2528 `italic', `underline', `strike-through', `code' and `verbatim'
2529 and CDR is beginning position."
2530 (save-excursion
2531 (unless (bolp) (backward-char))
2532 (when (re-search-forward org-emph-re limit t)
2533 (let ((marker (match-string 3)))
2534 (cons (cond
2535 ((equal marker "*") 'bold)
2536 ((equal marker "/") 'italic)
2537 ((equal marker "_") 'underline)
2538 ((equal marker "+") 'strike-through)
2539 ((equal marker "~") 'code)
2540 ((equal marker "=") 'verbatim)
2541 (t (error "Unknown marker at %d" (match-beginning 3))))
2542 (match-beginning 2))))))
2545 ;;;; Code
2547 (defun org-element-code-parser ()
2548 "Parse code object at point.
2550 Return a list whose CAR is `code' and CDR is a plist with
2551 `:value', `:begin', `:end' and `:post-blank' keywords.
2553 Assume point is at the first tilde marker."
2554 (save-excursion
2555 (unless (bolp) (backward-char 1))
2556 (looking-at org-emph-re)
2557 (let ((begin (match-beginning 2))
2558 (value (org-match-string-no-properties 4))
2559 (post-blank (progn (goto-char (match-end 2))
2560 (skip-chars-forward " \t")))
2561 (end (point)))
2562 (list 'code
2563 (list :value value
2564 :begin begin
2565 :end end
2566 :post-blank post-blank)))))
2568 (defun org-element-code-interpreter (code contents)
2569 "Interpret CODE object as Org syntax.
2570 CONTENTS is nil."
2571 (format "~%s~" (org-element-property :value code)))
2574 ;;;; Entity
2576 (defun org-element-entity-parser ()
2577 "Parse entity at point.
2579 Return a list whose CAR is `entity' and CDR a plist with
2580 `:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
2581 `:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
2582 keywords.
2584 Assume point is at the beginning of the entity."
2585 (save-excursion
2586 (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
2587 (let* ((value (org-entity-get (match-string 1)))
2588 (begin (match-beginning 0))
2589 (bracketsp (string= (match-string 2) "{}"))
2590 (post-blank (progn (goto-char (match-end 1))
2591 (when bracketsp (forward-char 2))
2592 (skip-chars-forward " \t")))
2593 (end (point)))
2594 (list 'entity
2595 (list :name (car value)
2596 :latex (nth 1 value)
2597 :latex-math-p (nth 2 value)
2598 :html (nth 3 value)
2599 :ascii (nth 4 value)
2600 :latin1 (nth 5 value)
2601 :utf-8 (nth 6 value)
2602 :begin begin
2603 :end end
2604 :use-brackets-p bracketsp
2605 :post-blank post-blank)))))
2607 (defun org-element-entity-interpreter (entity contents)
2608 "Interpret ENTITY object as Org syntax.
2609 CONTENTS is nil."
2610 (concat "\\"
2611 (org-element-property :name entity)
2612 (when (org-element-property :use-brackets-p entity) "{}")))
2614 (defun org-element-latex-or-entity-successor (limit)
2615 "Search for the next latex-fragment or entity object.
2617 LIMIT bounds the search.
2619 Return value is a cons cell whose CAR is `entity' or
2620 `latex-fragment' and CDR is beginning position."
2621 (save-excursion
2622 (unless (bolp) (backward-char))
2623 (let ((matchers
2624 (remove "begin" (plist-get org-format-latex-options :matchers)))
2625 ;; ENTITY-RE matches both LaTeX commands and Org entities.
2626 (entity-re
2627 "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
2628 (when (re-search-forward
2629 (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
2630 matchers "\\|")
2631 "\\|" entity-re)
2632 limit t)
2633 (goto-char (match-beginning 0))
2634 (if (looking-at entity-re)
2635 ;; Determine if it's a real entity or a LaTeX command.
2636 (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
2637 (match-beginning 0))
2638 ;; No entity nor command: point is at a LaTeX fragment.
2639 ;; Determine its type to get the correct beginning position.
2640 (cons 'latex-fragment
2641 (catch 'return
2642 (mapc (lambda (e)
2643 (when (looking-at (nth 1 (assoc e org-latex-regexps)))
2644 (throw 'return
2645 (match-beginning
2646 (nth 2 (assoc e org-latex-regexps))))))
2647 matchers)
2648 (point))))))))
2651 ;;;; Export Snippet
2653 (defun org-element-export-snippet-parser ()
2654 "Parse export snippet at point.
2656 Return a list whose CAR is `export-snippet' and CDR a plist with
2657 `:begin', `:end', `:back-end', `:value' and `:post-blank' as
2658 keywords.
2660 Assume point is at the beginning of the snippet."
2661 (save-excursion
2662 (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t)
2663 (let* ((begin (match-beginning 0))
2664 (back-end (org-match-string-no-properties 1))
2665 (value (buffer-substring-no-properties
2666 (point)
2667 (progn (re-search-forward "@@" nil t) (match-beginning 0))))
2668 (post-blank (skip-chars-forward " \t"))
2669 (end (point)))
2670 (list 'export-snippet
2671 (list :back-end back-end
2672 :value value
2673 :begin begin
2674 :end end
2675 :post-blank post-blank)))))
2677 (defun org-element-export-snippet-interpreter (export-snippet contents)
2678 "Interpret EXPORT-SNIPPET object as Org syntax.
2679 CONTENTS is nil."
2680 (format "@@%s:%s@@"
2681 (org-element-property :back-end export-snippet)
2682 (org-element-property :value export-snippet)))
2684 (defun org-element-export-snippet-successor (limit)
2685 "Search for the next export-snippet object.
2687 LIMIT bounds the search.
2689 Return value is a cons cell whose CAR is `export-snippet' and CDR
2690 its beginning position."
2691 (save-excursion
2692 (let (beg)
2693 (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
2694 (setq beg (match-beginning 0))
2695 (search-forward "@@" limit t))
2696 (cons 'export-snippet beg)))))
2699 ;;;; Footnote Reference
2701 (defun org-element-footnote-reference-parser ()
2702 "Parse footnote reference at point.
2704 Return a list whose CAR is `footnote-reference' and CDR a plist
2705 with `:label', `:type', `:inline-definition', `:begin', `:end'
2706 and `:post-blank' as keywords."
2707 (save-excursion
2708 (looking-at org-footnote-re)
2709 (let* ((begin (point))
2710 (label (or (org-match-string-no-properties 2)
2711 (org-match-string-no-properties 3)
2712 (and (match-string 1)
2713 (concat "fn:" (org-match-string-no-properties 1)))))
2714 (type (if (or (not label) (match-string 1)) 'inline 'standard))
2715 (inner-begin (match-end 0))
2716 (inner-end
2717 (let ((count 1))
2718 (forward-char)
2719 (while (and (> count 0) (re-search-forward "[][]" nil t))
2720 (if (equal (match-string 0) "[") (incf count) (decf count)))
2721 (1- (point))))
2722 (post-blank (progn (goto-char (1+ inner-end))
2723 (skip-chars-forward " \t")))
2724 (end (point))
2725 (footnote-reference
2726 (list 'footnote-reference
2727 (list :label label
2728 :type type
2729 :begin begin
2730 :end end
2731 :post-blank post-blank))))
2732 (org-element-put-property
2733 footnote-reference :inline-definition
2734 (and (eq type 'inline)
2735 (org-element-parse-secondary-string
2736 (buffer-substring inner-begin inner-end)
2737 (org-element-restriction 'footnote-reference)
2738 footnote-reference))))))
2740 (defun org-element-footnote-reference-interpreter (footnote-reference contents)
2741 "Interpret FOOTNOTE-REFERENCE object as Org syntax.
2742 CONTENTS is nil."
2743 (let ((label (or (org-element-property :label footnote-reference) "fn:"))
2744 (def
2745 (let ((inline-def
2746 (org-element-property :inline-definition footnote-reference)))
2747 (if (not inline-def) ""
2748 (concat ":" (org-element-interpret-data inline-def))))))
2749 (format "[%s]" (concat label def))))
2751 (defun org-element-footnote-reference-successor (limit)
2752 "Search for the next footnote-reference object.
2754 LIMIT bounds the search.
2756 Return value is a cons cell whose CAR is `footnote-reference' and
2757 CDR is beginning position."
2758 (save-excursion
2759 (catch 'exit
2760 (while (re-search-forward org-footnote-re limit t)
2761 (save-excursion
2762 (let ((beg (match-beginning 0))
2763 (count 1))
2764 (backward-char)
2765 (while (re-search-forward "[][]" limit t)
2766 (if (equal (match-string 0) "[") (incf count) (decf count))
2767 (when (zerop count)
2768 (throw 'exit (cons 'footnote-reference beg))))))))))
2771 ;;;; Inline Babel Call
2773 (defun org-element-inline-babel-call-parser ()
2774 "Parse inline babel call at point.
2776 Return a list whose CAR is `inline-babel-call' and CDR a plist
2777 with `:begin', `:end', `:info' and `:post-blank' as keywords.
2779 Assume point is at the beginning of the babel call."
2780 (save-excursion
2781 (unless (bolp) (backward-char))
2782 (looking-at org-babel-inline-lob-one-liner-regexp)
2783 (let ((info (save-match-data (org-babel-lob-get-info)))
2784 (begin (match-end 1))
2785 (post-blank (progn (goto-char (match-end 0))
2786 (skip-chars-forward " \t")))
2787 (end (point)))
2788 (list 'inline-babel-call
2789 (list :begin begin
2790 :end end
2791 :info info
2792 :post-blank post-blank)))))
2794 (defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
2795 "Interpret INLINE-BABEL-CALL object as Org syntax.
2796 CONTENTS is nil."
2797 (let* ((babel-info (org-element-property :info inline-babel-call))
2798 (main-source (car babel-info))
2799 (post-options (nth 1 babel-info)))
2800 (concat "call_"
2801 (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
2802 ;; Remove redundant square brackets.
2803 (replace-match
2804 (match-string 1 main-source) nil nil main-source)
2805 main-source)
2806 (and post-options (format "[%s]" post-options)))))
2808 (defun org-element-inline-babel-call-successor (limit)
2809 "Search for the next inline-babel-call object.
2811 LIMIT bounds the search.
2813 Return value is a cons cell whose CAR is `inline-babel-call' and
2814 CDR is beginning position."
2815 (save-excursion
2816 ;; Use a simplified version of
2817 ;; `org-babel-inline-lob-one-liner-regexp'.
2818 (when (re-search-forward
2819 "call_\\([^()\n]+?\\)\\(?:\\[.*?\\]\\)?([^\n]*?)\\(\\[.*?\\]\\)?"
2820 limit t)
2821 (cons 'inline-babel-call (match-beginning 0)))))
2824 ;;;; Inline Src Block
2826 (defun org-element-inline-src-block-parser ()
2827 "Parse inline source block at point.
2829 LIMIT bounds the search.
2831 Return a list whose CAR is `inline-src-block' and CDR a plist
2832 with `:begin', `:end', `:language', `:value', `:parameters' and
2833 `:post-blank' as keywords.
2835 Assume point is at the beginning of the inline src block."
2836 (save-excursion
2837 (unless (bolp) (backward-char))
2838 (looking-at org-babel-inline-src-block-regexp)
2839 (let ((begin (match-beginning 1))
2840 (language (org-match-string-no-properties 2))
2841 (parameters (org-match-string-no-properties 4))
2842 (value (org-match-string-no-properties 5))
2843 (post-blank (progn (goto-char (match-end 0))
2844 (skip-chars-forward " \t")))
2845 (end (point)))
2846 (list 'inline-src-block
2847 (list :language language
2848 :value value
2849 :parameters parameters
2850 :begin begin
2851 :end end
2852 :post-blank post-blank)))))
2854 (defun org-element-inline-src-block-interpreter (inline-src-block contents)
2855 "Interpret INLINE-SRC-BLOCK object as Org syntax.
2856 CONTENTS is nil."
2857 (let ((language (org-element-property :language inline-src-block))
2858 (arguments (org-element-property :parameters inline-src-block))
2859 (body (org-element-property :value inline-src-block)))
2860 (format "src_%s%s{%s}"
2861 language
2862 (if arguments (format "[%s]" arguments) "")
2863 body)))
2865 (defun org-element-inline-src-block-successor (limit)
2866 "Search for the next inline-babel-call element.
2868 LIMIT bounds the search.
2870 Return value is a cons cell whose CAR is `inline-babel-call' and
2871 CDR is beginning position."
2872 (save-excursion
2873 (unless (bolp) (backward-char))
2874 (when (re-search-forward org-babel-inline-src-block-regexp limit t)
2875 (cons 'inline-src-block (match-beginning 1)))))
2877 ;;;; Italic
2879 (defun org-element-italic-parser ()
2880 "Parse italic object at point.
2882 Return a list whose CAR is `italic' and CDR is a plist with
2883 `:begin', `:end', `:contents-begin' and `:contents-end' and
2884 `:post-blank' keywords.
2886 Assume point is at the first slash marker."
2887 (save-excursion
2888 (unless (bolp) (backward-char 1))
2889 (looking-at org-emph-re)
2890 (let ((begin (match-beginning 2))
2891 (contents-begin (match-beginning 4))
2892 (contents-end (match-end 4))
2893 (post-blank (progn (goto-char (match-end 2))
2894 (skip-chars-forward " \t")))
2895 (end (point)))
2896 (list 'italic
2897 (list :begin begin
2898 :end end
2899 :contents-begin contents-begin
2900 :contents-end contents-end
2901 :post-blank post-blank)))))
2903 (defun org-element-italic-interpreter (italic contents)
2904 "Interpret ITALIC object as Org syntax.
2905 CONTENTS is the contents of the object."
2906 (format "/%s/" contents))
2909 ;;;; Latex Fragment
2911 (defun org-element-latex-fragment-parser ()
2912 "Parse latex fragment at point.
2914 Return a list whose CAR is `latex-fragment' and CDR a plist with
2915 `:value', `:begin', `:end', and `:post-blank' as keywords.
2917 Assume point is at the beginning of the latex fragment."
2918 (save-excursion
2919 (let* ((begin (point))
2920 (substring-match
2921 (catch 'exit
2922 (mapc (lambda (e)
2923 (let ((latex-regexp (nth 1 (assoc e org-latex-regexps))))
2924 (when (or (looking-at latex-regexp)
2925 (and (not (bobp))
2926 (save-excursion
2927 (backward-char)
2928 (looking-at latex-regexp))))
2929 (throw 'exit (nth 2 (assoc e org-latex-regexps))))))
2930 (plist-get org-format-latex-options :matchers))
2931 ;; None found: it's a macro.
2932 (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
2934 (value (match-string-no-properties substring-match))
2935 (post-blank (progn (goto-char (match-end substring-match))
2936 (skip-chars-forward " \t")))
2937 (end (point)))
2938 (list 'latex-fragment
2939 (list :value value
2940 :begin begin
2941 :end end
2942 :post-blank post-blank)))))
2944 (defun org-element-latex-fragment-interpreter (latex-fragment contents)
2945 "Interpret LATEX-FRAGMENT object as Org syntax.
2946 CONTENTS is nil."
2947 (org-element-property :value latex-fragment))
2949 ;;;; Line Break
2951 (defun org-element-line-break-parser ()
2952 "Parse line break at point.
2954 Return a list whose CAR is `line-break', and CDR a plist with
2955 `:begin', `:end' and `:post-blank' keywords.
2957 Assume point is at the beginning of the line break."
2958 (list 'line-break
2959 (list :begin (point)
2960 :end (progn (forward-line) (point))
2961 :post-blank 0)))
2963 (defun org-element-line-break-interpreter (line-break contents)
2964 "Interpret LINE-BREAK object as Org syntax.
2965 CONTENTS is nil."
2966 "\\\\\n")
2968 (defun org-element-line-break-successor (limit)
2969 "Search for the next line-break object.
2971 LIMIT bounds the search.
2973 Return value is a cons cell whose CAR is `line-break' and CDR is
2974 beginning position."
2975 (save-excursion
2976 (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
2977 (goto-char (match-beginning 1)))))
2978 ;; A line break can only happen on a non-empty line.
2979 (when (and beg (re-search-backward "\\S-" (point-at-bol) t))
2980 (cons 'line-break beg)))))
2983 ;;;; Link
2985 (defun org-element-link-parser ()
2986 "Parse link at point.
2988 Return a list whose CAR is `link' and CDR a plist with `:type',
2989 `:path', `:raw-link', `:application', `:search-option', `:begin',
2990 `:end', `:contents-begin', `:contents-end' and `:post-blank' as
2991 keywords.
2993 Assume point is at the beginning of the link."
2994 (save-excursion
2995 (let ((begin (point))
2996 end contents-begin contents-end link-end post-blank path type
2997 raw-link link search-option application)
2998 (cond
2999 ;; Type 1: Text targeted from a radio target.
3000 ((and org-target-link-regexp (looking-at org-target-link-regexp))
3001 (setq type "radio"
3002 link-end (match-end 0)
3003 path (org-match-string-no-properties 0)))
3004 ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
3005 ((looking-at org-bracket-link-regexp)
3006 (setq contents-begin (match-beginning 3)
3007 contents-end (match-end 3)
3008 link-end (match-end 0)
3009 ;; RAW-LINK is the original link. Expand any
3010 ;; abbreviation in it.
3011 raw-link (org-translate-link
3012 (org-link-expand-abbrev
3013 (org-match-string-no-properties 1)))
3014 link (org-link-unescape raw-link))
3015 ;; Determine TYPE of link and set PATH accordingly.
3016 (cond
3017 ;; File type.
3018 ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link))
3019 (setq type "file" path link))
3020 ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
3021 ((string-match org-link-re-with-space3 link)
3022 (setq type (match-string 1 link) path (match-string 2 link)))
3023 ;; Id type: PATH is the id.
3024 ((string-match "^id:\\([-a-f0-9]+\\)" link)
3025 (setq type "id" path (match-string 1 link)))
3026 ;; Code-ref type: PATH is the name of the reference.
3027 ((string-match "^(\\(.*\\))$" link)
3028 (setq type "coderef" path (match-string 1 link)))
3029 ;; Custom-id type: PATH is the name of the custom id.
3030 ((= (aref link 0) ?#)
3031 (setq type "custom-id" path (substring link 1)))
3032 ;; Fuzzy type: Internal link either matches a target, an
3033 ;; headline name or nothing. PATH is the target or
3034 ;; headline's name.
3035 (t (setq type "fuzzy" path link))))
3036 ;; Type 3: Plain link, i.e. http://orgmode.org
3037 ((looking-at org-plain-link-re)
3038 (setq raw-link (org-match-string-no-properties 0)
3039 type (org-match-string-no-properties 1)
3040 path (org-match-string-no-properties 2)
3041 link-end (match-end 0)))
3042 ;; Type 4: Angular link, i.e. <http://orgmode.org>
3043 ((looking-at org-angle-link-re)
3044 (setq raw-link (buffer-substring-no-properties
3045 (match-beginning 1) (match-end 2))
3046 type (org-match-string-no-properties 1)
3047 path (org-match-string-no-properties 2)
3048 link-end (match-end 0))))
3049 ;; In any case, deduce end point after trailing white space from
3050 ;; LINK-END variable.
3051 (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
3052 end (point))
3053 ;; Extract search option and opening application out of
3054 ;; "file"-type links.
3055 (when (member type org-element-link-type-is-file)
3056 ;; Application.
3057 (cond ((string-match "^file\\+\\(.*\\)$" type)
3058 (setq application (match-string 1 type)))
3059 ((not (string-match "^file" type))
3060 (setq application type)))
3061 ;; Extract search option from PATH.
3062 (when (string-match "::\\(.*\\)$" path)
3063 (setq search-option (match-string 1 path)
3064 path (replace-match "" nil nil path)))
3065 ;; Make sure TYPE always report "file".
3066 (setq type "file"))
3067 (list 'link
3068 (list :type type
3069 :path path
3070 :raw-link (or raw-link path)
3071 :application application
3072 :search-option search-option
3073 :begin begin
3074 :end end
3075 :contents-begin contents-begin
3076 :contents-end contents-end
3077 :post-blank post-blank)))))
3079 (defun org-element-link-interpreter (link contents)
3080 "Interpret LINK object as Org syntax.
3081 CONTENTS is the contents of the object, or nil."
3082 (let ((type (org-element-property :type link))
3083 (raw-link (org-element-property :raw-link link)))
3084 (if (string= type "radio") raw-link
3085 (format "[[%s]%s]"
3086 raw-link
3087 (if contents (format "[%s]" contents) "")))))
3089 (defun org-element-link-successor (limit)
3090 "Search for the next link object.
3092 LIMIT bounds the search.
3094 Return value is a cons cell whose CAR is `link' and CDR is
3095 beginning position."
3096 (save-excursion
3097 (let ((link-regexp
3098 (if (not org-target-link-regexp) org-any-link-re
3099 (concat org-any-link-re "\\|" org-target-link-regexp))))
3100 (when (re-search-forward link-regexp limit t)
3101 (cons 'link (match-beginning 0))))))
3103 (defun org-element-plain-link-successor (limit)
3104 "Search for the next plain link object.
3106 LIMIT bounds the search.
3108 Return value is a cons cell whose CAR is `link' and CDR is
3109 beginning position."
3110 (and (save-excursion (re-search-forward org-plain-link-re limit t))
3111 (cons 'link (match-beginning 0))))
3114 ;;;; Macro
3116 (defun org-element-macro-parser ()
3117 "Parse macro at point.
3119 Return a list whose CAR is `macro' and CDR a plist with `:key',
3120 `:args', `:begin', `:end', `:value' and `:post-blank' as
3121 keywords.
3123 Assume point is at the macro."
3124 (save-excursion
3125 (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
3126 (let ((begin (point))
3127 (key (downcase (org-match-string-no-properties 1)))
3128 (value (org-match-string-no-properties 0))
3129 (post-blank (progn (goto-char (match-end 0))
3130 (skip-chars-forward " \t")))
3131 (end (point))
3132 (args (let ((args (org-match-string-no-properties 3)) args2)
3133 (when args
3134 ;; Do not use `org-split-string' since empty
3135 ;; strings are meaningful here.
3136 (setq args (split-string args ","))
3137 (while args
3138 (while (string-match "\\\\\\'" (car args))
3139 ;; Repair bad splits, when comma is protected,
3140 ;; and thus not a real separator.
3141 (setcar (cdr args) (concat (substring (car args) 0 -1)
3142 "," (nth 1 args)))
3143 (pop args))
3144 (push (pop args) args2))
3145 (mapcar 'org-trim (nreverse args2))))))
3146 (list 'macro
3147 (list :key key
3148 :value value
3149 :args args
3150 :begin begin
3151 :end end
3152 :post-blank post-blank)))))
3154 (defun org-element-macro-interpreter (macro contents)
3155 "Interpret MACRO object as Org syntax.
3156 CONTENTS is nil."
3157 (org-element-property :value macro))
3159 (defun org-element-macro-successor (limit)
3160 "Search for the next macro object.
3162 LIMIT bounds the search.
3164 Return value is cons cell whose CAR is `macro' and CDR is
3165 beginning position."
3166 (save-excursion
3167 (when (re-search-forward
3168 "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
3169 limit t)
3170 (cons 'macro (match-beginning 0)))))
3173 ;;;; Radio-target
3175 (defun org-element-radio-target-parser ()
3176 "Parse radio target at point.
3178 Return a list whose CAR is `radio-target' and CDR a plist with
3179 `:begin', `:end', `:contents-begin', `:contents-end', `:value'
3180 and `:post-blank' as keywords.
3182 Assume point is at the radio target."
3183 (save-excursion
3184 (looking-at org-radio-target-regexp)
3185 (let ((begin (point))
3186 (contents-begin (match-beginning 1))
3187 (contents-end (match-end 1))
3188 (value (org-match-string-no-properties 1))
3189 (post-blank (progn (goto-char (match-end 0))
3190 (skip-chars-forward " \t")))
3191 (end (point)))
3192 (list 'radio-target
3193 (list :begin begin
3194 :end end
3195 :contents-begin contents-begin
3196 :contents-end contents-end
3197 :post-blank post-blank
3198 :value value)))))
3200 (defun org-element-radio-target-interpreter (target contents)
3201 "Interpret TARGET object as Org syntax.
3202 CONTENTS is the contents of the object."
3203 (concat "<<<" contents ">>>"))
3205 (defun org-element-radio-target-successor (limit)
3206 "Search for the next radio-target object.
3208 LIMIT bounds the search.
3210 Return value is a cons cell whose CAR is `radio-target' and CDR
3211 is beginning position."
3212 (save-excursion
3213 (when (re-search-forward org-radio-target-regexp limit t)
3214 (cons 'radio-target (match-beginning 0)))))
3217 ;;;; Statistics Cookie
3219 (defun org-element-statistics-cookie-parser ()
3220 "Parse statistics cookie at point.
3222 Return a list whose CAR is `statistics-cookie', and CDR a plist
3223 with `:begin', `:end', `:value' and `:post-blank' keywords.
3225 Assume point is at the beginning of the statistics-cookie."
3226 (save-excursion
3227 (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
3228 (let* ((begin (point))
3229 (value (buffer-substring-no-properties
3230 (match-beginning 0) (match-end 0)))
3231 (post-blank (progn (goto-char (match-end 0))
3232 (skip-chars-forward " \t")))
3233 (end (point)))
3234 (list 'statistics-cookie
3235 (list :begin begin
3236 :end end
3237 :value value
3238 :post-blank post-blank)))))
3240 (defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
3241 "Interpret STATISTICS-COOKIE object as Org syntax.
3242 CONTENTS is nil."
3243 (org-element-property :value statistics-cookie))
3245 (defun org-element-statistics-cookie-successor (limit)
3246 "Search for the next statistics cookie object.
3248 LIMIT bounds the search.
3250 Return value is a cons cell whose CAR is `statistics-cookie' and
3251 CDR is beginning position."
3252 (save-excursion
3253 (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
3254 (cons 'statistics-cookie (match-beginning 0)))))
3257 ;;;; Strike-Through
3259 (defun org-element-strike-through-parser ()
3260 "Parse strike-through object at point.
3262 Return a list whose CAR is `strike-through' and CDR is a plist
3263 with `:begin', `:end', `:contents-begin' and `:contents-end' and
3264 `:post-blank' keywords.
3266 Assume point is at the first plus sign marker."
3267 (save-excursion
3268 (unless (bolp) (backward-char 1))
3269 (looking-at org-emph-re)
3270 (let ((begin (match-beginning 2))
3271 (contents-begin (match-beginning 4))
3272 (contents-end (match-end 4))
3273 (post-blank (progn (goto-char (match-end 2))
3274 (skip-chars-forward " \t")))
3275 (end (point)))
3276 (list 'strike-through
3277 (list :begin begin
3278 :end end
3279 :contents-begin contents-begin
3280 :contents-end contents-end
3281 :post-blank post-blank)))))
3283 (defun org-element-strike-through-interpreter (strike-through contents)
3284 "Interpret STRIKE-THROUGH object as Org syntax.
3285 CONTENTS is the contents of the object."
3286 (format "+%s+" contents))
3289 ;;;; Subscript
3291 (defun org-element-subscript-parser ()
3292 "Parse subscript at point.
3294 Return a list whose CAR is `subscript' and CDR a plist with
3295 `:begin', `:end', `:contents-begin', `:contents-end',
3296 `:use-brackets-p' and `:post-blank' as keywords.
3298 Assume point is at the underscore."
3299 (save-excursion
3300 (unless (bolp) (backward-char))
3301 (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
3303 (not (looking-at org-match-substring-regexp))))
3304 (begin (match-beginning 2))
3305 (contents-begin (or (match-beginning 5)
3306 (match-beginning 3)))
3307 (contents-end (or (match-end 5) (match-end 3)))
3308 (post-blank (progn (goto-char (match-end 0))
3309 (skip-chars-forward " \t")))
3310 (end (point)))
3311 (list 'subscript
3312 (list :begin begin
3313 :end end
3314 :use-brackets-p bracketsp
3315 :contents-begin contents-begin
3316 :contents-end contents-end
3317 :post-blank post-blank)))))
3319 (defun org-element-subscript-interpreter (subscript contents)
3320 "Interpret SUBSCRIPT object as Org syntax.
3321 CONTENTS is the contents of the object."
3322 (format
3323 (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
3324 contents))
3326 (defun org-element-sub/superscript-successor (limit)
3327 "Search for the next sub/superscript object.
3329 LIMIT bounds the search.
3331 Return value is a cons cell whose CAR is either `subscript' or
3332 `superscript' and CDR is beginning position."
3333 (save-excursion
3334 (unless (bolp) (backward-char))
3335 (when (re-search-forward org-match-substring-regexp limit t)
3336 (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
3337 (match-beginning 2)))))
3340 ;;;; Superscript
3342 (defun org-element-superscript-parser ()
3343 "Parse superscript at point.
3345 Return a list whose CAR is `superscript' and CDR a plist with
3346 `:begin', `:end', `:contents-begin', `:contents-end',
3347 `:use-brackets-p' and `:post-blank' as keywords.
3349 Assume point is at the caret."
3350 (save-excursion
3351 (unless (bolp) (backward-char))
3352 (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
3353 (not (looking-at org-match-substring-regexp))))
3354 (begin (match-beginning 2))
3355 (contents-begin (or (match-beginning 5)
3356 (match-beginning 3)))
3357 (contents-end (or (match-end 5) (match-end 3)))
3358 (post-blank (progn (goto-char (match-end 0))
3359 (skip-chars-forward " \t")))
3360 (end (point)))
3361 (list 'superscript
3362 (list :begin begin
3363 :end end
3364 :use-brackets-p bracketsp
3365 :contents-begin contents-begin
3366 :contents-end contents-end
3367 :post-blank post-blank)))))
3369 (defun org-element-superscript-interpreter (superscript contents)
3370 "Interpret SUPERSCRIPT object as Org syntax.
3371 CONTENTS is the contents of the object."
3372 (format
3373 (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s")
3374 contents))
3377 ;;;; Table Cell
3379 (defun org-element-table-cell-parser ()
3380 "Parse table cell at point.
3382 Return a list whose CAR is `table-cell' and CDR is a plist
3383 containing `:begin', `:end', `:contents-begin', `:contents-end'
3384 and `:post-blank' keywords."
3385 (looking-at "[ \t]*\\(.*?\\)[ \t]*|")
3386 (let* ((begin (match-beginning 0))
3387 (end (match-end 0))
3388 (contents-begin (match-beginning 1))
3389 (contents-end (match-end 1)))
3390 (list 'table-cell
3391 (list :begin begin
3392 :end end
3393 :contents-begin contents-begin
3394 :contents-end contents-end
3395 :post-blank 0))))
3397 (defun org-element-table-cell-interpreter (table-cell contents)
3398 "Interpret TABLE-CELL element as Org syntax.
3399 CONTENTS is the contents of the cell, or nil."
3400 (concat " " contents " |"))
3402 (defun org-element-table-cell-successor (limit)
3403 "Search for the next table-cell object.
3405 LIMIT bounds the search.
3407 Return value is a cons cell whose CAR is `table-cell' and CDR is
3408 beginning position."
3409 (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point))))
3412 ;;;; Target
3414 (defun org-element-target-parser ()
3415 "Parse target at point.
3417 Return a list whose CAR is `target' and CDR a plist with
3418 `:begin', `:end', `:value' and `:post-blank' as keywords.
3420 Assume point is at the target."
3421 (save-excursion
3422 (looking-at org-target-regexp)
3423 (let ((begin (point))
3424 (value (org-match-string-no-properties 1))
3425 (post-blank (progn (goto-char (match-end 0))
3426 (skip-chars-forward " \t")))
3427 (end (point)))
3428 (list 'target
3429 (list :begin begin
3430 :end end
3431 :value value
3432 :post-blank post-blank)))))
3434 (defun org-element-target-interpreter (target contents)
3435 "Interpret TARGET object as Org syntax.
3436 CONTENTS is nil."
3437 (format "<<%s>>" (org-element-property :value target)))
3439 (defun org-element-target-successor (limit)
3440 "Search for the next target object.
3442 LIMIT bounds the search.
3444 Return value is a cons cell whose CAR is `target' and CDR is
3445 beginning position."
3446 (save-excursion
3447 (when (re-search-forward org-target-regexp limit t)
3448 (cons 'target (match-beginning 0)))))
3451 ;;;; Timestamp
3453 (defun org-element-timestamp-parser ()
3454 "Parse time stamp at point.
3456 Return a list whose CAR is `timestamp', and CDR a plist with
3457 `:type', `:begin', `:end', `:value' and `:post-blank' keywords.
3459 Assume point is at the beginning of the timestamp."
3460 (save-excursion
3461 (let* ((begin (point))
3462 (activep (eq (char-after) ?<))
3463 (raw-value
3464 (progn
3465 (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
3466 (match-string-no-properties 0)))
3467 (date-start (match-string-no-properties 1))
3468 (date-end (match-string 3))
3469 (diaryp (match-beginning 2))
3470 (post-blank (progn (goto-char (match-end 0))
3471 (skip-chars-forward " \t")))
3472 (end (point))
3473 (time-range
3474 (and (not diaryp)
3475 (string-match
3476 "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
3477 date-start)
3478 (cons (string-to-number (match-string 2 date-start))
3479 (string-to-number (match-string 3 date-start)))))
3480 (type (cond (diaryp 'diary)
3481 ((and activep (or date-end time-range)) 'active-range)
3482 (activep 'active)
3483 ((or date-end time-range) 'inactive-range)
3484 (t 'inactive)))
3485 (repeater-props
3486 (and (not diaryp)
3487 (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)>"
3488 raw-value)
3489 (list
3490 :repeater-type
3491 (let ((type (match-string 1 raw-value)))
3492 (cond ((equal "++" type) 'catch-up)
3493 ((equal ".+" type) 'restart)
3494 (t 'cumulate)))
3495 :repeater-value (string-to-number (match-string 2 raw-value))
3496 :repeater-unit
3497 (case (string-to-char (match-string 3 raw-value))
3498 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
3499 year-start month-start day-start hour-start minute-start year-end
3500 month-end day-end hour-end minute-end)
3501 ;; Parse date-start.
3502 (unless diaryp
3503 (let ((date (org-parse-time-string date-start t)))
3504 (setq year-start (nth 5 date)
3505 month-start (nth 4 date)
3506 day-start (nth 3 date)
3507 hour-start (nth 2 date)
3508 minute-start (nth 1 date))))
3509 ;; Compute date-end. It can be provided directly in time-stamp,
3510 ;; or extracted from time range. Otherwise, it defaults to the
3511 ;; same values as date-start.
3512 (unless diaryp
3513 (let ((date (and date-end (org-parse-time-string date-end t))))
3514 (setq year-end (or (nth 5 date) year-start)
3515 month-end (or (nth 4 date) month-start)
3516 day-end (or (nth 3 date) day-start)
3517 hour-end (or (nth 2 date) (car time-range) hour-start)
3518 minute-end (or (nth 1 date) (cdr time-range) minute-start))))
3519 (list 'timestamp
3520 (nconc (list :type type
3521 :raw-value raw-value
3522 :year-start year-start
3523 :month-start month-start
3524 :day-start day-start
3525 :hour-start hour-start
3526 :minute-start minute-start
3527 :year-end year-end
3528 :month-end month-end
3529 :day-end day-end
3530 :hour-end hour-end
3531 :minute-end minute-end
3532 :begin begin
3533 :end end
3534 :post-blank post-blank)
3535 repeater-props)))))
3537 (defun org-element-timestamp-interpreter (timestamp contents)
3538 "Interpret TIMESTAMP object as Org syntax.
3539 CONTENTS is nil."
3540 ;; Use `:raw-value' if specified.
3541 (or (org-element-property :raw-value timestamp)
3542 ;; Otherwise, build timestamp string.
3543 (let* ((repeat-string
3544 (concat
3545 (case (org-element-property :repeater-type timestamp)
3546 (cumulate "+") (catch-up "++") (restart ".+"))
3547 (let ((val (org-element-property :repeater-value timestamp)))
3548 (and val (number-to-string val)))
3549 (case (org-element-property :repeater-unit timestamp)
3550 (hour "h") (day "d") (week "w") (month "m") (year "y"))))
3551 (build-ts-string
3552 ;; Build an Org timestamp string from TIME. ACTIVEP is
3553 ;; non-nil when time stamp is active. If WITH-TIME-P is
3554 ;; non-nil, add a time part. HOUR-END and MINUTE-END
3555 ;; specify a time range in the timestamp. REPEAT-STRING
3556 ;; is the repeater string, if any.
3557 (lambda (time activep &optional with-time-p hour-end minute-end)
3558 (let ((ts (format-time-string
3559 (funcall (if with-time-p 'cdr 'car)
3560 org-time-stamp-formats)
3561 time)))
3562 (when (and hour-end minute-end)
3563 (string-match "[012]?[0-9]:[0-5][0-9]" ts)
3564 (setq ts
3565 (replace-match
3566 (format "\\&-%02d:%02d" hour-end minute-end)
3567 nil nil ts)))
3568 (unless activep (setq ts (format "[%s]" (substring ts 1 -1))))
3569 (when (org-string-nw-p repeat-string)
3570 (setq ts (concat (substring ts 0 -1)
3572 repeat-string
3573 (substring ts -1))))
3574 ;; Return value.
3575 ts)))
3576 (type (org-element-property :type timestamp)))
3577 (case type
3578 ((active inactive)
3579 (let* ((minute-start (org-element-property :minute-start timestamp))
3580 (minute-end (org-element-property :minute-end timestamp))
3581 (hour-start (org-element-property :hour-start timestamp))
3582 (hour-end (org-element-property :hour-end timestamp))
3583 (time-range-p (and hour-start hour-end minute-start minute-end
3584 (or (/= hour-start hour-end)
3585 (/= minute-start minute-end)))))
3586 (funcall
3587 build-ts-string
3588 (encode-time 0
3589 (or minute-start 0)
3590 (or hour-start 0)
3591 (org-element-property :day-start timestamp)
3592 (org-element-property :month-start timestamp)
3593 (org-element-property :year-start timestamp))
3594 (eq type 'active)
3595 (and hour-start minute-start)
3596 (and time-range-p hour-end)
3597 (and time-range-p minute-end))))
3598 ((active-range inactive-range)
3599 (let ((minute-start (org-element-property :minute-start timestamp))
3600 (minute-end (org-element-property :minute-end timestamp))
3601 (hour-start (org-element-property :hour-start timestamp))
3602 (hour-end (org-element-property :hour-end timestamp)))
3603 (concat
3604 (funcall
3605 build-ts-string (encode-time
3607 (or minute-start 0)
3608 (or hour-start 0)
3609 (org-element-property :day-start timestamp)
3610 (org-element-property :month-start timestamp)
3611 (org-element-property :year-start timestamp))
3612 (eq type 'active-range)
3613 (and hour-start minute-start))
3614 "--"
3615 (funcall build-ts-string
3616 (encode-time 0
3617 (or minute-end 0)
3618 (or hour-end 0)
3619 (org-element-property :day-end timestamp)
3620 (org-element-property :month-end timestamp)
3621 (org-element-property :year-end timestamp))
3622 (eq type 'active-range)
3623 (and hour-end minute-end)))))))))
3625 (defun org-element-timestamp-successor (limit)
3626 "Search for the next timestamp object.
3628 LIMIT bounds the search.
3630 Return value is a cons cell whose CAR is `timestamp' and CDR is
3631 beginning position."
3632 (save-excursion
3633 (when (re-search-forward
3634 (concat org-ts-regexp-both
3635 "\\|"
3636 "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
3637 "\\|"
3638 "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
3639 limit t)
3640 (cons 'timestamp (match-beginning 0)))))
3643 ;;;; Underline
3645 (defun org-element-underline-parser ()
3646 "Parse underline object at point.
3648 Return a list whose CAR is `underline' and CDR is a plist with
3649 `:begin', `:end', `:contents-begin' and `:contents-end' and
3650 `:post-blank' keywords.
3652 Assume point is at the first underscore marker."
3653 (save-excursion
3654 (unless (bolp) (backward-char 1))
3655 (looking-at org-emph-re)
3656 (let ((begin (match-beginning 2))
3657 (contents-begin (match-beginning 4))
3658 (contents-end (match-end 4))
3659 (post-blank (progn (goto-char (match-end 2))
3660 (skip-chars-forward " \t")))
3661 (end (point)))
3662 (list 'underline
3663 (list :begin begin
3664 :end end
3665 :contents-begin contents-begin
3666 :contents-end contents-end
3667 :post-blank post-blank)))))
3669 (defun org-element-underline-interpreter (underline contents)
3670 "Interpret UNDERLINE object as Org syntax.
3671 CONTENTS is the contents of the object."
3672 (format "_%s_" contents))
3675 ;;;; Verbatim
3677 (defun org-element-verbatim-parser ()
3678 "Parse verbatim object at point.
3680 Return a list whose CAR is `verbatim' and CDR is a plist with
3681 `:value', `:begin', `:end' and `:post-blank' keywords.
3683 Assume point is at the first equal sign marker."
3684 (save-excursion
3685 (unless (bolp) (backward-char 1))
3686 (looking-at org-emph-re)
3687 (let ((begin (match-beginning 2))
3688 (value (org-match-string-no-properties 4))
3689 (post-blank (progn (goto-char (match-end 2))
3690 (skip-chars-forward " \t")))
3691 (end (point)))
3692 (list 'verbatim
3693 (list :value value
3694 :begin begin
3695 :end end
3696 :post-blank post-blank)))))
3698 (defun org-element-verbatim-interpreter (verbatim contents)
3699 "Interpret VERBATIM object as Org syntax.
3700 CONTENTS is nil."
3701 (format "=%s=" (org-element-property :value verbatim)))
3705 ;;; Parsing Element Starting At Point
3707 ;; `org-element--current-element' is the core function of this section.
3708 ;; It returns the Lisp representation of the element starting at
3709 ;; point.
3711 ;; `org-element--current-element' makes use of special modes. They
3712 ;; are activated for fixed element chaining (i.e. `plain-list' >
3713 ;; `item') or fixed conditional element chaining (i.e. `headline' >
3714 ;; `section'). Special modes are: `first-section', `item',
3715 ;; `node-property', `quote-section', `section' and `table-row'.
3717 (defun org-element--current-element
3718 (limit &optional granularity special structure)
3719 "Parse the element starting at point.
3721 LIMIT bounds the search.
3723 Return value is a list like (TYPE PROPS) where TYPE is the type
3724 of the element and PROPS a plist of properties associated to the
3725 element.
3727 Possible types are defined in `org-element-all-elements'.
3729 Optional argument GRANULARITY determines the depth of the
3730 recursion. Allowed values are `headline', `greater-element',
3731 `element', `object' or nil. When it is broader than `object' (or
3732 nil), secondary values will not be parsed, since they only
3733 contain objects.
3735 Optional argument SPECIAL, when non-nil, can be either
3736 `first-section', `item', `node-property', `quote-section',
3737 `section', and `table-row'.
3739 If STRUCTURE isn't provided but SPECIAL is set to `item', it will
3740 be computed.
3742 This function assumes point is always at the beginning of the
3743 element it has to parse."
3744 (save-excursion
3745 (let ((case-fold-search t)
3746 ;; Determine if parsing depth allows for secondary strings
3747 ;; parsing. It only applies to elements referenced in
3748 ;; `org-element-secondary-value-alist'.
3749 (raw-secondary-p (and granularity (not (eq granularity 'object)))))
3750 (cond
3751 ;; Item.
3752 ((eq special 'item)
3753 (org-element-item-parser limit structure raw-secondary-p))
3754 ;; Table Row.
3755 ((eq special 'table-row) (org-element-table-row-parser limit))
3756 ;; Node Property.
3757 ((eq special 'node-property) (org-element-node-property-parser limit))
3758 ;; Headline.
3759 ((org-with-limited-levels (org-at-heading-p))
3760 (org-element-headline-parser limit raw-secondary-p))
3761 ;; Sections (must be checked after headline).
3762 ((eq special 'section) (org-element-section-parser limit))
3763 ((eq special 'quote-section) (org-element-quote-section-parser limit))
3764 ((eq special 'first-section)
3765 (org-element-section-parser
3766 (or (save-excursion (org-with-limited-levels (outline-next-heading)))
3767 limit)))
3768 ;; When not at bol, point is at the beginning of an item or
3769 ;; a footnote definition: next item is always a paragraph.
3770 ((not (bolp)) (org-element-paragraph-parser limit (list (point))))
3771 ;; Planning and Clock.
3772 ((looking-at org-planning-or-clock-line-re)
3773 (if (equal (match-string 1) org-clock-string)
3774 (org-element-clock-parser limit)
3775 (org-element-planning-parser limit)))
3776 ;; Inlinetask.
3777 ((org-at-heading-p)
3778 (org-element-inlinetask-parser limit raw-secondary-p))
3779 ;; From there, elements can have affiliated keywords.
3780 (t (let ((affiliated (org-element--collect-affiliated-keywords limit)))
3781 (cond
3782 ;; Jumping over affiliated keywords put point off-limits.
3783 ;; Parse them as regular keywords.
3784 ((>= (point) limit)
3785 (goto-char (car affiliated))
3786 (org-element-keyword-parser limit nil))
3787 ;; LaTeX Environment.
3788 ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}[ \t]*$")
3789 (org-element-latex-environment-parser limit affiliated))
3790 ;; Drawer and Property Drawer.
3791 ((looking-at org-drawer-regexp)
3792 (if (equal (match-string 1) "PROPERTIES")
3793 (org-element-property-drawer-parser limit affiliated)
3794 (org-element-drawer-parser limit affiliated)))
3795 ;; Fixed Width
3796 ((looking-at "[ \t]*:\\( \\|$\\)")
3797 (org-element-fixed-width-parser limit affiliated))
3798 ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
3799 ;; Keywords.
3800 ((looking-at "[ \t]*#")
3801 (goto-char (match-end 0))
3802 (cond ((looking-at "\\(?: \\|$\\)")
3803 (beginning-of-line)
3804 (org-element-comment-parser limit affiliated))
3805 ((looking-at "\\+BEGIN_\\(\\S-+\\)")
3806 (beginning-of-line)
3807 (let ((parser (assoc (upcase (match-string 1))
3808 org-element-block-name-alist)))
3809 (if parser (funcall (cdr parser) limit affiliated)
3810 (org-element-special-block-parser limit affiliated))))
3811 ((looking-at "\\+CALL:")
3812 (beginning-of-line)
3813 (org-element-babel-call-parser limit affiliated))
3814 ((looking-at "\\+BEGIN:? ")
3815 (beginning-of-line)
3816 (org-element-dynamic-block-parser limit affiliated))
3817 ((looking-at "\\+\\S-+:")
3818 (beginning-of-line)
3819 (org-element-keyword-parser limit affiliated))
3821 (beginning-of-line)
3822 (org-element-paragraph-parser limit affiliated))))
3823 ;; Footnote Definition.
3824 ((looking-at org-footnote-definition-re)
3825 (org-element-footnote-definition-parser limit affiliated))
3826 ;; Horizontal Rule.
3827 ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
3828 (org-element-horizontal-rule-parser limit affiliated))
3829 ;; Diary Sexp.
3830 ((looking-at "%%(")
3831 (org-element-diary-sexp-parser limit affiliated))
3832 ;; Table.
3833 ((org-at-table-p t) (org-element-table-parser limit affiliated))
3834 ;; List.
3835 ((looking-at (org-item-re))
3836 (org-element-plain-list-parser
3837 limit affiliated (or structure (org-list-struct))))
3838 ;; Default element: Paragraph.
3839 (t (org-element-paragraph-parser limit affiliated)))))))))
3842 ;; Most elements can have affiliated keywords. When looking for an
3843 ;; element beginning, we want to move before them, as they belong to
3844 ;; that element, and, in the meantime, collect information they give
3845 ;; into appropriate properties. Hence the following function.
3847 (defun org-element--collect-affiliated-keywords (limit)
3848 "Collect affiliated keywords from point down to LIMIT.
3850 Return a list whose CAR is the position at the first of them and
3851 CDR a plist of keywords and values and move point to the
3852 beginning of the first line after them.
3854 As a special case, if element doesn't start at the beginning of
3855 the line (i.e. a paragraph starting an item), CAR is current
3856 position of point and CDR is nil."
3857 (if (not (bolp)) (list (point))
3858 (let ((case-fold-search t)
3859 (origin (point))
3860 ;; RESTRICT is the list of objects allowed in parsed
3861 ;; keywords value.
3862 (restrict (org-element-restriction 'keyword))
3863 output)
3864 (while (and (< (point) limit) (looking-at org-element--affiliated-re))
3865 (let* ((raw-kwd (upcase (match-string 1)))
3866 ;; Apply translation to RAW-KWD. From there, KWD is
3867 ;; the official keyword.
3868 (kwd (or (cdr (assoc raw-kwd
3869 org-element-keyword-translation-alist))
3870 raw-kwd))
3871 ;; Find main value for any keyword.
3872 (value
3873 (save-match-data
3874 (org-trim
3875 (buffer-substring-no-properties
3876 (match-end 0) (point-at-eol)))))
3877 ;; PARSEDP is non-nil when keyword should have its
3878 ;; value parsed.
3879 (parsedp (member kwd org-element-parsed-keywords))
3880 ;; If KWD is a dual keyword, find its secondary
3881 ;; value. Maybe parse it.
3882 (dualp (member kwd org-element-dual-keywords))
3883 (dual-value
3884 (and dualp
3885 (let ((sec (org-match-string-no-properties 2)))
3886 (if (or (not sec) (not parsedp)) sec
3887 (org-element-parse-secondary-string sec restrict)))))
3888 ;; Attribute a property name to KWD.
3889 (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
3890 ;; Now set final shape for VALUE.
3891 (when parsedp
3892 (setq value (org-element-parse-secondary-string value restrict)))
3893 (when dualp
3894 (setq value (and (or value dual-value) (cons value dual-value))))
3895 (when (or (member kwd org-element-multiple-keywords)
3896 ;; Attributes can always appear on multiple lines.
3897 (string-match "^ATTR_" kwd))
3898 (setq value (cons value (plist-get output kwd-sym))))
3899 ;; Eventually store the new value in OUTPUT.
3900 (setq output (plist-put output kwd-sym value))
3901 ;; Move to next keyword.
3902 (forward-line)))
3903 ;; If affiliated keywords are orphaned: move back to first one.
3904 ;; They will be parsed as a paragraph.
3905 (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil))
3906 ;; Return value.
3907 (cons origin output))))
3911 ;;; The Org Parser
3913 ;; The two major functions here are `org-element-parse-buffer', which
3914 ;; parses Org syntax inside the current buffer, taking into account
3915 ;; region, narrowing, or even visibility if specified, and
3916 ;; `org-element-parse-secondary-string', which parses objects within
3917 ;; a given string.
3919 ;; The (almost) almighty `org-element-map' allows to apply a function
3920 ;; on elements or objects matching some type, and accumulate the
3921 ;; resulting values. In an export situation, it also skips unneeded
3922 ;; parts of the parse tree.
3924 (defun org-element-parse-buffer (&optional granularity visible-only)
3925 "Recursively parse the buffer and return structure.
3926 If narrowing is in effect, only parse the visible part of the
3927 buffer.
3929 Optional argument GRANULARITY determines the depth of the
3930 recursion. It can be set to the following symbols:
3932 `headline' Only parse headlines.
3933 `greater-element' Don't recurse into greater elements excepted
3934 headlines and sections. Thus, elements
3935 parsed are the top-level ones.
3936 `element' Parse everything but objects and plain text.
3937 `object' Parse the complete buffer (default).
3939 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
3940 elements.
3942 An element or an objects is represented as a list with the
3943 pattern (TYPE PROPERTIES CONTENTS), where :
3945 TYPE is a symbol describing the element or object. See
3946 `org-element-all-elements' and `org-element-all-objects' for an
3947 exhaustive list of such symbols. One can retrieve it with
3948 `org-element-type' function.
3950 PROPERTIES is the list of attributes attached to the element or
3951 object, as a plist. Although most of them are specific to the
3952 element or object type, all types share `:begin', `:end',
3953 `:post-blank' and `:parent' properties, which respectively
3954 refer to buffer position where the element or object starts,
3955 ends, the number of white spaces or blank lines after it, and
3956 the element or object containing it. Properties values can be
3957 obtained by using `org-element-property' function.
3959 CONTENTS is a list of elements, objects or raw strings
3960 contained in the current element or object, when applicable.
3961 One can access them with `org-element-contents' function.
3963 The Org buffer has `org-data' as type and nil as properties.
3964 `org-element-map' function can be used to find specific elements
3965 or objects within the parse tree.
3967 This function assumes that current major mode is `org-mode'."
3968 (save-excursion
3969 (goto-char (point-min))
3970 (org-skip-whitespace)
3971 (org-element--parse-elements
3972 (point-at-bol) (point-max)
3973 ;; Start in `first-section' mode so text before the first
3974 ;; headline belongs to a section.
3975 'first-section nil granularity visible-only (list 'org-data nil))))
3977 (defun org-element-parse-secondary-string (string restriction &optional parent)
3978 "Recursively parse objects in STRING and return structure.
3980 RESTRICTION is a symbol limiting the object types that will be
3981 looked after.
3983 Optional argument PARENT, when non-nil, is the element or object
3984 containing the secondary string. It is used to set correctly
3985 `:parent' property within the string."
3986 ;; Copy buffer-local variables listed in
3987 ;; `org-element-object-variables' into temporary buffer. This is
3988 ;; required since object parsing is dependent on these variables.
3989 (let ((pairs (delq nil (mapcar (lambda (var)
3990 (when (boundp var)
3991 (cons var (symbol-value var))))
3992 org-element-object-variables))))
3993 (with-temp-buffer
3994 (mapc (lambda (pair) (org-set-local (car pair) (cdr pair))) pairs)
3995 (insert string)
3996 (let ((secondary (org-element--parse-objects
3997 (point-min) (point-max) nil restriction)))
3998 (when parent
3999 (mapc (lambda (obj) (org-element-put-property obj :parent parent))
4000 secondary))
4001 secondary))))
4003 (defun org-element-map
4004 (data types fun &optional info first-match no-recursion with-affiliated)
4005 "Map a function on selected elements or objects.
4007 DATA is a parse tree, an element, an object, a string, or a list
4008 of such constructs. TYPES is a symbol or list of symbols of
4009 elements or objects types (see `org-element-all-elements' and
4010 `org-element-all-objects' for a complete list of types). FUN is
4011 the function called on the matching element or object. It has to
4012 accept one argument: the element or object itself.
4014 When optional argument INFO is non-nil, it should be a plist
4015 holding export options. In that case, parts of the parse tree
4016 not exportable according to that property list will be skipped.
4018 When optional argument FIRST-MATCH is non-nil, stop at the first
4019 match for which FUN doesn't return nil, and return that value.
4021 Optional argument NO-RECURSION is a symbol or a list of symbols
4022 representing elements or objects types. `org-element-map' won't
4023 enter any recursive element or object whose type belongs to that
4024 list. Though, FUN can still be applied on them.
4026 When optional argument WITH-AFFILIATED is non-nil, FUN will also
4027 apply to matching objects within parsed affiliated keywords (see
4028 `org-element-parsed-keywords').
4030 Nil values returned from FUN do not appear in the results.
4033 Examples:
4034 --------
4036 Assuming TREE is a variable containing an Org buffer parse tree,
4037 the following example will return a flat list of all `src-block'
4038 and `example-block' elements in it:
4040 \(org-element-map tree '(example-block src-block) 'identity)
4042 The following snippet will find the first headline with a level
4043 of 1 and a \"phone\" tag, and will return its beginning position:
4045 \(org-element-map tree 'headline
4046 \(lambda (hl)
4047 \(and (= (org-element-property :level hl) 1)
4048 \(member \"phone\" (org-element-property :tags hl))
4049 \(org-element-property :begin hl)))
4050 nil t)
4052 The next example will return a flat list of all `plain-list' type
4053 elements in TREE that are not a sub-list themselves:
4055 \(org-element-map tree 'plain-list 'identity nil nil 'plain-list)
4057 Eventually, this example will return a flat list of all `bold'
4058 type objects containing a `latex-snippet' type object, even
4059 looking into captions:
4061 \(org-element-map tree 'bold
4062 \(lambda (b)
4063 \(and (org-element-map b 'latex-snippet 'identity nil t) b))
4064 nil nil nil t)"
4065 ;; Ensure TYPES and NO-RECURSION are a list, even of one element.
4066 (unless (listp types) (setq types (list types)))
4067 (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
4068 ;; Recursion depth is determined by --CATEGORY.
4069 (let* ((--category
4070 (catch 'found
4071 (let ((category 'greater-elements))
4072 (mapc (lambda (type)
4073 (cond ((or (memq type org-element-all-objects)
4074 (eq type 'plain-text))
4075 ;; If one object is found, the function
4076 ;; has to recurse into every object.
4077 (throw 'found 'objects))
4078 ((not (memq type org-element-greater-elements))
4079 ;; If one regular element is found, the
4080 ;; function has to recurse, at least,
4081 ;; into every element it encounters.
4082 (and (not (eq category 'elements))
4083 (setq category 'elements)))))
4084 types)
4085 category)))
4086 ;; Compute properties for affiliated keywords if necessary.
4087 (--affiliated-alist
4088 (and with-affiliated
4089 (mapcar (lambda (kwd)
4090 (cons kwd (intern (concat ":" (downcase kwd)))))
4091 org-element-affiliated-keywords)))
4092 --acc
4093 --walk-tree
4094 (--walk-tree
4095 (function
4096 (lambda (--data)
4097 ;; Recursively walk DATA. INFO, if non-nil, is a plist
4098 ;; holding contextual information.
4099 (let ((--type (org-element-type --data)))
4100 (cond
4101 ((not --data))
4102 ;; Ignored element in an export context.
4103 ((and info (memq --data (plist-get info :ignore-list))))
4104 ;; List of elements or objects.
4105 ((not --type) (mapc --walk-tree --data))
4106 ;; Unconditionally enter parse trees.
4107 ((eq --type 'org-data)
4108 (mapc --walk-tree (org-element-contents --data)))
4110 ;; Check if TYPE is matching among TYPES. If so,
4111 ;; apply FUN to --DATA and accumulate return value
4112 ;; into --ACC (or exit if FIRST-MATCH is non-nil).
4113 (when (memq --type types)
4114 (let ((result (funcall fun --data)))
4115 (cond ((not result))
4116 (first-match (throw '--map-first-match result))
4117 (t (push result --acc)))))
4118 ;; If --DATA has a secondary string that can contain
4119 ;; objects with their type among TYPES, look into it.
4120 (when (and (eq --category 'objects) (not (stringp --data)))
4121 (let ((sec-prop
4122 (assq --type org-element-secondary-value-alist)))
4123 (when sec-prop
4124 (funcall --walk-tree
4125 (org-element-property (cdr sec-prop) --data)))))
4126 ;; If --DATA has any affiliated keywords and
4127 ;; WITH-AFFILIATED is non-nil, look for objects in
4128 ;; them.
4129 (when (and with-affiliated
4130 (eq --category 'objects)
4131 (memq --type org-element-all-elements))
4132 (mapc (lambda (kwd-pair)
4133 (let ((kwd (car kwd-pair))
4134 (value (org-element-property
4135 (cdr kwd-pair) --data)))
4136 ;; Pay attention to the type of value.
4137 ;; Preserve order for multiple keywords.
4138 (cond
4139 ((not value))
4140 ((and (member kwd org-element-multiple-keywords)
4141 (member kwd org-element-dual-keywords))
4142 (mapc (lambda (line)
4143 (funcall --walk-tree (cdr line))
4144 (funcall --walk-tree (car line)))
4145 (reverse value)))
4146 ((member kwd org-element-multiple-keywords)
4147 (mapc (lambda (line) (funcall --walk-tree line))
4148 (reverse value)))
4149 ((member kwd org-element-dual-keywords)
4150 (funcall --walk-tree (cdr value))
4151 (funcall --walk-tree (car value)))
4152 (t (funcall --walk-tree value)))))
4153 --affiliated-alist))
4154 ;; Determine if a recursion into --DATA is possible.
4155 (cond
4156 ;; --TYPE is explicitly removed from recursion.
4157 ((memq --type no-recursion))
4158 ;; --DATA has no contents.
4159 ((not (org-element-contents --data)))
4160 ;; Looking for greater elements but --DATA is simply
4161 ;; an element or an object.
4162 ((and (eq --category 'greater-elements)
4163 (not (memq --type org-element-greater-elements))))
4164 ;; Looking for elements but --DATA is an object.
4165 ((and (eq --category 'elements)
4166 (memq --type org-element-all-objects)))
4167 ;; In any other case, map contents.
4168 (t (mapc --walk-tree (org-element-contents --data)))))))))))
4169 (catch '--map-first-match
4170 (funcall --walk-tree data)
4171 ;; Return value in a proper order.
4172 (nreverse --acc))))
4173 (put 'org-element-map 'lisp-indent-function 2)
4175 ;; The following functions are internal parts of the parser.
4177 ;; The first one, `org-element--parse-elements' acts at the element's
4178 ;; level.
4180 ;; The second one, `org-element--parse-objects' applies on all objects
4181 ;; of a paragraph or a secondary string. It uses
4182 ;; `org-element--get-next-object-candidates' to optimize the search of
4183 ;; the next object in the buffer.
4185 ;; More precisely, that function looks for every allowed object type
4186 ;; first. Then, it discards failed searches, keeps further matches,
4187 ;; and searches again types matched behind point, for subsequent
4188 ;; calls. Thus, searching for a given type fails only once, and every
4189 ;; object is searched only once at top level (but sometimes more for
4190 ;; nested types).
4192 (defun org-element--parse-elements
4193 (beg end special structure granularity visible-only acc)
4194 "Parse elements between BEG and END positions.
4196 SPECIAL prioritize some elements over the others. It can be set
4197 to `first-section', `quote-section', `section' `item' or
4198 `table-row'.
4200 When value is `item', STRUCTURE will be used as the current list
4201 structure.
4203 GRANULARITY determines the depth of the recursion. See
4204 `org-element-parse-buffer' for more information.
4206 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
4207 elements.
4209 Elements are accumulated into ACC."
4210 (save-excursion
4211 (goto-char beg)
4212 ;; When parsing only headlines, skip any text before first one.
4213 (when (and (eq granularity 'headline) (not (org-at-heading-p)))
4214 (org-with-limited-levels (outline-next-heading)))
4215 ;; Main loop start.
4216 (while (< (point) end)
4217 ;; Find current element's type and parse it accordingly to
4218 ;; its category.
4219 (let* ((element (org-element--current-element
4220 end granularity special structure))
4221 (type (org-element-type element))
4222 (cbeg (org-element-property :contents-begin element)))
4223 (goto-char (org-element-property :end element))
4224 ;; Fill ELEMENT contents by side-effect.
4225 (cond
4226 ;; If VISIBLE-ONLY is true and element is hidden or if it has
4227 ;; no contents, don't modify it.
4228 ((or (and visible-only (org-element-property :hiddenp element))
4229 (not cbeg)))
4230 ;; Greater element: parse it between `contents-begin' and
4231 ;; `contents-end'. Make sure GRANULARITY allows the
4232 ;; recursion, or ELEMENT is a headline, in which case going
4233 ;; inside is mandatory, in order to get sub-level headings.
4234 ((and (memq type org-element-greater-elements)
4235 (or (memq granularity '(element object nil))
4236 (and (eq granularity 'greater-element)
4237 (eq type 'section))
4238 (eq type 'headline)))
4239 (org-element--parse-elements
4240 cbeg (org-element-property :contents-end element)
4241 ;; Possibly switch to a special mode.
4242 (case type
4243 (headline
4244 (if (org-element-property :quotedp element) 'quote-section
4245 'section))
4246 (plain-list 'item)
4247 (property-drawer 'node-property)
4248 (table 'table-row))
4249 (and (memq type '(item plain-list))
4250 (org-element-property :structure element))
4251 granularity visible-only element))
4252 ;; ELEMENT has contents. Parse objects inside, if
4253 ;; GRANULARITY allows it.
4254 ((memq granularity '(object nil))
4255 (org-element--parse-objects
4256 cbeg (org-element-property :contents-end element) element
4257 (org-element-restriction type))))
4258 (org-element-adopt-elements acc element)))
4259 ;; Return result.
4260 acc))
4262 (defun org-element--parse-objects (beg end acc restriction)
4263 "Parse objects between BEG and END and return recursive structure.
4265 Objects are accumulated in ACC.
4267 RESTRICTION is a list of object successors which are allowed in
4268 the current object."
4269 (let ((candidates 'initial))
4270 (save-excursion
4271 (goto-char beg)
4272 (while (and (< (point) end)
4273 (setq candidates (org-element--get-next-object-candidates
4274 end restriction candidates)))
4275 (let ((next-object
4276 (let ((pos (apply 'min (mapcar 'cdr candidates))))
4277 (save-excursion
4278 (goto-char pos)
4279 (funcall (intern (format "org-element-%s-parser"
4280 (car (rassq pos candidates)))))))))
4281 ;; 1. Text before any object. Untabify it.
4282 (let ((obj-beg (org-element-property :begin next-object)))
4283 (unless (= (point) obj-beg)
4284 (setq acc
4285 (org-element-adopt-elements
4287 (replace-regexp-in-string
4288 "\t" (make-string tab-width ? )
4289 (buffer-substring-no-properties (point) obj-beg))))))
4290 ;; 2. Object...
4291 (let ((obj-end (org-element-property :end next-object))
4292 (cont-beg (org-element-property :contents-begin next-object)))
4293 ;; Fill contents of NEXT-OBJECT by side-effect, if it has
4294 ;; a recursive type.
4295 (when (and cont-beg
4296 (memq (car next-object) org-element-recursive-objects))
4297 (save-restriction
4298 (narrow-to-region
4299 cont-beg
4300 (org-element-property :contents-end next-object))
4301 (org-element--parse-objects
4302 (point-min) (point-max) next-object
4303 (org-element-restriction next-object))))
4304 (setq acc (org-element-adopt-elements acc next-object))
4305 (goto-char obj-end))))
4306 ;; 3. Text after last object. Untabify it.
4307 (unless (= (point) end)
4308 (setq acc
4309 (org-element-adopt-elements
4311 (replace-regexp-in-string
4312 "\t" (make-string tab-width ? )
4313 (buffer-substring-no-properties (point) end)))))
4314 ;; Result.
4315 acc)))
4317 (defun org-element--get-next-object-candidates (limit restriction objects)
4318 "Return an alist of candidates for the next object.
4320 LIMIT bounds the search, and RESTRICTION narrows candidates to
4321 some object successors.
4323 OBJECTS is the previous candidates alist. If it is set to
4324 `initial', no search has been done before, and all symbols in
4325 RESTRICTION should be looked after.
4327 Return value is an alist whose CAR is the object type and CDR its
4328 beginning position."
4329 (delq
4331 (if (eq objects 'initial)
4332 ;; When searching for the first time, look for every successor
4333 ;; allowed in RESTRICTION.
4334 (mapcar
4335 (lambda (res)
4336 (funcall (intern (format "org-element-%s-successor" res)) limit))
4337 restriction)
4338 ;; Focus on objects returned during last search. Keep those
4339 ;; still after point. Search again objects before it.
4340 (mapcar
4341 (lambda (obj)
4342 (if (>= (cdr obj) (point)) obj
4343 (let* ((type (car obj))
4344 (succ (or (cdr (assq type org-element-object-successor-alist))
4345 type)))
4346 (and succ
4347 (funcall (intern (format "org-element-%s-successor" succ))
4348 limit)))))
4349 objects))))
4353 ;;; Towards A Bijective Process
4355 ;; The parse tree obtained with `org-element-parse-buffer' is really
4356 ;; a snapshot of the corresponding Org buffer. Therefore, it can be
4357 ;; interpreted and expanded into a string with canonical Org syntax.
4358 ;; Hence `org-element-interpret-data'.
4360 ;; The function relies internally on
4361 ;; `org-element--interpret-affiliated-keywords'.
4363 ;;;###autoload
4364 (defun org-element-interpret-data (data &optional parent)
4365 "Interpret DATA as Org syntax.
4367 DATA is a parse tree, an element, an object or a secondary string
4368 to interpret.
4370 Optional argument PARENT is used for recursive calls. It contains
4371 the element or object containing data, or nil.
4373 Return Org syntax as a string."
4374 (let* ((type (org-element-type data))
4375 (results
4376 (cond
4377 ;; Secondary string.
4378 ((not type)
4379 (mapconcat
4380 (lambda (obj) (org-element-interpret-data obj parent))
4381 data ""))
4382 ;; Full Org document.
4383 ((eq type 'org-data)
4384 (mapconcat
4385 (lambda (obj) (org-element-interpret-data obj parent))
4386 (org-element-contents data) ""))
4387 ;; Plain text: remove `:parent' text property from output.
4388 ((stringp data) (org-no-properties data))
4389 ;; Element/Object without contents.
4390 ((not (org-element-contents data))
4391 (funcall (intern (format "org-element-%s-interpreter" type))
4392 data nil))
4393 ;; Element/Object with contents.
4395 (let* ((greaterp (memq type org-element-greater-elements))
4396 (objectp (and (not greaterp)
4397 (memq type org-element-recursive-objects)))
4398 (contents
4399 (mapconcat
4400 (lambda (obj) (org-element-interpret-data obj data))
4401 (org-element-contents
4402 (if (or greaterp objectp) data
4403 ;; Elements directly containing objects must
4404 ;; have their indentation normalized first.
4405 (org-element-normalize-contents
4406 data
4407 ;; When normalizing first paragraph of an
4408 ;; item or a footnote-definition, ignore
4409 ;; first line's indentation.
4410 (and (eq type 'paragraph)
4411 (equal data (car (org-element-contents parent)))
4412 (memq (org-element-type parent)
4413 '(footnote-definition item))))))
4414 "")))
4415 (funcall (intern (format "org-element-%s-interpreter" type))
4416 data
4417 (if greaterp (org-element-normalize-contents contents)
4418 contents)))))))
4419 (if (memq type '(org-data plain-text nil)) results
4420 ;; Build white spaces. If no `:post-blank' property is
4421 ;; specified, assume its value is 0.
4422 (let ((post-blank (or (org-element-property :post-blank data) 0)))
4423 (if (memq type org-element-all-objects)
4424 (concat results (make-string post-blank 32))
4425 (concat
4426 (org-element--interpret-affiliated-keywords data)
4427 (org-element-normalize-string results)
4428 (make-string post-blank 10)))))))
4430 (defun org-element--interpret-affiliated-keywords (element)
4431 "Return ELEMENT's affiliated keywords as Org syntax.
4432 If there is no affiliated keyword, return the empty string."
4433 (let ((keyword-to-org
4434 (function
4435 (lambda (key value)
4436 (let (dual)
4437 (when (member key org-element-dual-keywords)
4438 (setq dual (cdr value) value (car value)))
4439 (concat "#+" key
4440 (and dual
4441 (format "[%s]" (org-element-interpret-data dual)))
4442 ": "
4443 (if (member key org-element-parsed-keywords)
4444 (org-element-interpret-data value)
4445 value)
4446 "\n"))))))
4447 (mapconcat
4448 (lambda (prop)
4449 (let ((value (org-element-property prop element))
4450 (keyword (upcase (substring (symbol-name prop) 1))))
4451 (when value
4452 (if (or (member keyword org-element-multiple-keywords)
4453 ;; All attribute keywords can have multiple lines.
4454 (string-match "^ATTR_" keyword))
4455 (mapconcat (lambda (line) (funcall keyword-to-org keyword line))
4456 (reverse value)
4458 (funcall keyword-to-org keyword value)))))
4459 ;; List all ELEMENT's properties matching an attribute line or an
4460 ;; affiliated keyword, but ignore translated keywords since they
4461 ;; cannot belong to the property list.
4462 (loop for prop in (nth 1 element) by 'cddr
4463 when (let ((keyword (upcase (substring (symbol-name prop) 1))))
4464 (or (string-match "^ATTR_" keyword)
4465 (and
4466 (member keyword org-element-affiliated-keywords)
4467 (not (assoc keyword
4468 org-element-keyword-translation-alist)))))
4469 collect prop)
4470 "")))
4472 ;; Because interpretation of the parse tree must return the same
4473 ;; number of blank lines between elements and the same number of white
4474 ;; space after objects, some special care must be given to white
4475 ;; spaces.
4477 ;; The first function, `org-element-normalize-string', ensures any
4478 ;; string different from the empty string will end with a single
4479 ;; newline character.
4481 ;; The second function, `org-element-normalize-contents', removes
4482 ;; global indentation from the contents of the current element.
4484 (defun org-element-normalize-string (s)
4485 "Ensure string S ends with a single newline character.
4487 If S isn't a string return it unchanged. If S is the empty
4488 string, return it. Otherwise, return a new string with a single
4489 newline character at its end."
4490 (cond
4491 ((not (stringp s)) s)
4492 ((string= "" s) "")
4493 (t (and (string-match "\\(\n[ \t]*\\)*\\'" s)
4494 (replace-match "\n" nil nil s)))))
4496 (defun org-element-normalize-contents (element &optional ignore-first)
4497 "Normalize plain text in ELEMENT's contents.
4499 ELEMENT must only contain plain text and objects.
4501 If optional argument IGNORE-FIRST is non-nil, ignore first line's
4502 indentation to compute maximal common indentation.
4504 Return the normalized element that is element with global
4505 indentation removed from its contents. The function assumes that
4506 indentation is not done with TAB characters."
4507 (let* (ind-list ; for byte-compiler
4508 collect-inds ; for byte-compiler
4509 (collect-inds
4510 (function
4511 ;; Return list of indentations within BLOB. This is done by
4512 ;; walking recursively BLOB and updating IND-LIST along the
4513 ;; way. FIRST-FLAG is non-nil when the first string hasn't
4514 ;; been seen yet. It is required as this string is the only
4515 ;; one whose indentation doesn't happen after a newline
4516 ;; character.
4517 (lambda (blob first-flag)
4518 (mapc
4519 (lambda (object)
4520 (when (and first-flag (stringp object))
4521 (setq first-flag nil)
4522 (string-match "\\`\\( *\\)" object)
4523 (let ((len (length (match-string 1 object))))
4524 ;; An indentation of zero means no string will be
4525 ;; modified. Quit the process.
4526 (if (zerop len) (throw 'zero (setq ind-list nil))
4527 (push len ind-list))))
4528 (cond
4529 ((stringp object)
4530 (let ((start 0))
4531 ;; Avoid matching blank or empty lines.
4532 (while (and (string-match "\n\\( *\\)\\(.\\)" object start)
4533 (not (equal (match-string 2 object) " ")))
4534 (setq start (match-end 0))
4535 (push (length (match-string 1 object)) ind-list))))
4536 ((memq (org-element-type object) org-element-recursive-objects)
4537 (funcall collect-inds object first-flag))))
4538 (org-element-contents blob))))))
4539 ;; Collect indentation list in ELEMENT. Possibly remove first
4540 ;; value if IGNORE-FIRST is non-nil.
4541 (catch 'zero (funcall collect-inds element (not ignore-first)))
4542 (if (not ind-list) element
4543 ;; Build ELEMENT back, replacing each string with the same
4544 ;; string minus common indentation.
4545 (let* (build ; For byte compiler.
4546 (build
4547 (function
4548 (lambda (blob mci first-flag)
4549 ;; Return BLOB with all its strings indentation
4550 ;; shortened from MCI white spaces. FIRST-FLAG is
4551 ;; non-nil when the first string hasn't been seen
4552 ;; yet.
4553 (setcdr (cdr blob)
4554 (mapcar
4555 (lambda (object)
4556 (when (and first-flag (stringp object))
4557 (setq first-flag nil)
4558 (setq object
4559 (replace-regexp-in-string
4560 (format "\\` \\{%d\\}" mci) "" object)))
4561 (cond
4562 ((stringp object)
4563 (replace-regexp-in-string
4564 (format "\n \\{%d\\}" mci) "\n" object))
4565 ((memq (org-element-type object)
4566 org-element-recursive-objects)
4567 (funcall build object mci first-flag))
4568 (t object)))
4569 (org-element-contents blob)))
4570 blob))))
4571 (funcall build element (apply 'min ind-list) (not ignore-first))))))
4575 ;;; The Toolbox
4577 ;; The first move is to implement a way to obtain the smallest element
4578 ;; containing point. This is the job of `org-element-at-point'. It
4579 ;; basically jumps back to the beginning of section containing point
4580 ;; and moves, element after element, with
4581 ;; `org-element--current-element' until the container is found. Note:
4582 ;; When using `org-element-at-point', secondary values are never
4583 ;; parsed since the function focuses on elements, not on objects.
4585 ;; At a deeper level, `org-element-context' lists all elements and
4586 ;; objects containing point.
4588 ;; `org-element-nested-p' and `org-element-swap-A-B' may be used
4589 ;; internally by navigation and manipulation tools.
4591 ;;;###autoload
4592 (defun org-element-at-point (&optional keep-trail)
4593 "Determine closest element around point.
4595 Return value is a list like (TYPE PROPS) where TYPE is the type
4596 of the element and PROPS a plist of properties associated to the
4597 element.
4599 Possible types are defined in `org-element-all-elements'.
4600 Properties depend on element or object type, but always include
4601 `:begin', `:end', `:parent' and `:post-blank' properties.
4603 As a special case, if point is at the very beginning of a list or
4604 sub-list, returned element will be that list instead of the first
4605 item. In the same way, if point is at the beginning of the first
4606 row of a table, returned element will be the table instead of the
4607 first row.
4609 If optional argument KEEP-TRAIL is non-nil, the function returns
4610 a list of elements leading to element at point. The list's CAR
4611 is always the element at point. The following positions contain
4612 element's siblings, then parents, siblings of parents, until the
4613 first element of current section."
4614 (org-with-wide-buffer
4615 ;; If at a headline, parse it. It is the sole element that
4616 ;; doesn't require to know about context. Be sure to disallow
4617 ;; secondary string parsing, though.
4618 (if (org-with-limited-levels (org-at-heading-p))
4619 (progn
4620 (beginning-of-line)
4621 (if (not keep-trail) (org-element-headline-parser (point-max) t)
4622 (list (org-element-headline-parser (point-max) t))))
4623 ;; Otherwise move at the beginning of the section containing
4624 ;; point.
4625 (catch 'exit
4626 (let ((origin (point))
4627 (end (save-excursion
4628 (org-with-limited-levels (outline-next-heading)) (point)))
4629 element type special-flag trail struct prevs parent)
4630 (org-with-limited-levels
4631 (if (org-before-first-heading-p)
4632 ;; In empty lines at buffer's beginning, return nil.
4633 (progn (goto-char (point-min))
4634 (org-skip-whitespace)
4635 (when (or (eobp) (> (line-beginning-position) origin))
4636 (throw 'exit nil)))
4637 (org-back-to-heading)
4638 (forward-line)
4639 (org-skip-whitespace)
4640 (when (> (line-beginning-position) origin)
4641 ;; In blank lines just after the headline, point still
4642 ;; belongs to the headline.
4643 (throw 'exit
4644 (progn (org-back-to-heading)
4645 (if (not keep-trail)
4646 (org-element-headline-parser (point-max) t)
4647 (list (org-element-headline-parser
4648 (point-max) t))))))))
4649 (beginning-of-line)
4650 ;; Parse successively each element, skipping those ending
4651 ;; before original position.
4652 (while t
4653 (setq element
4654 (org-element--current-element end 'element special-flag struct)
4655 type (car element))
4656 (org-element-put-property element :parent parent)
4657 (when keep-trail (push element trail))
4658 (cond
4659 ;; 1. Skip any element ending before point. Also skip
4660 ;; element ending at point when we're sure that another
4661 ;; element has started.
4662 ((let ((elem-end (org-element-property :end element)))
4663 (when (or (< elem-end origin)
4664 (and (= elem-end origin) (/= elem-end end)))
4665 (goto-char elem-end))))
4666 ;; 2. An element containing point is always the element at
4667 ;; point.
4668 ((not (memq type org-element-greater-elements))
4669 (throw 'exit (if keep-trail trail element)))
4670 ;; 3. At any other greater element type, if point is
4671 ;; within contents, move into it.
4673 (let ((cbeg (org-element-property :contents-begin element))
4674 (cend (org-element-property :contents-end element)))
4675 (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
4676 ;; Create an anchor for tables and plain lists:
4677 ;; when point is at the very beginning of these
4678 ;; elements, ignoring affiliated keywords,
4679 ;; target them instead of their contents.
4680 (and (= cbeg origin) (memq type '(plain-list table)))
4681 ;; When point is at contents end, do not move
4682 ;; into elements with an explicit ending, but
4683 ;; return that element instead.
4684 (and (= cend origin)
4685 (memq type
4686 '(center-block
4687 drawer dynamic-block inlinetask item
4688 plain-list property-drawer quote-block
4689 special-block))))
4690 (throw 'exit (if keep-trail trail element))
4691 (setq parent element)
4692 (case type
4693 (plain-list
4694 (setq special-flag 'item
4695 struct (org-element-property :structure element)))
4696 (item (setq special-flag nil))
4697 (property-drawer
4698 (setq special-flag 'node-property struct nil))
4699 (table (setq special-flag 'table-row struct nil))
4700 (otherwise (setq special-flag nil struct nil)))
4701 (setq end cend)
4702 (goto-char cbeg)))))))))))
4704 ;;;###autoload
4705 (defun org-element-context (&optional element)
4706 "Return closest element or object around point.
4708 Return value is a list like (TYPE PROPS) where TYPE is the type
4709 of the element or object and PROPS a plist of properties
4710 associated to it.
4712 Possible types are defined in `org-element-all-elements' and
4713 `org-element-all-objects'. Properties depend on element or
4714 object type, but always include `:begin', `:end', `:parent' and
4715 `:post-blank'.
4717 Optional argument ELEMENT, when non-nil, is the closest element
4718 containing point, as returned by `org-element-at-point'.
4719 Providing it allows for quicker computation."
4720 (org-with-wide-buffer
4721 (let* ((origin (point))
4722 (element (or element (org-element-at-point)))
4723 (type (org-element-type element))
4724 end)
4725 ;; Check if point is inside an element containing objects or at
4726 ;; a secondary string. In that case, move to beginning of the
4727 ;; element or secondary string and set END to the other side.
4728 (if (not (or (let ((post (org-element-property :post-affiliated element)))
4729 (and post (> post origin)
4730 (< (org-element-property :begin element) origin)
4731 (progn (beginning-of-line)
4732 (looking-at org-element--affiliated-re)
4733 (member (upcase (match-string 1))
4734 org-element-parsed-keywords))
4735 ;; We're at an affiliated keyword. Change
4736 ;; type to retrieve correct restrictions.
4737 (setq type 'keyword)
4738 ;; Determine if we're at main or dual value.
4739 (if (and (match-end 2) (<= origin (match-end 2)))
4740 (progn (goto-char (match-beginning 2))
4741 (setq end (match-end 2)))
4742 (goto-char (match-end 0))
4743 (setq end (line-end-position)))))
4744 (and (eq type 'item)
4745 (let ((tag (org-element-property :tag element)))
4746 (and tag
4747 (progn
4748 (beginning-of-line)
4749 (search-forward tag (point-at-eol))
4750 (goto-char (match-beginning 0))
4751 (and (>= origin (point))
4752 (<= origin
4753 ;; `1+' is required so some
4754 ;; successors can match
4755 ;; properly their object.
4756 (setq end (1+ (match-end 0)))))))))
4757 (and (memq type '(headline inlinetask))
4758 (progn (beginning-of-line)
4759 (skip-chars-forward "* ")
4760 (setq end (point-at-eol))))
4761 (and (memq type '(paragraph table-row verse-block))
4762 (let ((cbeg (org-element-property
4763 :contents-begin element))
4764 (cend (org-element-property
4765 :contents-end element)))
4766 (and (>= origin cbeg)
4767 (<= origin cend)
4768 (progn (goto-char cbeg) (setq end cend)))))
4769 (and (eq type 'keyword)
4770 (let ((key (org-element-property :key element)))
4771 (and (member key org-element-document-properties)
4772 (progn (beginning-of-line)
4773 (search-forward key (line-end-position) t)
4774 (forward-char)
4775 (setq end (line-end-position))))))))
4776 element
4777 (let ((restriction (org-element-restriction type))
4778 (parent element)
4779 (candidates 'initial))
4780 (catch 'exit
4781 (while (setq candidates (org-element--get-next-object-candidates
4782 end restriction candidates))
4783 (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
4784 candidates)))
4785 ;; If ORIGIN is before next object in element, there's
4786 ;; no point in looking further.
4787 (if (> (cdr closest-cand) origin) (throw 'exit parent)
4788 (let* ((object
4789 (progn (goto-char (cdr closest-cand))
4790 (funcall (intern (format "org-element-%s-parser"
4791 (car closest-cand))))))
4792 (cbeg (org-element-property :contents-begin object))
4793 (cend (org-element-property :contents-end object))
4794 (obj-end (org-element-property :end object)))
4795 (cond
4796 ;; ORIGIN is after OBJECT, so skip it.
4797 ((<= obj-end origin)
4798 (if (/= obj-end end) (goto-char obj-end)
4799 (throw 'exit
4800 (org-element-put-property
4801 object :parent parent))))
4802 ;; ORIGIN is within a non-recursive object or at
4803 ;; an object boundaries: Return that object.
4804 ((or (not cbeg) (> cbeg origin) (< cend origin))
4805 (throw 'exit
4806 (org-element-put-property object :parent parent)))
4807 ;; Otherwise, move within current object and
4808 ;; restrict search to the end of its contents.
4809 (t (goto-char cbeg)
4810 (org-element-put-property object :parent parent)
4811 (setq parent object
4812 restriction (org-element-restriction object)
4813 candidates 'initial
4814 end cend)))))))
4815 parent))))))
4817 (defun org-element-nested-p (elem-A elem-B)
4818 "Non-nil when elements ELEM-A and ELEM-B are nested."
4819 (let ((beg-A (org-element-property :begin elem-A))
4820 (beg-B (org-element-property :begin elem-B))
4821 (end-A (org-element-property :end elem-A))
4822 (end-B (org-element-property :end elem-B)))
4823 (or (and (>= beg-A beg-B) (<= end-A end-B))
4824 (and (>= beg-B beg-A) (<= end-B end-A)))))
4826 (defun org-element-swap-A-B (elem-A elem-B)
4827 "Swap elements ELEM-A and ELEM-B.
4828 Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
4829 end of ELEM-A."
4830 (goto-char (org-element-property :begin elem-A))
4831 ;; There are two special cases when an element doesn't start at bol:
4832 ;; the first paragraph in an item or in a footnote definition.
4833 (let ((specialp (not (bolp))))
4834 ;; Only a paragraph without any affiliated keyword can be moved at
4835 ;; ELEM-A position in such a situation. Note that the case of
4836 ;; a footnote definition is impossible: it cannot contain two
4837 ;; paragraphs in a row because it cannot contain a blank line.
4838 (if (and specialp
4839 (or (not (eq (org-element-type elem-B) 'paragraph))
4840 (/= (org-element-property :begin elem-B)
4841 (org-element-property :contents-begin elem-B))))
4842 (error "Cannot swap elements"))
4843 ;; In a special situation, ELEM-A will have no indentation. We'll
4844 ;; give it ELEM-B's (which will in, in turn, have no indentation).
4845 (let* ((ind-B (when specialp
4846 (goto-char (org-element-property :begin elem-B))
4847 (org-get-indentation)))
4848 (beg-A (org-element-property :begin elem-A))
4849 (end-A (save-excursion
4850 (goto-char (org-element-property :end elem-A))
4851 (skip-chars-backward " \r\t\n")
4852 (point-at-eol)))
4853 (beg-B (org-element-property :begin elem-B))
4854 (end-B (save-excursion
4855 (goto-char (org-element-property :end elem-B))
4856 (skip-chars-backward " \r\t\n")
4857 (point-at-eol)))
4858 ;; Store overlays responsible for visibility status. We
4859 ;; also need to store their boundaries as they will be
4860 ;; removed from buffer.
4861 (overlays
4862 (cons
4863 (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
4864 (overlays-in beg-A end-A))
4865 (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
4866 (overlays-in beg-B end-B))))
4867 ;; Get contents.
4868 (body-A (buffer-substring beg-A end-A))
4869 (body-B (delete-and-extract-region beg-B end-B)))
4870 (goto-char beg-B)
4871 (when specialp
4872 (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
4873 (org-indent-to-column ind-B))
4874 (insert body-A)
4875 ;; Restore ex ELEM-A overlays.
4876 (let ((offset (- beg-B beg-A)))
4877 (mapc (lambda (ov)
4878 (move-overlay
4879 (car ov) (+ (nth 1 ov) offset) (+ (nth 2 ov) offset)))
4880 (car overlays))
4881 (goto-char beg-A)
4882 (delete-region beg-A end-A)
4883 (insert body-B)
4884 ;; Restore ex ELEM-B overlays.
4885 (mapc (lambda (ov)
4886 (move-overlay
4887 (car ov) (- (nth 1 ov) offset) (- (nth 2 ov) offset)))
4888 (cdr overlays)))
4889 (goto-char (org-element-property :end elem-B)))))
4891 (provide 'org-element)
4893 ;; Local variables:
4894 ;; generated-autoload-file: "org-loaddefs.el"
4895 ;; End:
4897 ;;; org-element.el ends here