org-e-latex: Correctly export statistics cookies with percents
[org-mode.git] / lisp / org-element.el
blob711c7916c49d2bacf4355c920e4396d74664d97f
1 ;;; org-element.el --- Parser And Applications for Org syntax
3 ;; Copyright (C) 2012 Free Software Foundation, Inc.
5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
6 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; This file is not part of GNU Emacs.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. 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 (namely `babel-call', `clock', `headline', `item',
34 ;; `keyword', `planning', `property-drawer' and `section' types), it
35 ;; can also accept a fixed set of keywords as attributes. Those are
36 ;; called "affiliated keywords" to distinguish them from other
37 ;; keywords, which are full-fledged elements. Almost all affiliated
38 ;; keywords are referenced in `org-element-affiliated-keywords'; the
39 ;; others are export attributes and start with "ATTR_" prefix.
41 ;; Element containing other elements (and only elements) are called
42 ;; greater elements. Concerned types are: `center-block', `drawer',
43 ;; `dynamic-block', `footnote-definition', `headline', `inlinetask',
44 ;; `item', `plain-list', `quote-block', `section' and `special-block'.
46 ;; Other element types are: `babel-call', `clock', `comment',
47 ;; `comment-block', `example-block', `export-block', `fixed-width',
48 ;; `horizontal-rule', `keyword', `latex-environment', `paragraph',
49 ;; `planning', `property-drawer', `quote-section', `src-block',
50 ;; `table', `table-row' and `verse-block'. Among them, `paragraph'
51 ;; and `verse-block' types can contain Org objects and plain text.
53 ;; Objects are related to document's contents. Some of them are
54 ;; recursive. Associated types are of the following: `bold', `code',
55 ;; `entity', `export-snippet', `footnote-reference',
56 ;; `inline-babel-call', `inline-src-block', `italic',
57 ;; `latex-fragment', `line-break', `link', `macro', `radio-target',
58 ;; `statistics-cookie', `strike-through', `subscript', `superscript',
59 ;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
61 ;; Some elements also have special properties whose value can hold
62 ;; objects themselves (i.e. an item tag or an headline name). Such
63 ;; values are called "secondary strings". Any object belongs to
64 ;; either an element or a secondary string.
66 ;; Notwithstanding affiliated keywords, each greater element, element
67 ;; and object has a fixed set of properties attached to it. Among
68 ;; them, four are shared by all types: `:begin' and `:end', which
69 ;; refer to the beginning and ending buffer positions of the
70 ;; considered element or object, `:post-blank', which holds the number
71 ;; of blank lines, or white spaces, at its end and `:parent' which
72 ;; refers to the element or object containing it. Greater elements
73 ;; and elements containing objects will also have `:contents-begin'
74 ;; and `:contents-end' properties to delimit contents.
76 ;; Lisp-wise, an element or an object can be represented as a list.
77 ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
78 ;; TYPE is a symbol describing the Org element or object.
79 ;; PROPERTIES is the property list attached to it. See docstring of
80 ;; appropriate parsing function to get an exhaustive
81 ;; list.
82 ;; CONTENTS is a list of elements, objects or raw strings contained
83 ;; in the current element or object, when applicable.
85 ;; An Org buffer is a nested list of such elements and objects, whose
86 ;; type is `org-data' and properties is nil.
88 ;; The first part of this file defines Org syntax, while the second
89 ;; one provide accessors and setters functions.
91 ;; The next part implements a parser and an interpreter for each
92 ;; element and object type in Org syntax.
94 ;; The following part creates a fully recursive buffer parser. It
95 ;; also provides a tool to map a function to elements or objects
96 ;; matching some criteria in the parse tree. Functions of interest
97 ;; are `org-element-parse-buffer', `org-element-map' and, to a lesser
98 ;; extent, `org-element-parse-secondary-string'.
100 ;; The penultimate part is the cradle of an interpreter for the
101 ;; obtained parse tree: `org-element-interpret-data'.
103 ;; The library ends by furnishing a set of interactive tools for
104 ;; element's navigation and manipulation, mostly based on
105 ;; `org-element-at-point' function, and a way to give information
106 ;; about document structure around point with `org-element-context'.
109 ;;; Code:
111 (eval-when-compile
112 (require 'cl))
114 (require 'org)
117 ;;; Definitions And Rules
119 ;; Define elements, greater elements and specify recursive objects,
120 ;; along with the affiliated keywords recognized. Also set up
121 ;; restrictions on recursive objects combinations.
123 ;; These variables really act as a control center for the parsing
124 ;; process.
126 (defconst org-element-paragraph-separate
127 (concat "^[ \t]*$" "\\|"
128 ;; Headlines and inlinetasks.
129 org-outline-regexp-bol "\\|"
130 ;; Comments, blocks (any type), keywords and babel calls.
131 "^[ \t]*#\\+" "\\|" "^#\\(?: \\|$\\)" "\\|"
132 ;; Lists.
133 (org-item-beginning-re) "\\|"
134 ;; Fixed-width, drawers (any type) and tables.
135 "^[ \t]*[:|]" "\\|"
136 ;; Footnote definitions.
137 org-footnote-definition-re "\\|"
138 ;; Horizontal rules.
139 "^[ \t]*-\\{5,\\}[ \t]*$" "\\|"
140 ;; LaTeX environments.
141 "^[ \t]*\\\\\\(begin\\|end\\)" "\\|"
142 ;; Planning and Clock lines.
143 org-planning-or-clock-line-re)
144 "Regexp to separate paragraphs in an Org buffer.")
146 (defconst org-element-all-elements
147 '(center-block clock comment comment-block drawer dynamic-block example-block
148 export-block fixed-width footnote-definition headline
149 horizontal-rule inlinetask item keyword latex-environment
150 babel-call paragraph plain-list planning property-drawer
151 quote-block quote-section section special-block src-block table
152 table-row verse-block)
153 "Complete list of element types.")
155 (defconst org-element-greater-elements
156 '(center-block drawer dynamic-block footnote-definition headline inlinetask
157 item plain-list quote-block section special-block table)
158 "List of recursive element types aka Greater Elements.")
160 (defconst org-element-all-successors
161 '(export-snippet footnote-reference inline-babel-call inline-src-block
162 latex-or-entity line-break link macro radio-target
163 statistics-cookie sub/superscript table-cell target
164 text-markup timestamp)
165 "Complete list of successors.")
167 (defconst org-element-object-successor-alist
168 '((subscript . sub/superscript) (superscript . sub/superscript)
169 (bold . text-markup) (code . text-markup) (italic . text-markup)
170 (strike-through . text-markup) (underline . text-markup)
171 (verbatim . text-markup) (entity . latex-or-entity)
172 (latex-fragment . latex-or-entity))
173 "Alist of translations between object type and successor name.
175 Sharing the same successor comes handy when, for example, the
176 regexp matching one object can also match the other object.")
178 (defconst org-element-all-objects
179 '(bold code entity export-snippet footnote-reference inline-babel-call
180 inline-src-block italic line-break latex-fragment link macro
181 radio-target statistics-cookie strike-through subscript superscript
182 table-cell target timestamp underline verbatim)
183 "Complete list of object types.")
185 (defconst org-element-recursive-objects
186 '(bold italic link macro subscript radio-target strike-through superscript
187 table-cell underline)
188 "List of recursive object types.")
190 (defconst org-element-block-name-alist
191 '(("CENTER" . org-element-center-block-parser)
192 ("COMMENT" . org-element-comment-block-parser)
193 ("EXAMPLE" . org-element-example-block-parser)
194 ("QUOTE" . org-element-quote-block-parser)
195 ("SRC" . org-element-src-block-parser)
196 ("VERSE" . org-element-verse-block-parser))
197 "Alist between block names and the associated parsing function.
198 Names must be uppercase. Any block whose name has no association
199 is parsed with `org-element-special-block-parser'.")
201 (defconst org-element-affiliated-keywords
202 '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
203 "RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
204 "List of affiliated keywords as strings.
205 By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
206 are affiliated keywords and need not to be in this list.")
208 (defconst org-element--affiliated-re
209 (format "[ \t]*#\\+%s:"
210 ;; Regular affiliated keywords.
211 (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?"
212 (regexp-opt org-element-affiliated-keywords)))
213 "Regexp matching any affiliated keyword.
215 Keyword name is put in match group 1. Moreover, if keyword
216 belongs to `org-element-dual-keywords', put the dual value in
217 match group 2.
219 Don't modify it, set `org-element-affiliated-keywords' instead.")
221 (defconst org-element-keyword-translation-alist
222 '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
223 ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
224 ("RESULT" . "RESULTS") ("HEADERS" . "HEADER"))
225 "Alist of usual translations for keywords.
226 The key is the old name and the value the new one. The property
227 holding their value will be named after the translated name.")
229 (defconst org-element-multiple-keywords '("HEADER")
230 "List of affiliated keywords that can occur more that once in an element.
232 Their value will be consed into a list of strings, which will be
233 returned as the value of the property.
235 This list is checked after translations have been applied. See
236 `org-element-keyword-translation-alist'.
238 By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
239 allow multiple occurrences and need not to be in this list.")
241 (defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE")
242 "List of keywords whose value can be parsed.
244 Their value will be stored as a secondary string: a list of
245 strings and objects.
247 This list is checked after translations have been applied. See
248 `org-element-keyword-translation-alist'.")
250 (defconst org-element-dual-keywords '("CAPTION" "RESULTS")
251 "List of keywords which can have a secondary value.
253 In Org syntax, they can be written with optional square brackets
254 before the colons. For example, results keyword can be
255 associated to a hash value with the following:
257 #+RESULTS[hash-string]: some-source
259 This list is checked after translations have been applied. See
260 `org-element-keyword-translation-alist'.")
262 (defconst org-element-object-restrictions
263 '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link
264 radio-target sub/superscript target text-markup timestamp)
265 (footnote-reference export-snippet footnote-reference inline-babel-call
266 inline-src-block latex-or-entity line-break link macro
267 radio-target sub/superscript target text-markup
268 timestamp)
269 (headline inline-babel-call inline-src-block latex-or-entity link macro
270 radio-target statistics-cookie sub/superscript target text-markup
271 timestamp)
272 (inlinetask inline-babel-call inline-src-block latex-or-entity link macro
273 radio-target sub/superscript target text-markup timestamp)
274 (italic export-snippet inline-babel-call inline-src-block latex-or-entity
275 link radio-target sub/superscript target text-markup timestamp)
276 (item export-snippet footnote-reference inline-babel-call latex-or-entity
277 link macro radio-target sub/superscript target text-markup)
278 (keyword latex-or-entity macro sub/superscript text-markup)
279 (link export-snippet inline-babel-call inline-src-block latex-or-entity link
280 sub/superscript text-markup)
281 (macro macro)
282 (paragraph export-snippet footnote-reference inline-babel-call
283 inline-src-block latex-or-entity line-break link macro
284 radio-target statistics-cookie sub/superscript target text-markup
285 timestamp)
286 (radio-target export-snippet latex-or-entity sub/superscript)
287 (strike-through export-snippet inline-babel-call inline-src-block
288 latex-or-entity link radio-target sub/superscript target
289 text-markup timestamp)
290 (subscript export-snippet inline-babel-call inline-src-block latex-or-entity
291 sub/superscript target text-markup)
292 (superscript export-snippet inline-babel-call inline-src-block
293 latex-or-entity sub/superscript target text-markup)
294 (table-cell export-snippet latex-or-entity link macro radio-target
295 sub/superscript target text-markup timestamp)
296 (table-row table-cell)
297 (underline export-snippet inline-babel-call inline-src-block latex-or-entity
298 link radio-target sub/superscript target text-markup timestamp)
299 (verse-block footnote-reference inline-babel-call inline-src-block
300 latex-or-entity line-break link macro radio-target
301 sub/superscript target text-markup timestamp))
302 "Alist of objects restrictions.
304 CAR is an element or object type containing objects and CDR is
305 a list of successors that will be called within an element or
306 object of such type.
308 For example, in a `radio-target' object, one can only find
309 entities, export snippets, latex-fragments, subscript and
310 superscript.
312 This alist also applies to secondary string. For example, an
313 `headline' type element doesn't directly contain objects, but
314 still has an entry since one of its properties (`:title') does.")
316 (defconst org-element-secondary-value-alist
317 '((headline . :title)
318 (inlinetask . :title)
319 (item . :tag)
320 (footnote-reference . :inline-definition))
321 "Alist between element types and location of secondary value.")
325 ;;; Accessors and Setters
327 ;; Provide four accessors: `org-element-type', `org-element-property'
328 ;; `org-element-contents' and `org-element-restriction'.
330 ;; Setter functions allow to modify elements by side effect. There is
331 ;; `org-element-put-property', `org-element-set-contents',
332 ;; `org-element-set-element' and `org-element-adopt-element'. Note
333 ;; that `org-element-set-element' and `org-element-adopt-element' are
334 ;; higher level functions since also update `:parent' property.
336 (defsubst org-element-type (element)
337 "Return type of ELEMENT.
339 The function returns the type of the element or object provided.
340 It can also return the following special value:
341 `plain-text' for a string
342 `org-data' for a complete document
343 nil in any other case."
344 (cond
345 ((not (consp element)) (and (stringp element) 'plain-text))
346 ((symbolp (car element)) (car element))))
348 (defsubst org-element-property (property element)
349 "Extract the value from the PROPERTY of an ELEMENT."
350 (plist-get (nth 1 element) property))
352 (defsubst org-element-contents (element)
353 "Extract contents from an ELEMENT."
354 (and (consp element) (nthcdr 2 element)))
356 (defsubst org-element-restriction (element)
357 "Return restriction associated to ELEMENT.
358 ELEMENT can be an element, an object or a symbol representing an
359 element or object type."
360 (cdr (assq (if (symbolp element) element (org-element-type element))
361 org-element-object-restrictions)))
363 (defsubst org-element-put-property (element property value)
364 "In ELEMENT set PROPERTY to VALUE.
365 Return modified element."
366 (when (consp element)
367 (setcar (cdr element) (plist-put (nth 1 element) property value)))
368 element)
370 (defsubst org-element-set-contents (element &rest contents)
371 "Set ELEMENT contents to CONTENTS.
372 Return modified element."
373 (cond ((not element) (list contents))
374 ((cdr element) (setcdr (cdr element) contents))
375 (t (nconc element contents))))
377 (defsubst org-element-set-element (old new)
378 "Replace element or object OLD with element or object NEW.
379 The function takes care of setting `:parent' property for NEW."
380 ;; OLD can belong to the contents of PARENT or to its secondary
381 ;; string.
382 (let* ((parent (org-element-property :parent old))
383 (sec-loc (cdr (assq (org-element-type parent)
384 org-element-secondary-value-alist)))
385 (sec-value (and sec-loc (org-element-property sec-loc parent)))
386 (place (or (memq old sec-value) (memq old parent))))
387 ;; Make sure NEW has correct `:parent' property.
388 (org-element-put-property new :parent parent)
389 ;; Replace OLD with NEW in PARENT.
390 (setcar place new)))
392 (defsubst org-element-adopt-element (parent child &optional append)
393 "Add an element to the contents of another element.
395 PARENT is an element or object. CHILD is an element, an object,
396 or a string.
398 CHILD is added at the beginning of PARENT contents, unless the
399 optional argument APPEND is non-nil, in which case CHILD is added
400 at the end.
402 The function takes care of setting `:parent' property for CHILD.
403 Return parent element."
404 (if (not parent) (list child)
405 (let ((contents (org-element-contents parent)))
406 (apply 'org-element-set-contents
407 parent
408 (if append (append contents (list child)) (cons child contents))))
409 ;; Link the CHILD element with PARENT.
410 (when (consp child) (org-element-put-property child :parent parent))
411 ;; Return the parent element.
412 parent))
416 ;;; Greater elements
418 ;; For each greater element type, we define a parser and an
419 ;; interpreter.
421 ;; A parser returns the element or object as the list described above.
422 ;; Most of them accepts no argument. Though, exceptions exist. Hence
423 ;; every element containing a secondary string (see
424 ;; `org-element-secondary-value-alist') will accept an optional
425 ;; argument to toggle parsing of that secondary string. Moreover,
426 ;; `item' parser requires current list's structure as its first
427 ;; element.
429 ;; An interpreter accepts two arguments: the list representation of
430 ;; the element or object, and its contents. The latter may be nil,
431 ;; depending on the element or object considered. It returns the
432 ;; appropriate Org syntax, as a string.
434 ;; Parsing functions must follow the naming convention:
435 ;; org-element-TYPE-parser, where TYPE is greater element's type, as
436 ;; defined in `org-element-greater-elements'.
438 ;; Similarly, interpreting functions must follow the naming
439 ;; convention: org-element-TYPE-interpreter.
441 ;; With the exception of `headline' and `item' types, greater elements
442 ;; cannot contain other greater elements of their own type.
444 ;; Beside implementing a parser and an interpreter, adding a new
445 ;; greater element requires to tweak `org-element--current-element'.
446 ;; Moreover, the newly defined type must be added to both
447 ;; `org-element-all-elements' and `org-element-greater-elements'.
450 ;;;; Center Block
452 (defun org-element-center-block-parser (limit)
453 "Parse a center block.
455 LIMIT bounds the search.
457 Return a list whose CAR is `center-block' and CDR is a plist
458 containing `:begin', `:end', `:hiddenp', `:contents-begin',
459 `:contents-end' and `:post-blank' keywords.
461 Assume point is at the beginning of the block."
462 (let ((case-fold-search t))
463 (if (not (save-excursion
464 (re-search-forward "^[ \t]*#\\+END_CENTER" limit t)))
465 ;; Incomplete block: parse it as a comment.
466 (org-element-comment-parser limit)
467 (let ((block-end-line (match-beginning 0)))
468 (let* ((keywords (org-element--collect-affiliated-keywords))
469 (begin (car keywords))
470 ;; Empty blocks have no contents.
471 (contents-begin (progn (forward-line)
472 (and (< (point) block-end-line)
473 (point))))
474 (contents-end (and contents-begin block-end-line))
475 (hidden (org-invisible-p2))
476 (pos-before-blank (progn (goto-char block-end-line)
477 (forward-line)
478 (point)))
479 (end (save-excursion (skip-chars-forward " \r\t\n" limit)
480 (if (eobp) (point) (point-at-bol)))))
481 (list 'center-block
482 (nconc
483 (list :begin begin
484 :end end
485 :hiddenp hidden
486 :contents-begin contents-begin
487 :contents-end contents-end
488 :post-blank (count-lines pos-before-blank end))
489 (cadr keywords))))))))
491 (defun org-element-center-block-interpreter (center-block contents)
492 "Interpret CENTER-BLOCK element as Org syntax.
493 CONTENTS is the contents of the element."
494 (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
497 ;;;; Drawer
499 (defun org-element-drawer-parser (limit)
500 "Parse a drawer.
502 LIMIT bounds the search.
504 Return a list whose CAR is `drawer' and CDR is a plist containing
505 `:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
506 `:contents-end' and `:post-blank' keywords.
508 Assume point is at beginning of drawer."
509 (let ((case-fold-search t))
510 (if (not (save-excursion (re-search-forward "^[ \t]*:END:" limit t)))
511 ;; Incomplete drawer: parse it as a paragraph.
512 (org-element-paragraph-parser limit)
513 (let ((drawer-end-line (match-beginning 0)))
514 (save-excursion
515 (let* ((case-fold-search t)
516 (name (progn (looking-at org-drawer-regexp)
517 (org-match-string-no-properties 1)))
518 (keywords (org-element--collect-affiliated-keywords))
519 (begin (car keywords))
520 ;; Empty drawers have no contents.
521 (contents-begin (progn (forward-line)
522 (and (< (point) drawer-end-line)
523 (point))))
524 (contents-end (and contents-begin drawer-end-line))
525 (hidden (org-invisible-p2))
526 (pos-before-blank (progn (goto-char drawer-end-line)
527 (forward-line)
528 (point)))
529 (end (progn (skip-chars-forward " \r\t\n" limit)
530 (if (eobp) (point) (point-at-bol)))))
531 (list 'drawer
532 (nconc
533 (list :begin begin
534 :end end
535 :drawer-name name
536 :hiddenp hidden
537 :contents-begin contents-begin
538 :contents-end contents-end
539 :post-blank (count-lines pos-before-blank end))
540 (cadr keywords)))))))))
542 (defun org-element-drawer-interpreter (drawer contents)
543 "Interpret DRAWER element as Org syntax.
544 CONTENTS is the contents of the element."
545 (format ":%s:\n%s:END:"
546 (org-element-property :drawer-name drawer)
547 contents))
550 ;;;; Dynamic Block
552 (defun org-element-dynamic-block-parser (limit)
553 "Parse a dynamic block.
555 LIMIT bounds the search.
557 Return a list whose CAR is `dynamic-block' and CDR is a plist
558 containing `:block-name', `:begin', `:end', `:hiddenp',
559 `:contents-begin', `:contents-end', `:arguments' and
560 `:post-blank' keywords.
562 Assume point is at beginning of dynamic block."
563 (let ((case-fold-search t))
564 (if (not (save-excursion (re-search-forward org-dblock-end-re limit t)))
565 ;; Incomplete block: parse it as a comment.
566 (org-element-comment-parser limit)
567 (let ((block-end-line (match-beginning 0)))
568 (save-excursion
569 (let* ((name (progn (looking-at org-dblock-start-re)
570 (org-match-string-no-properties 1)))
571 (arguments (org-match-string-no-properties 3))
572 (keywords (org-element--collect-affiliated-keywords))
573 (begin (car keywords))
574 ;; Empty blocks have no contents.
575 (contents-begin (progn (forward-line)
576 (and (< (point) block-end-line)
577 (point))))
578 (contents-end (and contents-begin block-end-line))
579 (hidden (org-invisible-p2))
580 (pos-before-blank (progn (goto-char block-end-line)
581 (forward-line)
582 (point)))
583 (end (progn (skip-chars-forward " \r\t\n" limit)
584 (if (eobp) (point) (point-at-bol)))))
585 (list 'dynamic-block
586 (nconc
587 (list :begin begin
588 :end end
589 :block-name name
590 :arguments arguments
591 :hiddenp hidden
592 :contents-begin contents-begin
593 :contents-end contents-end
594 :post-blank (count-lines pos-before-blank end))
595 (cadr keywords)))))))))
597 (defun org-element-dynamic-block-interpreter (dynamic-block contents)
598 "Interpret DYNAMIC-BLOCK element as Org syntax.
599 CONTENTS is the contents of the element."
600 (format "#+BEGIN: %s%s\n%s#+END:"
601 (org-element-property :block-name dynamic-block)
602 (let ((args (org-element-property :arguments dynamic-block)))
603 (and args (concat " " args)))
604 contents))
607 ;;;; Footnote Definition
609 (defun org-element-footnote-definition-parser (limit)
610 "Parse a footnote definition.
612 LIMIT bounds the search.
614 Return a list whose CAR is `footnote-definition' and CDR is
615 a plist containing `:label', `:begin' `:end', `:contents-begin',
616 `:contents-end' and `:post-blank' keywords.
618 Assume point is at the beginning of the footnote definition."
619 (save-excursion
620 (let* ((label (progn (looking-at org-footnote-definition-re)
621 (org-match-string-no-properties 1)))
622 (keywords (org-element--collect-affiliated-keywords))
623 (begin (car keywords))
624 (ending (save-excursion
625 (if (progn
626 (end-of-line)
627 (re-search-forward
628 (concat org-outline-regexp-bol "\\|"
629 org-footnote-definition-re "\\|"
630 "^[ \t]*$") limit 'move))
631 (match-beginning 0)
632 (point))))
633 (contents-begin (progn (search-forward "]")
634 (skip-chars-forward " \r\t\n" ending)
635 (and (/= (point) ending) (point))))
636 (contents-end (and contents-begin ending))
637 (end (progn (goto-char ending)
638 (skip-chars-forward " \r\t\n" limit)
639 (if (eobp) (point) (point-at-bol)))))
640 (list 'footnote-definition
641 (nconc
642 (list :label label
643 :begin begin
644 :end end
645 :contents-begin contents-begin
646 :contents-end contents-end
647 :post-blank (count-lines ending end))
648 (cadr keywords))))))
650 (defun org-element-footnote-definition-interpreter (footnote-definition contents)
651 "Interpret FOOTNOTE-DEFINITION element as Org syntax.
652 CONTENTS is the contents of the footnote-definition."
653 (concat (format "[%s]" (org-element-property :label footnote-definition))
655 contents))
658 ;;;; Headline
660 (defun org-element-headline-parser (limit &optional raw-secondary-p)
661 "Parse an headline.
663 Return a list whose CAR is `headline' and CDR is a plist
664 containing `:raw-value', `:title', `:begin', `:end',
665 `:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
666 `:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
667 `:scheduled', `:deadline', `:timestamp', `:clock', `:category',
668 `:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
669 keywords.
671 The plist also contains any property set in the property drawer,
672 with its name in lowercase, the underscores replaced with hyphens
673 and colons at the beginning (i.e. `:custom-id').
675 When RAW-SECONDARY-P is non-nil, headline's title will not be
676 parsed as a secondary string, but as a plain string instead.
678 Assume point is at beginning of the headline."
679 (save-excursion
680 (let* ((components (org-heading-components))
681 (level (nth 1 components))
682 (todo (nth 2 components))
683 (todo-type
684 (and todo (if (member todo org-done-keywords) 'done 'todo)))
685 (tags (let ((raw-tags (nth 5 components)))
686 (and raw-tags (org-split-string raw-tags ":"))))
687 (raw-value (nth 4 components))
688 (quotedp
689 (let ((case-fold-search nil))
690 (string-match (format "^%s +" org-quote-string) raw-value)))
691 (commentedp
692 (let ((case-fold-search nil))
693 (string-match (format "^%s +" org-comment-string) raw-value)))
694 (archivedp (member org-archive-tag tags))
695 (footnote-section-p (and org-footnote-section
696 (string= org-footnote-section raw-value)))
697 ;; Normalize property names: ":SOME_PROP:" becomes
698 ;; ":some-prop".
699 (standard-props (let (plist)
700 (mapc
701 (lambda (p)
702 (let ((p-name (downcase (car p))))
703 (while (string-match "_" p-name)
704 (setq p-name
705 (replace-match "-" nil nil p-name)))
706 (setq p-name (intern (concat ":" p-name)))
707 (setq plist
708 (plist-put plist p-name (cdr p)))))
709 (org-entry-properties nil 'standard))
710 plist))
711 (time-props (org-entry-properties nil 'special "CLOCK"))
712 (scheduled (cdr (assoc "SCHEDULED" time-props)))
713 (deadline (cdr (assoc "DEADLINE" time-props)))
714 (clock (cdr (assoc "CLOCK" time-props)))
715 (timestamp (cdr (assoc "TIMESTAMP" time-props)))
716 (begin (point))
717 (end (save-excursion (goto-char (org-end-of-subtree t t))))
718 (pos-after-head (progn (forward-line) (point)))
719 (contents-begin (save-excursion
720 (skip-chars-forward " \r\t\n" end)
721 (and (/= (point) end) (line-beginning-position))))
722 (hidden (org-invisible-p2))
723 (contents-end (and contents-begin
724 (progn (goto-char end)
725 (skip-chars-backward " \r\t\n")
726 (forward-line)
727 (point)))))
728 ;; Clean RAW-VALUE from any quote or comment string.
729 (when (or quotedp commentedp)
730 (setq raw-value
731 (replace-regexp-in-string
732 (concat "\\(" org-quote-string "\\|" org-comment-string "\\) +")
734 raw-value)))
735 ;; Clean TAGS from archive tag, if any.
736 (when archivedp (setq tags (delete org-archive-tag tags)))
737 (let ((headline
738 (list 'headline
739 (nconc
740 (list :raw-value raw-value
741 :begin begin
742 :end end
743 :pre-blank
744 (if (not contents-begin) 0
745 (count-lines pos-after-head contents-begin))
746 :hiddenp hidden
747 :contents-begin contents-begin
748 :contents-end contents-end
749 :level level
750 :priority (nth 3 components)
751 :tags tags
752 :todo-keyword todo
753 :todo-type todo-type
754 :scheduled scheduled
755 :deadline deadline
756 :timestamp timestamp
757 :clock clock
758 :post-blank (count-lines
759 (if (not contents-end) pos-after-head
760 (goto-char contents-end)
761 (forward-line)
762 (point))
763 end)
764 :footnote-section-p footnote-section-p
765 :archivedp archivedp
766 :commentedp commentedp
767 :quotedp quotedp)
768 standard-props))))
769 (org-element-put-property
770 headline :title
771 (if raw-secondary-p raw-value
772 (org-element-parse-secondary-string
773 raw-value (org-element-restriction 'headline) headline)))))))
775 (defun org-element-headline-interpreter (headline contents)
776 "Interpret HEADLINE element as Org syntax.
777 CONTENTS is the contents of the element."
778 (let* ((level (org-element-property :level headline))
779 (todo (org-element-property :todo-keyword headline))
780 (priority (org-element-property :priority headline))
781 (title (org-element-interpret-data
782 (org-element-property :title headline)))
783 (tags (let ((tag-list (if (org-element-property :archivedp headline)
784 (cons org-archive-tag
785 (org-element-property :tags headline))
786 (org-element-property :tags headline))))
787 (and tag-list
788 (format ":%s:" (mapconcat 'identity tag-list ":")))))
789 (commentedp (org-element-property :commentedp headline))
790 (quotedp (org-element-property :quotedp headline))
791 (pre-blank (or (org-element-property :pre-blank headline) 0))
792 (heading (concat (make-string level ?*)
793 (and todo (concat " " todo))
794 (and quotedp (concat " " org-quote-string))
795 (and commentedp (concat " " org-comment-string))
796 (and priority
797 (format " [#%s]" (char-to-string priority)))
798 (cond ((and org-footnote-section
799 (org-element-property
800 :footnote-section-p headline))
801 (concat " " org-footnote-section))
802 (title (concat " " title))))))
803 (concat heading
804 ;; Align tags.
805 (when tags
806 (cond
807 ((zerop org-tags-column) (format " %s" tags))
808 ((< org-tags-column 0)
809 (concat
810 (make-string
811 (max (- (+ org-tags-column (length heading) (length tags))) 1)
813 tags))
815 (concat
816 (make-string (max (- org-tags-column (length heading)) 1) ? )
817 tags))))
818 (make-string (1+ pre-blank) 10)
819 contents)))
822 ;;;; Inlinetask
824 (defun org-element-inlinetask-parser (limit &optional raw-secondary-p)
825 "Parse an inline task.
827 Return a list whose CAR is `inlinetask' and CDR is a plist
828 containing `:title', `:begin', `:end', `:hiddenp',
829 `:contents-begin' and `:contents-end', `:level', `:priority',
830 `:tags', `:todo-keyword', `:todo-type', `:scheduled',
831 `:deadline', `:timestamp', `:clock' and `:post-blank' keywords.
833 The plist also contains any property set in the property drawer,
834 with its name in lowercase, the underscores replaced with hyphens
835 and colons at the beginning (i.e. `:custom-id').
837 When optional argument RAW-SECONDARY-P is non-nil, inline-task's
838 title will not be parsed as a secondary string, but as a plain
839 string instead.
841 Assume point is at beginning of the inline task."
842 (save-excursion
843 (let* ((keywords (org-element--collect-affiliated-keywords))
844 (begin (car keywords))
845 (components (org-heading-components))
846 (todo (nth 2 components))
847 (todo-type (and todo
848 (if (member todo org-done-keywords) 'done 'todo)))
849 (tags (let ((raw-tags (nth 5 components)))
850 (and raw-tags (org-split-string raw-tags ":"))))
851 ;; Normalize property names: ":SOME_PROP:" becomes
852 ;; ":some-prop".
853 (standard-props (let (plist)
854 (mapc
855 (lambda (p)
856 (let ((p-name (downcase (car p))))
857 (while (string-match "_" p-name)
858 (setq p-name
859 (replace-match "-" nil nil p-name)))
860 (setq p-name (intern (concat ":" p-name)))
861 (setq plist
862 (plist-put plist p-name (cdr p)))))
863 (org-entry-properties nil 'standard))
864 plist))
865 (time-props (org-entry-properties nil 'special "CLOCK"))
866 (scheduled (cdr (assoc "SCHEDULED" time-props)))
867 (deadline (cdr (assoc "DEADLINE" time-props)))
868 (clock (cdr (assoc "CLOCK" time-props)))
869 (timestamp (cdr (assoc "TIMESTAMP" time-props)))
870 (task-end (save-excursion
871 (end-of-line)
872 (and (re-search-forward "^\\*+ END" limit t)
873 (match-beginning 0))))
874 (contents-begin (progn (forward-line)
875 (and task-end (< (point) task-end) (point))))
876 (hidden (and contents-begin (org-invisible-p2)))
877 (contents-end (and contents-begin task-end))
878 (before-blank (if (not task-end) (point)
879 (goto-char task-end)
880 (forward-line)
881 (point)))
882 (end (progn (skip-chars-forward " \r\t\n" limit)
883 (if (eobp) (point) (point-at-bol))))
884 (inlinetask
885 (list 'inlinetask
886 (nconc
887 (list :begin begin
888 :end end
889 :hiddenp hidden
890 :contents-begin contents-begin
891 :contents-end contents-end
892 :level (nth 1 components)
893 :priority (nth 3 components)
894 :tags tags
895 :todo-keyword todo
896 :todo-type todo-type
897 :scheduled scheduled
898 :deadline deadline
899 :timestamp timestamp
900 :clock clock
901 :post-blank (count-lines before-blank end))
902 standard-props
903 (cadr keywords)))))
904 (org-element-put-property
905 inlinetask :title
906 (if raw-secondary-p (nth 4 components)
907 (org-element-parse-secondary-string
908 (nth 4 components)
909 (org-element-restriction 'inlinetask)
910 inlinetask))))))
912 (defun org-element-inlinetask-interpreter (inlinetask contents)
913 "Interpret INLINETASK element as Org syntax.
914 CONTENTS is the contents of inlinetask."
915 (let* ((level (org-element-property :level inlinetask))
916 (todo (org-element-property :todo-keyword inlinetask))
917 (priority (org-element-property :priority inlinetask))
918 (title (org-element-interpret-data
919 (org-element-property :title inlinetask)))
920 (tags (let ((tag-list (org-element-property :tags inlinetask)))
921 (and tag-list
922 (format ":%s:" (mapconcat 'identity tag-list ":")))))
923 (task (concat (make-string level ?*)
924 (and todo (concat " " todo))
925 (and priority
926 (format " [#%s]" (char-to-string priority)))
927 (and title (concat " " title)))))
928 (concat task
929 ;; Align tags.
930 (when tags
931 (cond
932 ((zerop org-tags-column) (format " %s" tags))
933 ((< org-tags-column 0)
934 (concat
935 (make-string
936 (max (- (+ org-tags-column (length task) (length tags))) 1)
938 tags))
940 (concat
941 (make-string (max (- org-tags-column (length task)) 1) ? )
942 tags))))
943 ;; Prefer degenerate inlinetasks when there are no
944 ;; contents.
945 (when contents
946 (concat "\n"
947 contents
948 (make-string level ?*) " END")))))
951 ;;;; Item
953 (defun org-element-item-parser (limit struct &optional raw-secondary-p)
954 "Parse an item.
956 STRUCT is the structure of the plain list.
958 Return a list whose CAR is `item' and CDR is a plist containing
959 `:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
960 `:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
961 `:post-blank' keywords.
963 When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
964 any, will not be parsed as a secondary string, but as a plain
965 string instead.
967 Assume point is at the beginning of the item."
968 (save-excursion
969 (beginning-of-line)
970 (let* ((begin (point))
971 (bullet (org-list-get-bullet (point) struct))
972 (checkbox (let ((box (org-list-get-checkbox begin struct)))
973 (cond ((equal "[ ]" box) 'off)
974 ((equal "[X]" box) 'on)
975 ((equal "[-]" box) 'trans))))
976 (counter (let ((c (org-list-get-counter begin struct)))
977 (cond
978 ((not c) nil)
979 ((string-match "[A-Za-z]" c)
980 (- (string-to-char (upcase (match-string 0 c)))
981 64))
982 ((string-match "[0-9]+" c)
983 (string-to-number (match-string 0 c))))))
984 (end (org-list-get-item-end begin struct))
985 (contents-begin (progn (looking-at org-list-full-item-re)
986 (goto-char (match-end 0))
987 (org-skip-whitespace)
988 ;; If first line isn't empty,
989 ;; contents really start at the text
990 ;; after item's meta-data.
991 (if (= (point-at-bol) begin) (point)
992 (point-at-bol))))
993 (hidden (progn (forward-line)
994 (and (not (= (point) end))
995 (org-invisible-p2))))
996 (contents-end (progn (goto-char end)
997 (skip-chars-backward " \r\t\n")
998 (forward-line)
999 (point)))
1000 (item
1001 (list 'item
1002 (list :bullet bullet
1003 :begin begin
1004 :end end
1005 ;; CONTENTS-BEGIN and CONTENTS-END may be
1006 ;; mixed up in the case of an empty item
1007 ;; separated from the next by a blank line.
1008 ;; Thus ensure the former is always the
1009 ;; smallest.
1010 :contents-begin (min contents-begin contents-end)
1011 :contents-end (max contents-begin contents-end)
1012 :checkbox checkbox
1013 :counter counter
1014 :hiddenp hidden
1015 :structure struct
1016 :post-blank (count-lines contents-end end)))))
1017 (org-element-put-property
1018 item :tag
1019 (let ((raw-tag (org-list-get-tag begin struct)))
1020 (and raw-tag
1021 (if raw-secondary-p raw-tag
1022 (org-element-parse-secondary-string
1023 raw-tag (org-element-restriction 'item) item))))))))
1025 (defun org-element-item-interpreter (item contents)
1026 "Interpret ITEM element as Org syntax.
1027 CONTENTS is the contents of the element."
1028 (let* ((bullet (org-list-bullet-string (org-element-property :bullet item)))
1029 (checkbox (org-element-property :checkbox item))
1030 (counter (org-element-property :counter item))
1031 (tag (let ((tag (org-element-property :tag item)))
1032 (and tag (org-element-interpret-data tag))))
1033 ;; Compute indentation.
1034 (ind (make-string (length bullet) 32))
1035 (item-starts-with-par-p
1036 (eq (org-element-type (car (org-element-contents item)))
1037 'paragraph)))
1038 ;; Indent contents.
1039 (concat
1040 bullet
1041 (and counter (format "[@%d] " counter))
1042 (cond
1043 ((eq checkbox 'on) "[X] ")
1044 ((eq checkbox 'off) "[ ] ")
1045 ((eq checkbox 'trans) "[-] "))
1046 (and tag (format "%s :: " tag))
1047 (let ((contents (replace-regexp-in-string
1048 "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
1049 (if item-starts-with-par-p (org-trim contents)
1050 (concat "\n" contents))))))
1053 ;;;; Plain List
1055 (defun org-element-plain-list-parser (limit &optional structure)
1056 "Parse a plain list.
1058 Optional argument STRUCTURE, when non-nil, is the structure of
1059 the plain list being parsed.
1061 Return a list whose CAR is `plain-list' and CDR is a plist
1062 containing `:type', `:begin', `:end', `:contents-begin' and
1063 `:contents-end', `:structure' and `:post-blank' keywords.
1065 Assume point is at the beginning of the list."
1066 (save-excursion
1067 (let* ((struct (or structure (org-list-struct)))
1068 (prevs (org-list-prevs-alist struct))
1069 (parents (org-list-parents-alist struct))
1070 (type (org-list-get-list-type (point) struct prevs))
1071 (contents-begin (point))
1072 (keywords (org-element--collect-affiliated-keywords))
1073 (begin (car keywords))
1074 (contents-end
1075 (goto-char (org-list-get-list-end (point) struct prevs)))
1076 (end (save-excursion (org-skip-whitespace)
1077 (if (eobp) (point) (point-at-bol)))))
1078 ;; Blank lines below list belong to the top-level list only.
1079 (unless (= (org-list-get-top-point struct) contents-begin)
1080 (setq end (min (org-list-get-bottom-point struct)
1081 (progn (skip-chars-forward " \r\t\n" limit)
1082 (if (eobp) (point) (point-at-bol))))))
1083 ;; Return value.
1084 (list 'plain-list
1085 (nconc
1086 (list :type type
1087 :begin begin
1088 :end end
1089 :contents-begin contents-begin
1090 :contents-end contents-end
1091 :structure struct
1092 :post-blank (count-lines contents-end end))
1093 (cadr keywords))))))
1095 (defun org-element-plain-list-interpreter (plain-list contents)
1096 "Interpret PLAIN-LIST element as Org syntax.
1097 CONTENTS is the contents of the element."
1098 (with-temp-buffer
1099 (insert contents)
1100 (goto-char (point-min))
1101 (org-list-repair)
1102 (buffer-string)))
1105 ;;;; Quote Block
1107 (defun org-element-quote-block-parser (limit)
1108 "Parse a quote block.
1110 LIMIT bounds the search.
1112 Return a list whose CAR is `quote-block' and CDR is a plist
1113 containing `:begin', `:end', `:hiddenp', `:contents-begin',
1114 `:contents-end' and `:post-blank' keywords.
1116 Assume point is at the beginning of the block."
1117 (let ((case-fold-search t))
1118 (if (not (save-excursion
1119 (re-search-forward "^[ \t]*#\\+END_QUOTE" limit t)))
1120 ;; Incomplete block: parse it as a comment.
1121 (org-element-comment-parser limit)
1122 (let ((block-end-line (match-beginning 0)))
1123 (save-excursion
1124 (let* ((keywords (org-element--collect-affiliated-keywords))
1125 (begin (car keywords))
1126 ;; Empty blocks have no contents.
1127 (contents-begin (progn (forward-line)
1128 (and (< (point) block-end-line)
1129 (point))))
1130 (contents-end (and contents-begin block-end-line))
1131 (hidden (org-invisible-p2))
1132 (pos-before-blank (progn (goto-char block-end-line)
1133 (forward-line)
1134 (point)))
1135 (end (progn (skip-chars-forward " \r\t\n" limit)
1136 (if (eobp) (point) (point-at-bol)))))
1137 (list 'quote-block
1138 (nconc
1139 (list :begin begin
1140 :end end
1141 :hiddenp hidden
1142 :contents-begin contents-begin
1143 :contents-end contents-end
1144 :post-blank (count-lines pos-before-blank end))
1145 (cadr keywords)))))))))
1147 (defun org-element-quote-block-interpreter (quote-block contents)
1148 "Interpret QUOTE-BLOCK element as Org syntax.
1149 CONTENTS is the contents of the element."
1150 (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
1153 ;;;; Section
1155 (defun org-element-section-parser (limit)
1156 "Parse a section.
1158 LIMIT bounds the search.
1160 Return a list whose CAR is `section' and CDR is a plist
1161 containing `:begin', `:end', `:contents-begin', `contents-end'
1162 and `:post-blank' keywords."
1163 (save-excursion
1164 ;; Beginning of section is the beginning of the first non-blank
1165 ;; line after previous headline.
1166 (org-with-limited-levels
1167 (let ((begin (point))
1168 (end (progn (goto-char limit) (point)))
1169 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
1170 (forward-line)
1171 (point))))
1172 (list 'section
1173 (list :begin begin
1174 :end end
1175 :contents-begin begin
1176 :contents-end pos-before-blank
1177 :post-blank (count-lines pos-before-blank end)))))))
1179 (defun org-element-section-interpreter (section contents)
1180 "Interpret SECTION element as Org syntax.
1181 CONTENTS is the contents of the element."
1182 contents)
1185 ;;;; Special Block
1187 (defun org-element-special-block-parser (limit)
1188 "Parse a special block.
1190 LIMIT bounds the search.
1192 Return a list whose CAR is `special-block' and CDR is a plist
1193 containing `:type', `:begin', `:end', `:hiddenp',
1194 `:contents-begin', `:contents-end' and `:post-blank' keywords.
1196 Assume point is at the beginning of the block."
1197 (let* ((case-fold-search t)
1198 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)")
1199 (upcase (match-string-no-properties 1)))))
1200 (if (not (save-excursion
1201 (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t)))
1202 ;; Incomplete block: parse it as a comment.
1203 (org-element-comment-parser limit)
1204 (let ((block-end-line (match-beginning 0)))
1205 (save-excursion
1206 (let* ((keywords (org-element--collect-affiliated-keywords))
1207 (begin (car keywords))
1208 ;; Empty blocks have no contents.
1209 (contents-begin (progn (forward-line)
1210 (and (< (point) block-end-line)
1211 (point))))
1212 (contents-end (and contents-begin block-end-line))
1213 (hidden (org-invisible-p2))
1214 (pos-before-blank (progn (goto-char block-end-line)
1215 (forward-line)
1216 (point)))
1217 (end (progn (org-skip-whitespace)
1218 (if (eobp) (point) (point-at-bol)))))
1219 (list 'special-block
1220 (nconc
1221 (list :type type
1222 :begin begin
1223 :end end
1224 :hiddenp hidden
1225 :contents-begin contents-begin
1226 :contents-end contents-end
1227 :post-blank (count-lines pos-before-blank end))
1228 (cadr keywords)))))))))
1230 (defun org-element-special-block-interpreter (special-block contents)
1231 "Interpret SPECIAL-BLOCK element as Org syntax.
1232 CONTENTS is the contents of the element."
1233 (let ((block-type (org-element-property :type special-block)))
1234 (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type)))
1238 ;;; Elements
1240 ;; For each element, a parser and an interpreter are also defined.
1241 ;; Both follow the same naming convention used for greater elements.
1243 ;; Also, as for greater elements, adding a new element type is done
1244 ;; through the following steps: implement a parser and an interpreter,
1245 ;; tweak `org-element--current-element' so that it recognizes the new
1246 ;; type and add that new type to `org-element-all-elements'.
1248 ;; As a special case, when the newly defined type is a block type,
1249 ;; `org-element-block-name-alist' has to be modified accordingly.
1252 ;;;; Babel Call
1254 (defun org-element-babel-call-parser (limit)
1255 "Parse a babel call.
1257 LIMIT bounds the search.
1259 Return a list whose CAR is `babel-call' and CDR is a plist
1260 containing `:begin', `:end', `:info' and `:post-blank' as
1261 keywords."
1262 (save-excursion
1263 (let ((case-fold-search t)
1264 (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
1265 (org-babel-lob-get-info)))
1266 (begin (point-at-bol))
1267 (pos-before-blank (progn (forward-line) (point)))
1268 (end (progn (skip-chars-forward " \r\t\n" limit)
1269 (if (eobp) (point) (point-at-bol)))))
1270 (list 'babel-call
1271 (list :begin begin
1272 :end end
1273 :info info
1274 :post-blank (count-lines pos-before-blank end))))))
1276 (defun org-element-babel-call-interpreter (babel-call contents)
1277 "Interpret BABEL-CALL element as Org syntax.
1278 CONTENTS is nil."
1279 (let* ((babel-info (org-element-property :info babel-call))
1280 (main (car babel-info))
1281 (post-options (nth 1 babel-info)))
1282 (concat "#+CALL: "
1283 (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
1284 ;; Remove redundant square brackets.
1285 (replace-match (match-string 1 main) nil nil main))
1286 (and post-options (format "[%s]" post-options)))))
1289 ;;;; Clock
1291 (defun org-element-clock-parser (limit)
1292 "Parse a clock.
1294 LIMIT bounds the search.
1296 Return a list whose CAR is `clock' and CDR is a plist containing
1297 `:status', `:value', `:time', `:begin', `:end' and `:post-blank'
1298 as keywords."
1299 (save-excursion
1300 (let* ((case-fold-search nil)
1301 (begin (point))
1302 (value (progn (search-forward org-clock-string (line-end-position) t)
1303 (org-skip-whitespace)
1304 (looking-at "\\[.*\\]")
1305 (org-match-string-no-properties 0)))
1306 (time (and (progn (goto-char (match-end 0))
1307 (looking-at " +=> +\\(\\S-+\\)[ \t]*$"))
1308 (org-match-string-no-properties 1)))
1309 (status (if time 'closed 'running))
1310 (post-blank (let ((before-blank (progn (forward-line) (point))))
1311 (skip-chars-forward " \r\t\n" limit)
1312 (unless (eobp) (beginning-of-line))
1313 (count-lines before-blank (point))))
1314 (end (point)))
1315 (list 'clock
1316 (list :status status
1317 :value value
1318 :time time
1319 :begin begin
1320 :end end
1321 :post-blank post-blank)))))
1323 (defun org-element-clock-interpreter (clock contents)
1324 "Interpret CLOCK element as Org syntax.
1325 CONTENTS is nil."
1326 (concat org-clock-string " "
1327 (org-element-property :value clock)
1328 (let ((time (org-element-property :time clock)))
1329 (and time
1330 (concat " => "
1331 (apply 'format
1332 "%2s:%02s"
1333 (org-split-string time ":")))))))
1336 ;;;; Comment
1338 (defun org-element-comment-parser (limit)
1339 "Parse a comment.
1341 LIMIT bounds the search.
1343 Return a list whose CAR is `comment' and CDR is a plist
1344 containing `:begin', `:end', `:value' and `:post-blank'
1345 keywords.
1347 Assume point is at comment beginning."
1348 (save-excursion
1349 (let* ((keywords (org-element--collect-affiliated-keywords))
1350 (begin (car keywords))
1351 ;; Match first line with a loose regexp since it might as
1352 ;; well be an ill-defined keyword.
1353 (value (prog2 (looking-at "[ \t]*# ?")
1354 (buffer-substring-no-properties
1355 (match-end 0) (line-end-position))
1356 (forward-line)))
1357 (com-end
1358 ;; Get comments ending.
1359 (progn
1360 (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)"))
1361 ;; Accumulate lines without leading hash and first
1362 ;; whitespace.
1363 (setq value
1364 (concat value
1365 "\n"
1366 (buffer-substring-no-properties
1367 (match-end 0) (line-end-position))))
1368 (forward-line))
1369 (point)))
1370 (end (progn (goto-char com-end)
1371 (skip-chars-forward " \r\t\n" limit)
1372 (if (eobp) (point) (point-at-bol)))))
1373 (list 'comment
1374 (nconc
1375 (list :begin begin
1376 :end end
1377 :value value
1378 :post-blank (count-lines com-end end))
1379 (cadr keywords))))))
1381 (defun org-element-comment-interpreter (comment contents)
1382 "Interpret COMMENT element as Org syntax.
1383 CONTENTS is nil."
1384 (replace-regexp-in-string "^" "# " (org-element-property :value comment)))
1387 ;;;; Comment Block
1389 (defun org-element-comment-block-parser (limit)
1390 "Parse an export block.
1392 LIMIT bounds the search.
1394 Return a list whose CAR is `comment-block' and CDR is a plist
1395 containing `:begin', `:end', `:hiddenp', `:value' and
1396 `:post-blank' keywords.
1398 Assume point is at comment block beginning."
1399 (let ((case-fold-search t))
1400 (if (not (save-excursion
1401 (re-search-forward "^[ \t]*#\\+END_COMMENT" limit t)))
1402 ;; Incomplete block: parse it as a comment.
1403 (org-element-comment-parser limit)
1404 (let ((contents-end (match-beginning 0)))
1405 (save-excursion
1406 (let* ((keywords (org-element--collect-affiliated-keywords))
1407 (begin (car keywords))
1408 (contents-begin (progn (forward-line) (point)))
1409 (hidden (org-invisible-p2))
1410 (pos-before-blank (progn (goto-char contents-end)
1411 (forward-line)
1412 (point)))
1413 (end (progn (skip-chars-forward " \r\t\n" limit)
1414 (if (eobp) (point) (point-at-bol))))
1415 (value (buffer-substring-no-properties
1416 contents-begin contents-end)))
1417 (list 'comment-block
1418 (nconc
1419 (list :begin begin
1420 :end end
1421 :value value
1422 :hiddenp hidden
1423 :post-blank (count-lines pos-before-blank end))
1424 (cadr keywords)))))))))
1426 (defun org-element-comment-block-interpreter (comment-block contents)
1427 "Interpret COMMENT-BLOCK element as Org syntax.
1428 CONTENTS is nil."
1429 (format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
1430 (org-remove-indentation (org-element-property :value comment-block))))
1433 ;;;; Example Block
1435 (defun org-element-example-block-parser (limit)
1436 "Parse an example block.
1438 LIMIT bounds the search.
1440 Return a list whose CAR is `example-block' and CDR is a plist
1441 containing `:begin', `:end', `:number-lines', `:preserve-indent',
1442 `:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
1443 `:switches', `:value' and `:post-blank' keywords."
1444 (let ((case-fold-search t))
1445 (if (not (save-excursion
1446 (re-search-forward "^[ \t]*#\\+END_EXAMPLE" limit t)))
1447 ;; Incomplete block: parse it as a comment.
1448 (org-element-comment-parser limit)
1449 (let ((contents-end (match-beginning 0)))
1450 (save-excursion
1451 (let* ((switches
1452 (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
1453 (org-match-string-no-properties 1)))
1454 ;; Switches analysis
1455 (number-lines (cond ((not switches) nil)
1456 ((string-match "-n\\>" switches) 'new)
1457 ((string-match "+n\\>" switches) 'continued)))
1458 (preserve-indent (and switches (string-match "-i\\>" switches)))
1459 ;; Should labels be retained in (or stripped from) example
1460 ;; blocks?
1461 (retain-labels
1462 (or (not switches)
1463 (not (string-match "-r\\>" switches))
1464 (and number-lines (string-match "-k\\>" switches))))
1465 ;; What should code-references use - labels or
1466 ;; line-numbers?
1467 (use-labels
1468 (or (not switches)
1469 (and retain-labels (not (string-match "-k\\>" switches)))))
1470 (label-fmt (and switches
1471 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
1472 (match-string 1 switches)))
1473 ;; Standard block parsing.
1474 (keywords (org-element--collect-affiliated-keywords))
1475 (begin (car keywords))
1476 (contents-begin (progn (forward-line) (point)))
1477 (hidden (org-invisible-p2))
1478 (value (buffer-substring-no-properties contents-begin contents-end))
1479 (pos-before-blank (progn (goto-char contents-end)
1480 (forward-line)
1481 (point)))
1482 (end (progn (skip-chars-forward " \r\t\n" limit)
1483 (if (eobp) (point) (point-at-bol)))))
1484 (list 'example-block
1485 (nconc
1486 (list :begin begin
1487 :end end
1488 :value value
1489 :switches switches
1490 :number-lines number-lines
1491 :preserve-indent preserve-indent
1492 :retain-labels retain-labels
1493 :use-labels use-labels
1494 :label-fmt label-fmt
1495 :hiddenp hidden
1496 :post-blank (count-lines pos-before-blank end))
1497 (cadr keywords)))))))))
1499 (defun org-element-example-block-interpreter (example-block contents)
1500 "Interpret EXAMPLE-BLOCK element as Org syntax.
1501 CONTENTS is nil."
1502 (let ((switches (org-element-property :switches example-block)))
1503 (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
1504 (org-remove-indentation
1505 (org-element-property :value example-block))
1506 "#+END_EXAMPLE")))
1509 ;;;; Export Block
1511 (defun org-element-export-block-parser (limit)
1512 "Parse an export block.
1514 LIMIT bounds the search.
1516 Return a list whose CAR is `export-block' and CDR is a plist
1517 containing `:begin', `:end', `:type', `:hiddenp', `:value' and
1518 `:post-blank' keywords.
1520 Assume point is at export-block beginning."
1521 (let* ((case-fold-search t)
1522 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
1523 (upcase (org-match-string-no-properties 1)))))
1524 (if (not (save-excursion
1525 (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t)))
1526 ;; Incomplete block: parse it as a comment.
1527 (org-element-comment-parser limit)
1528 (let ((contents-end (match-beginning 0)))
1529 (save-excursion
1530 (let* ((keywords (org-element--collect-affiliated-keywords))
1531 (begin (car keywords))
1532 (contents-begin (progn (forward-line) (point)))
1533 (hidden (org-invisible-p2))
1534 (pos-before-blank (progn (goto-char contents-end)
1535 (forward-line)
1536 (point)))
1537 (end (progn (skip-chars-forward " \r\t\n" limit)
1538 (if (eobp) (point) (point-at-bol))))
1539 (value (buffer-substring-no-properties contents-begin
1540 contents-end)))
1541 (list 'export-block
1542 (nconc
1543 (list :begin begin
1544 :end end
1545 :type type
1546 :value value
1547 :hiddenp hidden
1548 :post-blank (count-lines pos-before-blank end))
1549 (cadr keywords)))))))))
1551 (defun org-element-export-block-interpreter (export-block contents)
1552 "Interpret EXPORT-BLOCK element as Org syntax.
1553 CONTENTS is nil."
1554 (let ((type (org-element-property :type export-block)))
1555 (concat (format "#+BEGIN_%s\n" type)
1556 (org-element-property :value export-block)
1557 (format "#+END_%s" type))))
1560 ;;;; Fixed-width
1562 (defun org-element-fixed-width-parser (limit)
1563 "Parse a fixed-width section.
1565 LIMIT bounds the search.
1567 Return a list whose CAR is `fixed-width' and CDR is a plist
1568 containing `:begin', `:end', `:value' and `:post-blank' keywords.
1570 Assume point is at the beginning of the fixed-width area."
1571 (save-excursion
1572 (let* ((keywords (org-element--collect-affiliated-keywords))
1573 (begin (car keywords))
1574 value
1575 (end-area
1576 (progn
1577 (while (and (< (point) limit)
1578 (looking-at "[ \t]*:\\( \\|$\\)"))
1579 ;; Accumulate text without starting colons.
1580 (setq value
1581 (concat value
1582 (buffer-substring-no-properties
1583 (match-end 0) (point-at-eol))
1584 "\n"))
1585 (forward-line))
1586 (point)))
1587 (end (progn (skip-chars-forward " \r\t\n" limit)
1588 (if (eobp) (point) (point-at-bol)))))
1589 (list 'fixed-width
1590 (nconc
1591 (list :begin begin
1592 :end end
1593 :value value
1594 :post-blank (count-lines end-area end))
1595 (cadr keywords))))))
1597 (defun org-element-fixed-width-interpreter (fixed-width contents)
1598 "Interpret FIXED-WIDTH element as Org syntax.
1599 CONTENTS is nil."
1600 (replace-regexp-in-string
1601 "^" ": " (substring (org-element-property :value fixed-width) 0 -1)))
1604 ;;;; Horizontal Rule
1606 (defun org-element-horizontal-rule-parser (limit)
1607 "Parse an horizontal rule.
1609 LIMIT bounds the search.
1611 Return a list whose CAR is `horizontal-rule' and CDR is a plist
1612 containing `:begin', `:end' and `:post-blank' keywords."
1613 (save-excursion
1614 (let* ((keywords (org-element--collect-affiliated-keywords))
1615 (begin (car keywords))
1616 (post-hr (progn (forward-line) (point)))
1617 (end (progn (skip-chars-forward " \r\t\n" limit)
1618 (if (eobp) (point) (point-at-bol)))))
1619 (list 'horizontal-rule
1620 (nconc
1621 (list :begin begin
1622 :end end
1623 :post-blank (count-lines post-hr end))
1624 (cadr keywords))))))
1626 (defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
1627 "Interpret HORIZONTAL-RULE element as Org syntax.
1628 CONTENTS is nil."
1629 "-----")
1632 ;;;; Keyword
1634 (defun org-element-keyword-parser (limit)
1635 "Parse a keyword at point.
1637 LIMIT bounds the search.
1639 Return a list whose CAR is `keyword' and CDR is a plist
1640 containing `:key', `:value', `:begin', `:end' and `:post-blank'
1641 keywords."
1642 (save-excursion
1643 (let* ((case-fold-search t)
1644 (begin (point))
1645 (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):")
1646 (upcase (org-match-string-no-properties 1))))
1647 (value (org-trim (buffer-substring-no-properties
1648 (match-end 0) (point-at-eol))))
1649 (pos-before-blank (progn (forward-line) (point)))
1650 (end (progn (skip-chars-forward " \r\t\n" limit)
1651 (if (eobp) (point) (point-at-bol)))))
1652 (list 'keyword
1653 (list :key key
1654 :value value
1655 :begin begin
1656 :end end
1657 :post-blank (count-lines pos-before-blank end))))))
1659 (defun org-element-keyword-interpreter (keyword contents)
1660 "Interpret KEYWORD element as Org syntax.
1661 CONTENTS is nil."
1662 (format "#+%s: %s"
1663 (org-element-property :key keyword)
1664 (org-element-property :value keyword)))
1667 ;;;; Latex Environment
1669 (defun org-element-latex-environment-parser (limit)
1670 "Parse a LaTeX environment.
1672 LIMIT bounds the search.
1674 Return a list whose CAR is `latex-environment' and CDR is a plist
1675 containing `:begin', `:end', `:value' and `:post-blank'
1676 keywords.
1678 Assume point is at the beginning of the latex environment."
1679 (save-excursion
1680 (let* ((case-fold-search t)
1681 (code-begin (point))
1682 (keywords (org-element--collect-affiliated-keywords))
1683 (begin (car keywords))
1684 (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}")
1685 (regexp-quote (match-string 1))))
1686 (code-end
1687 (progn (re-search-forward (format "^[ \t]*\\\\end{%s}" env) limit t)
1688 (forward-line)
1689 (point)))
1690 (value (buffer-substring-no-properties code-begin code-end))
1691 (end (progn (skip-chars-forward " \r\t\n" limit)
1692 (if (eobp) (point) (point-at-bol)))))
1693 (list 'latex-environment
1694 (nconc
1695 (list :begin begin
1696 :end end
1697 :value value
1698 :post-blank (count-lines code-end end))
1699 (cadr keywords))))))
1701 (defun org-element-latex-environment-interpreter (latex-environment contents)
1702 "Interpret LATEX-ENVIRONMENT element as Org syntax.
1703 CONTENTS is nil."
1704 (org-element-property :value latex-environment))
1707 ;;;; Paragraph
1709 (defun org-element-paragraph-parser (limit)
1710 "Parse a paragraph.
1712 LIMIT bounds the search.
1714 Return a list whose CAR is `paragraph' and CDR is a plist
1715 containing `:begin', `:end', `:contents-begin' and
1716 `:contents-end' and `:post-blank' keywords.
1718 Assume point is at the beginning of the paragraph."
1719 (save-excursion
1720 (let* ((contents-begin (point))
1721 (keywords (org-element--collect-affiliated-keywords))
1722 (begin (car keywords))
1723 (before-blank
1724 (progn (end-of-line)
1725 (if (re-search-forward org-element-paragraph-separate
1726 limit
1728 (goto-char (match-beginning 0))
1729 (point))))
1730 (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin)
1731 (forward-line)
1732 (point)))
1733 (end (progn (skip-chars-forward " \r\t\n" limit)
1734 (if (eobp) (point) (point-at-bol)))))
1735 (list 'paragraph
1736 ;; If paragraph has no affiliated keywords, it may not begin
1737 ;; at beginning of line if it starts an item.
1738 (nconc
1739 (list :begin (if (cadr keywords) begin contents-begin)
1740 :end end
1741 :contents-begin contents-begin
1742 :contents-end contents-end
1743 :post-blank (count-lines before-blank end))
1744 (cadr keywords))))))
1746 (defun org-element-paragraph-interpreter (paragraph contents)
1747 "Interpret PARAGRAPH element as Org syntax.
1748 CONTENTS is the contents of the element."
1749 contents)
1752 ;;;; Planning
1754 (defun org-element-planning-parser (limit)
1755 "Parse a planning.
1757 LIMIT bounds the search.
1759 Return a list whose CAR is `planning' and CDR is a plist
1760 containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
1761 and `:post-blank' keywords."
1762 (save-excursion
1763 (let* ((case-fold-search nil)
1764 (begin (point))
1765 (post-blank (let ((before-blank (progn (forward-line) (point))))
1766 (skip-chars-forward " \r\t\n" limit)
1767 (unless (eobp) (beginning-of-line))
1768 (count-lines before-blank (point))))
1769 (end (point))
1770 closed deadline scheduled)
1771 (goto-char begin)
1772 (while (re-search-forward org-keyword-time-not-clock-regexp
1773 (line-end-position) t)
1774 (goto-char (match-end 1))
1775 (org-skip-whitespace)
1776 (let ((time (buffer-substring-no-properties
1777 (1+ (point)) (1- (match-end 0))))
1778 (keyword (match-string 1)))
1779 (cond ((equal keyword org-closed-string) (setq closed time))
1780 ((equal keyword org-deadline-string) (setq deadline time))
1781 (t (setq scheduled time)))))
1782 (list 'planning
1783 (list :closed closed
1784 :deadline deadline
1785 :scheduled scheduled
1786 :begin begin
1787 :end end
1788 :post-blank post-blank)))))
1790 (defun org-element-planning-interpreter (planning contents)
1791 "Interpret PLANNING element as Org syntax.
1792 CONTENTS is nil."
1793 (mapconcat
1794 'identity
1795 (delq nil
1796 (list (let ((closed (org-element-property :closed planning)))
1797 (when closed (concat org-closed-string " [" closed "]")))
1798 (let ((deadline (org-element-property :deadline planning)))
1799 (when deadline (concat org-deadline-string " <" deadline ">")))
1800 (let ((scheduled (org-element-property :scheduled planning)))
1801 (when scheduled
1802 (concat org-scheduled-string " <" scheduled ">")))))
1803 " "))
1806 ;;;; Property Drawer
1808 (defun org-element-property-drawer-parser (limit)
1809 "Parse a property drawer.
1811 LIMIT bounds the search.
1813 Return a list whose CAR is `property-drawer' and CDR is a plist
1814 containing `:begin', `:end', `:hiddenp', `:contents-begin',
1815 `:contents-end', `:properties' and `:post-blank' keywords.
1817 Assume point is at the beginning of the property drawer."
1818 (save-excursion
1819 (let ((case-fold-search t)
1820 (begin (point))
1821 (prop-begin (progn (forward-line) (point)))
1822 (hidden (org-invisible-p2))
1823 (properties
1824 (let (val)
1825 (while (not (looking-at "^[ \t]*:END:"))
1826 (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):")
1827 (push (cons (org-match-string-no-properties 1)
1828 (org-trim
1829 (buffer-substring-no-properties
1830 (match-end 0) (point-at-eol))))
1831 val))
1832 (forward-line))
1833 val))
1834 (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t)
1835 (point-at-bol)))
1836 (pos-before-blank (progn (forward-line) (point)))
1837 (end (progn (skip-chars-forward " \r\t\n" limit)
1838 (if (eobp) (point) (point-at-bol)))))
1839 (list 'property-drawer
1840 (list :begin begin
1841 :end end
1842 :hiddenp hidden
1843 :properties properties
1844 :post-blank (count-lines pos-before-blank end))))))
1846 (defun org-element-property-drawer-interpreter (property-drawer contents)
1847 "Interpret PROPERTY-DRAWER element as Org syntax.
1848 CONTENTS is nil."
1849 (let ((props (org-element-property :properties property-drawer)))
1850 (concat
1851 ":PROPERTIES:\n"
1852 (mapconcat (lambda (p)
1853 (format org-property-format (format ":%s:" (car p)) (cdr p)))
1854 (nreverse props) "\n")
1855 "\n:END:")))
1858 ;;;; Quote Section
1860 (defun org-element-quote-section-parser (limit)
1861 "Parse a quote section.
1863 LIMIT bounds the search.
1865 Return a list whose CAR is `quote-section' and CDR is a plist
1866 containing `:begin', `:end', `:value' and `:post-blank' keywords.
1868 Assume point is at beginning of the section."
1869 (save-excursion
1870 (let* ((begin (point))
1871 (end (progn (org-with-limited-levels (outline-next-heading))
1872 (point)))
1873 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
1874 (forward-line)
1875 (point)))
1876 (value (buffer-substring-no-properties begin pos-before-blank)))
1877 (list 'quote-section
1878 (list :begin begin
1879 :end end
1880 :value value
1881 :post-blank (count-lines pos-before-blank end))))))
1883 (defun org-element-quote-section-interpreter (quote-section contents)
1884 "Interpret QUOTE-SECTION element as Org syntax.
1885 CONTENTS is nil."
1886 (org-element-property :value quote-section))
1889 ;;;; Src Block
1891 (defun org-element-src-block-parser (limit)
1892 "Parse a src block.
1894 LIMIT bounds the search.
1896 Return a list whose CAR is `src-block' and CDR is a plist
1897 containing `:language', `:switches', `:parameters', `:begin',
1898 `:end', `:hiddenp', `:number-lines', `:retain-labels',
1899 `:use-labels', `:label-fmt', `:preserve-indent', `:value' and
1900 `:post-blank' keywords.
1902 Assume point is at the beginning of the block."
1903 (let ((case-fold-search t))
1904 (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC" limit t)))
1905 ;; Incomplete block: parse it as a comment.
1906 (org-element-comment-parser limit)
1907 (let ((contents-end (match-beginning 0)))
1908 (save-excursion
1909 (let* ((keywords (org-element--collect-affiliated-keywords))
1910 ;; Get beginning position.
1911 (begin (car keywords))
1912 ;; Get language as a string.
1913 (language
1914 (progn
1915 (looking-at
1916 (concat "^[ \t]*#\\+BEGIN_SRC"
1917 "\\(?: +\\(\\S-+\\)\\)?"
1918 "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
1919 "\\(.*\\)[ \t]*$"))
1920 (org-match-string-no-properties 1)))
1921 ;; Get switches.
1922 (switches (org-match-string-no-properties 2))
1923 ;; Get parameters.
1924 (parameters (org-match-string-no-properties 3))
1925 ;; Switches analysis
1926 (number-lines (cond ((not switches) nil)
1927 ((string-match "-n\\>" switches) 'new)
1928 ((string-match "+n\\>" switches) 'continued)))
1929 (preserve-indent (and switches (string-match "-i\\>" switches)))
1930 (label-fmt (and switches
1931 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
1932 (match-string 1 switches)))
1933 ;; Should labels be retained in (or stripped from)
1934 ;; src blocks?
1935 (retain-labels
1936 (or (not switches)
1937 (not (string-match "-r\\>" switches))
1938 (and number-lines (string-match "-k\\>" switches))))
1939 ;; What should code-references use - labels or
1940 ;; line-numbers?
1941 (use-labels
1942 (or (not switches)
1943 (and retain-labels (not (string-match "-k\\>" switches)))))
1944 ;; Get visibility status.
1945 (hidden (progn (forward-line) (org-invisible-p2)))
1946 ;; Retrieve code.
1947 (value (buffer-substring-no-properties (point) contents-end))
1948 (pos-before-blank (progn (goto-char contents-end)
1949 (forward-line)
1950 (point)))
1951 ;; Get position after ending blank lines.
1952 (end (progn (skip-chars-forward " \r\t\n" limit)
1953 (if (eobp) (point) (point-at-bol)))))
1954 (list 'src-block
1955 (nconc
1956 (list :language language
1957 :switches (and (org-string-nw-p switches)
1958 (org-trim switches))
1959 :parameters (and (org-string-nw-p parameters)
1960 (org-trim parameters))
1961 :begin begin
1962 :end end
1963 :number-lines number-lines
1964 :preserve-indent preserve-indent
1965 :retain-labels retain-labels
1966 :use-labels use-labels
1967 :label-fmt label-fmt
1968 :hiddenp hidden
1969 :value value
1970 :post-blank (count-lines pos-before-blank end))
1971 (cadr keywords)))))))))
1973 (defun org-element-src-block-interpreter (src-block contents)
1974 "Interpret SRC-BLOCK element as Org syntax.
1975 CONTENTS is nil."
1976 (let ((lang (org-element-property :language src-block))
1977 (switches (org-element-property :switches src-block))
1978 (params (org-element-property :parameters src-block))
1979 (value (let ((val (org-element-property :value src-block)))
1980 (cond
1982 (org-src-preserve-indentation val)
1983 ((zerop org-edit-src-content-indentation)
1984 (org-remove-indentation val))
1986 (let ((ind (make-string
1987 org-edit-src-content-indentation 32)))
1988 (replace-regexp-in-string
1989 "\\(^\\)[ \t]*\\S-" ind
1990 (org-remove-indentation val) nil nil 1)))))))
1991 (concat (format "#+BEGIN_SRC%s\n"
1992 (concat (and lang (concat " " lang))
1993 (and switches (concat " " switches))
1994 (and params (concat " " params))))
1995 value
1996 "#+END_SRC")))
1999 ;;;; Table
2001 (defun org-element-table-parser (limit)
2002 "Parse a table at point.
2004 LIMIT bounds the search.
2006 Return a list whose CAR is `table' and CDR is a plist containing
2007 `:begin', `:end', `:tblfm', `:type', `:contents-begin',
2008 `:contents-end', `:value' and `:post-blank' keywords.
2010 Assume point is at the beginning of the table."
2011 (save-excursion
2012 (let* ((case-fold-search t)
2013 (table-begin (point))
2014 (type (if (org-at-table.el-p) 'table.el 'org))
2015 (keywords (org-element--collect-affiliated-keywords))
2016 (begin (car keywords))
2017 (table-end (goto-char (marker-position (org-table-end t))))
2018 (tblfm (let (acc)
2019 (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
2020 (push (org-match-string-no-properties 1) acc)
2021 (forward-line))
2022 acc))
2023 (pos-before-blank (point))
2024 (end (progn (skip-chars-forward " \r\t\n" limit)
2025 (if (eobp) (point) (point-at-bol)))))
2026 (list 'table
2027 (nconc
2028 (list :begin begin
2029 :end end
2030 :type type
2031 :tblfm tblfm
2032 ;; Only `org' tables have contents. `table.el' tables
2033 ;; use a `:value' property to store raw table as
2034 ;; a string.
2035 :contents-begin (and (eq type 'org) table-begin)
2036 :contents-end (and (eq type 'org) table-end)
2037 :value (and (eq type 'table.el)
2038 (buffer-substring-no-properties
2039 table-begin table-end))
2040 :post-blank (count-lines pos-before-blank end))
2041 (cadr keywords))))))
2043 (defun org-element-table-interpreter (table contents)
2044 "Interpret TABLE element as Org syntax.
2045 CONTENTS is nil."
2046 (if (eq (org-element-property :type table) 'table.el)
2047 (org-remove-indentation (org-element-property :value table))
2048 (concat (with-temp-buffer (insert contents)
2049 (org-table-align)
2050 (buffer-string))
2051 (mapconcat (lambda (fm) (concat "#+TBLFM: " fm))
2052 (reverse (org-element-property :tblfm table))
2053 "\n"))))
2056 ;;;; Table Row
2058 (defun org-element-table-row-parser (limit)
2059 "Parse table row at point.
2061 LIMIT bounds the search.
2063 Return a list whose CAR is `table-row' and CDR is a plist
2064 containing `:begin', `:end', `:contents-begin', `:contents-end',
2065 `:type' and `:post-blank' keywords."
2066 (save-excursion
2067 (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
2068 (begin (point))
2069 ;; A table rule has no contents. In that case, ensure
2070 ;; CONTENTS-BEGIN matches CONTENTS-END.
2071 (contents-begin (and (eq type 'standard)
2072 (search-forward "|")
2073 (point)))
2074 (contents-end (and (eq type 'standard)
2075 (progn
2076 (end-of-line)
2077 (skip-chars-backward " \t")
2078 (point))))
2079 (end (progn (forward-line) (point))))
2080 (list 'table-row
2081 (list :type type
2082 :begin begin
2083 :end end
2084 :contents-begin contents-begin
2085 :contents-end contents-end
2086 :post-blank 0)))))
2088 (defun org-element-table-row-interpreter (table-row contents)
2089 "Interpret TABLE-ROW element as Org syntax.
2090 CONTENTS is the contents of the table row."
2091 (if (eq (org-element-property :type table-row) 'rule) "|-"
2092 (concat "| " contents)))
2095 ;;;; Verse Block
2097 (defun org-element-verse-block-parser (limit)
2098 "Parse a verse block.
2100 LIMIT bounds the search.
2102 Return a list whose CAR is `verse-block' and CDR is a plist
2103 containing `:begin', `:end', `:contents-begin', `:contents-end',
2104 `:hiddenp' and `:post-blank' keywords.
2106 Assume point is at beginning of the block."
2107 (let ((case-fold-search t))
2108 (if (not (save-excursion
2109 (re-search-forward "^[ \t]*#\\+END_VERSE" limit t)))
2110 ;; Incomplete block: parse it as a comment.
2111 (org-element-comment-parser limit)
2112 (let ((contents-end (match-beginning 0)))
2113 (save-excursion
2114 (let* ((keywords (org-element--collect-affiliated-keywords))
2115 (begin (car keywords))
2116 (hidden (progn (forward-line) (org-invisible-p2)))
2117 (contents-begin (point))
2118 (pos-before-blank (progn (goto-char contents-end)
2119 (forward-line)
2120 (point)))
2121 (end (progn (skip-chars-forward " \r\t\n" limit)
2122 (if (eobp) (point) (point-at-bol)))))
2123 (list 'verse-block
2124 (nconc
2125 (list :begin begin
2126 :end end
2127 :contents-begin contents-begin
2128 :contents-end contents-end
2129 :hiddenp hidden
2130 :post-blank (count-lines pos-before-blank end))
2131 (cadr keywords)))))))))
2133 (defun org-element-verse-block-interpreter (verse-block contents)
2134 "Interpret VERSE-BLOCK element as Org syntax.
2135 CONTENTS is verse block contents."
2136 (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
2140 ;;; Objects
2142 ;; Unlike to elements, interstices can be found between objects.
2143 ;; That's why, along with the parser, successor functions are provided
2144 ;; for each object. Some objects share the same successor (i.e. `code'
2145 ;; and `verbatim' objects).
2147 ;; A successor must accept a single argument bounding the search. It
2148 ;; will return either a cons cell whose CAR is the object's type, as
2149 ;; a symbol, and CDR the position of its next occurrence, or nil.
2151 ;; Successors follow the naming convention:
2152 ;; org-element-NAME-successor, where NAME is the name of the
2153 ;; successor, as defined in `org-element-all-successors'.
2155 ;; Some object types (i.e. `italic') are recursive. Restrictions on
2156 ;; object types they can contain will be specified in
2157 ;; `org-element-object-restrictions'.
2159 ;; Adding a new type of object is simple. Implement a successor,
2160 ;; a parser, and an interpreter for it, all following the naming
2161 ;; convention. Register type in `org-element-all-objects' and
2162 ;; successor in `org-element-all-successors'. Maybe tweak
2163 ;; restrictions about it, and that's it.
2166 ;;;; Bold
2168 (defun org-element-bold-parser ()
2169 "Parse bold object at point.
2171 Return a list whose CAR is `bold' and CDR is a plist with
2172 `:begin', `:end', `:contents-begin' and `:contents-end' and
2173 `:post-blank' keywords.
2175 Assume point is at the first star marker."
2176 (save-excursion
2177 (unless (bolp) (backward-char 1))
2178 (looking-at org-emph-re)
2179 (let ((begin (match-beginning 2))
2180 (contents-begin (match-beginning 4))
2181 (contents-end (match-end 4))
2182 (post-blank (progn (goto-char (match-end 2))
2183 (skip-chars-forward " \t")))
2184 (end (point)))
2185 (list 'bold
2186 (list :begin begin
2187 :end end
2188 :contents-begin contents-begin
2189 :contents-end contents-end
2190 :post-blank post-blank)))))
2192 (defun org-element-bold-interpreter (bold contents)
2193 "Interpret BOLD object as Org syntax.
2194 CONTENTS is the contents of the object."
2195 (format "*%s*" contents))
2197 (defun org-element-text-markup-successor (limit)
2198 "Search for the next text-markup object.
2200 LIMIT bounds the search.
2202 LIMIT bounds the search.
2204 Return value is a cons cell whose CAR is a symbol among `bold',
2205 `italic', `underline', `strike-through', `code' and `verbatim'
2206 and CDR is beginning position."
2207 (save-excursion
2208 (unless (bolp) (backward-char))
2209 (when (re-search-forward org-emph-re limit t)
2210 (let ((marker (match-string 3)))
2211 (cons (cond
2212 ((equal marker "*") 'bold)
2213 ((equal marker "/") 'italic)
2214 ((equal marker "_") 'underline)
2215 ((equal marker "+") 'strike-through)
2216 ((equal marker "~") 'code)
2217 ((equal marker "=") 'verbatim)
2218 (t (error "Unknown marker at %d" (match-beginning 3))))
2219 (match-beginning 2))))))
2222 ;;;; Code
2224 (defun org-element-code-parser ()
2225 "Parse code object at point.
2227 Return a list whose CAR is `code' and CDR is a plist with
2228 `:value', `:begin', `:end' and `:post-blank' keywords.
2230 Assume point is at the first tilde marker."
2231 (save-excursion
2232 (unless (bolp) (backward-char 1))
2233 (looking-at org-emph-re)
2234 (let ((begin (match-beginning 2))
2235 (value (org-match-string-no-properties 4))
2236 (post-blank (progn (goto-char (match-end 2))
2237 (skip-chars-forward " \t")))
2238 (end (point)))
2239 (list 'code
2240 (list :value value
2241 :begin begin
2242 :end end
2243 :post-blank post-blank)))))
2245 (defun org-element-code-interpreter (code contents)
2246 "Interpret CODE object as Org syntax.
2247 CONTENTS is nil."
2248 (format "~%s~" (org-element-property :value code)))
2251 ;;;; Entity
2253 (defun org-element-entity-parser ()
2254 "Parse entity at point.
2256 Return a list whose CAR is `entity' and CDR a plist with
2257 `:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
2258 `:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
2259 keywords.
2261 Assume point is at the beginning of the entity."
2262 (save-excursion
2263 (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
2264 (let* ((value (org-entity-get (match-string 1)))
2265 (begin (match-beginning 0))
2266 (bracketsp (string= (match-string 2) "{}"))
2267 (post-blank (progn (goto-char (match-end 1))
2268 (when bracketsp (forward-char 2))
2269 (skip-chars-forward " \t")))
2270 (end (point)))
2271 (list 'entity
2272 (list :name (car value)
2273 :latex (nth 1 value)
2274 :latex-math-p (nth 2 value)
2275 :html (nth 3 value)
2276 :ascii (nth 4 value)
2277 :latin1 (nth 5 value)
2278 :utf-8 (nth 6 value)
2279 :begin begin
2280 :end end
2281 :use-brackets-p bracketsp
2282 :post-blank post-blank)))))
2284 (defun org-element-entity-interpreter (entity contents)
2285 "Interpret ENTITY object as Org syntax.
2286 CONTENTS is nil."
2287 (concat "\\"
2288 (org-element-property :name entity)
2289 (when (org-element-property :use-brackets-p entity) "{}")))
2291 (defun org-element-latex-or-entity-successor (limit)
2292 "Search for the next latex-fragment or entity object.
2294 LIMIT bounds the search.
2296 Return value is a cons cell whose CAR is `entity' or
2297 `latex-fragment' and CDR is beginning position."
2298 (save-excursion
2299 (let ((matchers (plist-get org-format-latex-options :matchers))
2300 ;; ENTITY-RE matches both LaTeX commands and Org entities.
2301 (entity-re
2302 "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
2303 (when (re-search-forward
2304 (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
2305 matchers "\\|")
2306 "\\|" entity-re)
2307 limit t)
2308 (goto-char (match-beginning 0))
2309 (if (looking-at entity-re)
2310 ;; Determine if it's a real entity or a LaTeX command.
2311 (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
2312 (match-beginning 0))
2313 ;; No entity nor command: point is at a LaTeX fragment.
2314 ;; Determine its type to get the correct beginning position.
2315 (cons 'latex-fragment
2316 (catch 'return
2317 (mapc (lambda (e)
2318 (when (looking-at (nth 1 (assoc e org-latex-regexps)))
2319 (throw 'return
2320 (match-beginning
2321 (nth 2 (assoc e org-latex-regexps))))))
2322 matchers)
2323 (point))))))))
2326 ;;;; Export Snippet
2328 (defun org-element-export-snippet-parser ()
2329 "Parse export snippet at point.
2331 Return a list whose CAR is `export-snippet' and CDR a plist with
2332 `:begin', `:end', `:back-end', `:value' and `:post-blank' as
2333 keywords.
2335 Assume point is at the beginning of the snippet."
2336 (save-excursion
2337 (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t)
2338 (let* ((begin (match-beginning 0))
2339 (back-end (org-match-string-no-properties 1))
2340 (value (buffer-substring-no-properties
2341 (point)
2342 (progn (re-search-forward "@@" nil t) (match-beginning 0))))
2343 (post-blank (skip-chars-forward " \t"))
2344 (end (point)))
2345 (list 'export-snippet
2346 (list :back-end back-end
2347 :value value
2348 :begin begin
2349 :end end
2350 :post-blank post-blank)))))
2352 (defun org-element-export-snippet-interpreter (export-snippet contents)
2353 "Interpret EXPORT-SNIPPET object as Org syntax.
2354 CONTENTS is nil."
2355 (format "@@%s:%s@@"
2356 (org-element-property :back-end export-snippet)
2357 (org-element-property :value export-snippet)))
2359 (defun org-element-export-snippet-successor (limit)
2360 "Search for the next export-snippet object.
2362 LIMIT bounds the search.
2364 Return value is a cons cell whose CAR is `export-snippet' and CDR
2365 its beginning position."
2366 (save-excursion
2367 (let (beg)
2368 (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
2369 (setq beg (match-beginning 0))
2370 (re-search-forward "@@" limit t))
2371 (cons 'export-snippet beg)))))
2374 ;;;; Footnote Reference
2376 (defun org-element-footnote-reference-parser ()
2377 "Parse footnote reference at point.
2379 Return a list whose CAR is `footnote-reference' and CDR a plist
2380 with `:label', `:type', `:inline-definition', `:begin', `:end'
2381 and `:post-blank' as keywords."
2382 (save-excursion
2383 (looking-at org-footnote-re)
2384 (let* ((begin (point))
2385 (label (or (org-match-string-no-properties 2)
2386 (org-match-string-no-properties 3)
2387 (and (match-string 1)
2388 (concat "fn:" (org-match-string-no-properties 1)))))
2389 (type (if (or (not label) (match-string 1)) 'inline 'standard))
2390 (inner-begin (match-end 0))
2391 (inner-end
2392 (let ((count 1))
2393 (forward-char)
2394 (while (and (> count 0) (re-search-forward "[][]" nil t))
2395 (if (equal (match-string 0) "[") (incf count) (decf count)))
2396 (1- (point))))
2397 (post-blank (progn (goto-char (1+ inner-end))
2398 (skip-chars-forward " \t")))
2399 (end (point))
2400 (footnote-reference
2401 (list 'footnote-reference
2402 (list :label label
2403 :type type
2404 :begin begin
2405 :end end
2406 :post-blank post-blank))))
2407 (org-element-put-property
2408 footnote-reference :inline-definition
2409 (and (eq type 'inline)
2410 (org-element-parse-secondary-string
2411 (buffer-substring inner-begin inner-end)
2412 (org-element-restriction 'footnote-reference)
2413 footnote-reference))))))
2415 (defun org-element-footnote-reference-interpreter (footnote-reference contents)
2416 "Interpret FOOTNOTE-REFERENCE object as Org syntax.
2417 CONTENTS is nil."
2418 (let ((label (or (org-element-property :label footnote-reference) "fn:"))
2419 (def
2420 (let ((inline-def
2421 (org-element-property :inline-definition footnote-reference)))
2422 (if (not inline-def) ""
2423 (concat ":" (org-element-interpret-data inline-def))))))
2424 (format "[%s]" (concat label def))))
2426 (defun org-element-footnote-reference-successor (limit)
2427 "Search for the next footnote-reference object.
2429 LIMIT bounds the search.
2431 Return value is a cons cell whose CAR is `footnote-reference' and
2432 CDR is beginning position."
2433 (save-excursion
2434 (catch 'exit
2435 (while (re-search-forward org-footnote-re limit t)
2436 (save-excursion
2437 (let ((beg (match-beginning 0))
2438 (count 1))
2439 (backward-char)
2440 (while (re-search-forward "[][]" limit t)
2441 (if (equal (match-string 0) "[") (incf count) (decf count))
2442 (when (zerop count)
2443 (throw 'exit (cons 'footnote-reference beg))))))))))
2446 ;;;; Inline Babel Call
2448 (defun org-element-inline-babel-call-parser ()
2449 "Parse inline babel call at point.
2451 Return a list whose CAR is `inline-babel-call' and CDR a plist
2452 with `:begin', `:end', `:info' and `:post-blank' as keywords.
2454 Assume point is at the beginning of the babel call."
2455 (save-excursion
2456 (unless (bolp) (backward-char))
2457 (looking-at org-babel-inline-lob-one-liner-regexp)
2458 (let ((info (save-match-data (org-babel-lob-get-info)))
2459 (begin (match-end 1))
2460 (post-blank (progn (goto-char (match-end 0))
2461 (skip-chars-forward " \t")))
2462 (end (point)))
2463 (list 'inline-babel-call
2464 (list :begin begin
2465 :end end
2466 :info info
2467 :post-blank post-blank)))))
2469 (defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
2470 "Interpret INLINE-BABEL-CALL object as Org syntax.
2471 CONTENTS is nil."
2472 (let* ((babel-info (org-element-property :info inline-babel-call))
2473 (main-source (car babel-info))
2474 (post-options (nth 1 babel-info)))
2475 (concat "call_"
2476 (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
2477 ;; Remove redundant square brackets.
2478 (replace-match
2479 (match-string 1 main-source) nil nil main-source)
2480 main-source)
2481 (and post-options (format "[%s]" post-options)))))
2483 (defun org-element-inline-babel-call-successor (limit)
2484 "Search for the next inline-babel-call object.
2486 LIMIT bounds the search.
2488 Return value is a cons cell whose CAR is `inline-babel-call' and
2489 CDR is beginning position."
2490 (save-excursion
2491 ;; Use a simplified version of
2492 ;; org-babel-inline-lob-one-liner-regexp as regexp for more speed.
2493 (when (re-search-forward
2494 "\\(?:babel\\|call\\)_\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\([^\n]*\\))\\(\\[\\(.*?\\)\\]\\)?"
2495 limit t)
2496 (cons 'inline-babel-call (match-beginning 0)))))
2499 ;;;; Inline Src Block
2501 (defun org-element-inline-src-block-parser ()
2502 "Parse inline source block at point.
2504 LIMIT bounds the search.
2506 Return a list whose CAR is `inline-src-block' and CDR a plist
2507 with `:begin', `:end', `:language', `:value', `:parameters' and
2508 `:post-blank' as keywords.
2510 Assume point is at the beginning of the inline src block."
2511 (save-excursion
2512 (unless (bolp) (backward-char))
2513 (looking-at org-babel-inline-src-block-regexp)
2514 (let ((begin (match-beginning 1))
2515 (language (org-match-string-no-properties 2))
2516 (parameters (org-match-string-no-properties 4))
2517 (value (org-match-string-no-properties 5))
2518 (post-blank (progn (goto-char (match-end 0))
2519 (skip-chars-forward " \t")))
2520 (end (point)))
2521 (list 'inline-src-block
2522 (list :language language
2523 :value value
2524 :parameters parameters
2525 :begin begin
2526 :end end
2527 :post-blank post-blank)))))
2529 (defun org-element-inline-src-block-interpreter (inline-src-block contents)
2530 "Interpret INLINE-SRC-BLOCK object as Org syntax.
2531 CONTENTS is nil."
2532 (let ((language (org-element-property :language inline-src-block))
2533 (arguments (org-element-property :parameters inline-src-block))
2534 (body (org-element-property :value inline-src-block)))
2535 (format "src_%s%s{%s}"
2536 language
2537 (if arguments (format "[%s]" arguments) "")
2538 body)))
2540 (defun org-element-inline-src-block-successor (limit)
2541 "Search for the next inline-babel-call element.
2543 LIMIT bounds the search.
2545 Return value is a cons cell whose CAR is `inline-babel-call' and
2546 CDR is beginning position."
2547 (save-excursion
2548 (when (re-search-forward org-babel-inline-src-block-regexp limit t)
2549 (cons 'inline-src-block (match-beginning 1)))))
2551 ;;;; Italic
2553 (defun org-element-italic-parser ()
2554 "Parse italic object at point.
2556 Return a list whose CAR is `italic' and CDR is a plist with
2557 `:begin', `:end', `:contents-begin' and `:contents-end' and
2558 `:post-blank' keywords.
2560 Assume point is at the first slash marker."
2561 (save-excursion
2562 (unless (bolp) (backward-char 1))
2563 (looking-at org-emph-re)
2564 (let ((begin (match-beginning 2))
2565 (contents-begin (match-beginning 4))
2566 (contents-end (match-end 4))
2567 (post-blank (progn (goto-char (match-end 2))
2568 (skip-chars-forward " \t")))
2569 (end (point)))
2570 (list 'italic
2571 (list :begin begin
2572 :end end
2573 :contents-begin contents-begin
2574 :contents-end contents-end
2575 :post-blank post-blank)))))
2577 (defun org-element-italic-interpreter (italic contents)
2578 "Interpret ITALIC object as Org syntax.
2579 CONTENTS is the contents of the object."
2580 (format "/%s/" contents))
2583 ;;;; Latex Fragment
2585 (defun org-element-latex-fragment-parser ()
2586 "Parse latex fragment at point.
2588 Return a list whose CAR is `latex-fragment' and CDR a plist with
2589 `:value', `:begin', `:end', and `:post-blank' as keywords.
2591 Assume point is at the beginning of the latex fragment."
2592 (save-excursion
2593 (let* ((begin (point))
2594 (substring-match
2595 (catch 'exit
2596 (mapc (lambda (e)
2597 (let ((latex-regexp (nth 1 (assoc e org-latex-regexps))))
2598 (when (or (looking-at latex-regexp)
2599 (and (not (bobp))
2600 (save-excursion
2601 (backward-char)
2602 (looking-at latex-regexp))))
2603 (throw 'exit (nth 2 (assoc e org-latex-regexps))))))
2604 (plist-get org-format-latex-options :matchers))
2605 ;; None found: it's a macro.
2606 (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
2608 (value (match-string-no-properties substring-match))
2609 (post-blank (progn (goto-char (match-end substring-match))
2610 (skip-chars-forward " \t")))
2611 (end (point)))
2612 (list 'latex-fragment
2613 (list :value value
2614 :begin begin
2615 :end end
2616 :post-blank post-blank)))))
2618 (defun org-element-latex-fragment-interpreter (latex-fragment contents)
2619 "Interpret LATEX-FRAGMENT object as Org syntax.
2620 CONTENTS is nil."
2621 (org-element-property :value latex-fragment))
2623 ;;;; Line Break
2625 (defun org-element-line-break-parser ()
2626 "Parse line break at point.
2628 Return a list whose CAR is `line-break', and CDR a plist with
2629 `:begin', `:end' and `:post-blank' keywords.
2631 Assume point is at the beginning of the line break."
2632 (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0)))
2634 (defun org-element-line-break-interpreter (line-break contents)
2635 "Interpret LINE-BREAK object as Org syntax.
2636 CONTENTS is nil."
2637 "\\\\")
2639 (defun org-element-line-break-successor (limit)
2640 "Search for the next line-break object.
2642 LIMIT bounds the search.
2644 Return value is a cons cell whose CAR is `line-break' and CDR is
2645 beginning position."
2646 (save-excursion
2647 (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
2648 (goto-char (match-beginning 1)))))
2649 ;; A line break can only happen on a non-empty line.
2650 (when (and beg (re-search-backward "\\S-" (point-at-bol) t))
2651 (cons 'line-break beg)))))
2654 ;;;; Link
2656 (defun org-element-link-parser ()
2657 "Parse link at point.
2659 Return a list whose CAR is `link' and CDR a plist with `:type',
2660 `:path', `:raw-link', `:begin', `:end', `:contents-begin',
2661 `:contents-end' and `:post-blank' as keywords.
2663 Assume point is at the beginning of the link."
2664 (save-excursion
2665 (let ((begin (point))
2666 end contents-begin contents-end link-end post-blank path type
2667 raw-link link)
2668 (cond
2669 ;; Type 1: Text targeted from a radio target.
2670 ((and org-target-link-regexp (looking-at org-target-link-regexp))
2671 (setq type "radio"
2672 link-end (match-end 0)
2673 path (org-match-string-no-properties 0)))
2674 ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
2675 ((looking-at org-bracket-link-regexp)
2676 (setq contents-begin (match-beginning 3)
2677 contents-end (match-end 3)
2678 link-end (match-end 0)
2679 ;; RAW-LINK is the original link.
2680 raw-link (org-match-string-no-properties 1)
2681 link (org-translate-link
2682 (org-link-expand-abbrev
2683 (org-link-unescape raw-link))))
2684 ;; Determine TYPE of link and set PATH accordingly.
2685 (cond
2686 ;; File type.
2687 ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link))
2688 (setq type "file" path link))
2689 ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
2690 ((string-match org-link-re-with-space3 link)
2691 (setq type (match-string 1 link) path (match-string 2 link)))
2692 ;; Id type: PATH is the id.
2693 ((string-match "^id:\\([-a-f0-9]+\\)" link)
2694 (setq type "id" path (match-string 1 link)))
2695 ;; Code-ref type: PATH is the name of the reference.
2696 ((string-match "^(\\(.*\\))$" link)
2697 (setq type "coderef" path (match-string 1 link)))
2698 ;; Custom-id type: PATH is the name of the custom id.
2699 ((= (aref link 0) ?#)
2700 (setq type "custom-id" path (substring link 1)))
2701 ;; Fuzzy type: Internal link either matches a target, an
2702 ;; headline name or nothing. PATH is the target or
2703 ;; headline's name.
2704 (t (setq type "fuzzy" path link))))
2705 ;; Type 3: Plain link, i.e. http://orgmode.org
2706 ((looking-at org-plain-link-re)
2707 (setq raw-link (org-match-string-no-properties 0)
2708 type (org-match-string-no-properties 1)
2709 path (org-match-string-no-properties 2)
2710 link-end (match-end 0)))
2711 ;; Type 4: Angular link, i.e. <http://orgmode.org>
2712 ((looking-at org-angle-link-re)
2713 (setq raw-link (buffer-substring-no-properties
2714 (match-beginning 1) (match-end 2))
2715 type (org-match-string-no-properties 1)
2716 path (org-match-string-no-properties 2)
2717 link-end (match-end 0))))
2718 ;; In any case, deduce end point after trailing white space from
2719 ;; LINK-END variable.
2720 (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
2721 end (point))
2722 (list 'link
2723 (list :type type
2724 :path path
2725 :raw-link (or raw-link path)
2726 :begin begin
2727 :end end
2728 :contents-begin contents-begin
2729 :contents-end contents-end
2730 :post-blank post-blank)))))
2732 (defun org-element-link-interpreter (link contents)
2733 "Interpret LINK object as Org syntax.
2734 CONTENTS is the contents of the object, or nil."
2735 (let ((type (org-element-property :type link))
2736 (raw-link (org-element-property :raw-link link)))
2737 (if (string= type "radio") raw-link
2738 (format "[[%s]%s]"
2739 raw-link
2740 (if contents (format "[%s]" contents) "")))))
2742 (defun org-element-link-successor (limit)
2743 "Search for the next link object.
2745 LIMIT bounds the search.
2747 Return value is a cons cell whose CAR is `link' and CDR is
2748 beginning position."
2749 (save-excursion
2750 (let ((link-regexp
2751 (if (not org-target-link-regexp) org-any-link-re
2752 (concat org-any-link-re "\\|" org-target-link-regexp))))
2753 (when (re-search-forward link-regexp limit t)
2754 (cons 'link (match-beginning 0))))))
2757 ;;;; Macro
2759 (defun org-element-macro-parser ()
2760 "Parse macro at point.
2762 Return a list whose CAR is `macro' and CDR a plist with `:key',
2763 `:args', `:begin', `:end', `:value' and `:post-blank' as
2764 keywords.
2766 Assume point is at the macro."
2767 (save-excursion
2768 (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
2769 (let ((begin (point))
2770 (key (downcase (org-match-string-no-properties 1)))
2771 (value (org-match-string-no-properties 0))
2772 (post-blank (progn (goto-char (match-end 0))
2773 (skip-chars-forward " \t")))
2774 (end (point))
2775 (args (let ((args (org-match-string-no-properties 3)) args2)
2776 (when args
2777 (setq args (org-split-string args ","))
2778 (while args
2779 (while (string-match "\\\\\\'" (car args))
2780 ;; Repair bad splits.
2781 (setcar (cdr args) (concat (substring (car args) 0 -1)
2782 "," (nth 1 args)))
2783 (pop args))
2784 (push (pop args) args2))
2785 (mapcar 'org-trim (nreverse args2))))))
2786 (list 'macro
2787 (list :key key
2788 :value value
2789 :args args
2790 :begin begin
2791 :end end
2792 :post-blank post-blank)))))
2794 (defun org-element-macro-interpreter (macro contents)
2795 "Interpret MACRO object as Org syntax.
2796 CONTENTS is nil."
2797 (org-element-property :value macro))
2799 (defun org-element-macro-successor (limit)
2800 "Search for the next macro object.
2802 LIMIT bounds the search.
2804 Return value is cons cell whose CAR is `macro' and CDR is
2805 beginning position."
2806 (save-excursion
2807 (when (re-search-forward
2808 "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
2809 limit t)
2810 (cons 'macro (match-beginning 0)))))
2813 ;;;; Radio-target
2815 (defun org-element-radio-target-parser ()
2816 "Parse radio target at point.
2818 Return a list whose CAR is `radio-target' and CDR a plist with
2819 `:begin', `:end', `:contents-begin', `:contents-end', `:value'
2820 and `:post-blank' as keywords.
2822 Assume point is at the radio target."
2823 (save-excursion
2824 (looking-at org-radio-target-regexp)
2825 (let ((begin (point))
2826 (contents-begin (match-beginning 1))
2827 (contents-end (match-end 1))
2828 (value (org-match-string-no-properties 1))
2829 (post-blank (progn (goto-char (match-end 0))
2830 (skip-chars-forward " \t")))
2831 (end (point)))
2832 (list 'radio-target
2833 (list :begin begin
2834 :end end
2835 :contents-begin contents-begin
2836 :contents-end contents-end
2837 :post-blank post-blank
2838 :value value)))))
2840 (defun org-element-radio-target-interpreter (target contents)
2841 "Interpret TARGET object as Org syntax.
2842 CONTENTS is the contents of the object."
2843 (concat "<<<" contents ">>>"))
2845 (defun org-element-radio-target-successor (limit)
2846 "Search for the next radio-target object.
2848 LIMIT bounds the search.
2850 Return value is a cons cell whose CAR is `radio-target' and CDR
2851 is beginning position."
2852 (save-excursion
2853 (when (re-search-forward org-radio-target-regexp limit t)
2854 (cons 'radio-target (match-beginning 0)))))
2857 ;;;; Statistics Cookie
2859 (defun org-element-statistics-cookie-parser ()
2860 "Parse statistics cookie at point.
2862 Return a list whose CAR is `statistics-cookie', and CDR a plist
2863 with `:begin', `:end', `:value' and `:post-blank' keywords.
2865 Assume point is at the beginning of the statistics-cookie."
2866 (save-excursion
2867 (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
2868 (let* ((begin (point))
2869 (value (buffer-substring-no-properties
2870 (match-beginning 0) (match-end 0)))
2871 (post-blank (progn (goto-char (match-end 0))
2872 (skip-chars-forward " \t")))
2873 (end (point)))
2874 (list 'statistics-cookie
2875 (list :begin begin
2876 :end end
2877 :value value
2878 :post-blank post-blank)))))
2880 (defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
2881 "Interpret STATISTICS-COOKIE object as Org syntax.
2882 CONTENTS is nil."
2883 (org-element-property :value statistics-cookie))
2885 (defun org-element-statistics-cookie-successor (limit)
2886 "Search for the next statistics cookie object.
2888 LIMIT bounds the search.
2890 Return value is a cons cell whose CAR is `statistics-cookie' and
2891 CDR is beginning position."
2892 (save-excursion
2893 (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
2894 (cons 'statistics-cookie (match-beginning 0)))))
2897 ;;;; Strike-Through
2899 (defun org-element-strike-through-parser ()
2900 "Parse strike-through object at point.
2902 Return a list whose CAR is `strike-through' and CDR is a plist
2903 with `:begin', `:end', `:contents-begin' and `:contents-end' and
2904 `:post-blank' keywords.
2906 Assume point is at the first plus sign marker."
2907 (save-excursion
2908 (unless (bolp) (backward-char 1))
2909 (looking-at org-emph-re)
2910 (let ((begin (match-beginning 2))
2911 (contents-begin (match-beginning 4))
2912 (contents-end (match-end 4))
2913 (post-blank (progn (goto-char (match-end 2))
2914 (skip-chars-forward " \t")))
2915 (end (point)))
2916 (list 'strike-through
2917 (list :begin begin
2918 :end end
2919 :contents-begin contents-begin
2920 :contents-end contents-end
2921 :post-blank post-blank)))))
2923 (defun org-element-strike-through-interpreter (strike-through contents)
2924 "Interpret STRIKE-THROUGH object as Org syntax.
2925 CONTENTS is the contents of the object."
2926 (format "+%s+" contents))
2929 ;;;; Subscript
2931 (defun org-element-subscript-parser ()
2932 "Parse subscript at point.
2934 Return a list whose CAR is `subscript' and CDR a plist with
2935 `:begin', `:end', `:contents-begin', `:contents-end',
2936 `:use-brackets-p' and `:post-blank' as keywords.
2938 Assume point is at the underscore."
2939 (save-excursion
2940 (unless (bolp) (backward-char))
2941 (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
2943 (not (looking-at org-match-substring-regexp))))
2944 (begin (match-beginning 2))
2945 (contents-begin (or (match-beginning 5)
2946 (match-beginning 3)))
2947 (contents-end (or (match-end 5) (match-end 3)))
2948 (post-blank (progn (goto-char (match-end 0))
2949 (skip-chars-forward " \t")))
2950 (end (point)))
2951 (list 'subscript
2952 (list :begin begin
2953 :end end
2954 :use-brackets-p bracketsp
2955 :contents-begin contents-begin
2956 :contents-end contents-end
2957 :post-blank post-blank)))))
2959 (defun org-element-subscript-interpreter (subscript contents)
2960 "Interpret SUBSCRIPT object as Org syntax.
2961 CONTENTS is the contents of the object."
2962 (format
2963 (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
2964 contents))
2966 (defun org-element-sub/superscript-successor (limit)
2967 "Search for the next sub/superscript object.
2969 LIMIT bounds the search.
2971 Return value is a cons cell whose CAR is either `subscript' or
2972 `superscript' and CDR is beginning position."
2973 (save-excursion
2974 (when (re-search-forward org-match-substring-regexp limit t)
2975 (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
2976 (match-beginning 2)))))
2979 ;;;; Superscript
2981 (defun org-element-superscript-parser ()
2982 "Parse superscript at point.
2984 Return a list whose CAR is `superscript' and CDR a plist with
2985 `:begin', `:end', `:contents-begin', `:contents-end',
2986 `:use-brackets-p' and `:post-blank' as keywords.
2988 Assume point is at the caret."
2989 (save-excursion
2990 (unless (bolp) (backward-char))
2991 (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
2992 (not (looking-at org-match-substring-regexp))))
2993 (begin (match-beginning 2))
2994 (contents-begin (or (match-beginning 5)
2995 (match-beginning 3)))
2996 (contents-end (or (match-end 5) (match-end 3)))
2997 (post-blank (progn (goto-char (match-end 0))
2998 (skip-chars-forward " \t")))
2999 (end (point)))
3000 (list 'superscript
3001 (list :begin begin
3002 :end end
3003 :use-brackets-p bracketsp
3004 :contents-begin contents-begin
3005 :contents-end contents-end
3006 :post-blank post-blank)))))
3008 (defun org-element-superscript-interpreter (superscript contents)
3009 "Interpret SUPERSCRIPT object as Org syntax.
3010 CONTENTS is the contents of the object."
3011 (format
3012 (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s")
3013 contents))
3016 ;;;; Table Cell
3018 (defun org-element-table-cell-parser ()
3019 "Parse table cell at point.
3021 Return a list whose CAR is `table-cell' and CDR is a plist
3022 containing `:begin', `:end', `:contents-begin', `:contents-end'
3023 and `:post-blank' keywords."
3024 (looking-at "[ \t]*\\(.*?\\)[ \t]*|")
3025 (let* ((begin (match-beginning 0))
3026 (end (match-end 0))
3027 (contents-begin (match-beginning 1))
3028 (contents-end (match-end 1)))
3029 (list 'table-cell
3030 (list :begin begin
3031 :end end
3032 :contents-begin contents-begin
3033 :contents-end contents-end
3034 :post-blank 0))))
3036 (defun org-element-table-cell-interpreter (table-cell contents)
3037 "Interpret TABLE-CELL element as Org syntax.
3038 CONTENTS is the contents of the cell, or nil."
3039 (concat " " contents " |"))
3041 (defun org-element-table-cell-successor (limit)
3042 "Search for the next table-cell object.
3044 LIMIT bounds the search.
3046 Return value is a cons cell whose CAR is `table-cell' and CDR is
3047 beginning position."
3048 (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point))))
3051 ;;;; Target
3053 (defun org-element-target-parser ()
3054 "Parse target at point.
3056 Return a list whose CAR is `target' and CDR a plist with
3057 `:begin', `:end', `:value' and `:post-blank' as keywords.
3059 Assume point is at the target."
3060 (save-excursion
3061 (looking-at org-target-regexp)
3062 (let ((begin (point))
3063 (value (org-match-string-no-properties 1))
3064 (post-blank (progn (goto-char (match-end 0))
3065 (skip-chars-forward " \t")))
3066 (end (point)))
3067 (list 'target
3068 (list :begin begin
3069 :end end
3070 :value value
3071 :post-blank post-blank)))))
3073 (defun org-element-target-interpreter (target contents)
3074 "Interpret TARGET object as Org syntax.
3075 CONTENTS is nil."
3076 (format "<<%s>>" (org-element-property :value target)))
3078 (defun org-element-target-successor (limit)
3079 "Search for the next target object.
3081 LIMIT bounds the search.
3083 Return value is a cons cell whose CAR is `target' and CDR is
3084 beginning position."
3085 (save-excursion
3086 (when (re-search-forward org-target-regexp limit t)
3087 (cons 'target (match-beginning 0)))))
3090 ;;;; Timestamp
3092 (defun org-element-timestamp-parser ()
3093 "Parse time stamp at point.
3095 Return a list whose CAR is `timestamp', and CDR a plist with
3096 `:type', `:begin', `:end', `:value' and `:post-blank' keywords.
3098 Assume point is at the beginning of the timestamp."
3099 (save-excursion
3100 (let* ((begin (point))
3101 (activep (eq (char-after) ?<))
3102 (main-value
3103 (progn
3104 (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?")
3105 (match-string-no-properties 1)))
3106 (range-end (match-string-no-properties 3))
3107 (type (cond ((match-string 2) 'diary)
3108 ((and activep range-end) 'active-range)
3109 (activep 'active)
3110 (range-end 'inactive-range)
3111 (t 'inactive)))
3112 (post-blank (progn (goto-char (match-end 0))
3113 (skip-chars-forward " \t")))
3114 (end (point)))
3115 (list 'timestamp
3116 (list :type type
3117 :value main-value
3118 :range-end range-end
3119 :begin begin
3120 :end end
3121 :post-blank post-blank)))))
3123 (defun org-element-timestamp-interpreter (timestamp contents)
3124 "Interpret TIMESTAMP object as Org syntax.
3125 CONTENTS is nil."
3126 (let ((type (org-element-property :type timestamp) ))
3127 (concat
3128 (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>")
3129 (org-element-property :value timestamp))
3130 (let ((range-end (org-element-property :range-end timestamp)))
3131 (when range-end
3132 (concat "--"
3133 (format (if (eq type 'inactive-range) "[%s]" "<%s>")
3134 range-end)))))))
3136 (defun org-element-timestamp-successor (limit)
3137 "Search for the next timestamp object.
3139 LIMIT bounds the search.
3141 Return value is a cons cell whose CAR is `timestamp' and CDR is
3142 beginning position."
3143 (save-excursion
3144 (when (re-search-forward
3145 (concat org-ts-regexp-both
3146 "\\|"
3147 "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
3148 "\\|"
3149 "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
3150 limit t)
3151 (cons 'timestamp (match-beginning 0)))))
3154 ;;;; Underline
3156 (defun org-element-underline-parser ()
3157 "Parse underline object at point.
3159 Return a list whose CAR is `underline' and CDR is a plist with
3160 `:begin', `:end', `:contents-begin' and `:contents-end' and
3161 `:post-blank' keywords.
3163 Assume point is at the first underscore marker."
3164 (save-excursion
3165 (unless (bolp) (backward-char 1))
3166 (looking-at org-emph-re)
3167 (let ((begin (match-beginning 2))
3168 (contents-begin (match-beginning 4))
3169 (contents-end (match-end 4))
3170 (post-blank (progn (goto-char (match-end 2))
3171 (skip-chars-forward " \t")))
3172 (end (point)))
3173 (list 'underline
3174 (list :begin begin
3175 :end end
3176 :contents-begin contents-begin
3177 :contents-end contents-end
3178 :post-blank post-blank)))))
3180 (defun org-element-underline-interpreter (underline contents)
3181 "Interpret UNDERLINE object as Org syntax.
3182 CONTENTS is the contents of the object."
3183 (format "_%s_" contents))
3186 ;;;; Verbatim
3188 (defun org-element-verbatim-parser ()
3189 "Parse verbatim object at point.
3191 Return a list whose CAR is `verbatim' and CDR is a plist with
3192 `:value', `:begin', `:end' and `:post-blank' keywords.
3194 Assume point is at the first equal sign marker."
3195 (save-excursion
3196 (unless (bolp) (backward-char 1))
3197 (looking-at org-emph-re)
3198 (let ((begin (match-beginning 2))
3199 (value (org-match-string-no-properties 4))
3200 (post-blank (progn (goto-char (match-end 2))
3201 (skip-chars-forward " \t")))
3202 (end (point)))
3203 (list 'verbatim
3204 (list :value value
3205 :begin begin
3206 :end end
3207 :post-blank post-blank)))))
3209 (defun org-element-verbatim-interpreter (verbatim contents)
3210 "Interpret VERBATIM object as Org syntax.
3211 CONTENTS is nil."
3212 (format "=%s=" (org-element-property :value verbatim)))
3216 ;;; Parsing Element Starting At Point
3218 ;; `org-element--current-element' is the core function of this section.
3219 ;; It returns the Lisp representation of the element starting at
3220 ;; point.
3222 ;; `org-element--current-element' makes use of special modes. They
3223 ;; are activated for fixed element chaining (i.e. `plain-list' >
3224 ;; `item') or fixed conditional element chaining (i.e. `headline' >
3225 ;; `section'). Special modes are: `first-section', `section',
3226 ;; `quote-section', `item' and `table-row'.
3228 (defun org-element--current-element
3229 (limit &optional granularity special structure)
3230 "Parse the element starting at point.
3232 LIMIT bounds the search.
3234 Return value is a list like (TYPE PROPS) where TYPE is the type
3235 of the element and PROPS a plist of properties associated to the
3236 element.
3238 Possible types are defined in `org-element-all-elements'.
3240 Optional argument GRANULARITY determines the depth of the
3241 recursion. Allowed values are `headline', `greater-element',
3242 `element', `object' or nil. When it is broader than `object' (or
3243 nil), secondary values will not be parsed, since they only
3244 contain objects.
3246 Optional argument SPECIAL, when non-nil, can be either
3247 `first-section', `section', `quote-section', `table-row' and
3248 `item'.
3250 If STRUCTURE isn't provided but SPECIAL is set to `item', it will
3251 be computed.
3253 This function assumes point is always at the beginning of the
3254 element it has to parse."
3255 (save-excursion
3256 ;; If point is at an affiliated keyword, try moving to the
3257 ;; beginning of the associated element. If none is found, the
3258 ;; keyword is orphaned and will be treated as plain text.
3259 (when (looking-at org-element--affiliated-re)
3260 (let ((opoint (point)))
3261 (while (looking-at org-element--affiliated-re) (forward-line))
3262 (when (looking-at "[ \t]*$") (goto-char opoint))))
3263 (let ((case-fold-search t)
3264 ;; Determine if parsing depth allows for secondary strings
3265 ;; parsing. It only applies to elements referenced in
3266 ;; `org-element-secondary-value-alist'.
3267 (raw-secondary-p (and granularity (not (eq granularity 'object)))))
3268 (cond
3269 ;; Item.
3270 ((eq special 'item)
3271 (org-element-item-parser limit structure raw-secondary-p))
3272 ;; Quote Section.
3273 ((eq special 'quote-section) (org-element-quote-section-parser limit))
3274 ;; Table Row.
3275 ((eq special 'table-row) (org-element-table-row-parser limit))
3276 ;; Headline.
3277 ((org-with-limited-levels (org-at-heading-p))
3278 (org-element-headline-parser limit raw-secondary-p))
3279 ;; Section (must be checked after headline).
3280 ((eq special 'section) (org-element-section-parser limit))
3281 ((eq special 'first-section)
3282 (org-element-section-parser
3283 (or (save-excursion (org-with-limited-levels (outline-next-heading)))
3284 limit)))
3285 ;; Planning and Clock.
3286 ((and (looking-at org-planning-or-clock-line-re))
3287 (if (equal (match-string 1) org-clock-string)
3288 (org-element-clock-parser limit)
3289 (org-element-planning-parser limit)))
3290 ;; Inlinetask.
3291 ((org-at-heading-p)
3292 (org-element-inlinetask-parser limit raw-secondary-p))
3293 ;; LaTeX Environment.
3294 ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}")
3295 (if (save-excursion
3296 (re-search-forward
3297 (format "[ \t]*\\\\end{%s}[ \t]*"
3298 (regexp-quote (match-string 1)))
3299 nil t))
3300 (org-element-latex-environment-parser limit)
3301 (org-element-paragraph-parser limit)))
3302 ;; Drawer and Property Drawer.
3303 ((looking-at org-drawer-regexp)
3304 (let ((name (match-string 1)))
3305 (cond
3306 ((not (save-excursion
3307 (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)))
3308 (org-element-paragraph-parser limit))
3309 ((equal "PROPERTIES" name)
3310 (org-element-property-drawer-parser limit))
3311 (t (org-element-drawer-parser limit)))))
3312 ;; Fixed Width
3313 ((looking-at "[ \t]*:\\( \\|$\\)")
3314 (org-element-fixed-width-parser limit))
3315 ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
3316 ;; Keywords.
3317 ((looking-at "[ \t]*#")
3318 (goto-char (match-end 0))
3319 (cond ((looking-at "\\+BEGIN_\\(\\S-+\\)")
3320 (beginning-of-line)
3321 (let ((parser (assoc (upcase (match-string 1))
3322 org-element-block-name-alist)))
3323 (if parser (funcall (cdr parser) limit)
3324 (org-element-special-block-parser limit))))
3325 ((looking-at "\\+CALL")
3326 (beginning-of-line)
3327 (org-element-babel-call-parser limit))
3328 ((looking-at "\\+BEGIN:? ")
3329 (beginning-of-line)
3330 (org-element-dynamic-block-parser limit))
3331 ((looking-at "\\+\\S-+:")
3332 (beginning-of-line)
3333 (org-element-keyword-parser limit))
3335 (beginning-of-line)
3336 (org-element-comment-parser limit))))
3337 ;; Footnote Definition.
3338 ((looking-at org-footnote-definition-re)
3339 (org-element-footnote-definition-parser limit))
3340 ;; Horizontal Rule.
3341 ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
3342 (org-element-horizontal-rule-parser limit))
3343 ;; Table.
3344 ((org-at-table-p t) (org-element-table-parser limit))
3345 ;; List.
3346 ((looking-at (org-item-re))
3347 (org-element-plain-list-parser limit (or structure (org-list-struct))))
3348 ;; Default element: Paragraph.
3349 (t (org-element-paragraph-parser limit))))))
3352 ;; Most elements can have affiliated keywords. When looking for an
3353 ;; element beginning, we want to move before them, as they belong to
3354 ;; that element, and, in the meantime, collect information they give
3355 ;; into appropriate properties. Hence the following function.
3357 ;; Usage of optional arguments may not be obvious at first glance:
3359 ;; - TRANS-LIST is used to polish keywords names that have evolved
3360 ;; during Org history. In example, even though =result= and
3361 ;; =results= coexist, we want to have them under the same =result=
3362 ;; property. It's also true for "srcname" and "name", where the
3363 ;; latter seems to be preferred nowadays (thus the "name" property).
3365 ;; - CONSED allows to regroup multi-lines keywords under the same
3366 ;; property, while preserving their own identity. This is mostly
3367 ;; used for "attr_latex" and al.
3369 ;; - PARSED prepares a keyword value for export. This is useful for
3370 ;; "caption". Objects restrictions for such keywords are defined in
3371 ;; `org-element-object-restrictions'.
3373 ;; - DUALS is used to take care of keywords accepting a main and an
3374 ;; optional secondary values. For example "results" has its
3375 ;; source's name as the main value, and may have an hash string in
3376 ;; optional square brackets as the secondary one.
3378 ;; A keyword may belong to more than one category.
3380 (defun org-element--collect-affiliated-keywords
3381 (&optional key-re trans-list consed parsed duals)
3382 "Collect affiliated keywords before point.
3384 Optional argument KEY-RE is a regexp matching keywords, which
3385 puts matched keyword in group 1. It defaults to
3386 `org-element--affiliated-re'.
3388 TRANS-LIST is an alist where key is the keyword and value the
3389 property name it should be translated to, without the colons. It
3390 defaults to `org-element-keyword-translation-alist'.
3392 CONSED is a list of strings. Any keyword belonging to that list
3393 will have its value consed. The check is done after keyword
3394 translation. It defaults to `org-element-multiple-keywords'.
3396 PARSED is a list of strings. Any keyword member of this list
3397 will have its value parsed. The check is done after keyword
3398 translation. If a keyword is a member of both CONSED and PARSED,
3399 it's value will be a list of parsed strings. It defaults to
3400 `org-element-parsed-keywords'.
3402 DUALS is a list of strings. Any keyword member of this list can
3403 have two parts: one mandatory and one optional. Its value is
3404 a cons cell whose CAR is the former, and the CDR the latter. If
3405 a keyword is a member of both PARSED and DUALS, both values will
3406 be parsed. It defaults to `org-element-dual-keywords'.
3408 Return a list whose CAR is the position at the first of them and
3409 CDR a plist of keywords and values."
3410 (save-excursion
3411 (let ((case-fold-search t)
3412 (key-re (or key-re org-element--affiliated-re))
3413 (trans-list (or trans-list org-element-keyword-translation-alist))
3414 (consed (or consed org-element-multiple-keywords))
3415 (parsed (or parsed org-element-parsed-keywords))
3416 (duals (or duals org-element-dual-keywords))
3417 ;; RESTRICT is the list of objects allowed in parsed
3418 ;; keywords value.
3419 (restrict (org-element-restriction 'keyword))
3420 output)
3421 (unless (bobp)
3422 (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re)))
3423 (let* ((raw-kwd (upcase (or (match-string 2) (match-string 1))))
3424 ;; Apply translation to RAW-KWD. From there, KWD is
3425 ;; the official keyword.
3426 (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd))
3427 ;; Find main value for any keyword.
3428 (value
3429 (save-match-data
3430 (org-trim
3431 (buffer-substring-no-properties
3432 (match-end 0) (point-at-eol)))))
3433 ;; If KWD is a dual keyword, find its secondary
3434 ;; value. Maybe parse it.
3435 (dual-value
3436 (and (member kwd duals)
3437 (let ((sec (org-match-string-no-properties 3)))
3438 (if (or (not sec) (not (member kwd parsed))) sec
3439 (org-element-parse-secondary-string sec restrict)))))
3440 ;; Attribute a property name to KWD.
3441 (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
3442 ;; Now set final shape for VALUE.
3443 (when (member kwd parsed)
3444 (setq value (org-element-parse-secondary-string value restrict)))
3445 (when (member kwd duals)
3446 ;; VALUE is mandatory. Set it to nil if there is none.
3447 (setq value (and value (cons value dual-value))))
3448 ;; Attributes are always consed.
3449 (when (or (member kwd consed) (string-match "^ATTR_" kwd))
3450 (setq value (cons value (plist-get output kwd-sym))))
3451 ;; Eventually store the new value in OUTPUT.
3452 (setq output (plist-put output kwd-sym value))))
3453 (unless (looking-at key-re) (forward-line 1)))
3454 (list (point) output))))
3458 ;;; The Org Parser
3460 ;; The two major functions here are `org-element-parse-buffer', which
3461 ;; parses Org syntax inside the current buffer, taking into account
3462 ;; region, narrowing, or even visibility if specified, and
3463 ;; `org-element-parse-secondary-string', which parses objects within
3464 ;; a given string.
3466 ;; The (almost) almighty `org-element-map' allows to apply a function
3467 ;; on elements or objects matching some type, and accumulate the
3468 ;; resulting values. In an export situation, it also skips unneeded
3469 ;; parts of the parse tree.
3471 (defun org-element-parse-buffer (&optional granularity visible-only)
3472 "Recursively parse the buffer and return structure.
3473 If narrowing is in effect, only parse the visible part of the
3474 buffer.
3476 Optional argument GRANULARITY determines the depth of the
3477 recursion. It can be set to the following symbols:
3479 `headline' Only parse headlines.
3480 `greater-element' Don't recurse into greater elements excepted
3481 headlines and sections. Thus, elements
3482 parsed are the top-level ones.
3483 `element' Parse everything but objects and plain text.
3484 `object' Parse the complete buffer (default).
3486 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
3487 elements.
3489 Assume buffer is in Org mode."
3490 (save-excursion
3491 (goto-char (point-min))
3492 (org-skip-whitespace)
3493 (org-element--parse-elements
3494 (point-at-bol) (point-max)
3495 ;; Start in `first-section' mode so text before the first
3496 ;; headline belongs to a section.
3497 'first-section nil granularity visible-only (list 'org-data nil))))
3499 (defun org-element-parse-secondary-string (string restriction &optional parent)
3500 "Recursively parse objects in STRING and return structure.
3502 RESTRICTION is a symbol limiting the object types that will be
3503 looked after.
3505 Optional argument PARENT, when non-nil, is the element or object
3506 containing the secondary string. It is used to set correctly
3507 `:parent' property within the string."
3508 (with-temp-buffer
3509 (insert string)
3510 (let ((secondary (org-element--parse-objects
3511 (point-min) (point-max) nil restriction)))
3512 (mapc (lambda (obj) (org-element-put-property obj :parent parent))
3513 secondary))))
3515 (defun org-element-map (data types fun &optional info first-match no-recursion)
3516 "Map a function on selected elements or objects.
3518 DATA is the parsed tree, as returned by, i.e,
3519 `org-element-parse-buffer'. TYPES is a symbol or list of symbols
3520 of elements or objects types. FUN is the function called on the
3521 matching element or object. It must accept one arguments: the
3522 element or object itself.
3524 When optional argument INFO is non-nil, it should be a plist
3525 holding export options. In that case, parts of the parse tree
3526 not exportable according to that property list will be skipped.
3528 When optional argument FIRST-MATCH is non-nil, stop at the first
3529 match for which FUN doesn't return nil, and return that value.
3531 Optional argument NO-RECURSION is a symbol or a list of symbols
3532 representing elements or objects types. `org-element-map' won't
3533 enter any recursive element or object whose type belongs to that
3534 list. Though, FUN can still be applied on them.
3536 Nil values returned from FUN do not appear in the results."
3537 ;; Ensure TYPES and NO-RECURSION are a list, even of one element.
3538 (unless (listp types) (setq types (list types)))
3539 (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
3540 ;; Recursion depth is determined by --CATEGORY.
3541 (let* ((--category
3542 (catch 'found
3543 (let ((category 'greater-elements))
3544 (mapc (lambda (type)
3545 (cond ((or (memq type org-element-all-objects)
3546 (eq type 'plain-text))
3547 ;; If one object is found, the function
3548 ;; has to recurse into every object.
3549 (throw 'found 'objects))
3550 ((not (memq type org-element-greater-elements))
3551 ;; If one regular element is found, the
3552 ;; function has to recurse, at lest, into
3553 ;; every element it encounters.
3554 (and (not (eq category 'elements))
3555 (setq category 'elements)))))
3556 types)
3557 category)))
3558 --acc
3559 --walk-tree
3560 (--walk-tree
3561 (function
3562 (lambda (--data)
3563 ;; Recursively walk DATA. INFO, if non-nil, is a plist
3564 ;; holding contextual information.
3565 (let ((--type (org-element-type --data)))
3566 (cond
3567 ((not --data))
3568 ;; Ignored element in an export context.
3569 ((and info (memq --data (plist-get info :ignore-list))))
3570 ;; Secondary string: only objects can be found there.
3571 ((not --type)
3572 (when (eq --category 'objects) (mapc --walk-tree --data)))
3573 ;; Unconditionally enter parse trees.
3574 ((eq --type 'org-data)
3575 (mapc --walk-tree (org-element-contents --data)))
3577 ;; Check if TYPE is matching among TYPES. If so,
3578 ;; apply FUN to --DATA and accumulate return value
3579 ;; into --ACC (or exit if FIRST-MATCH is non-nil).
3580 (when (memq --type types)
3581 (let ((result (funcall fun --data)))
3582 (cond ((not result))
3583 (first-match (throw '--map-first-match result))
3584 (t (push result --acc)))))
3585 ;; If --DATA has a secondary string that can contain
3586 ;; objects with their type among TYPES, look into it.
3587 (when (eq --category 'objects)
3588 (let ((sec-prop
3589 (assq --type org-element-secondary-value-alist)))
3590 (when sec-prop
3591 (funcall --walk-tree
3592 (org-element-property (cdr sec-prop) --data)))))
3593 ;; Determine if a recursion into --DATA is possible.
3594 (cond
3595 ;; --TYPE is explicitly removed from recursion.
3596 ((memq --type no-recursion))
3597 ;; --DATA has no contents.
3598 ((not (org-element-contents --data)))
3599 ;; Looking for greater elements but --DATA is simply
3600 ;; an element or an object.
3601 ((and (eq --category 'greater-elements)
3602 (not (memq --type org-element-greater-elements))))
3603 ;; Looking for elements but --DATA is an object.
3604 ((and (eq --category 'elements)
3605 (memq --type org-element-all-objects)))
3606 ;; In any other case, map contents.
3607 (t (mapc --walk-tree (org-element-contents --data)))))))))))
3608 (catch '--map-first-match
3609 (funcall --walk-tree data)
3610 ;; Return value in a proper order.
3611 (nreverse --acc))))
3613 ;; The following functions are internal parts of the parser.
3615 ;; The first one, `org-element--parse-elements' acts at the element's
3616 ;; level.
3618 ;; The second one, `org-element--parse-objects' applies on all objects
3619 ;; of a paragraph or a secondary string. It uses
3620 ;; `org-element--get-next-object-candidates' to optimize the search of
3621 ;; the next object in the buffer.
3623 ;; More precisely, that function looks for every allowed object type
3624 ;; first. Then, it discards failed searches, keeps further matches,
3625 ;; and searches again types matched behind point, for subsequent
3626 ;; calls. Thus, searching for a given type fails only once, and every
3627 ;; object is searched only once at top level (but sometimes more for
3628 ;; nested types).
3630 (defun org-element--parse-elements
3631 (beg end special structure granularity visible-only acc)
3632 "Parse elements between BEG and END positions.
3634 SPECIAL prioritize some elements over the others. It can be set
3635 to `first-section', `quote-section', `section' `item' or
3636 `table-row'.
3638 When value is `item', STRUCTURE will be used as the current list
3639 structure.
3641 GRANULARITY determines the depth of the recursion. See
3642 `org-element-parse-buffer' for more information.
3644 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
3645 elements.
3647 Elements are accumulated into ACC."
3648 (save-excursion
3649 (goto-char beg)
3650 ;; When parsing only headlines, skip any text before first one.
3651 (when (and (eq granularity 'headline) (not (org-at-heading-p)))
3652 (org-with-limited-levels (outline-next-heading)))
3653 ;; Main loop start.
3654 (while (< (point) end)
3655 ;; Find current element's type and parse it accordingly to
3656 ;; its category.
3657 (let* ((element (org-element--current-element
3658 end granularity special structure))
3659 (type (org-element-type element))
3660 (cbeg (org-element-property :contents-begin element)))
3661 (goto-char (org-element-property :end element))
3662 ;; Fill ELEMENT contents by side-effect.
3663 (cond
3664 ;; If VISIBLE-ONLY is true and element is hidden or if it has
3665 ;; no contents, don't modify it.
3666 ((or (and visible-only (org-element-property :hiddenp element))
3667 (not cbeg)))
3668 ;; Greater element: parse it between `contents-begin' and
3669 ;; `contents-end'. Make sure GRANULARITY allows the
3670 ;; recursion, or ELEMENT is an headline, in which case going
3671 ;; inside is mandatory, in order to get sub-level headings.
3672 ((and (memq type org-element-greater-elements)
3673 (or (memq granularity '(element object nil))
3674 (and (eq granularity 'greater-element)
3675 (eq type 'section))
3676 (eq type 'headline)))
3677 (org-element--parse-elements
3678 cbeg (org-element-property :contents-end element)
3679 ;; Possibly switch to a special mode.
3680 (case type
3681 (headline
3682 (if (org-element-property :quotedp element) 'quote-section
3683 'section))
3684 (plain-list 'item)
3685 (table 'table-row))
3686 (org-element-property :structure element)
3687 granularity visible-only element))
3688 ;; ELEMENT has contents. Parse objects inside, if
3689 ;; GRANULARITY allows it.
3690 ((memq granularity '(object nil))
3691 (org-element--parse-objects
3692 cbeg (org-element-property :contents-end element) element
3693 (org-element-restriction type))))
3694 (org-element-adopt-element acc element t)))
3695 ;; Return result.
3696 acc))
3698 (defun org-element--parse-objects (beg end acc restriction)
3699 "Parse objects between BEG and END and return recursive structure.
3701 Objects are accumulated in ACC.
3703 RESTRICTION is a list of object types which are allowed in the
3704 current object."
3705 (let (candidates)
3706 (save-excursion
3707 (goto-char beg)
3708 (while (and (< (point) end)
3709 (setq candidates (org-element--get-next-object-candidates
3710 end restriction candidates)))
3711 (let ((next-object
3712 (let ((pos (apply 'min (mapcar 'cdr candidates))))
3713 (save-excursion
3714 (goto-char pos)
3715 (funcall (intern (format "org-element-%s-parser"
3716 (car (rassq pos candidates)))))))))
3717 ;; 1. Text before any object. Untabify it.
3718 (let ((obj-beg (org-element-property :begin next-object)))
3719 (unless (= (point) obj-beg)
3720 (setq acc
3721 (org-element-adopt-element
3723 (replace-regexp-in-string
3724 "\t" (make-string tab-width ? )
3725 (buffer-substring-no-properties (point) obj-beg)) t))))
3726 ;; 2. Object...
3727 (let ((obj-end (org-element-property :end next-object))
3728 (cont-beg (org-element-property :contents-begin next-object)))
3729 ;; Fill contents of NEXT-OBJECT by side-effect, if it has
3730 ;; a recursive type.
3731 (when (and cont-beg
3732 (memq (car next-object) org-element-recursive-objects))
3733 (save-restriction
3734 (narrow-to-region
3735 cont-beg
3736 (org-element-property :contents-end next-object))
3737 (org-element--parse-objects
3738 (point-min) (point-max) next-object
3739 (org-element-restriction next-object))))
3740 (setq acc (org-element-adopt-element acc next-object t))
3741 (goto-char obj-end))))
3742 ;; 3. Text after last object. Untabify it.
3743 (unless (= (point) end)
3744 (setq acc
3745 (org-element-adopt-element
3747 (replace-regexp-in-string
3748 "\t" (make-string tab-width ? )
3749 (buffer-substring-no-properties (point) end)) t)))
3750 ;; Result.
3751 acc)))
3753 (defun org-element--get-next-object-candidates (limit restriction objects)
3754 "Return an alist of candidates for the next object.
3756 LIMIT bounds the search, and RESTRICTION narrows candidates to
3757 some object types.
3759 Return value is an alist whose CAR is position and CDR the object
3760 type, as a symbol.
3762 OBJECTS is the previous candidates alist."
3763 (let (next-candidates types-to-search)
3764 ;; If no previous result, search every object type in RESTRICTION.
3765 ;; Otherwise, keep potential candidates (old objects located after
3766 ;; point) and ask to search again those which had matched before.
3767 (if (not objects) (setq types-to-search restriction)
3768 (mapc (lambda (obj)
3769 (if (< (cdr obj) (point)) (push (car obj) types-to-search)
3770 (push obj next-candidates)))
3771 objects))
3772 ;; Call the appropriate successor function for each type to search
3773 ;; and accumulate matches.
3774 (mapc
3775 (lambda (type)
3776 (let* ((successor-fun
3777 (intern
3778 (format "org-element-%s-successor"
3779 (or (cdr (assq type org-element-object-successor-alist))
3780 type))))
3781 (obj (funcall successor-fun limit)))
3782 (and obj (push obj next-candidates))))
3783 types-to-search)
3784 ;; Return alist.
3785 next-candidates))
3789 ;;; Towards A Bijective Process
3791 ;; The parse tree obtained with `org-element-parse-buffer' is really
3792 ;; a snapshot of the corresponding Org buffer. Therefore, it can be
3793 ;; interpreted and expanded into a string with canonical Org syntax.
3794 ;; Hence `org-element-interpret-data'.
3796 ;; The function relies internally on
3797 ;; `org-element--interpret-affiliated-keywords'.
3799 (defun org-element-interpret-data (data &optional parent)
3800 "Interpret DATA as Org syntax.
3802 DATA is a parse tree, an element, an object or a secondary string
3803 to interpret.
3805 Optional argument PARENT is used for recursive calls. It contains
3806 the element or object containing data, or nil.
3808 Return Org syntax as a string."
3809 (let* ((type (org-element-type data))
3810 (results
3811 (cond
3812 ;; Secondary string.
3813 ((not type)
3814 (mapconcat
3815 (lambda (obj) (org-element-interpret-data obj parent))
3816 data ""))
3817 ;; Full Org document.
3818 ((eq type 'org-data)
3819 (mapconcat
3820 (lambda (obj) (org-element-interpret-data obj parent))
3821 (org-element-contents data) ""))
3822 ;; Plain text.
3823 ((stringp data) data)
3824 ;; Element/Object without contents.
3825 ((not (org-element-contents data))
3826 (funcall (intern (format "org-element-%s-interpreter" type))
3827 data nil))
3828 ;; Element/Object with contents.
3830 (let* ((greaterp (memq type org-element-greater-elements))
3831 (objectp (and (not greaterp)
3832 (memq type org-element-recursive-objects)))
3833 (contents
3834 (mapconcat
3835 (lambda (obj) (org-element-interpret-data obj data))
3836 (org-element-contents
3837 (if (or greaterp objectp) data
3838 ;; Elements directly containing objects must
3839 ;; have their indentation normalized first.
3840 (org-element-normalize-contents
3841 data
3842 ;; When normalizing first paragraph of an
3843 ;; item or a footnote-definition, ignore
3844 ;; first line's indentation.
3845 (and (eq type 'paragraph)
3846 (equal data (car (org-element-contents parent)))
3847 (memq (org-element-type parent)
3848 '(footnote-definiton item))))))
3849 "")))
3850 (funcall (intern (format "org-element-%s-interpreter" type))
3851 data
3852 (if greaterp (org-element-normalize-contents contents)
3853 contents)))))))
3854 (if (memq type '(org-data plain-text nil)) results
3855 ;; Build white spaces. If no `:post-blank' property is
3856 ;; specified, assume its value is 0.
3857 (let ((post-blank (or (org-element-property :post-blank data) 0)))
3858 (if (memq type org-element-all-objects)
3859 (concat results (make-string post-blank 32))
3860 (concat
3861 (org-element--interpret-affiliated-keywords data)
3862 (org-element-normalize-string results)
3863 (make-string post-blank 10)))))))
3865 (defun org-element--interpret-affiliated-keywords (element)
3866 "Return ELEMENT's affiliated keywords as Org syntax.
3867 If there is no affiliated keyword, return the empty string."
3868 (let ((keyword-to-org
3869 (function
3870 (lambda (key value)
3871 (let (dual)
3872 (when (member key org-element-dual-keywords)
3873 (setq dual (cdr value) value (car value)))
3874 (concat "#+" key
3875 (and dual
3876 (format "[%s]" (org-element-interpret-data dual)))
3877 ": "
3878 (if (member key org-element-parsed-keywords)
3879 (org-element-interpret-data value)
3880 value)
3881 "\n"))))))
3882 (mapconcat
3883 (lambda (prop)
3884 (let ((value (org-element-property prop element))
3885 (keyword (upcase (substring (symbol-name prop) 1))))
3886 (when value
3887 (if (or (member keyword org-element-multiple-keywords)
3888 ;; All attribute keywords can have multiple lines.
3889 (string-match "^ATTR_" keyword))
3890 (mapconcat (lambda (line) (funcall keyword-to-org keyword line))
3891 value
3893 (funcall keyword-to-org keyword value)))))
3894 ;; List all ELEMENT's properties matching an attribute line or an
3895 ;; affiliated keyword, but ignore translated keywords since they
3896 ;; cannot belong to the property list.
3897 (loop for prop in (nth 1 element) by 'cddr
3898 when (let ((keyword (upcase (substring (symbol-name prop) 1))))
3899 (or (string-match "^ATTR_" keyword)
3900 (and
3901 (member keyword org-element-affiliated-keywords)
3902 (not (assoc keyword
3903 org-element-keyword-translation-alist)))))
3904 collect prop)
3905 "")))
3907 ;; Because interpretation of the parse tree must return the same
3908 ;; number of blank lines between elements and the same number of white
3909 ;; space after objects, some special care must be given to white
3910 ;; spaces.
3912 ;; The first function, `org-element-normalize-string', ensures any
3913 ;; string different from the empty string will end with a single
3914 ;; newline character.
3916 ;; The second function, `org-element-normalize-contents', removes
3917 ;; global indentation from the contents of the current element.
3919 (defun org-element-normalize-string (s)
3920 "Ensure string S ends with a single newline character.
3922 If S isn't a string return it unchanged. If S is the empty
3923 string, return it. Otherwise, return a new string with a single
3924 newline character at its end."
3925 (cond
3926 ((not (stringp s)) s)
3927 ((string= "" s) "")
3928 (t (and (string-match "\\(\n[ \t]*\\)*\\'" s)
3929 (replace-match "\n" nil nil s)))))
3931 (defun org-element-normalize-contents (element &optional ignore-first)
3932 "Normalize plain text in ELEMENT's contents.
3934 ELEMENT must only contain plain text and objects.
3936 If optional argument IGNORE-FIRST is non-nil, ignore first line's
3937 indentation to compute maximal common indentation.
3939 Return the normalized element that is element with global
3940 indentation removed from its contents. The function assumes that
3941 indentation is not done with TAB characters."
3942 (let* (ind-list ; for byte-compiler
3943 collect-inds ; for byte-compiler
3944 (collect-inds
3945 (function
3946 ;; Return list of indentations within BLOB. This is done by
3947 ;; walking recursively BLOB and updating IND-LIST along the
3948 ;; way. FIRST-FLAG is non-nil when the first string hasn't
3949 ;; been seen yet. It is required as this string is the only
3950 ;; one whose indentation doesn't happen after a newline
3951 ;; character.
3952 (lambda (blob first-flag)
3953 (mapc
3954 (lambda (object)
3955 (when (and first-flag (stringp object))
3956 (setq first-flag nil)
3957 (string-match "\\`\\( *\\)" object)
3958 (let ((len (length (match-string 1 object))))
3959 ;; An indentation of zero means no string will be
3960 ;; modified. Quit the process.
3961 (if (zerop len) (throw 'zero (setq ind-list nil))
3962 (push len ind-list))))
3963 (cond
3964 ((stringp object)
3965 (let ((start 0))
3966 ;; Avoid matching blank or empty lines.
3967 (while (and (string-match "\n\\( *\\)\\(.\\)" object start)
3968 (not (equal (match-string 2 object) " ")))
3969 (setq start (match-end 0))
3970 (push (length (match-string 1 object)) ind-list))))
3971 ((memq (org-element-type object) org-element-recursive-objects)
3972 (funcall collect-inds object first-flag))))
3973 (org-element-contents blob))))))
3974 ;; Collect indentation list in ELEMENT. Possibly remove first
3975 ;; value if IGNORE-FIRST is non-nil.
3976 (catch 'zero (funcall collect-inds element (not ignore-first)))
3977 (if (not ind-list) element
3978 ;; Build ELEMENT back, replacing each string with the same
3979 ;; string minus common indentation.
3980 (let* (build ; For byte compiler.
3981 (build
3982 (function
3983 (lambda (blob mci first-flag)
3984 ;; Return BLOB with all its strings indentation
3985 ;; shortened from MCI white spaces. FIRST-FLAG is
3986 ;; non-nil when the first string hasn't been seen
3987 ;; yet.
3988 (setcdr (cdr blob)
3989 (mapcar
3990 (lambda (object)
3991 (when (and first-flag (stringp object))
3992 (setq first-flag nil)
3993 (setq object
3994 (replace-regexp-in-string
3995 (format "\\` \\{%d\\}" mci) "" object)))
3996 (cond
3997 ((stringp object)
3998 (replace-regexp-in-string
3999 (format "\n \\{%d\\}" mci) "\n" object))
4000 ((memq (org-element-type object)
4001 org-element-recursive-objects)
4002 (funcall build object mci first-flag))
4003 (t object)))
4004 (org-element-contents blob)))
4005 blob))))
4006 (funcall build element (apply 'min ind-list) (not ignore-first))))))
4010 ;;; The Toolbox
4012 ;; The first move is to implement a way to obtain the smallest element
4013 ;; containing point. This is the job of `org-element-at-point'. It
4014 ;; basically jumps back to the beginning of section containing point
4015 ;; and moves, element after element, with
4016 ;; `org-element--current-element' until the container is found.
4018 ;; At a deeper level, `org-element-context' lists all elements and
4019 ;; objects containing point.
4021 ;; Note: When using `org-element-at-point', secondary values are never
4022 ;; parsed since the function focuses on elements, not on objects.
4024 ;;;###autoload
4025 (defun org-element-at-point (&optional keep-trail)
4026 "Determine closest element around point.
4028 Return value is a list like (TYPE PROPS) where TYPE is the type
4029 of the element and PROPS a plist of properties associated to the
4030 element.
4032 Possible types are defined in `org-element-all-elements'.
4033 Properties depend on element or object type, but always
4034 include :begin, :end, :parent and :post-blank properties.
4036 As a special case, if point is at the very beginning of a list or
4037 sub-list, returned element will be that list instead of the first
4038 item. In the same way, if point is at the beginning of the first
4039 row of a table, returned element will be the table instead of the
4040 first row.
4042 If optional argument KEEP-TRAIL is non-nil, the function returns
4043 a list of of elements leading to element at point. The list's
4044 CAR is always the element at point. Following positions contain
4045 element's siblings, then parents, siblings of parents, until the
4046 first element of current section."
4047 (org-with-wide-buffer
4048 ;; If at an headline, parse it. It is the sole element that
4049 ;; doesn't require to know about context. Be sure to disallow
4050 ;; secondary string parsing, though.
4051 (if (org-with-limited-levels (org-at-heading-p))
4052 (progn
4053 (beginning-of-line)
4054 (if (not keep-trail) (org-element-headline-parser (point-max) t)
4055 (list (org-element-headline-parser (point-max) t))))
4056 ;; Otherwise move at the beginning of the section containing
4057 ;; point.
4058 (let ((origin (point))
4059 (end (save-excursion
4060 (org-with-limited-levels (outline-next-heading)) (point)))
4061 element type special-flag trail struct prevs parent)
4062 (org-with-limited-levels
4063 (if (org-with-limited-levels (org-before-first-heading-p))
4064 (goto-char (point-min))
4065 (org-back-to-heading)
4066 (forward-line)))
4067 (org-skip-whitespace)
4068 (beginning-of-line)
4069 ;; Parse successively each element, skipping those ending
4070 ;; before original position.
4071 (catch 'exit
4072 (while t
4073 (setq element
4074 (org-element--current-element end 'element special-flag struct)
4075 type (car element))
4076 (org-element-put-property element :parent parent)
4077 (when keep-trail (push element trail))
4078 (cond
4079 ;; 1. Skip any element ending before point or at point
4080 ;; because the following element has started. On the
4081 ;; other hand, if the element ends at point and that
4082 ;; point is also the end of the buffer, do not skip it.
4083 ((let ((end (org-element-property :end element)))
4084 (when (or (< end origin)
4085 (and (= end origin) (/= (point-max) end)))
4086 (if (> (point-max) end) (goto-char end)
4087 (throw 'exit (if keep-trail trail element))))))
4088 ;; 2. An element containing point is always the element at
4089 ;; point.
4090 ((not (memq type org-element-greater-elements))
4091 (throw 'exit (if keep-trail trail element)))
4092 ;; 3. At any other greater element type, if point is
4093 ;; within contents, move into it. Otherwise, return
4094 ;; that element. As a special case, when ORIGIN is
4095 ;; contents end and is also the end of the buffer, try
4096 ;; to move inside the greater element to find the end
4097 ;; of the innermost element.
4099 (let ((cbeg (org-element-property :contents-begin element))
4100 (cend (org-element-property :contents-end element)))
4101 (if (or (not cbeg) (not cend) (> cbeg origin) (< cend origin)
4102 (and (= cend origin) (/= (point-max) origin))
4103 (and (= cbeg origin) (memq type '(plain-list table))))
4104 (throw 'exit (if keep-trail trail element))
4105 (setq parent element)
4106 (case type
4107 (plain-list
4108 (setq special-flag 'item
4109 struct (org-element-property :structure element)))
4110 (table (setq special-flag 'table-row))
4111 (otherwise (setq special-flag nil)))
4112 (setq end cend)
4113 (goto-char cbeg)))))))))))
4115 (defun org-element-context ()
4116 "Return closest element or object around point.
4118 Return value is a list like (TYPE PROPS) where TYPE is the type
4119 of the element or object and PROPS a plist of properties
4120 associated to it.
4122 Possible types are defined in `org-element-all-elements' and
4123 `org-element-all-objects'. Properties depend on element or
4124 object type, but always include :begin, :end, :parent
4125 and :post-blank properties."
4126 (org-with-wide-buffer
4127 (let* ((origin (point))
4128 (element (org-element-at-point))
4129 (type (car element))
4130 end)
4131 ;; Check if point is inside an element containing objects or at
4132 ;; a secondary string. In that case, move to beginning of the
4133 ;; element or secondary string and set END to the other side.
4134 (if (not (or (and (eq type 'item)
4135 (let ((tag (org-element-property :tag element)))
4136 (and tag
4137 (progn
4138 (beginning-of-line)
4139 (search-forward tag (point-at-eol))
4140 (goto-char (match-beginning 0))
4141 (and (>= origin (point))
4142 (<= origin
4143 ;; `1+' is required so some
4144 ;; successors can match
4145 ;; properly their object.
4146 (setq end (1+ (match-end 0)))))))))
4147 (and (memq type '(headline inlinetask))
4148 (progn (beginning-of-line)
4149 (skip-chars-forward "* ")
4150 (setq end (point-at-eol))))
4151 (and (memq type '(paragraph table-cell verse-block))
4152 (let ((cbeg (org-element-property
4153 :contents-begin element))
4154 (cend (org-element-property
4155 :contents-end element)))
4156 (and (>= origin cbeg)
4157 (<= origin cend)
4158 (progn (goto-char cbeg) (setq end cend)))))))
4159 element
4160 (let ((restriction (org-element-restriction element))
4161 (parent element)
4162 candidates)
4163 (catch 'exit
4164 (while (setq candidates (org-element--get-next-object-candidates
4165 end restriction candidates))
4166 (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
4167 candidates)))
4168 ;; If ORIGIN is before next object in element, there's
4169 ;; no point in looking further.
4170 (if (> (cdr closest-cand) origin) (throw 'exit element)
4171 (let* ((object
4172 (progn (goto-char (cdr closest-cand))
4173 (funcall (intern (format "org-element-%s-parser"
4174 (car closest-cand))))))
4175 (cbeg (org-element-property :contents-begin object))
4176 (cend (org-element-property :contents-end object)))
4177 (cond
4178 ;; ORIGIN is after OBJECT, so skip it.
4179 ((< (org-element-property :end object) origin)
4180 (goto-char (org-element-property :end object)))
4181 ;; ORIGIN is within a non-recursive object or at an
4182 ;; object boundaries: Return that object.
4183 ((or (not cbeg) (> cbeg origin) (< cend origin))
4184 (throw 'exit
4185 (org-element-put-property object :parent parent)))
4186 ;; Otherwise, move within current object and restrict
4187 ;; search to the end of its contents.
4188 (t (goto-char cbeg)
4189 (org-element-put-property object :parent parent)
4190 (setq parent object end cend)))))))
4191 parent))))))
4194 ;; Once the local structure around point is well understood, it's easy
4195 ;; to implement some replacements for `forward-paragraph'
4196 ;; `backward-paragraph', namely `org-element-forward' and
4197 ;; `org-element-backward'.
4199 ;; Also, `org-transpose-elements' mimics the behaviour of
4200 ;; `transpose-words', at the element's level, whereas
4201 ;; `org-element-drag-forward', `org-element-drag-backward', and
4202 ;; `org-element-up' generalize, respectively, functions
4203 ;; `org-subtree-down', `org-subtree-up' and `outline-up-heading'.
4205 ;; `org-element-unindent-buffer' will, as its name almost suggests,
4206 ;; smartly remove global indentation from buffer, making it possible
4207 ;; to use Org indent mode on a file created with hard indentation.
4209 ;; `org-element-nested-p' and `org-element-swap-A-B' are used
4210 ;; internally by some of the previously cited tools.
4212 (defsubst org-element-nested-p (elem-A elem-B)
4213 "Non-nil when elements ELEM-A and ELEM-B are nested."
4214 (let ((beg-A (org-element-property :begin elem-A))
4215 (beg-B (org-element-property :begin elem-B))
4216 (end-A (org-element-property :end elem-A))
4217 (end-B (org-element-property :end elem-B)))
4218 (or (and (>= beg-A beg-B) (<= end-A end-B))
4219 (and (>= beg-B beg-A) (<= end-B end-A)))))
4221 (defun org-element-swap-A-B (elem-A elem-B)
4222 "Swap elements ELEM-A and ELEM-B.
4223 Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
4224 end of ELEM-A."
4225 (goto-char (org-element-property :begin elem-A))
4226 ;; There are two special cases when an element doesn't start at bol:
4227 ;; the first paragraph in an item or in a footnote definition.
4228 (let ((specialp (not (bolp))))
4229 ;; Only a paragraph without any affiliated keyword can be moved at
4230 ;; ELEM-A position in such a situation. Note that the case of
4231 ;; a footnote definition is impossible: it cannot contain two
4232 ;; paragraphs in a row because it cannot contain a blank line.
4233 (if (and specialp
4234 (or (not (eq (org-element-type elem-B) 'paragraph))
4235 (/= (org-element-property :begin elem-B)
4236 (org-element-property :contents-begin elem-B))))
4237 (error "Cannot swap elements"))
4238 ;; In a special situation, ELEM-A will have no indentation. We'll
4239 ;; give it ELEM-B's (which will in, in turn, have no indentation).
4240 (let* ((ind-B (when specialp
4241 (goto-char (org-element-property :begin elem-B))
4242 (org-get-indentation)))
4243 (beg-A (org-element-property :begin elem-A))
4244 (end-A (save-excursion
4245 (goto-char (org-element-property :end elem-A))
4246 (skip-chars-backward " \r\t\n")
4247 (point-at-eol)))
4248 (beg-B (org-element-property :begin elem-B))
4249 (end-B (save-excursion
4250 (goto-char (org-element-property :end elem-B))
4251 (skip-chars-backward " \r\t\n")
4252 (point-at-eol)))
4253 ;; Store overlays responsible for visibility status. We
4254 ;; also need to store their boundaries as they will be
4255 ;; removed from buffer.
4256 (overlays
4257 (cons
4258 (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
4259 (overlays-in beg-A end-A))
4260 (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
4261 (overlays-in beg-B end-B))))
4262 ;; Get contents.
4263 (body-A (buffer-substring beg-A end-A))
4264 (body-B (delete-and-extract-region beg-B end-B)))
4265 (goto-char beg-B)
4266 (when specialp
4267 (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
4268 (org-indent-to-column ind-B))
4269 (insert body-A)
4270 ;; Restore ex ELEM-A overlays.
4271 (mapc (lambda (ov)
4272 (move-overlay
4273 (car ov)
4274 (+ (nth 1 ov) (- beg-B beg-A))
4275 (+ (nth 2 ov) (- beg-B beg-A))))
4276 (car overlays))
4277 (goto-char beg-A)
4278 (delete-region beg-A end-A)
4279 (insert body-B)
4280 ;; Restore ex ELEM-B overlays.
4281 (mapc (lambda (ov)
4282 (move-overlay (car ov)
4283 (+ (nth 1 ov) (- beg-A beg-B))
4284 (+ (nth 2 ov) (- beg-A beg-B))))
4285 (cdr overlays))
4286 (goto-char (org-element-property :end elem-B)))))
4288 ;;;###autoload
4289 (defun org-element-forward ()
4290 "Move forward by one element.
4291 Move to the next element at the same level, when possible."
4292 (interactive)
4293 (cond ((eobp) (error "Cannot move further down"))
4294 ((org-with-limited-levels (org-at-heading-p))
4295 (let ((origin (point)))
4296 (org-forward-same-level 1)
4297 (unless (org-with-limited-levels (org-at-heading-p))
4298 (goto-char origin)
4299 (error "Cannot move further down"))))
4301 (let* ((elem (org-element-at-point))
4302 (end (org-element-property :end elem))
4303 (parent (org-element-property :parent elem)))
4304 (if (and parent (= (org-element-property :contents-end parent) end))
4305 (goto-char (org-element-property :end parent))
4306 (goto-char end))))))
4308 ;;;###autoload
4309 (defun org-element-backward ()
4310 "Move backward by one element.
4311 Move to the previous element at the same level, when possible."
4312 (interactive)
4313 (if (org-with-limited-levels (org-at-heading-p))
4314 ;; At an headline, move to the previous one, if any, or stay
4315 ;; here.
4316 (let ((origin (point)))
4317 (org-backward-same-level 1)
4318 (unless (org-with-limited-levels (org-at-heading-p))
4319 (goto-char origin)
4320 (error "Cannot move further up")))
4321 (let* ((trail (org-element-at-point 'keep-trail))
4322 (elem (car trail))
4323 (prev-elem (nth 1 trail))
4324 (beg (org-element-property :begin elem)))
4325 (cond
4326 ;; Move to beginning of current element if point isn't there
4327 ;; already.
4328 ((/= (point) beg) (goto-char beg))
4329 ((not prev-elem) (error "Cannot move further up"))
4330 (t (goto-char (org-element-property :begin prev-elem)))))))
4332 ;;;###autoload
4333 (defun org-element-up ()
4334 "Move to upper element."
4335 (interactive)
4336 (if (org-with-limited-levels (org-at-heading-p))
4337 (unless (org-up-heading-safe) (error "No surrounding element"))
4338 (let* ((elem (org-element-at-point))
4339 (parent (org-element-property :parent elem)))
4340 (if parent (goto-char (org-element-property :begin parent))
4341 (if (org-with-limited-levels (org-before-first-heading-p))
4342 (error "No surrounding element")
4343 (org-with-limited-levels (org-back-to-heading)))))))
4345 ;;;###autoload
4346 (defun org-element-down ()
4347 "Move to inner element."
4348 (interactive)
4349 (let ((element (org-element-at-point)))
4350 (cond
4351 ((memq (org-element-type element) '(plain-list table))
4352 (goto-char (org-element-property :contents-begin element))
4353 (forward-char))
4354 ((memq (org-element-type element) org-element-greater-elements)
4355 ;; If contents are hidden, first disclose them.
4356 (when (org-element-property :hiddenp element) (org-cycle))
4357 (goto-char (or (org-element-property :contents-begin element)
4358 (error "No content for this element"))))
4359 (t (error "No inner element")))))
4361 ;;;###autoload
4362 (defun org-element-drag-backward ()
4363 "Move backward element at point."
4364 (interactive)
4365 (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
4366 (let* ((trail (org-element-at-point 'keep-trail))
4367 (elem (car trail))
4368 (prev-elem (nth 1 trail)))
4369 ;; Error out if no previous element or previous element is
4370 ;; a parent of the current one.
4371 (if (or (not prev-elem) (org-element-nested-p elem prev-elem))
4372 (error "Cannot drag element backward")
4373 (let ((pos (point)))
4374 (org-element-swap-A-B prev-elem elem)
4375 (goto-char (+ (org-element-property :begin prev-elem)
4376 (- pos (org-element-property :begin elem)))))))))
4378 ;;;###autoload
4379 (defun org-element-drag-forward ()
4380 "Move forward element at point."
4381 (interactive)
4382 (let* ((pos (point))
4383 (elem (org-element-at-point)))
4384 (when (= (point-max) (org-element-property :end elem))
4385 (error "Cannot drag element forward"))
4386 (goto-char (org-element-property :end elem))
4387 (let ((next-elem (org-element-at-point)))
4388 (when (or (org-element-nested-p elem next-elem)
4389 (and (eq (org-element-type next-elem) 'headline)
4390 (not (eq (org-element-type elem) 'headline))))
4391 (goto-char pos)
4392 (error "Cannot drag element forward"))
4393 ;; Compute new position of point: it's shifted by NEXT-ELEM
4394 ;; body's length (without final blanks) and by the length of
4395 ;; blanks between ELEM and NEXT-ELEM.
4396 (let ((size-next (- (save-excursion
4397 (goto-char (org-element-property :end next-elem))
4398 (skip-chars-backward " \r\t\n")
4399 (forward-line)
4400 ;; Small correction if buffer doesn't end
4401 ;; with a newline character.
4402 (if (and (eolp) (not (bolp))) (1+ (point)) (point)))
4403 (org-element-property :begin next-elem)))
4404 (size-blank (- (org-element-property :end elem)
4405 (save-excursion
4406 (goto-char (org-element-property :end elem))
4407 (skip-chars-backward " \r\t\n")
4408 (forward-line)
4409 (point)))))
4410 (org-element-swap-A-B elem next-elem)
4411 (goto-char (+ pos size-next size-blank))))))
4413 ;;;###autoload
4414 (defun org-element-mark-element ()
4415 "Put point at beginning of this element, mark at end.
4417 Interactively, if this command is repeated or (in Transient Mark
4418 mode) if the mark is active, it marks the next element after the
4419 ones already marked."
4420 (interactive)
4421 (let (deactivate-mark)
4422 (if (or (and (eq last-command this-command) (mark t))
4423 (and transient-mark-mode mark-active))
4424 (set-mark
4425 (save-excursion
4426 (goto-char (mark))
4427 (goto-char (org-element-property :end (org-element-at-point)))))
4428 (let ((element (org-element-at-point)))
4429 (end-of-line)
4430 (push-mark (org-element-property :end element) t t)
4431 (goto-char (org-element-property :begin element))))))
4433 ;;;###autoload
4434 (defun org-narrow-to-element ()
4435 "Narrow buffer to current element."
4436 (interactive)
4437 (let ((elem (org-element-at-point)))
4438 (cond
4439 ((eq (car elem) 'headline)
4440 (narrow-to-region
4441 (org-element-property :begin elem)
4442 (org-element-property :end elem)))
4443 ((memq (car elem) org-element-greater-elements)
4444 (narrow-to-region
4445 (org-element-property :contents-begin elem)
4446 (org-element-property :contents-end elem)))
4448 (narrow-to-region
4449 (org-element-property :begin elem)
4450 (org-element-property :end elem))))))
4452 ;;;###autoload
4453 (defun org-element-transpose ()
4454 "Transpose current and previous elements, keeping blank lines between.
4455 Point is moved after both elements."
4456 (interactive)
4457 (org-skip-whitespace)
4458 (let ((end (org-element-property :end (org-element-at-point))))
4459 (org-element-drag-backward)
4460 (goto-char end)))
4462 ;;;###autoload
4463 (defun org-element-unindent-buffer ()
4464 "Un-indent the visible part of the buffer.
4465 Relative indentation (between items, inside blocks, etc.) isn't
4466 modified."
4467 (interactive)
4468 (unless (eq major-mode 'org-mode)
4469 (error "Cannot un-indent a buffer not in Org mode"))
4470 (let* ((parse-tree (org-element-parse-buffer 'greater-element))
4471 unindent-tree ; For byte-compiler.
4472 (unindent-tree
4473 (function
4474 (lambda (contents)
4475 (mapc
4476 (lambda (element)
4477 (if (memq (org-element-type element) '(headline section))
4478 (funcall unindent-tree (org-element-contents element))
4479 (save-excursion
4480 (save-restriction
4481 (narrow-to-region
4482 (org-element-property :begin element)
4483 (org-element-property :end element))
4484 (org-do-remove-indentation)))))
4485 (reverse contents))))))
4486 (funcall unindent-tree (org-element-contents parse-tree))))
4489 (provide 'org-element)
4490 ;;; org-element.el ends here