org-element: Refactor code
[org-mode.git] / lisp / org-element.el
blob0fe947e516f34de41b8a2882cfc94f49c2d24e23
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))
116 ;;; Definitions And Rules
118 ;; Define elements, greater elements and specify recursive objects,
119 ;; along with the affiliated keywords recognized. Also set up
120 ;; restrictions on recursive objects combinations.
122 ;; These variables really act as a control center for the parsing
123 ;; process.
125 (defconst org-element-paragraph-separate
126 (concat "^[ \t]*$" "\\|"
127 ;; Headlines and inlinetasks.
128 org-outline-regexp-bol "\\|"
129 ;; Comments, blocks (any type), keywords and babel calls.
130 "^[ \t]*#\\+" "\\|" "^#\\(?: \\|$\\)" "\\|"
131 ;; Lists.
132 (org-item-beginning-re) "\\|"
133 ;; Fixed-width, drawers (any type) and tables.
134 "^[ \t]*[:|]" "\\|"
135 ;; Footnote definitions.
136 org-footnote-definition-re "\\|"
137 ;; Horizontal rules.
138 "^[ \t]*-\\{5,\\}[ \t]*$" "\\|"
139 ;; LaTeX environments.
140 "^[ \t]*\\\\\\(begin\\|end\\)" "\\|"
141 ;; Planning and Clock lines.
142 org-planning-or-clock-line-re)
143 "Regexp to separate paragraphs in an Org buffer.")
145 (defconst org-element-all-elements
146 '(center-block clock comment comment-block drawer dynamic-block example-block
147 export-block fixed-width footnote-definition headline
148 horizontal-rule inlinetask item keyword latex-environment
149 babel-call paragraph plain-list planning property-drawer
150 quote-block quote-section section special-block src-block table
151 table-row verse-block)
152 "Complete list of element types.")
154 (defconst org-element-greater-elements
155 '(center-block drawer dynamic-block footnote-definition headline inlinetask
156 item plain-list quote-block section special-block table)
157 "List of recursive element types aka Greater Elements.")
159 (defconst org-element-all-successors
160 '(export-snippet footnote-reference inline-babel-call inline-src-block
161 latex-or-entity line-break link macro radio-target
162 statistics-cookie sub/superscript table-cell target
163 text-markup timestamp)
164 "Complete list of successors.")
166 (defconst org-element-object-successor-alist
167 '((subscript . sub/superscript) (superscript . sub/superscript)
168 (bold . text-markup) (code . text-markup) (italic . text-markup)
169 (strike-through . text-markup) (underline . text-markup)
170 (verbatim . text-markup) (entity . latex-or-entity)
171 (latex-fragment . latex-or-entity))
172 "Alist of translations between object type and successor name.
174 Sharing the same successor comes handy when, for example, the
175 regexp matching one object can also match the other object.")
177 (defconst org-element-all-objects
178 '(bold code entity export-snippet footnote-reference inline-babel-call
179 inline-src-block italic line-break latex-fragment link macro
180 radio-target statistics-cookie strike-through subscript superscript
181 table-cell target timestamp underline verbatim)
182 "Complete list of object types.")
184 (defconst org-element-recursive-objects
185 '(bold italic link macro subscript radio-target strike-through superscript
186 table-cell underline)
187 "List of recursive object types.")
189 (defconst org-element-block-name-alist
190 '(("CENTER" . org-element-center-block-parser)
191 ("COMMENT" . org-element-comment-block-parser)
192 ("EXAMPLE" . org-element-example-block-parser)
193 ("QUOTE" . org-element-quote-block-parser)
194 ("SRC" . org-element-src-block-parser)
195 ("VERSE" . org-element-verse-block-parser))
196 "Alist between block names and the associated parsing function.
197 Names must be uppercase. Any block whose name has no association
198 is parsed with `org-element-special-block-parser'.")
200 (defconst org-element-affiliated-keywords
201 '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
202 "RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
203 "List of affiliated keywords as strings.
204 By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
205 are affiliated keywords and need not to be in this list.")
207 (defconst org-element--affiliated-re
208 (format "[ \t]*#\\+%s:"
209 ;; Regular affiliated keywords.
210 (format "\\(%s\\|ATTR_[-_A-Za-z0-9]+\\)\\(?:\\[\\(.*\\)\\]\\)?"
211 (regexp-opt org-element-affiliated-keywords)))
212 "Regexp matching any affiliated keyword.
214 Keyword name is put in match group 1. Moreover, if keyword
215 belongs to `org-element-dual-keywords', put the dual value in
216 match group 2.
218 Don't modify it, set `org-element-affiliated-keywords' instead.")
220 (defconst org-element-keyword-translation-alist
221 '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
222 ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
223 ("RESULT" . "RESULTS") ("HEADERS" . "HEADER"))
224 "Alist of usual translations for keywords.
225 The key is the old name and the value the new one. The property
226 holding their value will be named after the translated name.")
228 (defconst org-element-multiple-keywords '("HEADER")
229 "List of affiliated keywords that can occur more that once in an element.
231 Their value will be consed into a list of strings, which will be
232 returned as the value of the property.
234 This list is checked after translations have been applied. See
235 `org-element-keyword-translation-alist'.
237 By default, all keywords setting attributes (i.e. \"ATTR_LATEX\")
238 allow multiple occurrences and need not to be in this list.")
240 (defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "DATE" "TITLE")
241 "List of keywords whose value can be parsed.
243 Their value will be stored as a secondary string: a list of
244 strings and objects.
246 This list is checked after translations have been applied. See
247 `org-element-keyword-translation-alist'.")
249 (defconst org-element-dual-keywords '("CAPTION" "RESULTS")
250 "List of keywords which can have a secondary value.
252 In Org syntax, they can be written with optional square brackets
253 before the colons. For example, results keyword can be
254 associated to a hash value with the following:
256 #+RESULTS[hash-string]: some-source
258 This list is checked after translations have been applied. See
259 `org-element-keyword-translation-alist'.")
261 (defconst org-element-object-restrictions
262 '((bold export-snippet inline-babel-call inline-src-block latex-or-entity link
263 radio-target sub/superscript target text-markup timestamp)
264 (footnote-reference export-snippet footnote-reference inline-babel-call
265 inline-src-block latex-or-entity line-break link macro
266 radio-target sub/superscript target text-markup
267 timestamp)
268 (headline inline-babel-call inline-src-block latex-or-entity link macro
269 radio-target statistics-cookie sub/superscript target text-markup
270 timestamp)
271 (inlinetask inline-babel-call inline-src-block latex-or-entity link macro
272 radio-target sub/superscript target text-markup timestamp)
273 (italic export-snippet inline-babel-call inline-src-block latex-or-entity
274 link radio-target sub/superscript target text-markup timestamp)
275 (item export-snippet footnote-reference inline-babel-call latex-or-entity
276 link macro radio-target sub/superscript target text-markup)
277 (keyword latex-or-entity macro sub/superscript text-markup)
278 (link export-snippet inline-babel-call inline-src-block latex-or-entity link
279 sub/superscript text-markup)
280 (macro macro)
281 (paragraph export-snippet footnote-reference inline-babel-call
282 inline-src-block latex-or-entity line-break link macro
283 radio-target statistics-cookie sub/superscript target text-markup
284 timestamp)
285 (radio-target export-snippet latex-or-entity sub/superscript)
286 (strike-through export-snippet inline-babel-call inline-src-block
287 latex-or-entity link radio-target sub/superscript target
288 text-markup timestamp)
289 (subscript export-snippet inline-babel-call inline-src-block latex-or-entity
290 sub/superscript target text-markup)
291 (superscript export-snippet inline-babel-call inline-src-block
292 latex-or-entity sub/superscript target text-markup)
293 (table-cell export-snippet latex-or-entity link macro radio-target
294 sub/superscript target text-markup timestamp)
295 (table-row table-cell)
296 (underline export-snippet inline-babel-call inline-src-block latex-or-entity
297 link radio-target sub/superscript target text-markup timestamp)
298 (verse-block footnote-reference inline-babel-call inline-src-block
299 latex-or-entity line-break link macro radio-target
300 sub/superscript target text-markup timestamp))
301 "Alist of objects restrictions.
303 CAR is an element or object type containing objects and CDR is
304 a list of successors that will be called within an element or
305 object of such type.
307 For example, in a `radio-target' object, one can only find
308 entities, export snippets, latex-fragments, subscript and
309 superscript.
311 This alist also applies to secondary string. For example, an
312 `headline' type element doesn't directly contain objects, but
313 still has an entry since one of its properties (`:title') does.")
315 (defconst org-element-secondary-value-alist
316 '((headline . :title)
317 (inlinetask . :title)
318 (item . :tag)
319 (footnote-reference . :inline-definition))
320 "Alist between element types and location of secondary value.")
324 ;;; Accessors and Setters
326 ;; Provide four accessors: `org-element-type', `org-element-property'
327 ;; `org-element-contents' and `org-element-restriction'.
329 ;; Setter functions allow to modify elements by side effect. There is
330 ;; `org-element-put-property', `org-element-set-contents',
331 ;; `org-element-set-element' and `org-element-adopt-element'. Note
332 ;; that `org-element-set-element' and `org-element-adopt-element' are
333 ;; higher level functions since also update `:parent' property.
335 (defsubst org-element-type (element)
336 "Return type of ELEMENT.
338 The function returns the type of the element or object provided.
339 It can also return the following special value:
340 `plain-text' for a string
341 `org-data' for a complete document
342 nil in any other case."
343 (cond
344 ((not (consp element)) (and (stringp element) 'plain-text))
345 ((symbolp (car element)) (car element))))
347 (defsubst org-element-property (property element)
348 "Extract the value from the PROPERTY of an ELEMENT."
349 (plist-get (nth 1 element) property))
351 (defsubst org-element-contents (element)
352 "Extract contents from an ELEMENT."
353 (and (consp element) (nthcdr 2 element)))
355 (defsubst org-element-restriction (element)
356 "Return restriction associated to ELEMENT.
357 ELEMENT can be an element, an object or a symbol representing an
358 element or object type."
359 (cdr (assq (if (symbolp element) element (org-element-type element))
360 org-element-object-restrictions)))
362 (defsubst org-element-put-property (element property value)
363 "In ELEMENT set PROPERTY to VALUE.
364 Return modified element."
365 (when (consp element)
366 (setcar (cdr element) (plist-put (nth 1 element) property value)))
367 element)
369 (defsubst org-element-set-contents (element &rest contents)
370 "Set ELEMENT contents to CONTENTS.
371 Return modified element."
372 (cond ((not element) (list contents))
373 ((cdr element) (setcdr (cdr element) contents))
374 (t (nconc element contents))))
376 (defsubst org-element-set-element (old new)
377 "Replace element or object OLD with element or object NEW.
378 The function takes care of setting `:parent' property for NEW."
379 ;; OLD can belong to the contents of PARENT or to its secondary
380 ;; string.
381 (let* ((parent (org-element-property :parent old))
382 (sec-loc (cdr (assq (org-element-type parent)
383 org-element-secondary-value-alist)))
384 (sec-value (and sec-loc (org-element-property sec-loc parent)))
385 (place (or (memq old sec-value) (memq old parent))))
386 ;; Make sure NEW has correct `:parent' property.
387 (org-element-put-property new :parent parent)
388 ;; Replace OLD with NEW in PARENT.
389 (setcar place new)))
391 (defsubst org-element-adopt-element (parent child &optional append)
392 "Add an element to the contents of another element.
394 PARENT is an element or object. CHILD is an element, an object,
395 or a string.
397 CHILD is added at the beginning of PARENT contents, unless the
398 optional argument APPEND is non-nil, in which case CHILD is added
399 at the end.
401 The function takes care of setting `:parent' property for CHILD.
402 Return parent element."
403 (if (not parent) (list child)
404 (let ((contents (org-element-contents parent)))
405 (apply 'org-element-set-contents
406 parent
407 (if append (append contents (list child)) (cons child contents))))
408 ;; Link the CHILD element with PARENT.
409 (when (consp child) (org-element-put-property child :parent parent))
410 ;; Return the parent element.
411 parent))
415 ;;; Greater elements
417 ;; For each greater element type, we define a parser and an
418 ;; interpreter.
420 ;; A parser returns the element or object as the list described above.
421 ;; Most of them accepts no argument. Though, exceptions exist. Hence
422 ;; every element containing a secondary string (see
423 ;; `org-element-secondary-value-alist') will accept an optional
424 ;; argument to toggle parsing of that secondary string. Moreover,
425 ;; `item' parser requires current list's structure as its first
426 ;; element.
428 ;; An interpreter accepts two arguments: the list representation of
429 ;; the element or object, and its contents. The latter may be nil,
430 ;; depending on the element or object considered. It returns the
431 ;; appropriate Org syntax, as a string.
433 ;; Parsing functions must follow the naming convention:
434 ;; org-element-TYPE-parser, where TYPE is greater element's type, as
435 ;; defined in `org-element-greater-elements'.
437 ;; Similarly, interpreting functions must follow the naming
438 ;; convention: org-element-TYPE-interpreter.
440 ;; With the exception of `headline' and `item' types, greater elements
441 ;; cannot contain other greater elements of their own type.
443 ;; Beside implementing a parser and an interpreter, adding a new
444 ;; greater element requires to tweak `org-element--current-element'.
445 ;; Moreover, the newly defined type must be added to both
446 ;; `org-element-all-elements' and `org-element-greater-elements'.
449 ;;;; Center Block
451 (defun org-element-center-block-parser (limit)
452 "Parse a center block.
454 LIMIT bounds the search.
456 Return a list whose CAR is `center-block' and CDR is a plist
457 containing `:begin', `:end', `:hiddenp', `:contents-begin',
458 `:contents-end' and `:post-blank' keywords.
460 Assume point is at the beginning of the block."
461 (let ((case-fold-search t))
462 (if (not (save-excursion
463 (re-search-forward "^[ \t]*#\\+END_CENTER" limit t)))
464 ;; Incomplete block: parse it as a comment.
465 (org-element-comment-parser limit)
466 (let ((block-end-line (match-beginning 0)))
467 (let* ((keywords (org-element--collect-affiliated-keywords))
468 (begin (car keywords))
469 ;; Empty blocks have no contents.
470 (contents-begin (progn (forward-line)
471 (and (< (point) block-end-line)
472 (point))))
473 (contents-end (and contents-begin block-end-line))
474 (hidden (org-invisible-p2))
475 (pos-before-blank (progn (goto-char block-end-line)
476 (forward-line)
477 (point)))
478 (end (save-excursion (skip-chars-forward " \r\t\n" limit)
479 (if (eobp) (point) (point-at-bol)))))
480 (list 'center-block
481 (nconc
482 (list :begin begin
483 :end end
484 :hiddenp hidden
485 :contents-begin contents-begin
486 :contents-end contents-end
487 :post-blank (count-lines pos-before-blank end))
488 (cadr keywords))))))))
490 (defun org-element-center-block-interpreter (center-block contents)
491 "Interpret CENTER-BLOCK element as Org syntax.
492 CONTENTS is the contents of the element."
493 (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
496 ;;;; Drawer
498 (defun org-element-drawer-parser (limit)
499 "Parse a drawer.
501 LIMIT bounds the search.
503 Return a list whose CAR is `drawer' and CDR is a plist containing
504 `:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
505 `:contents-end' and `:post-blank' keywords.
507 Assume point is at beginning of drawer."
508 (let ((case-fold-search t))
509 (if (not (save-excursion (re-search-forward "^[ \t]*:END:" limit t)))
510 ;; Incomplete drawer: parse it as a paragraph.
511 (org-element-paragraph-parser limit)
512 (let ((drawer-end-line (match-beginning 0)))
513 (save-excursion
514 (let* ((case-fold-search t)
515 (name (progn (looking-at org-drawer-regexp)
516 (org-match-string-no-properties 1)))
517 (keywords (org-element--collect-affiliated-keywords))
518 (begin (car keywords))
519 ;; Empty drawers have no contents.
520 (contents-begin (progn (forward-line)
521 (and (< (point) drawer-end-line)
522 (point))))
523 (contents-end (and contents-begin drawer-end-line))
524 (hidden (org-invisible-p2))
525 (pos-before-blank (progn (goto-char drawer-end-line)
526 (forward-line)
527 (point)))
528 (end (progn (skip-chars-forward " \r\t\n" limit)
529 (if (eobp) (point) (point-at-bol)))))
530 (list 'drawer
531 (nconc
532 (list :begin begin
533 :end end
534 :drawer-name name
535 :hiddenp hidden
536 :contents-begin contents-begin
537 :contents-end contents-end
538 :post-blank (count-lines pos-before-blank end))
539 (cadr keywords)))))))))
541 (defun org-element-drawer-interpreter (drawer contents)
542 "Interpret DRAWER element as Org syntax.
543 CONTENTS is the contents of the element."
544 (format ":%s:\n%s:END:"
545 (org-element-property :drawer-name drawer)
546 contents))
549 ;;;; Dynamic Block
551 (defun org-element-dynamic-block-parser (limit)
552 "Parse a dynamic block.
554 LIMIT bounds the search.
556 Return a list whose CAR is `dynamic-block' and CDR is a plist
557 containing `:block-name', `:begin', `:end', `:hiddenp',
558 `:contents-begin', `:contents-end', `:arguments' and
559 `:post-blank' keywords.
561 Assume point is at beginning of dynamic block."
562 (let ((case-fold-search t))
563 (if (not (save-excursion (re-search-forward org-dblock-end-re limit t)))
564 ;; Incomplete block: parse it as a comment.
565 (org-element-comment-parser limit)
566 (let ((block-end-line (match-beginning 0)))
567 (save-excursion
568 (let* ((name (progn (looking-at org-dblock-start-re)
569 (org-match-string-no-properties 1)))
570 (arguments (org-match-string-no-properties 3))
571 (keywords (org-element--collect-affiliated-keywords))
572 (begin (car keywords))
573 ;; Empty blocks have no contents.
574 (contents-begin (progn (forward-line)
575 (and (< (point) block-end-line)
576 (point))))
577 (contents-end (and contents-begin block-end-line))
578 (hidden (org-invisible-p2))
579 (pos-before-blank (progn (goto-char block-end-line)
580 (forward-line)
581 (point)))
582 (end (progn (skip-chars-forward " \r\t\n" limit)
583 (if (eobp) (point) (point-at-bol)))))
584 (list 'dynamic-block
585 (nconc
586 (list :begin begin
587 :end end
588 :block-name name
589 :arguments arguments
590 :hiddenp hidden
591 :contents-begin contents-begin
592 :contents-end contents-end
593 :post-blank (count-lines pos-before-blank end))
594 (cadr keywords)))))))))
596 (defun org-element-dynamic-block-interpreter (dynamic-block contents)
597 "Interpret DYNAMIC-BLOCK element as Org syntax.
598 CONTENTS is the contents of the element."
599 (format "#+BEGIN: %s%s\n%s#+END:"
600 (org-element-property :block-name dynamic-block)
601 (let ((args (org-element-property :arguments dynamic-block)))
602 (and args (concat " " args)))
603 contents))
606 ;;;; Footnote Definition
608 (defun org-element-footnote-definition-parser (limit)
609 "Parse a footnote definition.
611 LIMIT bounds the search.
613 Return a list whose CAR is `footnote-definition' and CDR is
614 a plist containing `:label', `:begin' `:end', `:contents-begin',
615 `:contents-end' and `:post-blank' keywords.
617 Assume point is at the beginning of the footnote definition."
618 (save-excursion
619 (let* ((label (progn (looking-at org-footnote-definition-re)
620 (org-match-string-no-properties 1)))
621 (keywords (org-element--collect-affiliated-keywords))
622 (begin (car keywords))
623 (ending (save-excursion
624 (if (progn
625 (end-of-line)
626 (re-search-forward
627 (concat org-outline-regexp-bol "\\|"
628 org-footnote-definition-re "\\|"
629 "^[ \t]*$") limit 'move))
630 (match-beginning 0)
631 (point))))
632 (contents-begin (progn (search-forward "]")
633 (skip-chars-forward " \r\t\n" ending)
634 (and (/= (point) ending) (point))))
635 (contents-end (and contents-begin ending))
636 (end (progn (goto-char ending)
637 (skip-chars-forward " \r\t\n" limit)
638 (if (eobp) (point) (point-at-bol)))))
639 (list 'footnote-definition
640 (nconc
641 (list :label label
642 :begin begin
643 :end end
644 :contents-begin contents-begin
645 :contents-end contents-end
646 :post-blank (count-lines ending end))
647 (cadr keywords))))))
649 (defun org-element-footnote-definition-interpreter (footnote-definition contents)
650 "Interpret FOOTNOTE-DEFINITION element as Org syntax.
651 CONTENTS is the contents of the footnote-definition."
652 (concat (format "[%s]" (org-element-property :label footnote-definition))
654 contents))
657 ;;;; Headline
659 (defun org-element-headline-parser (limit &optional raw-secondary-p)
660 "Parse an headline.
662 Return a list whose CAR is `headline' and CDR is a plist
663 containing `:raw-value', `:title', `:begin', `:end',
664 `:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
665 `:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
666 `:scheduled', `:deadline', `:timestamp', `:clock', `:category',
667 `:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
668 keywords.
670 The plist also contains any property set in the property drawer,
671 with its name in lowercase, the underscores replaced with hyphens
672 and colons at the beginning (i.e. `:custom-id').
674 When RAW-SECONDARY-P is non-nil, headline's title will not be
675 parsed as a secondary string, but as a plain string instead.
677 Assume point is at beginning of the headline."
678 (save-excursion
679 (let* ((components (org-heading-components))
680 (level (nth 1 components))
681 (todo (nth 2 components))
682 (todo-type
683 (and todo (if (member todo org-done-keywords) 'done 'todo)))
684 (tags (let ((raw-tags (nth 5 components)))
685 (and raw-tags (org-split-string raw-tags ":"))))
686 (raw-value (nth 4 components))
687 (quotedp
688 (let ((case-fold-search nil))
689 (string-match (format "^%s +" org-quote-string) raw-value)))
690 (commentedp
691 (let ((case-fold-search nil))
692 (string-match (format "^%s +" org-comment-string) raw-value)))
693 (archivedp (member org-archive-tag tags))
694 (footnote-section-p (and org-footnote-section
695 (string= org-footnote-section raw-value)))
696 ;; Normalize property names: ":SOME_PROP:" becomes
697 ;; ":some-prop".
698 (standard-props (let (plist)
699 (mapc
700 (lambda (p)
701 (let ((p-name (downcase (car p))))
702 (while (string-match "_" p-name)
703 (setq p-name
704 (replace-match "-" nil nil p-name)))
705 (setq p-name (intern (concat ":" p-name)))
706 (setq plist
707 (plist-put plist p-name (cdr p)))))
708 (org-entry-properties nil 'standard))
709 plist))
710 (time-props (org-entry-properties nil 'special "CLOCK"))
711 (scheduled (cdr (assoc "SCHEDULED" time-props)))
712 (deadline (cdr (assoc "DEADLINE" time-props)))
713 (clock (cdr (assoc "CLOCK" time-props)))
714 (timestamp (cdr (assoc "TIMESTAMP" time-props)))
715 (begin (point))
716 (end (save-excursion (goto-char (org-end-of-subtree t t))))
717 (pos-after-head (progn (forward-line) (point)))
718 (contents-begin (save-excursion
719 (skip-chars-forward " \r\t\n" end)
720 (and (/= (point) end) (line-beginning-position))))
721 (hidden (org-invisible-p2))
722 (contents-end (and contents-begin
723 (progn (goto-char end)
724 (skip-chars-backward " \r\t\n")
725 (forward-line)
726 (point)))))
727 ;; Clean RAW-VALUE from any quote or comment string.
728 (when (or quotedp commentedp)
729 (setq raw-value
730 (replace-regexp-in-string
731 (concat "\\(" org-quote-string "\\|" org-comment-string "\\) +")
733 raw-value)))
734 ;; Clean TAGS from archive tag, if any.
735 (when archivedp (setq tags (delete org-archive-tag tags)))
736 (let ((headline
737 (list 'headline
738 (nconc
739 (list :raw-value raw-value
740 :begin begin
741 :end end
742 :pre-blank
743 (if (not contents-begin) 0
744 (count-lines pos-after-head contents-begin))
745 :hiddenp hidden
746 :contents-begin contents-begin
747 :contents-end contents-end
748 :level level
749 :priority (nth 3 components)
750 :tags tags
751 :todo-keyword todo
752 :todo-type todo-type
753 :scheduled scheduled
754 :deadline deadline
755 :timestamp timestamp
756 :clock clock
757 :post-blank (count-lines
758 (if (not contents-end) pos-after-head
759 (goto-char contents-end)
760 (forward-line)
761 (point))
762 end)
763 :footnote-section-p footnote-section-p
764 :archivedp archivedp
765 :commentedp commentedp
766 :quotedp quotedp)
767 standard-props))))
768 (org-element-put-property
769 headline :title
770 (if raw-secondary-p raw-value
771 (org-element-parse-secondary-string
772 raw-value (org-element-restriction 'headline) headline)))))))
774 (defun org-element-headline-interpreter (headline contents)
775 "Interpret HEADLINE element as Org syntax.
776 CONTENTS is the contents of the element."
777 (let* ((level (org-element-property :level headline))
778 (todo (org-element-property :todo-keyword headline))
779 (priority (org-element-property :priority headline))
780 (title (org-element-interpret-data
781 (org-element-property :title headline)))
782 (tags (let ((tag-list (if (org-element-property :archivedp headline)
783 (cons org-archive-tag
784 (org-element-property :tags headline))
785 (org-element-property :tags headline))))
786 (and tag-list
787 (format ":%s:" (mapconcat 'identity tag-list ":")))))
788 (commentedp (org-element-property :commentedp headline))
789 (quotedp (org-element-property :quotedp headline))
790 (pre-blank (or (org-element-property :pre-blank headline) 0))
791 (heading (concat (make-string level ?*)
792 (and todo (concat " " todo))
793 (and quotedp (concat " " org-quote-string))
794 (and commentedp (concat " " org-comment-string))
795 (and priority
796 (format " [#%s]" (char-to-string priority)))
797 (cond ((and org-footnote-section
798 (org-element-property
799 :footnote-section-p headline))
800 (concat " " org-footnote-section))
801 (title (concat " " title))))))
802 (concat heading
803 ;; Align tags.
804 (when tags
805 (cond
806 ((zerop org-tags-column) (format " %s" tags))
807 ((< org-tags-column 0)
808 (concat
809 (make-string
810 (max (- (+ org-tags-column (length heading) (length tags))) 1)
812 tags))
814 (concat
815 (make-string (max (- org-tags-column (length heading)) 1) ? )
816 tags))))
817 (make-string (1+ pre-blank) 10)
818 contents)))
821 ;;;; Inlinetask
823 (defun org-element-inlinetask-parser (limit &optional raw-secondary-p)
824 "Parse an inline task.
826 Return a list whose CAR is `inlinetask' and CDR is a plist
827 containing `:title', `:begin', `:end', `:hiddenp',
828 `:contents-begin' and `:contents-end', `:level', `:priority',
829 `:tags', `:todo-keyword', `:todo-type', `:scheduled',
830 `:deadline', `:timestamp', `:clock' and `:post-blank' keywords.
832 The plist also contains any property set in the property drawer,
833 with its name in lowercase, the underscores replaced with hyphens
834 and colons at the beginning (i.e. `:custom-id').
836 When optional argument RAW-SECONDARY-P is non-nil, inline-task's
837 title will not be parsed as a secondary string, but as a plain
838 string instead.
840 Assume point is at beginning of the inline task."
841 (save-excursion
842 (let* ((keywords (org-element--collect-affiliated-keywords))
843 (begin (car keywords))
844 (components (org-heading-components))
845 (todo (nth 2 components))
846 (todo-type (and todo
847 (if (member todo org-done-keywords) 'done 'todo)))
848 (tags (let ((raw-tags (nth 5 components)))
849 (and raw-tags (org-split-string raw-tags ":"))))
850 ;; Normalize property names: ":SOME_PROP:" becomes
851 ;; ":some-prop".
852 (standard-props (let (plist)
853 (mapc
854 (lambda (p)
855 (let ((p-name (downcase (car p))))
856 (while (string-match "_" p-name)
857 (setq p-name
858 (replace-match "-" nil nil p-name)))
859 (setq p-name (intern (concat ":" p-name)))
860 (setq plist
861 (plist-put plist p-name (cdr p)))))
862 (org-entry-properties nil 'standard))
863 plist))
864 (time-props (org-entry-properties nil 'special "CLOCK"))
865 (scheduled (cdr (assoc "SCHEDULED" time-props)))
866 (deadline (cdr (assoc "DEADLINE" time-props)))
867 (clock (cdr (assoc "CLOCK" time-props)))
868 (timestamp (cdr (assoc "TIMESTAMP" time-props)))
869 (task-end (save-excursion
870 (end-of-line)
871 (and (re-search-forward "^\\*+ END" limit t)
872 (match-beginning 0))))
873 (contents-begin (progn (forward-line)
874 (and task-end (< (point) task-end) (point))))
875 (hidden (and contents-begin (org-invisible-p2)))
876 (contents-end (and contents-begin task-end))
877 (before-blank (if (not task-end) (point)
878 (goto-char task-end)
879 (forward-line)
880 (point)))
881 (end (progn (skip-chars-forward " \r\t\n" limit)
882 (if (eobp) (point) (point-at-bol))))
883 (inlinetask
884 (list 'inlinetask
885 (nconc
886 (list :begin begin
887 :end end
888 :hiddenp hidden
889 :contents-begin contents-begin
890 :contents-end contents-end
891 :level (nth 1 components)
892 :priority (nth 3 components)
893 :tags tags
894 :todo-keyword todo
895 :todo-type todo-type
896 :scheduled scheduled
897 :deadline deadline
898 :timestamp timestamp
899 :clock clock
900 :post-blank (count-lines before-blank end))
901 standard-props
902 (cadr keywords)))))
903 (org-element-put-property
904 inlinetask :title
905 (if raw-secondary-p (nth 4 components)
906 (org-element-parse-secondary-string
907 (nth 4 components)
908 (org-element-restriction 'inlinetask)
909 inlinetask))))))
911 (defun org-element-inlinetask-interpreter (inlinetask contents)
912 "Interpret INLINETASK element as Org syntax.
913 CONTENTS is the contents of inlinetask."
914 (let* ((level (org-element-property :level inlinetask))
915 (todo (org-element-property :todo-keyword inlinetask))
916 (priority (org-element-property :priority inlinetask))
917 (title (org-element-interpret-data
918 (org-element-property :title inlinetask)))
919 (tags (let ((tag-list (org-element-property :tags inlinetask)))
920 (and tag-list
921 (format ":%s:" (mapconcat 'identity tag-list ":")))))
922 (task (concat (make-string level ?*)
923 (and todo (concat " " todo))
924 (and priority
925 (format " [#%s]" (char-to-string priority)))
926 (and title (concat " " title)))))
927 (concat task
928 ;; Align tags.
929 (when tags
930 (cond
931 ((zerop org-tags-column) (format " %s" tags))
932 ((< org-tags-column 0)
933 (concat
934 (make-string
935 (max (- (+ org-tags-column (length task) (length tags))) 1)
937 tags))
939 (concat
940 (make-string (max (- org-tags-column (length task)) 1) ? )
941 tags))))
942 ;; Prefer degenerate inlinetasks when there are no
943 ;; contents.
944 (when contents
945 (concat "\n"
946 contents
947 (make-string level ?*) " END")))))
950 ;;;; Item
952 (defun org-element-item-parser (limit struct &optional raw-secondary-p)
953 "Parse an item.
955 STRUCT is the structure of the plain list.
957 Return a list whose CAR is `item' and CDR is a plist containing
958 `:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
959 `:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
960 `:post-blank' keywords.
962 When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
963 any, will not be parsed as a secondary string, but as a plain
964 string instead.
966 Assume point is at the beginning of the item."
967 (save-excursion
968 (beginning-of-line)
969 (let* ((begin (point))
970 (bullet (org-list-get-bullet (point) struct))
971 (checkbox (let ((box (org-list-get-checkbox begin struct)))
972 (cond ((equal "[ ]" box) 'off)
973 ((equal "[X]" box) 'on)
974 ((equal "[-]" box) 'trans))))
975 (counter (let ((c (org-list-get-counter begin struct)))
976 (cond
977 ((not c) nil)
978 ((string-match "[A-Za-z]" c)
979 (- (string-to-char (upcase (match-string 0 c)))
980 64))
981 ((string-match "[0-9]+" c)
982 (string-to-number (match-string 0 c))))))
983 (end (org-list-get-item-end begin struct))
984 (contents-begin (progn (looking-at org-list-full-item-re)
985 (goto-char (match-end 0))
986 (org-skip-whitespace)
987 ;; If first line isn't empty,
988 ;; contents really start at the text
989 ;; after item's meta-data.
990 (if (= (point-at-bol) begin) (point)
991 (point-at-bol))))
992 (hidden (progn (forward-line)
993 (and (not (= (point) end))
994 (org-invisible-p2))))
995 (contents-end (progn (goto-char end)
996 (skip-chars-backward " \r\t\n")
997 (forward-line)
998 (point)))
999 (item
1000 (list 'item
1001 (list :bullet bullet
1002 :begin begin
1003 :end end
1004 ;; CONTENTS-BEGIN and CONTENTS-END may be
1005 ;; mixed up in the case of an empty item
1006 ;; separated from the next by a blank line.
1007 ;; Thus ensure the former is always the
1008 ;; smallest.
1009 :contents-begin (min contents-begin contents-end)
1010 :contents-end (max contents-begin contents-end)
1011 :checkbox checkbox
1012 :counter counter
1013 :hiddenp hidden
1014 :structure struct
1015 :post-blank (count-lines contents-end end)))))
1016 (org-element-put-property
1017 item :tag
1018 (let ((raw-tag (org-list-get-tag begin struct)))
1019 (and raw-tag
1020 (if raw-secondary-p raw-tag
1021 (org-element-parse-secondary-string
1022 raw-tag (org-element-restriction 'item) item))))))))
1024 (defun org-element-item-interpreter (item contents)
1025 "Interpret ITEM element as Org syntax.
1026 CONTENTS is the contents of the element."
1027 (let* ((bullet
1028 (let* ((beg (org-element-property :begin item))
1029 (struct (org-element-property :structure item))
1030 (pre (org-list-prevs-alist struct))
1031 (bul (org-element-property :bullet item)))
1032 (org-list-bullet-string
1033 (if (not (eq (org-list-get-list-type beg struct pre) 'ordered)) "-"
1034 (let ((num
1035 (car
1036 (last
1037 (org-list-get-item-number
1038 beg struct pre (org-list-parents-alist struct))))))
1039 (format "%d%s"
1041 (if (eq org-plain-list-ordered-item-terminator ?\)) ")"
1042 ".")))))))
1043 (checkbox (org-element-property :checkbox item))
1044 (counter (org-element-property :counter item))
1045 (tag (let ((tag (org-element-property :tag item)))
1046 (and tag (org-element-interpret-data tag))))
1047 ;; Compute indentation.
1048 (ind (make-string (length bullet) 32))
1049 (item-starts-with-par-p
1050 (eq (org-element-type (car (org-element-contents item)))
1051 'paragraph)))
1052 ;; Indent contents.
1053 (concat
1054 bullet
1055 (and counter (format "[@%d] " counter))
1056 (cond
1057 ((eq checkbox 'on) "[X] ")
1058 ((eq checkbox 'off) "[ ] ")
1059 ((eq checkbox 'trans) "[-] "))
1060 (and tag (format "%s :: " tag))
1061 (let ((contents (replace-regexp-in-string
1062 "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))
1063 (if item-starts-with-par-p (org-trim contents)
1064 (concat "\n" contents))))))
1067 ;;;; Plain List
1069 (defun org-element-plain-list-parser (limit &optional structure)
1070 "Parse a plain list.
1072 Optional argument STRUCTURE, when non-nil, is the structure of
1073 the plain list being parsed.
1075 Return a list whose CAR is `plain-list' and CDR is a plist
1076 containing `:type', `:begin', `:end', `:contents-begin' and
1077 `:contents-end', `:structure' and `:post-blank' keywords.
1079 Assume point is at the beginning of the list."
1080 (save-excursion
1081 (let* ((struct (or structure (org-list-struct)))
1082 (prevs (org-list-prevs-alist struct))
1083 (parents (org-list-parents-alist struct))
1084 (type (org-list-get-list-type (point) struct prevs))
1085 (contents-begin (point))
1086 (keywords (org-element--collect-affiliated-keywords))
1087 (begin (car keywords))
1088 (contents-end
1089 (goto-char (org-list-get-list-end (point) struct prevs)))
1090 (end (save-excursion (org-skip-whitespace)
1091 (if (eobp) (point) (point-at-bol)))))
1092 ;; Blank lines below list belong to the top-level list only.
1093 (unless (= (org-list-get-top-point struct) contents-begin)
1094 (setq end (min (org-list-get-bottom-point struct)
1095 (progn (skip-chars-forward " \r\t\n" limit)
1096 (if (eobp) (point) (point-at-bol))))))
1097 ;; Return value.
1098 (list 'plain-list
1099 (nconc
1100 (list :type type
1101 :begin begin
1102 :end end
1103 :contents-begin contents-begin
1104 :contents-end contents-end
1105 :structure struct
1106 :post-blank (count-lines contents-end end))
1107 (cadr keywords))))))
1109 (defun org-element-plain-list-interpreter (plain-list contents)
1110 "Interpret PLAIN-LIST element as Org syntax.
1111 CONTENTS is the contents of the element."
1112 contents)
1115 ;;;; Quote Block
1117 (defun org-element-quote-block-parser (limit)
1118 "Parse a quote block.
1120 LIMIT bounds the search.
1122 Return a list whose CAR is `quote-block' and CDR is a plist
1123 containing `:begin', `:end', `:hiddenp', `:contents-begin',
1124 `:contents-end' and `:post-blank' keywords.
1126 Assume point is at the beginning of the block."
1127 (let ((case-fold-search t))
1128 (if (not (save-excursion
1129 (re-search-forward "^[ \t]*#\\+END_QUOTE" limit t)))
1130 ;; Incomplete block: parse it as a comment.
1131 (org-element-comment-parser limit)
1132 (let ((block-end-line (match-beginning 0)))
1133 (save-excursion
1134 (let* ((keywords (org-element--collect-affiliated-keywords))
1135 (begin (car keywords))
1136 ;; Empty blocks have no contents.
1137 (contents-begin (progn (forward-line)
1138 (and (< (point) block-end-line)
1139 (point))))
1140 (contents-end (and contents-begin block-end-line))
1141 (hidden (org-invisible-p2))
1142 (pos-before-blank (progn (goto-char block-end-line)
1143 (forward-line)
1144 (point)))
1145 (end (progn (skip-chars-forward " \r\t\n" limit)
1146 (if (eobp) (point) (point-at-bol)))))
1147 (list 'quote-block
1148 (nconc
1149 (list :begin begin
1150 :end end
1151 :hiddenp hidden
1152 :contents-begin contents-begin
1153 :contents-end contents-end
1154 :post-blank (count-lines pos-before-blank end))
1155 (cadr keywords)))))))))
1157 (defun org-element-quote-block-interpreter (quote-block contents)
1158 "Interpret QUOTE-BLOCK element as Org syntax.
1159 CONTENTS is the contents of the element."
1160 (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
1163 ;;;; Section
1165 (defun org-element-section-parser (limit)
1166 "Parse a section.
1168 LIMIT bounds the search.
1170 Return a list whose CAR is `section' and CDR is a plist
1171 containing `:begin', `:end', `:contents-begin', `contents-end'
1172 and `:post-blank' keywords."
1173 (save-excursion
1174 ;; Beginning of section is the beginning of the first non-blank
1175 ;; line after previous headline.
1176 (org-with-limited-levels
1177 (let ((begin (point))
1178 (end (progn (goto-char limit) (point)))
1179 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
1180 (forward-line)
1181 (point))))
1182 (list 'section
1183 (list :begin begin
1184 :end end
1185 :contents-begin begin
1186 :contents-end pos-before-blank
1187 :post-blank (count-lines pos-before-blank end)))))))
1189 (defun org-element-section-interpreter (section contents)
1190 "Interpret SECTION element as Org syntax.
1191 CONTENTS is the contents of the element."
1192 contents)
1195 ;;;; Special Block
1197 (defun org-element-special-block-parser (limit)
1198 "Parse a special block.
1200 LIMIT bounds the search.
1202 Return a list whose CAR is `special-block' and CDR is a plist
1203 containing `:type', `:begin', `:end', `:hiddenp',
1204 `:contents-begin', `:contents-end' and `:post-blank' keywords.
1206 Assume point is at the beginning of the block."
1207 (let* ((case-fold-search t)
1208 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(S-+\\)")
1209 (upcase (match-string-no-properties 1)))))
1210 (if (not (save-excursion
1211 (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t)))
1212 ;; Incomplete block: parse it as a comment.
1213 (org-element-comment-parser limit)
1214 (let ((block-end-line (match-beginning 0)))
1215 (save-excursion
1216 (let* ((keywords (org-element--collect-affiliated-keywords))
1217 (begin (car keywords))
1218 ;; Empty blocks have no contents.
1219 (contents-begin (progn (forward-line)
1220 (and (< (point) block-end-line)
1221 (point))))
1222 (contents-end (and contents-begin block-end-line))
1223 (hidden (org-invisible-p2))
1224 (pos-before-blank (progn (goto-char block-end-line)
1225 (forward-line)
1226 (point)))
1227 (end (progn (org-skip-whitespace)
1228 (if (eobp) (point) (point-at-bol)))))
1229 (list 'special-block
1230 (nconc
1231 (list :type type
1232 :begin begin
1233 :end end
1234 :hiddenp hidden
1235 :contents-begin contents-begin
1236 :contents-end contents-end
1237 :post-blank (count-lines pos-before-blank end))
1238 (cadr keywords)))))))))
1240 (defun org-element-special-block-interpreter (special-block contents)
1241 "Interpret SPECIAL-BLOCK element as Org syntax.
1242 CONTENTS is the contents of the element."
1243 (let ((block-type (org-element-property :type special-block)))
1244 (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type)))
1248 ;;; Elements
1250 ;; For each element, a parser and an interpreter are also defined.
1251 ;; Both follow the same naming convention used for greater elements.
1253 ;; Also, as for greater elements, adding a new element type is done
1254 ;; through the following steps: implement a parser and an interpreter,
1255 ;; tweak `org-element--current-element' so that it recognizes the new
1256 ;; type and add that new type to `org-element-all-elements'.
1258 ;; As a special case, when the newly defined type is a block type,
1259 ;; `org-element-block-name-alist' has to be modified accordingly.
1262 ;;;; Babel Call
1264 (defun org-element-babel-call-parser (limit)
1265 "Parse a babel call.
1267 LIMIT bounds the search.
1269 Return a list whose CAR is `babel-call' and CDR is a plist
1270 containing `:begin', `:end', `:info' and `:post-blank' as
1271 keywords."
1272 (save-excursion
1273 (let ((case-fold-search t)
1274 (info (progn (looking-at org-babel-block-lob-one-liner-regexp)
1275 (org-babel-lob-get-info)))
1276 (begin (point-at-bol))
1277 (pos-before-blank (progn (forward-line) (point)))
1278 (end (progn (skip-chars-forward " \r\t\n" limit)
1279 (if (eobp) (point) (point-at-bol)))))
1280 (list 'babel-call
1281 (list :begin begin
1282 :end end
1283 :info info
1284 :post-blank (count-lines pos-before-blank end))))))
1286 (defun org-element-babel-call-interpreter (babel-call contents)
1287 "Interpret BABEL-CALL element as Org syntax.
1288 CONTENTS is nil."
1289 (let* ((babel-info (org-element-property :info babel-call))
1290 (main (car babel-info))
1291 (post-options (nth 1 babel-info)))
1292 (concat "#+CALL: "
1293 (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
1294 ;; Remove redundant square brackets.
1295 (replace-match (match-string 1 main) nil nil main))
1296 (and post-options (format "[%s]" post-options)))))
1299 ;;;; Clock
1301 (defun org-element-clock-parser (limit)
1302 "Parse a clock.
1304 LIMIT bounds the search.
1306 Return a list whose CAR is `clock' and CDR is a plist containing
1307 `:status', `:value', `:time', `:begin', `:end' and `:post-blank'
1308 as keywords."
1309 (save-excursion
1310 (let* ((case-fold-search nil)
1311 (begin (point))
1312 (value (progn (search-forward org-clock-string (line-end-position) t)
1313 (org-skip-whitespace)
1314 (looking-at "\\[.*\\]")
1315 (org-match-string-no-properties 0)))
1316 (time (and (progn (goto-char (match-end 0))
1317 (looking-at " +=> +\\(\\S-+\\)[ \t]*$"))
1318 (org-match-string-no-properties 1)))
1319 (status (if time 'closed 'running))
1320 (post-blank (let ((before-blank (progn (forward-line) (point))))
1321 (skip-chars-forward " \r\t\n" limit)
1322 (unless (eobp) (beginning-of-line))
1323 (count-lines before-blank (point))))
1324 (end (point)))
1325 (list 'clock
1326 (list :status status
1327 :value value
1328 :time time
1329 :begin begin
1330 :end end
1331 :post-blank post-blank)))))
1333 (defun org-element-clock-interpreter (clock contents)
1334 "Interpret CLOCK element as Org syntax.
1335 CONTENTS is nil."
1336 (concat org-clock-string " "
1337 (org-element-property :value clock)
1338 (let ((time (org-element-property :time clock)))
1339 (and time
1340 (concat " => "
1341 (apply 'format
1342 "%2s:%02s"
1343 (org-split-string time ":")))))))
1346 ;;;; Comment
1348 (defun org-element-comment-parser (limit)
1349 "Parse a comment.
1351 LIMIT bounds the search.
1353 Return a list whose CAR is `comment' and CDR is a plist
1354 containing `:begin', `:end', `:value' and `:post-blank'
1355 keywords.
1357 Assume point is at comment beginning."
1358 (save-excursion
1359 (let* ((keywords (org-element--collect-affiliated-keywords))
1360 (begin (car keywords))
1361 ;; Match first line with a loose regexp since it might as
1362 ;; well be an ill-defined keyword.
1363 (value (progn
1364 (looking-at "#\\+? ?")
1365 (buffer-substring-no-properties
1366 (match-end 0) (progn (forward-line) (point)))))
1367 (com-end
1368 ;; Get comments ending.
1369 (progn
1370 (while (and (< (point) limit)
1371 (looking-at "\\(\\(# ?\\)[^+]\\|[ \t]*#\\+\\( \\|$\\)\\)"))
1372 ;; Accumulate lines without leading hash and plus sign
1373 ;; if any. First whitespace is also ignored.
1374 (setq value
1375 (concat value
1376 (buffer-substring-no-properties
1377 (or (match-end 2) (match-end 3))
1378 (progn (forward-line) (point))))))
1379 (point)))
1380 (end (progn (goto-char com-end)
1381 (skip-chars-forward " \r\t\n" limit)
1382 (if (eobp) (point) (point-at-bol)))))
1383 (list 'comment
1384 (nconc
1385 (list :begin begin
1386 :end end
1387 :value value
1388 :post-blank (count-lines com-end end))
1389 (cadr keywords))))))
1391 (defun org-element-comment-interpreter (comment contents)
1392 "Interpret COMMENT element as Org syntax.
1393 CONTENTS is nil."
1394 (replace-regexp-in-string "^" "#+ " (org-element-property :value comment)))
1397 ;;;; Comment Block
1399 (defun org-element-comment-block-parser (limit)
1400 "Parse an export block.
1402 LIMIT bounds the search.
1404 Return a list whose CAR is `comment-block' and CDR is a plist
1405 containing `:begin', `:end', `:hiddenp', `:value' and
1406 `:post-blank' keywords.
1408 Assume point is at comment block beginning."
1409 (let ((case-fold-search t))
1410 (if (not (save-excursion
1411 (re-search-forward "^[ \t]*#\\+END_COMMENT" limit t)))
1412 ;; Incomplete block: parse it as a comment.
1413 (org-element-comment-parser limit)
1414 (let ((contents-end (match-beginning 0)))
1415 (save-excursion
1416 (let* ((keywords (org-element--collect-affiliated-keywords))
1417 (begin (car keywords))
1418 (contents-begin (progn (forward-line) (point)))
1419 (hidden (org-invisible-p2))
1420 (pos-before-blank (progn (goto-char contents-end)
1421 (forward-line)
1422 (point)))
1423 (end (progn (skip-chars-forward " \r\t\n" limit)
1424 (if (eobp) (point) (point-at-bol))))
1425 (value (buffer-substring-no-properties
1426 contents-begin contents-end)))
1427 (list 'comment-block
1428 (nconc
1429 (list :begin begin
1430 :end end
1431 :value value
1432 :hiddenp hidden
1433 :post-blank (count-lines pos-before-blank end))
1434 (cadr keywords)))))))))
1436 (defun org-element-comment-block-interpreter (comment-block contents)
1437 "Interpret COMMENT-BLOCK element as Org syntax.
1438 CONTENTS is nil."
1439 (format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
1440 (org-remove-indentation (org-element-property :value comment-block))))
1443 ;;;; Example Block
1445 (defun org-element-example-block-parser (limit)
1446 "Parse an example block.
1448 LIMIT bounds the search.
1450 Return a list whose CAR is `example-block' and CDR is a plist
1451 containing `:begin', `:end', `:number-lines', `:preserve-indent',
1452 `:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
1453 `:switches', `:value' and `:post-blank' keywords."
1454 (let ((case-fold-search t))
1455 (if (not (save-excursion
1456 (re-search-forward "^[ \t]*#\\+END_EXAMPLE" limit t)))
1457 ;; Incomplete block: parse it as a comment.
1458 (org-element-comment-parser limit)
1459 (let ((contents-end (match-beginning 0)))
1460 (save-excursion
1461 (let* ((switches
1462 (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
1463 (org-match-string-no-properties 1)))
1464 ;; Switches analysis
1465 (number-lines (cond ((not switches) nil)
1466 ((string-match "-n\\>" switches) 'new)
1467 ((string-match "+n\\>" switches) 'continued)))
1468 (preserve-indent (and switches (string-match "-i\\>" switches)))
1469 ;; Should labels be retained in (or stripped from) example
1470 ;; blocks?
1471 (retain-labels
1472 (or (not switches)
1473 (not (string-match "-r\\>" switches))
1474 (and number-lines (string-match "-k\\>" switches))))
1475 ;; What should code-references use - labels or
1476 ;; line-numbers?
1477 (use-labels
1478 (or (not switches)
1479 (and retain-labels (not (string-match "-k\\>" switches)))))
1480 (label-fmt (and switches
1481 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
1482 (match-string 1 switches)))
1483 ;; Standard block parsing.
1484 (keywords (org-element--collect-affiliated-keywords))
1485 (begin (car keywords))
1486 (contents-begin (progn (forward-line) (point)))
1487 (hidden (org-invisible-p2))
1488 (value (buffer-substring-no-properties contents-begin contents-end))
1489 (pos-before-blank (progn (goto-char contents-end)
1490 (forward-line)
1491 (point)))
1492 (end (progn (skip-chars-forward " \r\t\n" limit)
1493 (if (eobp) (point) (point-at-bol)))))
1494 (list 'example-block
1495 (nconc
1496 (list :begin begin
1497 :end end
1498 :value value
1499 :switches switches
1500 :number-lines number-lines
1501 :preserve-indent preserve-indent
1502 :retain-labels retain-labels
1503 :use-labels use-labels
1504 :label-fmt label-fmt
1505 :hiddenp hidden
1506 :post-blank (count-lines pos-before-blank end))
1507 (cadr keywords)))))))))
1509 (defun org-element-example-block-interpreter (example-block contents)
1510 "Interpret EXAMPLE-BLOCK element as Org syntax.
1511 CONTENTS is nil."
1512 (let ((switches (org-element-property :switches example-block)))
1513 (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
1514 (org-remove-indentation
1515 (org-element-property :value example-block))
1516 "#+END_EXAMPLE")))
1519 ;;;; Export Block
1521 (defun org-element-export-block-parser (limit)
1522 "Parse an export block.
1524 LIMIT bounds the search.
1526 Return a list whose CAR is `export-block' and CDR is a plist
1527 containing `:begin', `:end', `:type', `:hiddenp', `:value' and
1528 `:post-blank' keywords.
1530 Assume point is at export-block beginning."
1531 (let* ((case-fold-search t)
1532 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
1533 (upcase (org-match-string-no-properties 1)))))
1534 (if (not (save-excursion
1535 (re-search-forward (concat "^[ \t]*#\\+END_" type) limit t)))
1536 ;; Incomplete block: parse it as a comment.
1537 (org-element-comment-parser limit)
1538 (let ((contents-end (match-beginning 0)))
1539 (save-excursion
1540 (let* ((keywords (org-element--collect-affiliated-keywords))
1541 (begin (car keywords))
1542 (contents-begin (progn (forward-line) (point)))
1543 (hidden (org-invisible-p2))
1544 (pos-before-blank (progn (goto-char contents-end)
1545 (forward-line)
1546 (point)))
1547 (end (progn (skip-chars-forward " \r\t\n" limit)
1548 (if (eobp) (point) (point-at-bol))))
1549 (value (buffer-substring-no-properties contents-begin
1550 contents-end)))
1551 (list 'export-block
1552 (nconc
1553 (list :begin begin
1554 :end end
1555 :type type
1556 :value value
1557 :hiddenp hidden
1558 :post-blank (count-lines pos-before-blank end))
1559 (cadr keywords)))))))))
1561 (defun org-element-export-block-interpreter (export-block contents)
1562 "Interpret EXPORT-BLOCK element as Org syntax.
1563 CONTENTS is nil."
1564 (let ((type (org-element-property :type export-block)))
1565 (concat (format "#+BEGIN_%s\n" type)
1566 (org-element-property :value export-block)
1567 (format "#+END_%s" type))))
1570 ;;;; Fixed-width
1572 (defun org-element-fixed-width-parser (limit)
1573 "Parse a fixed-width section.
1575 LIMIT bounds the search.
1577 Return a list whose CAR is `fixed-width' and CDR is a plist
1578 containing `:begin', `:end', `:value' and `:post-blank' keywords.
1580 Assume point is at the beginning of the fixed-width area."
1581 (save-excursion
1582 (let* ((keywords (org-element--collect-affiliated-keywords))
1583 (begin (car keywords))
1584 value
1585 (end-area
1586 (progn
1587 (while (and (< (point) limit)
1588 (looking-at "[ \t]*:\\( \\|$\\)"))
1589 ;; Accumulate text without starting colons.
1590 (setq value
1591 (concat value
1592 (buffer-substring-no-properties
1593 (match-end 0) (point-at-eol))
1594 "\n"))
1595 (forward-line))
1596 (point)))
1597 (end (progn (skip-chars-forward " \r\t\n" limit)
1598 (if (eobp) (point) (point-at-bol)))))
1599 (list 'fixed-width
1600 (nconc
1601 (list :begin begin
1602 :end end
1603 :value value
1604 :post-blank (count-lines end-area end))
1605 (cadr keywords))))))
1607 (defun org-element-fixed-width-interpreter (fixed-width contents)
1608 "Interpret FIXED-WIDTH element as Org syntax.
1609 CONTENTS is nil."
1610 (replace-regexp-in-string
1611 "^" ": " (substring (org-element-property :value fixed-width) 0 -1)))
1614 ;;;; Horizontal Rule
1616 (defun org-element-horizontal-rule-parser (limit)
1617 "Parse an horizontal rule.
1619 LIMIT bounds the search.
1621 Return a list whose CAR is `horizontal-rule' and CDR is a plist
1622 containing `:begin', `:end' and `:post-blank' keywords."
1623 (save-excursion
1624 (let* ((keywords (org-element--collect-affiliated-keywords))
1625 (begin (car keywords))
1626 (post-hr (progn (forward-line) (point)))
1627 (end (progn (skip-chars-forward " \r\t\n" limit)
1628 (if (eobp) (point) (point-at-bol)))))
1629 (list 'horizontal-rule
1630 (nconc
1631 (list :begin begin
1632 :end end
1633 :post-blank (count-lines post-hr end))
1634 (cadr keywords))))))
1636 (defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
1637 "Interpret HORIZONTAL-RULE element as Org syntax.
1638 CONTENTS is nil."
1639 "-----")
1642 ;;;; Keyword
1644 (defun org-element-keyword-parser (limit)
1645 "Parse a keyword at point.
1647 LIMIT bounds the search.
1649 Return a list whose CAR is `keyword' and CDR is a plist
1650 containing `:key', `:value', `:begin', `:end' and `:post-blank'
1651 keywords."
1652 (save-excursion
1653 (let* ((case-fold-search t)
1654 (begin (point))
1655 (key (progn (looking-at "[ \t]*#\\+\\(\\S-+\\):")
1656 (upcase (org-match-string-no-properties 1))))
1657 (value (org-trim (buffer-substring-no-properties
1658 (match-end 0) (point-at-eol))))
1659 (pos-before-blank (progn (forward-line) (point)))
1660 (end (progn (skip-chars-forward " \r\t\n" limit)
1661 (if (eobp) (point) (point-at-bol)))))
1662 (list 'keyword
1663 (list :key key
1664 :value value
1665 :begin begin
1666 :end end
1667 :post-blank (count-lines pos-before-blank end))))))
1669 (defun org-element-keyword-interpreter (keyword contents)
1670 "Interpret KEYWORD element as Org syntax.
1671 CONTENTS is nil."
1672 (format "#+%s: %s"
1673 (org-element-property :key keyword)
1674 (org-element-property :value keyword)))
1677 ;;;; Latex Environment
1679 (defun org-element-latex-environment-parser (limit)
1680 "Parse a LaTeX environment.
1682 LIMIT bounds the search.
1684 Return a list whose CAR is `latex-environment' and CDR is a plist
1685 containing `:begin', `:end', `:value' and `:post-blank'
1686 keywords.
1688 Assume point is at the beginning of the latex environment."
1689 (save-excursion
1690 (let* ((case-fold-search t)
1691 (code-begin (point))
1692 (keywords (org-element--collect-affiliated-keywords))
1693 (begin (car keywords))
1694 (env (progn (looking-at "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}")
1695 (regexp-quote (match-string 1))))
1696 (code-end
1697 (progn (re-search-forward (format "^[ \t]*\\\\end{%s}" env) limit t)
1698 (forward-line)
1699 (point)))
1700 (value (buffer-substring-no-properties code-begin code-end))
1701 (end (progn (skip-chars-forward " \r\t\n" limit)
1702 (if (eobp) (point) (point-at-bol)))))
1703 (list 'latex-environment
1704 (nconc
1705 (list :begin begin
1706 :end end
1707 :value value
1708 :post-blank (count-lines code-end end))
1709 (cadr keywords))))))
1711 (defun org-element-latex-environment-interpreter (latex-environment contents)
1712 "Interpret LATEX-ENVIRONMENT element as Org syntax.
1713 CONTENTS is nil."
1714 (org-element-property :value latex-environment))
1717 ;;;; Paragraph
1719 (defun org-element-paragraph-parser (limit)
1720 "Parse a paragraph.
1722 LIMIT bounds the search.
1724 Return a list whose CAR is `paragraph' and CDR is a plist
1725 containing `:begin', `:end', `:contents-begin' and
1726 `:contents-end' and `:post-blank' keywords.
1728 Assume point is at the beginning of the paragraph."
1729 (save-excursion
1730 (let* ((contents-begin (point))
1731 (keywords (org-element--collect-affiliated-keywords))
1732 (begin (car keywords))
1733 (before-blank
1734 (progn (end-of-line)
1735 (if (re-search-forward org-element-paragraph-separate
1736 limit
1738 (goto-char (match-beginning 0))
1739 (point))))
1740 (contents-end (progn (skip-chars-backward " \r\t\n" contents-begin)
1741 (forward-line)
1742 (point)))
1743 (end (progn (skip-chars-forward " \r\t\n" limit)
1744 (if (eobp) (point) (point-at-bol)))))
1745 (list 'paragraph
1746 ;; If paragraph has no affiliated keywords, it may not begin
1747 ;; at beginning of line if it starts an item.
1748 (nconc
1749 (list :begin (if (cadr keywords) begin contents-begin)
1750 :end end
1751 :contents-begin contents-begin
1752 :contents-end contents-end
1753 :post-blank (count-lines before-blank end))
1754 (cadr keywords))))))
1756 (defun org-element-paragraph-interpreter (paragraph contents)
1757 "Interpret PARAGRAPH element as Org syntax.
1758 CONTENTS is the contents of the element."
1759 contents)
1762 ;;;; Planning
1764 (defun org-element-planning-parser (limit)
1765 "Parse a planning.
1767 LIMIT bounds the search.
1769 Return a list whose CAR is `planning' and CDR is a plist
1770 containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
1771 and `:post-blank' keywords."
1772 (save-excursion
1773 (let* ((case-fold-search nil)
1774 (begin (point))
1775 (post-blank (let ((before-blank (progn (forward-line) (point))))
1776 (skip-chars-forward " \r\t\n" limit)
1777 (unless (eobp) (beginning-of-line))
1778 (count-lines before-blank (point))))
1779 (end (point))
1780 closed deadline scheduled)
1781 (goto-char begin)
1782 (while (re-search-forward org-keyword-time-not-clock-regexp
1783 (line-end-position) t)
1784 (goto-char (match-end 1))
1785 (org-skip-whitespace)
1786 (let ((time (buffer-substring-no-properties
1787 (1+ (point)) (1- (match-end 0))))
1788 (keyword (match-string 1)))
1789 (cond ((equal keyword org-closed-string) (setq closed time))
1790 ((equal keyword org-deadline-string) (setq deadline time))
1791 (t (setq scheduled time)))))
1792 (list 'planning
1793 (list :closed closed
1794 :deadline deadline
1795 :scheduled scheduled
1796 :begin begin
1797 :end end
1798 :post-blank post-blank)))))
1800 (defun org-element-planning-interpreter (planning contents)
1801 "Interpret PLANNING element as Org syntax.
1802 CONTENTS is nil."
1803 (mapconcat
1804 'identity
1805 (delq nil
1806 (list (let ((closed (org-element-property :closed planning)))
1807 (when closed (concat org-closed-string " [" closed "]")))
1808 (let ((deadline (org-element-property :deadline planning)))
1809 (when deadline (concat org-deadline-string " <" deadline ">")))
1810 (let ((scheduled (org-element-property :scheduled planning)))
1811 (when scheduled
1812 (concat org-scheduled-string " <" scheduled ">")))))
1813 " "))
1816 ;;;; Property Drawer
1818 (defun org-element-property-drawer-parser (limit)
1819 "Parse a property drawer.
1821 LIMIT bounds the search.
1823 Return a list whose CAR is `property-drawer' and CDR is a plist
1824 containing `:begin', `:end', `:hiddenp', `:contents-begin',
1825 `:contents-end', `:properties' and `:post-blank' keywords.
1827 Assume point is at the beginning of the property drawer."
1828 (save-excursion
1829 (let ((case-fold-search t)
1830 (begin (point))
1831 (prop-begin (progn (forward-line) (point)))
1832 (hidden (org-invisible-p2))
1833 (properties
1834 (let (val)
1835 (while (not (looking-at "^[ \t]*:END:"))
1836 (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):")
1837 (push (cons (org-match-string-no-properties 1)
1838 (org-trim
1839 (buffer-substring-no-properties
1840 (match-end 0) (point-at-eol))))
1841 val))
1842 (forward-line))
1843 val))
1844 (prop-end (progn (re-search-forward "^[ \t]*:END:" limit t)
1845 (point-at-bol)))
1846 (pos-before-blank (progn (forward-line) (point)))
1847 (end (progn (skip-chars-forward " \r\t\n" limit)
1848 (if (eobp) (point) (point-at-bol)))))
1849 (list 'property-drawer
1850 (list :begin begin
1851 :end end
1852 :hiddenp hidden
1853 :properties properties
1854 :post-blank (count-lines pos-before-blank end))))))
1856 (defun org-element-property-drawer-interpreter (property-drawer contents)
1857 "Interpret PROPERTY-DRAWER element as Org syntax.
1858 CONTENTS is nil."
1859 (let ((props (org-element-property :properties property-drawer)))
1860 (concat
1861 ":PROPERTIES:\n"
1862 (mapconcat (lambda (p)
1863 (format org-property-format (format ":%s:" (car p)) (cdr p)))
1864 (nreverse props) "\n")
1865 "\n:END:")))
1868 ;;;; Quote Section
1870 (defun org-element-quote-section-parser (limit)
1871 "Parse a quote section.
1873 LIMIT bounds the search.
1875 Return a list whose CAR is `quote-section' and CDR is a plist
1876 containing `:begin', `:end', `:value' and `:post-blank' keywords.
1878 Assume point is at beginning of the section."
1879 (save-excursion
1880 (let* ((begin (point))
1881 (end (progn (org-with-limited-levels (outline-next-heading))
1882 (point)))
1883 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
1884 (forward-line)
1885 (point)))
1886 (value (buffer-substring-no-properties begin pos-before-blank)))
1887 (list 'quote-section
1888 (list :begin begin
1889 :end end
1890 :value value
1891 :post-blank (count-lines pos-before-blank end))))))
1893 (defun org-element-quote-section-interpreter (quote-section contents)
1894 "Interpret QUOTE-SECTION element as Org syntax.
1895 CONTENTS is nil."
1896 (org-element-property :value quote-section))
1899 ;;;; Src Block
1901 (defun org-element-src-block-parser (limit)
1902 "Parse a src block.
1904 LIMIT bounds the search.
1906 Return a list whose CAR is `src-block' and CDR is a plist
1907 containing `:language', `:switches', `:parameters', `:begin',
1908 `:end', `:hiddenp', `:number-lines', `:retain-labels',
1909 `:use-labels', `:label-fmt', `:preserve-indent', `:value' and
1910 `:post-blank' keywords.
1912 Assume point is at the beginning of the block."
1913 (let ((case-fold-search t))
1914 (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC" limit t)))
1915 ;; Incomplete block: parse it as a comment.
1916 (org-element-comment-parser limit)
1917 (let ((contents-end (match-beginning 0)))
1918 (save-excursion
1919 (let* ((keywords (org-element--collect-affiliated-keywords))
1920 ;; Get beginning position.
1921 (begin (car keywords))
1922 ;; Get language as a string.
1923 (language
1924 (progn
1925 (looking-at
1926 (concat "^[ \t]*#\\+BEGIN_SRC"
1927 "\\(?: +\\(\\S-+\\)\\)?"
1928 "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
1929 "\\(.*\\)[ \t]*$"))
1930 (org-match-string-no-properties 1)))
1931 ;; Get switches.
1932 (switches (org-match-string-no-properties 2))
1933 ;; Get parameters.
1934 (parameters (org-match-string-no-properties 3))
1935 ;; Switches analysis
1936 (number-lines (cond ((not switches) nil)
1937 ((string-match "-n\\>" switches) 'new)
1938 ((string-match "+n\\>" switches) 'continued)))
1939 (preserve-indent (and switches (string-match "-i\\>" switches)))
1940 (label-fmt (and switches
1941 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
1942 (match-string 1 switches)))
1943 ;; Should labels be retained in (or stripped from)
1944 ;; src blocks?
1945 (retain-labels
1946 (or (not switches)
1947 (not (string-match "-r\\>" switches))
1948 (and number-lines (string-match "-k\\>" switches))))
1949 ;; What should code-references use - labels or
1950 ;; line-numbers?
1951 (use-labels
1952 (or (not switches)
1953 (and retain-labels (not (string-match "-k\\>" switches)))))
1954 ;; Get visibility status.
1955 (hidden (progn (forward-line) (org-invisible-p2)))
1956 ;; Retrieve code.
1957 (value (buffer-substring-no-properties (point) contents-end))
1958 (pos-before-blank (progn (goto-char contents-end)
1959 (forward-line)
1960 (point)))
1961 ;; Get position after ending blank lines.
1962 (end (progn (skip-chars-forward " \r\t\n" limit)
1963 (if (eobp) (point) (point-at-bol)))))
1964 (list 'src-block
1965 (nconc
1966 (list :language language
1967 :switches (and (org-string-nw-p switches)
1968 (org-trim switches))
1969 :parameters (and (org-string-nw-p parameters)
1970 (org-trim parameters))
1971 :begin begin
1972 :end end
1973 :number-lines number-lines
1974 :preserve-indent preserve-indent
1975 :retain-labels retain-labels
1976 :use-labels use-labels
1977 :label-fmt label-fmt
1978 :hiddenp hidden
1979 :value value
1980 :post-blank (count-lines pos-before-blank end))
1981 (cadr keywords)))))))))
1983 (defun org-element-src-block-interpreter (src-block contents)
1984 "Interpret SRC-BLOCK element as Org syntax.
1985 CONTENTS is nil."
1986 (let ((lang (org-element-property :language src-block))
1987 (switches (org-element-property :switches src-block))
1988 (params (org-element-property :parameters src-block))
1989 (value (let ((val (org-element-property :value src-block)))
1990 (cond
1992 (org-src-preserve-indentation val)
1993 ((zerop org-edit-src-content-indentation)
1994 (org-remove-indentation val))
1996 (let ((ind (make-string
1997 org-edit-src-content-indentation 32)))
1998 (replace-regexp-in-string
1999 "\\(^\\)[ \t]*\\S-" ind
2000 (org-remove-indentation val) nil nil 1)))))))
2001 (concat (format "#+BEGIN_SRC%s\n"
2002 (concat (and lang (concat " " lang))
2003 (and switches (concat " " switches))
2004 (and params (concat " " params))))
2005 value
2006 "#+END_SRC")))
2009 ;;;; Table
2011 (defun org-element-table-parser (limit)
2012 "Parse a table at point.
2014 LIMIT bounds the search.
2016 Return a list whose CAR is `table' and CDR is a plist containing
2017 `:begin', `:end', `:tblfm', `:type', `:contents-begin',
2018 `:contents-end', `:value' and `:post-blank' keywords.
2020 Assume point is at the beginning of the table."
2021 (save-excursion
2022 (let* ((case-fold-search t)
2023 (table-begin (point))
2024 (type (if (org-at-table.el-p) 'table.el 'org))
2025 (keywords (org-element--collect-affiliated-keywords))
2026 (begin (car keywords))
2027 (table-end (goto-char (marker-position (org-table-end t))))
2028 (tblfm (let (acc)
2029 (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
2030 (push (org-match-string-no-properties 1) acc)
2031 (forward-line))
2032 acc))
2033 (pos-before-blank (point))
2034 (end (progn (skip-chars-forward " \r\t\n" limit)
2035 (if (eobp) (point) (point-at-bol)))))
2036 (list 'table
2037 (nconc
2038 (list :begin begin
2039 :end end
2040 :type type
2041 :tblfm tblfm
2042 ;; Only `org' tables have contents. `table.el' tables
2043 ;; use a `:value' property to store raw table as
2044 ;; a string.
2045 :contents-begin (and (eq type 'org) table-begin)
2046 :contents-end (and (eq type 'org) table-end)
2047 :value (and (eq type 'table.el)
2048 (buffer-substring-no-properties
2049 table-begin table-end))
2050 :post-blank (count-lines pos-before-blank end))
2051 (cadr keywords))))))
2053 (defun org-element-table-interpreter (table contents)
2054 "Interpret TABLE element as Org syntax.
2055 CONTENTS is nil."
2056 (if (eq (org-element-property :type table) 'table.el)
2057 (org-remove-indentation (org-element-property :value table))
2058 (concat (with-temp-buffer (insert contents)
2059 (org-table-align)
2060 (buffer-string))
2061 (mapconcat (lambda (fm) (concat "#+TBLFM: " fm))
2062 (reverse (org-element-property :tblfm table))
2063 "\n"))))
2066 ;;;; Table Row
2068 (defun org-element-table-row-parser (limit)
2069 "Parse table row at point.
2071 LIMIT bounds the search.
2073 Return a list whose CAR is `table-row' and CDR is a plist
2074 containing `:begin', `:end', `:contents-begin', `:contents-end',
2075 `:type' and `:post-blank' keywords."
2076 (save-excursion
2077 (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
2078 (begin (point))
2079 ;; A table rule has no contents. In that case, ensure
2080 ;; CONTENTS-BEGIN matches CONTENTS-END.
2081 (contents-begin (and (eq type 'standard)
2082 (search-forward "|")
2083 (point)))
2084 (contents-end (and (eq type 'standard)
2085 (progn
2086 (end-of-line)
2087 (skip-chars-backward " \t")
2088 (point))))
2089 (end (progn (forward-line) (point))))
2090 (list 'table-row
2091 (list :type type
2092 :begin begin
2093 :end end
2094 :contents-begin contents-begin
2095 :contents-end contents-end
2096 :post-blank 0)))))
2098 (defun org-element-table-row-interpreter (table-row contents)
2099 "Interpret TABLE-ROW element as Org syntax.
2100 CONTENTS is the contents of the table row."
2101 (if (eq (org-element-property :type table-row) 'rule) "|-"
2102 (concat "| " contents)))
2105 ;;;; Verse Block
2107 (defun org-element-verse-block-parser (limit)
2108 "Parse a verse block.
2110 LIMIT bounds the search.
2112 Return a list whose CAR is `verse-block' and CDR is a plist
2113 containing `:begin', `:end', `:contents-begin', `:contents-end',
2114 `:hiddenp' and `:post-blank' keywords.
2116 Assume point is at beginning of the block."
2117 (let ((case-fold-search t))
2118 (if (not (save-excursion
2119 (re-search-forward "^[ \t]*#\\+END_VERSE" limit t)))
2120 ;; Incomplete block: parse it as a comment.
2121 (org-element-comment-parser limit)
2122 (let ((contents-end (match-beginning 0)))
2123 (save-excursion
2124 (let* ((keywords (org-element--collect-affiliated-keywords))
2125 (begin (car keywords))
2126 (hidden (progn (forward-line) (org-invisible-p2)))
2127 (contents-begin (point))
2128 (pos-before-blank (progn (goto-char contents-end)
2129 (forward-line)
2130 (point)))
2131 (end (progn (skip-chars-forward " \r\t\n" limit)
2132 (if (eobp) (point) (point-at-bol)))))
2133 (list 'verse-block
2134 (nconc
2135 (list :begin begin
2136 :end end
2137 :contents-begin contents-begin
2138 :contents-end contents-end
2139 :hiddenp hidden
2140 :post-blank (count-lines pos-before-blank end))
2141 (cadr keywords)))))))))
2143 (defun org-element-verse-block-interpreter (verse-block contents)
2144 "Interpret VERSE-BLOCK element as Org syntax.
2145 CONTENTS is verse block contents."
2146 (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
2150 ;;; Objects
2152 ;; Unlike to elements, interstices can be found between objects.
2153 ;; That's why, along with the parser, successor functions are provided
2154 ;; for each object. Some objects share the same successor (i.e. `code'
2155 ;; and `verbatim' objects).
2157 ;; A successor must accept a single argument bounding the search. It
2158 ;; will return either a cons cell whose CAR is the object's type, as
2159 ;; a symbol, and CDR the position of its next occurrence, or nil.
2161 ;; Successors follow the naming convention:
2162 ;; org-element-NAME-successor, where NAME is the name of the
2163 ;; successor, as defined in `org-element-all-successors'.
2165 ;; Some object types (i.e. `emphasis') are recursive. Restrictions on
2166 ;; object types they can contain will be specified in
2167 ;; `org-element-object-restrictions'.
2169 ;; Adding a new type of object is simple. Implement a successor,
2170 ;; a parser, and an interpreter for it, all following the naming
2171 ;; convention. Register type in `org-element-all-objects' and
2172 ;; successor in `org-element-all-successors'. Maybe tweak
2173 ;; restrictions about it, and that's it.
2176 ;;;; Bold
2178 (defun org-element-bold-parser ()
2179 "Parse bold object at point.
2181 Return a list whose CAR is `bold' and CDR is a plist with
2182 `:begin', `:end', `:contents-begin' and `:contents-end' and
2183 `:post-blank' keywords.
2185 Assume point is at the first star marker."
2186 (save-excursion
2187 (unless (bolp) (backward-char 1))
2188 (looking-at org-emph-re)
2189 (let ((begin (match-beginning 2))
2190 (contents-begin (match-beginning 4))
2191 (contents-end (match-end 4))
2192 (post-blank (progn (goto-char (match-end 2))
2193 (skip-chars-forward " \t")))
2194 (end (point)))
2195 (list 'bold
2196 (list :begin begin
2197 :end end
2198 :contents-begin contents-begin
2199 :contents-end contents-end
2200 :post-blank post-blank)))))
2202 (defun org-element-bold-interpreter (bold contents)
2203 "Interpret BOLD object as Org syntax.
2204 CONTENTS is the contents of the object."
2205 (format "*%s*" contents))
2207 (defun org-element-text-markup-successor (limit)
2208 "Search for the next text-markup object.
2210 LIMIT bounds the search.
2212 LIMIT bounds the search.
2214 Return value is a cons cell whose CAR is a symbol among `bold',
2215 `italic', `underline', `strike-through', `code' and `verbatim'
2216 and CDR is beginning position."
2217 (save-excursion
2218 (unless (bolp) (backward-char))
2219 (when (re-search-forward org-emph-re limit t)
2220 (let ((marker (match-string 3)))
2221 (cons (cond
2222 ((equal marker "*") 'bold)
2223 ((equal marker "/") 'italic)
2224 ((equal marker "_") 'underline)
2225 ((equal marker "+") 'strike-through)
2226 ((equal marker "~") 'code)
2227 ((equal marker "=") 'verbatim)
2228 (t (error "Unknown marker at %d" (match-beginning 3))))
2229 (match-beginning 2))))))
2232 ;;;; Code
2234 (defun org-element-code-parser ()
2235 "Parse code object at point.
2237 Return a list whose CAR is `code' and CDR is a plist with
2238 `:value', `:begin', `:end' and `:post-blank' keywords.
2240 Assume point is at the first tilde marker."
2241 (save-excursion
2242 (unless (bolp) (backward-char 1))
2243 (looking-at org-emph-re)
2244 (let ((begin (match-beginning 2))
2245 (value (org-match-string-no-properties 4))
2246 (post-blank (progn (goto-char (match-end 2))
2247 (skip-chars-forward " \t")))
2248 (end (point)))
2249 (list 'code
2250 (list :value value
2251 :begin begin
2252 :end end
2253 :post-blank post-blank)))))
2255 (defun org-element-code-interpreter (code contents)
2256 "Interpret CODE object as Org syntax.
2257 CONTENTS is nil."
2258 (format "~%s~" (org-element-property :value code)))
2261 ;;;; Entity
2263 (defun org-element-entity-parser ()
2264 "Parse entity at point.
2266 Return a list whose CAR is `entity' and CDR a plist with
2267 `:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
2268 `:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
2269 keywords.
2271 Assume point is at the beginning of the entity."
2272 (save-excursion
2273 (looking-at "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
2274 (let* ((value (org-entity-get (match-string 1)))
2275 (begin (match-beginning 0))
2276 (bracketsp (string= (match-string 2) "{}"))
2277 (post-blank (progn (goto-char (match-end 1))
2278 (when bracketsp (forward-char 2))
2279 (skip-chars-forward " \t")))
2280 (end (point)))
2281 (list 'entity
2282 (list :name (car value)
2283 :latex (nth 1 value)
2284 :latex-math-p (nth 2 value)
2285 :html (nth 3 value)
2286 :ascii (nth 4 value)
2287 :latin1 (nth 5 value)
2288 :utf-8 (nth 6 value)
2289 :begin begin
2290 :end end
2291 :use-brackets-p bracketsp
2292 :post-blank post-blank)))))
2294 (defun org-element-entity-interpreter (entity contents)
2295 "Interpret ENTITY object as Org syntax.
2296 CONTENTS is nil."
2297 (concat "\\"
2298 (org-element-property :name entity)
2299 (when (org-element-property :use-brackets-p entity) "{}")))
2301 (defun org-element-latex-or-entity-successor (limit)
2302 "Search for the next latex-fragment or entity object.
2304 LIMIT bounds the search.
2306 Return value is a cons cell whose CAR is `entity' or
2307 `latex-fragment' and CDR is beginning position."
2308 (save-excursion
2309 (let ((matchers (plist-get org-format-latex-options :matchers))
2310 ;; ENTITY-RE matches both LaTeX commands and Org entities.
2311 (entity-re
2312 "\\\\\\(there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)"))
2313 (when (re-search-forward
2314 (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
2315 matchers "\\|")
2316 "\\|" entity-re)
2317 limit t)
2318 (goto-char (match-beginning 0))
2319 (if (looking-at entity-re)
2320 ;; Determine if it's a real entity or a LaTeX command.
2321 (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
2322 (match-beginning 0))
2323 ;; No entity nor command: point is at a LaTeX fragment.
2324 ;; Determine its type to get the correct beginning position.
2325 (cons 'latex-fragment
2326 (catch 'return
2327 (mapc (lambda (e)
2328 (when (looking-at (nth 1 (assoc e org-latex-regexps)))
2329 (throw 'return
2330 (match-beginning
2331 (nth 2 (assoc e org-latex-regexps))))))
2332 matchers)
2333 (point))))))))
2336 ;;;; Export Snippet
2338 (defun org-element-export-snippet-parser ()
2339 "Parse export snippet at point.
2341 Return a list whose CAR is `export-snippet' and CDR a plist with
2342 `:begin', `:end', `:back-end', `:value' and `:post-blank' as
2343 keywords.
2345 Assume point is at the beginning of the snippet."
2346 (save-excursion
2347 (re-search-forward "@@\\([-A-Za-z0-9]+\\):" nil t)
2348 (let* ((begin (match-beginning 0))
2349 (back-end (org-match-string-no-properties 1))
2350 (value (buffer-substring-no-properties
2351 (point)
2352 (progn (re-search-forward "@@" nil t) (match-beginning 0))))
2353 (post-blank (skip-chars-forward " \t"))
2354 (end (point)))
2355 (list 'export-snippet
2356 (list :back-end back-end
2357 :value value
2358 :begin begin
2359 :end end
2360 :post-blank post-blank)))))
2362 (defun org-element-export-snippet-interpreter (export-snippet contents)
2363 "Interpret EXPORT-SNIPPET object as Org syntax.
2364 CONTENTS is nil."
2365 (format "@@%s:%s@@"
2366 (org-element-property :back-end export-snippet)
2367 (org-element-property :value export-snippet)))
2369 (defun org-element-export-snippet-successor (limit)
2370 "Search for the next export-snippet object.
2372 LIMIT bounds the search.
2374 Return value is a cons cell whose CAR is `export-snippet' and CDR
2375 its beginning position."
2376 (save-excursion
2377 (let (beg)
2378 (when (and (re-search-forward "@@[-A-Za-z0-9]+:" limit t)
2379 (setq beg (match-beginning 0))
2380 (re-search-forward "@@" limit t))
2381 (cons 'export-snippet beg)))))
2384 ;;;; Footnote Reference
2386 (defun org-element-footnote-reference-parser ()
2387 "Parse footnote reference at point.
2389 Return a list whose CAR is `footnote-reference' and CDR a plist
2390 with `:label', `:type', `:inline-definition', `:begin', `:end'
2391 and `:post-blank' as keywords."
2392 (save-excursion
2393 (looking-at org-footnote-re)
2394 (let* ((begin (point))
2395 (label (or (org-match-string-no-properties 2)
2396 (org-match-string-no-properties 3)
2397 (and (match-string 1)
2398 (concat "fn:" (org-match-string-no-properties 1)))))
2399 (type (if (or (not label) (match-string 1)) 'inline 'standard))
2400 (inner-begin (match-end 0))
2401 (inner-end
2402 (let ((count 1))
2403 (forward-char)
2404 (while (and (> count 0) (re-search-forward "[][]" nil t))
2405 (if (equal (match-string 0) "[") (incf count) (decf count)))
2406 (1- (point))))
2407 (post-blank (progn (goto-char (1+ inner-end))
2408 (skip-chars-forward " \t")))
2409 (end (point))
2410 (footnote-reference
2411 (list 'footnote-reference
2412 (list :label label
2413 :type type
2414 :begin begin
2415 :end end
2416 :post-blank post-blank))))
2417 (org-element-put-property
2418 footnote-reference :inline-definition
2419 (and (eq type 'inline)
2420 (org-element-parse-secondary-string
2421 (buffer-substring inner-begin inner-end)
2422 (org-element-restriction 'footnote-reference)
2423 footnote-reference))))))
2425 (defun org-element-footnote-reference-interpreter (footnote-reference contents)
2426 "Interpret FOOTNOTE-REFERENCE object as Org syntax.
2427 CONTENTS is nil."
2428 (let ((label (or (org-element-property :label footnote-reference) "fn:"))
2429 (def
2430 (let ((inline-def
2431 (org-element-property :inline-definition footnote-reference)))
2432 (if (not inline-def) ""
2433 (concat ":" (org-element-interpret-data inline-def))))))
2434 (format "[%s]" (concat label def))))
2436 (defun org-element-footnote-reference-successor (limit)
2437 "Search for the next footnote-reference object.
2439 LIMIT bounds the search.
2441 Return value is a cons cell whose CAR is `footnote-reference' and
2442 CDR is beginning position."
2443 (save-excursion
2444 (catch 'exit
2445 (while (re-search-forward org-footnote-re limit t)
2446 (save-excursion
2447 (let ((beg (match-beginning 0))
2448 (count 1))
2449 (backward-char)
2450 (while (re-search-forward "[][]" limit t)
2451 (if (equal (match-string 0) "[") (incf count) (decf count))
2452 (when (zerop count)
2453 (throw 'exit (cons 'footnote-reference beg))))))))))
2456 ;;;; Inline Babel Call
2458 (defun org-element-inline-babel-call-parser ()
2459 "Parse inline babel call at point.
2461 Return a list whose CAR is `inline-babel-call' and CDR a plist
2462 with `:begin', `:end', `:info' and `:post-blank' as keywords.
2464 Assume point is at the beginning of the babel call."
2465 (save-excursion
2466 (unless (bolp) (backward-char))
2467 (looking-at org-babel-inline-lob-one-liner-regexp)
2468 (let ((info (save-match-data (org-babel-lob-get-info)))
2469 (begin (match-end 1))
2470 (post-blank (progn (goto-char (match-end 0))
2471 (skip-chars-forward " \t")))
2472 (end (point)))
2473 (list 'inline-babel-call
2474 (list :begin begin
2475 :end end
2476 :info info
2477 :post-blank post-blank)))))
2479 (defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
2480 "Interpret INLINE-BABEL-CALL object as Org syntax.
2481 CONTENTS is nil."
2482 (let* ((babel-info (org-element-property :info inline-babel-call))
2483 (main-source (car babel-info))
2484 (post-options (nth 1 babel-info)))
2485 (concat "call_"
2486 (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
2487 ;; Remove redundant square brackets.
2488 (replace-match
2489 (match-string 1 main-source) nil nil main-source)
2490 main-source)
2491 (and post-options (format "[%s]" post-options)))))
2493 (defun org-element-inline-babel-call-successor (limit)
2494 "Search for the next inline-babel-call object.
2496 LIMIT bounds the search.
2498 Return value is a cons cell whose CAR is `inline-babel-call' and
2499 CDR is beginning position."
2500 (save-excursion
2501 ;; Use a simplified version of
2502 ;; org-babel-inline-lob-one-liner-regexp as regexp for more speed.
2503 (when (re-search-forward
2504 "\\(?:babel\\|call\\)_\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\([^\n]*\\))\\(\\[\\(.*?\\)\\]\\)?"
2505 limit t)
2506 (cons 'inline-babel-call (match-beginning 0)))))
2509 ;;;; Inline Src Block
2511 (defun org-element-inline-src-block-parser ()
2512 "Parse inline source block at point.
2514 LIMIT bounds the search.
2516 Return a list whose CAR is `inline-src-block' and CDR a plist
2517 with `:begin', `:end', `:language', `:value', `:parameters' and
2518 `:post-blank' as keywords.
2520 Assume point is at the beginning of the inline src block."
2521 (save-excursion
2522 (unless (bolp) (backward-char))
2523 (looking-at org-babel-inline-src-block-regexp)
2524 (let ((begin (match-beginning 1))
2525 (language (org-match-string-no-properties 2))
2526 (parameters (org-match-string-no-properties 4))
2527 (value (org-match-string-no-properties 5))
2528 (post-blank (progn (goto-char (match-end 0))
2529 (skip-chars-forward " \t")))
2530 (end (point)))
2531 (list 'inline-src-block
2532 (list :language language
2533 :value value
2534 :parameters parameters
2535 :begin begin
2536 :end end
2537 :post-blank post-blank)))))
2539 (defun org-element-inline-src-block-interpreter (inline-src-block contents)
2540 "Interpret INLINE-SRC-BLOCK object as Org syntax.
2541 CONTENTS is nil."
2542 (let ((language (org-element-property :language inline-src-block))
2543 (arguments (org-element-property :parameters inline-src-block))
2544 (body (org-element-property :value inline-src-block)))
2545 (format "src_%s%s{%s}"
2546 language
2547 (if arguments (format "[%s]" arguments) "")
2548 body)))
2550 (defun org-element-inline-src-block-successor (limit)
2551 "Search for the next inline-babel-call element.
2553 LIMIT bounds the search.
2555 Return value is a cons cell whose CAR is `inline-babel-call' and
2556 CDR is beginning position."
2557 (save-excursion
2558 (when (re-search-forward org-babel-inline-src-block-regexp limit t)
2559 (cons 'inline-src-block (match-beginning 1)))))
2561 ;;;; Italic
2563 (defun org-element-italic-parser ()
2564 "Parse italic object at point.
2566 Return a list whose CAR is `italic' and CDR is a plist with
2567 `:begin', `:end', `:contents-begin' and `:contents-end' and
2568 `:post-blank' keywords.
2570 Assume point is at the first slash marker."
2571 (save-excursion
2572 (unless (bolp) (backward-char 1))
2573 (looking-at org-emph-re)
2574 (let ((begin (match-beginning 2))
2575 (contents-begin (match-beginning 4))
2576 (contents-end (match-end 4))
2577 (post-blank (progn (goto-char (match-end 2))
2578 (skip-chars-forward " \t")))
2579 (end (point)))
2580 (list 'italic
2581 (list :begin begin
2582 :end end
2583 :contents-begin contents-begin
2584 :contents-end contents-end
2585 :post-blank post-blank)))))
2587 (defun org-element-italic-interpreter (italic contents)
2588 "Interpret ITALIC object as Org syntax.
2589 CONTENTS is the contents of the object."
2590 (format "/%s/" contents))
2593 ;;;; Latex Fragment
2595 (defun org-element-latex-fragment-parser ()
2596 "Parse latex fragment at point.
2598 Return a list whose CAR is `latex-fragment' and CDR a plist with
2599 `:value', `:begin', `:end', and `:post-blank' as keywords.
2601 Assume point is at the beginning of the latex fragment."
2602 (save-excursion
2603 (let* ((begin (point))
2604 (substring-match
2605 (catch 'exit
2606 (mapc (lambda (e)
2607 (let ((latex-regexp (nth 1 (assoc e org-latex-regexps))))
2608 (when (or (looking-at latex-regexp)
2609 (and (not (bobp))
2610 (save-excursion
2611 (backward-char)
2612 (looking-at latex-regexp))))
2613 (throw 'exit (nth 2 (assoc e org-latex-regexps))))))
2614 (plist-get org-format-latex-options :matchers))
2615 ;; None found: it's a macro.
2616 (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
2618 (value (match-string-no-properties substring-match))
2619 (post-blank (progn (goto-char (match-end substring-match))
2620 (skip-chars-forward " \t")))
2621 (end (point)))
2622 (list 'latex-fragment
2623 (list :value value
2624 :begin begin
2625 :end end
2626 :post-blank post-blank)))))
2628 (defun org-element-latex-fragment-interpreter (latex-fragment contents)
2629 "Interpret LATEX-FRAGMENT object as Org syntax.
2630 CONTENTS is nil."
2631 (org-element-property :value latex-fragment))
2633 ;;;; Line Break
2635 (defun org-element-line-break-parser ()
2636 "Parse line break at point.
2638 Return a list whose CAR is `line-break', and CDR a plist with
2639 `:begin', `:end' and `:post-blank' keywords.
2641 Assume point is at the beginning of the line break."
2642 (list 'line-break (list :begin (point) :end (point-at-eol) :post-blank 0)))
2644 (defun org-element-line-break-interpreter (line-break contents)
2645 "Interpret LINE-BREAK object as Org syntax.
2646 CONTENTS is nil."
2647 "\\\\")
2649 (defun org-element-line-break-successor (limit)
2650 "Search for the next line-break object.
2652 LIMIT bounds the search.
2654 Return value is a cons cell whose CAR is `line-break' and CDR is
2655 beginning position."
2656 (save-excursion
2657 (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
2658 (goto-char (match-beginning 1)))))
2659 ;; A line break can only happen on a non-empty line.
2660 (when (and beg (re-search-backward "\\S-" (point-at-bol) t))
2661 (cons 'line-break beg)))))
2664 ;;;; Link
2666 (defun org-element-link-parser ()
2667 "Parse link at point.
2669 Return a list whose CAR is `link' and CDR a plist with `:type',
2670 `:path', `:raw-link', `:begin', `:end', `:contents-begin',
2671 `:contents-end' and `:post-blank' as keywords.
2673 Assume point is at the beginning of the link."
2674 (save-excursion
2675 (let ((begin (point))
2676 end contents-begin contents-end link-end post-blank path type
2677 raw-link link)
2678 (cond
2679 ;; Type 1: Text targeted from a radio target.
2680 ((and org-target-link-regexp (looking-at org-target-link-regexp))
2681 (setq type "radio"
2682 link-end (match-end 0)
2683 path (org-match-string-no-properties 0)))
2684 ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
2685 ((looking-at org-bracket-link-regexp)
2686 (setq contents-begin (match-beginning 3)
2687 contents-end (match-end 3)
2688 link-end (match-end 0)
2689 ;; RAW-LINK is the original link.
2690 raw-link (org-match-string-no-properties 1)
2691 link (org-translate-link
2692 (org-link-expand-abbrev
2693 (org-link-unescape raw-link))))
2694 ;; Determine TYPE of link and set PATH accordingly.
2695 (cond
2696 ;; File type.
2697 ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link))
2698 (setq type "file" path link))
2699 ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
2700 ((string-match org-link-re-with-space3 link)
2701 (setq type (match-string 1 link) path (match-string 2 link)))
2702 ;; Id type: PATH is the id.
2703 ((string-match "^id:\\([-a-f0-9]+\\)" link)
2704 (setq type "id" path (match-string 1 link)))
2705 ;; Code-ref type: PATH is the name of the reference.
2706 ((string-match "^(\\(.*\\))$" link)
2707 (setq type "coderef" path (match-string 1 link)))
2708 ;; Custom-id type: PATH is the name of the custom id.
2709 ((= (aref link 0) ?#)
2710 (setq type "custom-id" path (substring link 1)))
2711 ;; Fuzzy type: Internal link either matches a target, an
2712 ;; headline name or nothing. PATH is the target or
2713 ;; headline's name.
2714 (t (setq type "fuzzy" path link))))
2715 ;; Type 3: Plain link, i.e. http://orgmode.org
2716 ((looking-at org-plain-link-re)
2717 (setq raw-link (org-match-string-no-properties 0)
2718 type (org-match-string-no-properties 1)
2719 path (org-match-string-no-properties 2)
2720 link-end (match-end 0)))
2721 ;; Type 4: Angular link, i.e. <http://orgmode.org>
2722 ((looking-at org-angle-link-re)
2723 (setq raw-link (buffer-substring-no-properties
2724 (match-beginning 1) (match-end 2))
2725 type (org-match-string-no-properties 1)
2726 path (org-match-string-no-properties 2)
2727 link-end (match-end 0))))
2728 ;; In any case, deduce end point after trailing white space from
2729 ;; LINK-END variable.
2730 (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
2731 end (point))
2732 (list 'link
2733 (list :type type
2734 :path path
2735 :raw-link (or raw-link path)
2736 :begin begin
2737 :end end
2738 :contents-begin contents-begin
2739 :contents-end contents-end
2740 :post-blank post-blank)))))
2742 (defun org-element-link-interpreter (link contents)
2743 "Interpret LINK object as Org syntax.
2744 CONTENTS is the contents of the object, or nil."
2745 (let ((type (org-element-property :type link))
2746 (raw-link (org-element-property :raw-link link)))
2747 (if (string= type "radio") raw-link
2748 (format "[[%s]%s]"
2749 raw-link
2750 (if contents (format "[%s]" contents) "")))))
2752 (defun org-element-link-successor (limit)
2753 "Search for the next link object.
2755 LIMIT bounds the search.
2757 Return value is a cons cell whose CAR is `link' and CDR is
2758 beginning position."
2759 (save-excursion
2760 (let ((link-regexp
2761 (if (not org-target-link-regexp) org-any-link-re
2762 (concat org-any-link-re "\\|" org-target-link-regexp))))
2763 (when (re-search-forward link-regexp limit t)
2764 (cons 'link (match-beginning 0))))))
2767 ;;;; Macro
2769 (defun org-element-macro-parser ()
2770 "Parse macro at point.
2772 Return a list whose CAR is `macro' and CDR a plist with `:key',
2773 `:args', `:begin', `:end', `:value' and `:post-blank' as
2774 keywords.
2776 Assume point is at the macro."
2777 (save-excursion
2778 (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
2779 (let ((begin (point))
2780 (key (downcase (org-match-string-no-properties 1)))
2781 (value (org-match-string-no-properties 0))
2782 (post-blank (progn (goto-char (match-end 0))
2783 (skip-chars-forward " \t")))
2784 (end (point))
2785 (args (let ((args (org-match-string-no-properties 3)) args2)
2786 (when args
2787 (setq args (org-split-string args ","))
2788 (while args
2789 (while (string-match "\\\\\\'" (car args))
2790 ;; Repair bad splits.
2791 (setcar (cdr args) (concat (substring (car args) 0 -1)
2792 "," (nth 1 args)))
2793 (pop args))
2794 (push (pop args) args2))
2795 (mapcar 'org-trim (nreverse args2))))))
2796 (list 'macro
2797 (list :key key
2798 :value value
2799 :args args
2800 :begin begin
2801 :end end
2802 :post-blank post-blank)))))
2804 (defun org-element-macro-interpreter (macro contents)
2805 "Interpret MACRO object as Org syntax.
2806 CONTENTS is nil."
2807 (org-element-property :value macro))
2809 (defun org-element-macro-successor (limit)
2810 "Search for the next macro object.
2812 LIMIT bounds the search.
2814 Return value is cons cell whose CAR is `macro' and CDR is
2815 beginning position."
2816 (save-excursion
2817 (when (re-search-forward
2818 "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
2819 limit t)
2820 (cons 'macro (match-beginning 0)))))
2823 ;;;; Radio-target
2825 (defun org-element-radio-target-parser ()
2826 "Parse radio target at point.
2828 Return a list whose CAR is `radio-target' and CDR a plist with
2829 `:begin', `:end', `:contents-begin', `:contents-end', `:value'
2830 and `:post-blank' as keywords.
2832 Assume point is at the radio target."
2833 (save-excursion
2834 (looking-at org-radio-target-regexp)
2835 (let ((begin (point))
2836 (contents-begin (match-beginning 1))
2837 (contents-end (match-end 1))
2838 (value (org-match-string-no-properties 1))
2839 (post-blank (progn (goto-char (match-end 0))
2840 (skip-chars-forward " \t")))
2841 (end (point)))
2842 (list 'radio-target
2843 (list :begin begin
2844 :end end
2845 :contents-begin contents-begin
2846 :contents-end contents-end
2847 :post-blank post-blank
2848 :value value)))))
2850 (defun org-element-radio-target-interpreter (target contents)
2851 "Interpret TARGET object as Org syntax.
2852 CONTENTS is the contents of the object."
2853 (concat "<<<" contents ">>>"))
2855 (defun org-element-radio-target-successor (limit)
2856 "Search for the next radio-target object.
2858 LIMIT bounds the search.
2860 Return value is a cons cell whose CAR is `radio-target' and CDR
2861 is beginning position."
2862 (save-excursion
2863 (when (re-search-forward org-radio-target-regexp limit t)
2864 (cons 'radio-target (match-beginning 0)))))
2867 ;;;; Statistics Cookie
2869 (defun org-element-statistics-cookie-parser ()
2870 "Parse statistics cookie at point.
2872 Return a list whose CAR is `statistics-cookie', and CDR a plist
2873 with `:begin', `:end', `:value' and `:post-blank' keywords.
2875 Assume point is at the beginning of the statistics-cookie."
2876 (save-excursion
2877 (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
2878 (let* ((begin (point))
2879 (value (buffer-substring-no-properties
2880 (match-beginning 0) (match-end 0)))
2881 (post-blank (progn (goto-char (match-end 0))
2882 (skip-chars-forward " \t")))
2883 (end (point)))
2884 (list 'statistics-cookie
2885 (list :begin begin
2886 :end end
2887 :value value
2888 :post-blank post-blank)))))
2890 (defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
2891 "Interpret STATISTICS-COOKIE object as Org syntax.
2892 CONTENTS is nil."
2893 (org-element-property :value statistics-cookie))
2895 (defun org-element-statistics-cookie-successor (limit)
2896 "Search for the next statistics cookie object.
2898 LIMIT bounds the search.
2900 Return value is a cons cell whose CAR is `statistics-cookie' and
2901 CDR is beginning position."
2902 (save-excursion
2903 (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
2904 (cons 'statistics-cookie (match-beginning 0)))))
2907 ;;;; Strike-Through
2909 (defun org-element-strike-through-parser ()
2910 "Parse strike-through object at point.
2912 Return a list whose CAR is `strike-through' and CDR is a plist
2913 with `:begin', `:end', `:contents-begin' and `:contents-end' and
2914 `:post-blank' keywords.
2916 Assume point is at the first plus sign marker."
2917 (save-excursion
2918 (unless (bolp) (backward-char 1))
2919 (looking-at org-emph-re)
2920 (let ((begin (match-beginning 2))
2921 (contents-begin (match-beginning 4))
2922 (contents-end (match-end 4))
2923 (post-blank (progn (goto-char (match-end 2))
2924 (skip-chars-forward " \t")))
2925 (end (point)))
2926 (list 'strike-through
2927 (list :begin begin
2928 :end end
2929 :contents-begin contents-begin
2930 :contents-end contents-end
2931 :post-blank post-blank)))))
2933 (defun org-element-strike-through-interpreter (strike-through contents)
2934 "Interpret STRIKE-THROUGH object as Org syntax.
2935 CONTENTS is the contents of the object."
2936 (format "+%s+" contents))
2939 ;;;; Subscript
2941 (defun org-element-subscript-parser ()
2942 "Parse subscript at point.
2944 Return a list whose CAR is `subscript' and CDR a plist with
2945 `:begin', `:end', `:contents-begin', `:contents-end',
2946 `:use-brackets-p' and `:post-blank' as keywords.
2948 Assume point is at the underscore."
2949 (save-excursion
2950 (unless (bolp) (backward-char))
2951 (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
2953 (not (looking-at org-match-substring-regexp))))
2954 (begin (match-beginning 2))
2955 (contents-begin (or (match-beginning 5)
2956 (match-beginning 3)))
2957 (contents-end (or (match-end 5) (match-end 3)))
2958 (post-blank (progn (goto-char (match-end 0))
2959 (skip-chars-forward " \t")))
2960 (end (point)))
2961 (list 'subscript
2962 (list :begin begin
2963 :end end
2964 :use-brackets-p bracketsp
2965 :contents-begin contents-begin
2966 :contents-end contents-end
2967 :post-blank post-blank)))))
2969 (defun org-element-subscript-interpreter (subscript contents)
2970 "Interpret SUBSCRIPT object as Org syntax.
2971 CONTENTS is the contents of the object."
2972 (format
2973 (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
2974 contents))
2976 (defun org-element-sub/superscript-successor (limit)
2977 "Search for the next sub/superscript object.
2979 LIMIT bounds the search.
2981 Return value is a cons cell whose CAR is either `subscript' or
2982 `superscript' and CDR is beginning position."
2983 (save-excursion
2984 (when (re-search-forward org-match-substring-regexp limit t)
2985 (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
2986 (match-beginning 2)))))
2989 ;;;; Superscript
2991 (defun org-element-superscript-parser ()
2992 "Parse superscript at point.
2994 Return a list whose CAR is `superscript' and CDR a plist with
2995 `:begin', `:end', `:contents-begin', `:contents-end',
2996 `:use-brackets-p' and `:post-blank' as keywords.
2998 Assume point is at the caret."
2999 (save-excursion
3000 (unless (bolp) (backward-char))
3001 (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
3002 (not (looking-at org-match-substring-regexp))))
3003 (begin (match-beginning 2))
3004 (contents-begin (or (match-beginning 5)
3005 (match-beginning 3)))
3006 (contents-end (or (match-end 5) (match-end 3)))
3007 (post-blank (progn (goto-char (match-end 0))
3008 (skip-chars-forward " \t")))
3009 (end (point)))
3010 (list 'superscript
3011 (list :begin begin
3012 :end end
3013 :use-brackets-p bracketsp
3014 :contents-begin contents-begin
3015 :contents-end contents-end
3016 :post-blank post-blank)))))
3018 (defun org-element-superscript-interpreter (superscript contents)
3019 "Interpret SUPERSCRIPT object as Org syntax.
3020 CONTENTS is the contents of the object."
3021 (format
3022 (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s")
3023 contents))
3026 ;;;; Table Cell
3028 (defun org-element-table-cell-parser ()
3029 "Parse table cell at point.
3031 Return a list whose CAR is `table-cell' and CDR is a plist
3032 containing `:begin', `:end', `:contents-begin', `:contents-end'
3033 and `:post-blank' keywords."
3034 (looking-at "[ \t]*\\(.*?\\)[ \t]*|")
3035 (let* ((begin (match-beginning 0))
3036 (end (match-end 0))
3037 (contents-begin (match-beginning 1))
3038 (contents-end (match-end 1)))
3039 (list 'table-cell
3040 (list :begin begin
3041 :end end
3042 :contents-begin contents-begin
3043 :contents-end contents-end
3044 :post-blank 0))))
3046 (defun org-element-table-cell-interpreter (table-cell contents)
3047 "Interpret TABLE-CELL element as Org syntax.
3048 CONTENTS is the contents of the cell, or nil."
3049 (concat " " contents " |"))
3051 (defun org-element-table-cell-successor (limit)
3052 "Search for the next table-cell object.
3054 LIMIT bounds the search.
3056 Return value is a cons cell whose CAR is `table-cell' and CDR is
3057 beginning position."
3058 (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point))))
3061 ;;;; Target
3063 (defun org-element-target-parser ()
3064 "Parse target at point.
3066 Return a list whose CAR is `target' and CDR a plist with
3067 `:begin', `:end', `:value' and `:post-blank' as keywords.
3069 Assume point is at the target."
3070 (save-excursion
3071 (looking-at org-target-regexp)
3072 (let ((begin (point))
3073 (value (org-match-string-no-properties 1))
3074 (post-blank (progn (goto-char (match-end 0))
3075 (skip-chars-forward " \t")))
3076 (end (point)))
3077 (list 'target
3078 (list :begin begin
3079 :end end
3080 :value value
3081 :post-blank post-blank)))))
3083 (defun org-element-target-interpreter (target contents)
3084 "Interpret TARGET object as Org syntax.
3085 CONTENTS is nil."
3086 (format "<<%s>>" (org-element-property :value target)))
3088 (defun org-element-target-successor (limit)
3089 "Search for the next target object.
3091 LIMIT bounds the search.
3093 Return value is a cons cell whose CAR is `target' and CDR is
3094 beginning position."
3095 (save-excursion
3096 (when (re-search-forward org-target-regexp limit t)
3097 (cons 'target (match-beginning 0)))))
3100 ;;;; Timestamp
3102 (defun org-element-timestamp-parser ()
3103 "Parse time stamp at point.
3105 Return a list whose CAR is `timestamp', and CDR a plist with
3106 `:type', `:begin', `:end', `:value' and `:post-blank' keywords.
3108 Assume point is at the beginning of the timestamp."
3109 (save-excursion
3110 (let* ((begin (point))
3111 (activep (eq (char-after) ?<))
3112 (main-value
3113 (progn
3114 (looking-at "[<[]\\(\\(%%\\)?.*?\\)[]>]\\(?:--[<[]\\(.*?\\)[]>]\\)?")
3115 (match-string-no-properties 1)))
3116 (range-end (match-string-no-properties 3))
3117 (type (cond ((match-string 2) 'diary)
3118 ((and activep range-end) 'active-range)
3119 (activep 'active)
3120 (range-end 'inactive-range)
3121 (t 'inactive)))
3122 (post-blank (progn (goto-char (match-end 0))
3123 (skip-chars-forward " \t")))
3124 (end (point)))
3125 (list 'timestamp
3126 (list :type type
3127 :value main-value
3128 :range-end range-end
3129 :begin begin
3130 :end end
3131 :post-blank post-blank)))))
3133 (defun org-element-timestamp-interpreter (timestamp contents)
3134 "Interpret TIMESTAMP object as Org syntax.
3135 CONTENTS is nil."
3136 (let ((type (org-element-property :type timestamp) ))
3137 (concat
3138 (format (if (memq type '(inactive inactive-range)) "[%s]" "<%s>")
3139 (org-element-property :value timestamp))
3140 (let ((range-end (org-element-property :range-end timestamp)))
3141 (when range-end
3142 (concat "--"
3143 (format (if (eq type 'inactive-range) "[%s]" "<%s>")
3144 range-end)))))))
3146 (defun org-element-timestamp-successor (limit)
3147 "Search for the next timestamp object.
3149 LIMIT bounds the search.
3151 Return value is a cons cell whose CAR is `timestamp' and CDR is
3152 beginning position."
3153 (save-excursion
3154 (when (re-search-forward
3155 (concat org-ts-regexp-both
3156 "\\|"
3157 "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
3158 "\\|"
3159 "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
3160 limit t)
3161 (cons 'timestamp (match-beginning 0)))))
3164 ;;;; Underline
3166 (defun org-element-underline-parser ()
3167 "Parse underline object at point.
3169 Return a list whose CAR is `underline' and CDR is a plist with
3170 `:begin', `:end', `:contents-begin' and `:contents-end' and
3171 `:post-blank' keywords.
3173 Assume point is at the first underscore marker."
3174 (save-excursion
3175 (unless (bolp) (backward-char 1))
3176 (looking-at org-emph-re)
3177 (let ((begin (match-beginning 2))
3178 (contents-begin (match-beginning 4))
3179 (contents-end (match-end 4))
3180 (post-blank (progn (goto-char (match-end 2))
3181 (skip-chars-forward " \t")))
3182 (end (point)))
3183 (list 'underline
3184 (list :begin begin
3185 :end end
3186 :contents-begin contents-begin
3187 :contents-end contents-end
3188 :post-blank post-blank)))))
3190 (defun org-element-underline-interpreter (underline contents)
3191 "Interpret UNDERLINE object as Org syntax.
3192 CONTENTS is the contents of the object."
3193 (format "_%s_" contents))
3196 ;;;; Verbatim
3198 (defun org-element-verbatim-parser ()
3199 "Parse verbatim object at point.
3201 Return a list whose CAR is `verbatim' and CDR is a plist with
3202 `:value', `:begin', `:end' and `:post-blank' keywords.
3204 Assume point is at the first equal sign marker."
3205 (save-excursion
3206 (unless (bolp) (backward-char 1))
3207 (looking-at org-emph-re)
3208 (let ((begin (match-beginning 2))
3209 (value (org-match-string-no-properties 4))
3210 (post-blank (progn (goto-char (match-end 2))
3211 (skip-chars-forward " \t")))
3212 (end (point)))
3213 (list 'verbatim
3214 (list :value value
3215 :begin begin
3216 :end end
3217 :post-blank post-blank)))))
3219 (defun org-element-verbatim-interpreter (verbatim contents)
3220 "Interpret VERBATIM object as Org syntax.
3221 CONTENTS is nil."
3222 (format "=%s=" (org-element-property :value verbatim)))
3226 ;;; Parsing Element Starting At Point
3228 ;; `org-element--current-element' is the core function of this section.
3229 ;; It returns the Lisp representation of the element starting at
3230 ;; point.
3232 ;; `org-element--current-element' makes use of special modes. They
3233 ;; are activated for fixed element chaining (i.e. `plain-list' >
3234 ;; `item') or fixed conditional element chaining (i.e. `headline' >
3235 ;; `section'). Special modes are: `first-section', `section',
3236 ;; `quote-section', `item' and `table-row'.
3238 (defun org-element--current-element
3239 (limit &optional granularity special structure)
3240 "Parse the element starting at point.
3242 LIMIT bounds the search.
3244 Return value is a list like (TYPE PROPS) where TYPE is the type
3245 of the element and PROPS a plist of properties associated to the
3246 element.
3248 Possible types are defined in `org-element-all-elements'.
3250 Optional argument GRANULARITY determines the depth of the
3251 recursion. Allowed values are `headline', `greater-element',
3252 `element', `object' or nil. When it is broader than `object' (or
3253 nil), secondary values will not be parsed, since they only
3254 contain objects.
3256 Optional argument SPECIAL, when non-nil, can be either
3257 `first-section', `section', `quote-section', `table-row' and
3258 `item'.
3260 If STRUCTURE isn't provided but SPECIAL is set to `item', it will
3261 be computed.
3263 This function assumes point is always at the beginning of the
3264 element it has to parse."
3265 (save-excursion
3266 ;; If point is at an affiliated keyword, try moving to the
3267 ;; beginning of the associated element. If none is found, the
3268 ;; keyword is orphaned and will be treated as plain text.
3269 (when (looking-at org-element--affiliated-re)
3270 (let ((opoint (point)))
3271 (while (looking-at org-element--affiliated-re) (forward-line))
3272 (when (looking-at "[ \t]*$") (goto-char opoint))))
3273 (let ((case-fold-search t)
3274 ;; Determine if parsing depth allows for secondary strings
3275 ;; parsing. It only applies to elements referenced in
3276 ;; `org-element-secondary-value-alist'.
3277 (raw-secondary-p (and granularity (not (eq granularity 'object)))))
3278 (cond
3279 ;; Item.
3280 ((eq special 'item)
3281 (org-element-item-parser limit structure raw-secondary-p))
3282 ;; Quote Section.
3283 ((eq special 'quote-section) (org-element-quote-section-parser limit))
3284 ;; Table Row.
3285 ((eq special 'table-row) (org-element-table-row-parser limit))
3286 ;; Headline.
3287 ((org-with-limited-levels (org-at-heading-p))
3288 (org-element-headline-parser limit raw-secondary-p))
3289 ;; Section (must be checked after headline).
3290 ((eq special 'section) (org-element-section-parser limit))
3291 ((eq special 'first-section)
3292 (org-element-section-parser
3293 (or (save-excursion (org-with-limited-levels (outline-next-heading)))
3294 limit)))
3295 ;; Planning and Clock.
3296 ((and (looking-at org-planning-or-clock-line-re))
3297 (if (equal (match-string 1) org-clock-string)
3298 (org-element-clock-parser limit)
3299 (org-element-planning-parser limit)))
3300 ;; Inlinetask.
3301 ((org-at-heading-p)
3302 (org-element-inlinetask-parser limit raw-secondary-p))
3303 ;; LaTeX Environment.
3304 ((looking-at "[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}")
3305 (if (save-excursion
3306 (re-search-forward
3307 (format "[ \t]*\\\\end{%s}[ \t]*"
3308 (regexp-quote (match-string 1)))
3309 nil t))
3310 (org-element-latex-environment-parser limit)
3311 (org-element-paragraph-parser limit)))
3312 ;; Drawer and Property Drawer.
3313 ((looking-at org-drawer-regexp)
3314 (let ((name (match-string 1)))
3315 (cond
3316 ((not (save-excursion
3317 (re-search-forward "^[ \t]*:END:[ \t]*$" nil t)))
3318 (org-element-paragraph-parser limit))
3319 ((equal "PROPERTIES" name)
3320 (org-element-property-drawer-parser limit))
3321 (t (org-element-drawer-parser limit)))))
3322 ;; Fixed Width
3323 ((looking-at "[ \t]*:\\( \\|$\\)")
3324 (org-element-fixed-width-parser limit))
3325 ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and
3326 ;; Keywords.
3327 ((looking-at "[ \t]*#\\+")
3328 (goto-char (match-end 0))
3329 (cond ((looking-at "$\\| ")
3330 (beginning-of-line)
3331 (org-element-comment-parser limit))
3332 ((looking-at "BEGIN_\\(\\S-+\\)")
3333 (beginning-of-line)
3334 (let ((parser (assoc (upcase (match-string 1))
3335 org-element-block-name-alist)))
3336 (if parser (funcall (cdr parser) limit)
3337 (org-element-special-block-parser limit))))
3338 ((looking-at "CALL")
3339 (beginning-of-line)
3340 (org-element-babel-call-parser limit))
3341 ((looking-at "BEGIN:? ")
3342 (beginning-of-line)
3343 (org-element-dynamic-block-parser limit))
3344 ((looking-at "\\S-+:")
3345 (beginning-of-line)
3346 (org-element-keyword-parser limit))
3347 ;; Ill-formed syntax is considered as a comment.
3349 (beginning-of-line)
3350 (org-element-comment-parser limit))))
3351 ;; Comments.
3352 ((eq (char-after) ?#) (org-element-comment-parser limit))
3353 ;; Footnote Definition.
3354 ((looking-at org-footnote-definition-re)
3355 (org-element-footnote-definition-parser limit))
3356 ;; Horizontal Rule.
3357 ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
3358 (org-element-horizontal-rule-parser limit))
3359 ;; Table.
3360 ((org-at-table-p t) (org-element-table-parser limit))
3361 ;; List.
3362 ((looking-at (org-item-re))
3363 (org-element-plain-list-parser limit (or structure (org-list-struct))))
3364 ;; Default element: Paragraph.
3365 (t (org-element-paragraph-parser limit))))))
3368 ;; Most elements can have affiliated keywords. When looking for an
3369 ;; element beginning, we want to move before them, as they belong to
3370 ;; that element, and, in the meantime, collect information they give
3371 ;; into appropriate properties. Hence the following function.
3373 ;; Usage of optional arguments may not be obvious at first glance:
3375 ;; - TRANS-LIST is used to polish keywords names that have evolved
3376 ;; during Org history. In example, even though =result= and
3377 ;; =results= coexist, we want to have them under the same =result=
3378 ;; property. It's also true for "srcname" and "name", where the
3379 ;; latter seems to be preferred nowadays (thus the "name" property).
3381 ;; - CONSED allows to regroup multi-lines keywords under the same
3382 ;; property, while preserving their own identity. This is mostly
3383 ;; used for "attr_latex" and al.
3385 ;; - PARSED prepares a keyword value for export. This is useful for
3386 ;; "caption". Objects restrictions for such keywords are defined in
3387 ;; `org-element-object-restrictions'.
3389 ;; - DUALS is used to take care of keywords accepting a main and an
3390 ;; optional secondary values. For example "results" has its
3391 ;; source's name as the main value, and may have an hash string in
3392 ;; optional square brackets as the secondary one.
3394 ;; A keyword may belong to more than one category.
3396 (defun org-element--collect-affiliated-keywords
3397 (&optional key-re trans-list consed parsed duals)
3398 "Collect affiliated keywords before point.
3400 Optional argument KEY-RE is a regexp matching keywords, which
3401 puts matched keyword in group 1. It defaults to
3402 `org-element--affiliated-re'.
3404 TRANS-LIST is an alist where key is the keyword and value the
3405 property name it should be translated to, without the colons. It
3406 defaults to `org-element-keyword-translation-alist'.
3408 CONSED is a list of strings. Any keyword belonging to that list
3409 will have its value consed. The check is done after keyword
3410 translation. It defaults to `org-element-multiple-keywords'.
3412 PARSED is a list of strings. Any keyword member of this list
3413 will have its value parsed. The check is done after keyword
3414 translation. If a keyword is a member of both CONSED and PARSED,
3415 it's value will be a list of parsed strings. It defaults to
3416 `org-element-parsed-keywords'.
3418 DUALS is a list of strings. Any keyword member of this list can
3419 have two parts: one mandatory and one optional. Its value is
3420 a cons cell whose CAR is the former, and the CDR the latter. If
3421 a keyword is a member of both PARSED and DUALS, both values will
3422 be parsed. It defaults to `org-element-dual-keywords'.
3424 Return a list whose CAR is the position at the first of them and
3425 CDR a plist of keywords and values."
3426 (save-excursion
3427 (let ((case-fold-search t)
3428 (key-re (or key-re org-element--affiliated-re))
3429 (trans-list (or trans-list org-element-keyword-translation-alist))
3430 (consed (or consed org-element-multiple-keywords))
3431 (parsed (or parsed org-element-parsed-keywords))
3432 (duals (or duals org-element-dual-keywords))
3433 ;; RESTRICT is the list of objects allowed in parsed
3434 ;; keywords value.
3435 (restrict (org-element-restriction 'keyword))
3436 output)
3437 (unless (bobp)
3438 (while (and (not (bobp)) (progn (forward-line -1) (looking-at key-re)))
3439 (let* ((raw-kwd (upcase (or (match-string 2) (match-string 1))))
3440 ;; Apply translation to RAW-KWD. From there, KWD is
3441 ;; the official keyword.
3442 (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd))
3443 ;; Find main value for any keyword.
3444 (value
3445 (save-match-data
3446 (org-trim
3447 (buffer-substring-no-properties
3448 (match-end 0) (point-at-eol)))))
3449 ;; If KWD is a dual keyword, find its secondary
3450 ;; value. Maybe parse it.
3451 (dual-value
3452 (and (member kwd duals)
3453 (let ((sec (org-match-string-no-properties 3)))
3454 (if (or (not sec) (not (member kwd parsed))) sec
3455 (org-element-parse-secondary-string sec restrict)))))
3456 ;; Attribute a property name to KWD.
3457 (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
3458 ;; Now set final shape for VALUE.
3459 (when (member kwd parsed)
3460 (setq value (org-element-parse-secondary-string value restrict)))
3461 (when (member kwd duals)
3462 ;; VALUE is mandatory. Set it to nil if there is none.
3463 (setq value (and value (cons value dual-value))))
3464 ;; Attributes are always consed.
3465 (when (or (member kwd consed) (string-match "^ATTR_" kwd))
3466 (setq value (cons value (plist-get output kwd-sym))))
3467 ;; Eventually store the new value in OUTPUT.
3468 (setq output (plist-put output kwd-sym value))))
3469 (unless (looking-at key-re) (forward-line 1)))
3470 (list (point) output))))
3474 ;;; The Org Parser
3476 ;; The two major functions here are `org-element-parse-buffer', which
3477 ;; parses Org syntax inside the current buffer, taking into account
3478 ;; region, narrowing, or even visibility if specified, and
3479 ;; `org-element-parse-secondary-string', which parses objects within
3480 ;; a given string.
3482 ;; The (almost) almighty `org-element-map' allows to apply a function
3483 ;; on elements or objects matching some type, and accumulate the
3484 ;; resulting values. In an export situation, it also skips unneeded
3485 ;; parts of the parse tree.
3487 (defun org-element-parse-buffer (&optional granularity visible-only)
3488 "Recursively parse the buffer and return structure.
3489 If narrowing is in effect, only parse the visible part of the
3490 buffer.
3492 Optional argument GRANULARITY determines the depth of the
3493 recursion. It can be set to the following symbols:
3495 `headline' Only parse headlines.
3496 `greater-element' Don't recurse into greater elements excepted
3497 headlines and sections. Thus, elements
3498 parsed are the top-level ones.
3499 `element' Parse everything but objects and plain text.
3500 `object' Parse the complete buffer (default).
3502 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
3503 elements.
3505 Assume buffer is in Org mode."
3506 (save-excursion
3507 (goto-char (point-min))
3508 (org-skip-whitespace)
3509 (org-element--parse-elements
3510 (point-at-bol) (point-max)
3511 ;; Start in `first-section' mode so text before the first
3512 ;; headline belongs to a section.
3513 'first-section nil granularity visible-only (list 'org-data nil))))
3515 (defun org-element-parse-secondary-string (string restriction &optional parent)
3516 "Recursively parse objects in STRING and return structure.
3518 RESTRICTION is a symbol limiting the object types that will be
3519 looked after.
3521 Optional argument PARENT, when non-nil, is the element or object
3522 containing the secondary string. It is used to set correctly
3523 `:parent' property within the string."
3524 (with-temp-buffer
3525 (insert string)
3526 (let ((secondary (org-element--parse-objects
3527 (point-min) (point-max) nil restriction)))
3528 (mapc (lambda (obj) (org-element-put-property obj :parent parent))
3529 secondary))))
3531 (defun org-element-map (data types fun &optional info first-match no-recursion)
3532 "Map a function on selected elements or objects.
3534 DATA is the parsed tree, as returned by, i.e,
3535 `org-element-parse-buffer'. TYPES is a symbol or list of symbols
3536 of elements or objects types. FUN is the function called on the
3537 matching element or object. It must accept one arguments: the
3538 element or object itself.
3540 When optional argument INFO is non-nil, it should be a plist
3541 holding export options. In that case, parts of the parse tree
3542 not exportable according to that property list will be skipped.
3544 When optional argument FIRST-MATCH is non-nil, stop at the first
3545 match for which FUN doesn't return nil, and return that value.
3547 Optional argument NO-RECURSION is a symbol or a list of symbols
3548 representing elements or objects types. `org-element-map' won't
3549 enter any recursive element or object whose type belongs to that
3550 list. Though, FUN can still be applied on them.
3552 Nil values returned from FUN do not appear in the results."
3553 ;; Ensure TYPES and NO-RECURSION are a list, even of one element.
3554 (unless (listp types) (setq types (list types)))
3555 (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
3556 ;; Recursion depth is determined by --CATEGORY.
3557 (let* ((--category
3558 (catch 'found
3559 (let ((category 'greater-elements))
3560 (mapc (lambda (type)
3561 (cond ((or (memq type org-element-all-objects)
3562 (eq type 'plain-text))
3563 ;; If one object is found, the function
3564 ;; has to recurse into every object.
3565 (throw 'found 'objects))
3566 ((not (memq type org-element-greater-elements))
3567 ;; If one regular element is found, the
3568 ;; function has to recurse, at lest, into
3569 ;; every element it encounters.
3570 (and (not (eq category 'elements))
3571 (setq category 'elements)))))
3572 types)
3573 category)))
3574 --acc
3575 --walk-tree
3576 (--walk-tree
3577 (function
3578 (lambda (--data)
3579 ;; Recursively walk DATA. INFO, if non-nil, is a plist
3580 ;; holding contextual information.
3581 (let ((--type (org-element-type --data)))
3582 (cond
3583 ((not --data))
3584 ;; Ignored element in an export context.
3585 ((and info (memq --data (plist-get info :ignore-list))))
3586 ;; Secondary string: only objects can be found there.
3587 ((not --type)
3588 (when (eq --category 'objects) (mapc --walk-tree --data)))
3589 ;; Unconditionally enter parse trees.
3590 ((eq --type 'org-data)
3591 (mapc --walk-tree (org-element-contents --data)))
3593 ;; Check if TYPE is matching among TYPES. If so,
3594 ;; apply FUN to --DATA and accumulate return value
3595 ;; into --ACC (or exit if FIRST-MATCH is non-nil).
3596 (when (memq --type types)
3597 (let ((result (funcall fun --data)))
3598 (cond ((not result))
3599 (first-match (throw '--map-first-match result))
3600 (t (push result --acc)))))
3601 ;; If --DATA has a secondary string that can contain
3602 ;; objects with their type among TYPES, look into it.
3603 (when (eq --category 'objects)
3604 (let ((sec-prop
3605 (assq --type org-element-secondary-value-alist)))
3606 (when sec-prop
3607 (funcall --walk-tree
3608 (org-element-property (cdr sec-prop) --data)))))
3609 ;; Determine if a recursion into --DATA is possible.
3610 (cond
3611 ;; --TYPE is explicitly removed from recursion.
3612 ((memq --type no-recursion))
3613 ;; --DATA has no contents.
3614 ((not (org-element-contents --data)))
3615 ;; Looking for greater elements but --DATA is simply
3616 ;; an element or an object.
3617 ((and (eq --category 'greater-elements)
3618 (not (memq --type org-element-greater-elements))))
3619 ;; Looking for elements but --DATA is an object.
3620 ((and (eq --category 'elements)
3621 (memq --type org-element-all-objects)))
3622 ;; In any other case, map contents.
3623 (t (mapc --walk-tree (org-element-contents --data)))))))))))
3624 (catch '--map-first-match
3625 (funcall --walk-tree data)
3626 ;; Return value in a proper order.
3627 (nreverse --acc))))
3629 ;; The following functions are internal parts of the parser.
3631 ;; The first one, `org-element--parse-elements' acts at the element's
3632 ;; level.
3634 ;; The second one, `org-element--parse-objects' applies on all objects
3635 ;; of a paragraph or a secondary string. It uses
3636 ;; `org-element--get-next-object-candidates' to optimize the search of
3637 ;; the next object in the buffer.
3639 ;; More precisely, that function looks for every allowed object type
3640 ;; first. Then, it discards failed searches, keeps further matches,
3641 ;; and searches again types matched behind point, for subsequent
3642 ;; calls. Thus, searching for a given type fails only once, and every
3643 ;; object is searched only once at top level (but sometimes more for
3644 ;; nested types).
3646 (defun org-element--parse-elements
3647 (beg end special structure granularity visible-only acc)
3648 "Parse elements between BEG and END positions.
3650 SPECIAL prioritize some elements over the others. It can be set
3651 to `first-section', `quote-section', `section' `item' or
3652 `table-row'.
3654 When value is `item', STRUCTURE will be used as the current list
3655 structure.
3657 GRANULARITY determines the depth of the recursion. See
3658 `org-element-parse-buffer' for more information.
3660 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
3661 elements.
3663 Elements are accumulated into ACC."
3664 (save-excursion
3665 (goto-char beg)
3666 ;; When parsing only headlines, skip any text before first one.
3667 (when (and (eq granularity 'headline) (not (org-at-heading-p)))
3668 (org-with-limited-levels (outline-next-heading)))
3669 ;; Main loop start.
3670 (while (< (point) end)
3671 ;; Find current element's type and parse it accordingly to
3672 ;; its category.
3673 (let* ((element (org-element--current-element
3674 end granularity special structure))
3675 (type (org-element-type element))
3676 (cbeg (org-element-property :contents-begin element)))
3677 (goto-char (org-element-property :end element))
3678 ;; Fill ELEMENT contents by side-effect.
3679 (cond
3680 ;; If VISIBLE-ONLY is true and element is hidden or if it has
3681 ;; no contents, don't modify it.
3682 ((or (and visible-only (org-element-property :hiddenp element))
3683 (not cbeg)))
3684 ;; Greater element: parse it between `contents-begin' and
3685 ;; `contents-end'. Make sure GRANULARITY allows the
3686 ;; recursion, or ELEMENT is an headline, in which case going
3687 ;; inside is mandatory, in order to get sub-level headings.
3688 ((and (memq type org-element-greater-elements)
3689 (or (memq granularity '(element object nil))
3690 (and (eq granularity 'greater-element)
3691 (eq type 'section))
3692 (eq type 'headline)))
3693 (org-element--parse-elements
3694 cbeg (org-element-property :contents-end element)
3695 ;; Possibly switch to a special mode.
3696 (case type
3697 (headline
3698 (if (org-element-property :quotedp element) 'quote-section
3699 'section))
3700 (plain-list 'item)
3701 (table 'table-row))
3702 (org-element-property :structure element)
3703 granularity visible-only element))
3704 ;; ELEMENT has contents. Parse objects inside, if
3705 ;; GRANULARITY allows it.
3706 ((memq granularity '(object nil))
3707 (org-element--parse-objects
3708 cbeg (org-element-property :contents-end element) element
3709 (org-element-restriction type))))
3710 (org-element-adopt-element acc element t)))
3711 ;; Return result.
3712 acc))
3714 (defun org-element--parse-objects (beg end acc restriction)
3715 "Parse objects between BEG and END and return recursive structure.
3717 Objects are accumulated in ACC.
3719 RESTRICTION is a list of object types which are allowed in the
3720 current object."
3721 (let (candidates)
3722 (save-excursion
3723 (goto-char beg)
3724 (while (and (< (point) end)
3725 (setq candidates (org-element--get-next-object-candidates
3726 end restriction candidates)))
3727 (let ((next-object
3728 (let ((pos (apply 'min (mapcar 'cdr candidates))))
3729 (save-excursion
3730 (goto-char pos)
3731 (funcall (intern (format "org-element-%s-parser"
3732 (car (rassq pos candidates)))))))))
3733 ;; 1. Text before any object. Untabify it.
3734 (let ((obj-beg (org-element-property :begin next-object)))
3735 (unless (= (point) obj-beg)
3736 (setq acc
3737 (org-element-adopt-element
3739 (replace-regexp-in-string
3740 "\t" (make-string tab-width ? )
3741 (buffer-substring-no-properties (point) obj-beg)) t))))
3742 ;; 2. Object...
3743 (let ((obj-end (org-element-property :end next-object))
3744 (cont-beg (org-element-property :contents-begin next-object)))
3745 ;; Fill contents of NEXT-OBJECT by side-effect, if it has
3746 ;; a recursive type.
3747 (when (and cont-beg
3748 (memq (car next-object) org-element-recursive-objects))
3749 (save-restriction
3750 (narrow-to-region
3751 cont-beg
3752 (org-element-property :contents-end next-object))
3753 (org-element--parse-objects
3754 (point-min) (point-max) next-object
3755 (org-element-restriction next-object))))
3756 (setq acc (org-element-adopt-element acc next-object t))
3757 (goto-char obj-end))))
3758 ;; 3. Text after last object. Untabify it.
3759 (unless (= (point) end)
3760 (setq acc
3761 (org-element-adopt-element
3763 (replace-regexp-in-string
3764 "\t" (make-string tab-width ? )
3765 (buffer-substring-no-properties (point) end)) t)))
3766 ;; Result.
3767 acc)))
3769 (defun org-element--get-next-object-candidates (limit restriction objects)
3770 "Return an alist of candidates for the next object.
3772 LIMIT bounds the search, and RESTRICTION narrows candidates to
3773 some object types.
3775 Return value is an alist whose CAR is position and CDR the object
3776 type, as a symbol.
3778 OBJECTS is the previous candidates alist."
3779 (let (next-candidates types-to-search)
3780 ;; If no previous result, search every object type in RESTRICTION.
3781 ;; Otherwise, keep potential candidates (old objects located after
3782 ;; point) and ask to search again those which had matched before.
3783 (if (not objects) (setq types-to-search restriction)
3784 (mapc (lambda (obj)
3785 (if (< (cdr obj) (point)) (push (car obj) types-to-search)
3786 (push obj next-candidates)))
3787 objects))
3788 ;; Call the appropriate successor function for each type to search
3789 ;; and accumulate matches.
3790 (mapc
3791 (lambda (type)
3792 (let* ((successor-fun
3793 (intern
3794 (format "org-element-%s-successor"
3795 (or (cdr (assq type org-element-object-successor-alist))
3796 type))))
3797 (obj (funcall successor-fun limit)))
3798 (and obj (push obj next-candidates))))
3799 types-to-search)
3800 ;; Return alist.
3801 next-candidates))
3805 ;;; Towards A Bijective Process
3807 ;; The parse tree obtained with `org-element-parse-buffer' is really
3808 ;; a snapshot of the corresponding Org buffer. Therefore, it can be
3809 ;; interpreted and expanded into a string with canonical Org syntax.
3810 ;; Hence `org-element-interpret-data'.
3812 ;; The function relies internally on
3813 ;; `org-element--interpret-affiliated-keywords'.
3815 (defun org-element-interpret-data (data &optional parent)
3816 "Interpret DATA as Org syntax.
3818 DATA is a parse tree, an element, an object or a secondary string
3819 to interpret.
3821 Optional argument PARENT is used for recursive calls. It contains
3822 the element or object containing data, or nil.
3824 Return Org syntax as a string."
3825 (let* ((type (org-element-type data))
3826 (results
3827 (cond
3828 ;; Secondary string.
3829 ((not type)
3830 (mapconcat
3831 (lambda (obj) (org-element-interpret-data obj parent))
3832 data ""))
3833 ;; Full Org document.
3834 ((eq type 'org-data)
3835 (mapconcat
3836 (lambda (obj) (org-element-interpret-data obj parent))
3837 (org-element-contents data) ""))
3838 ;; Plain text.
3839 ((stringp data) data)
3840 ;; Element/Object without contents.
3841 ((not (org-element-contents data))
3842 (funcall (intern (format "org-element-%s-interpreter" type))
3843 data nil))
3844 ;; Element/Object with contents.
3846 (let* ((greaterp (memq type org-element-greater-elements))
3847 (objectp (and (not greaterp)
3848 (memq type org-element-recursive-objects)))
3849 (contents
3850 (mapconcat
3851 (lambda (obj) (org-element-interpret-data obj data))
3852 (org-element-contents
3853 (if (or greaterp objectp) data
3854 ;; Elements directly containing objects must
3855 ;; have their indentation normalized first.
3856 (org-element-normalize-contents
3857 data
3858 ;; When normalizing first paragraph of an
3859 ;; item or a footnote-definition, ignore
3860 ;; first line's indentation.
3861 (and (eq type 'paragraph)
3862 (equal data (car (org-element-contents parent)))
3863 (memq (org-element-type parent)
3864 '(footnote-definiton item))))))
3865 "")))
3866 (funcall (intern (format "org-element-%s-interpreter" type))
3867 data
3868 (if greaterp (org-element-normalize-contents contents)
3869 contents)))))))
3870 (if (memq type '(org-data plain-text nil)) results
3871 ;; Build white spaces. If no `:post-blank' property is
3872 ;; specified, assume its value is 0.
3873 (let ((post-blank (or (org-element-property :post-blank data) 0)))
3874 (if (memq type org-element-all-objects)
3875 (concat results (make-string post-blank 32))
3876 (concat
3877 (org-element--interpret-affiliated-keywords data)
3878 (org-element-normalize-string results)
3879 (make-string post-blank 10)))))))
3881 (defun org-element--interpret-affiliated-keywords (element)
3882 "Return ELEMENT's affiliated keywords as Org syntax.
3883 If there is no affiliated keyword, return the empty string."
3884 (let ((keyword-to-org
3885 (function
3886 (lambda (key value)
3887 (let (dual)
3888 (when (member key org-element-dual-keywords)
3889 (setq dual (cdr value) value (car value)))
3890 (concat "#+" key
3891 (and dual
3892 (format "[%s]" (org-element-interpret-data dual)))
3893 ": "
3894 (if (member key org-element-parsed-keywords)
3895 (org-element-interpret-data value)
3896 value)
3897 "\n"))))))
3898 (mapconcat
3899 (lambda (prop)
3900 (let ((value (org-element-property prop element))
3901 (keyword (upcase (substring (symbol-name prop) 1))))
3902 (when value
3903 (if (or (member keyword org-element-multiple-keywords)
3904 ;; All attribute keywords can have multiple lines.
3905 (string-match "^ATTR_" keyword))
3906 (mapconcat (lambda (line) (funcall keyword-to-org keyword line))
3907 value
3909 (funcall keyword-to-org keyword value)))))
3910 ;; List all ELEMENT's properties matching an attribute line or an
3911 ;; affiliated keyword, but ignore translated keywords since they
3912 ;; cannot belong to the property list.
3913 (loop for prop in (nth 1 element) by 'cddr
3914 when (let ((keyword (upcase (substring (symbol-name prop) 1))))
3915 (or (string-match "^ATTR_" keyword)
3916 (and
3917 (member keyword org-element-affiliated-keywords)
3918 (not (assoc keyword
3919 org-element-keyword-translation-alist)))))
3920 collect prop)
3921 "")))
3923 ;; Because interpretation of the parse tree must return the same
3924 ;; number of blank lines between elements and the same number of white
3925 ;; space after objects, some special care must be given to white
3926 ;; spaces.
3928 ;; The first function, `org-element-normalize-string', ensures any
3929 ;; string different from the empty string will end with a single
3930 ;; newline character.
3932 ;; The second function, `org-element-normalize-contents', removes
3933 ;; global indentation from the contents of the current element.
3935 (defun org-element-normalize-string (s)
3936 "Ensure string S ends with a single newline character.
3938 If S isn't a string return it unchanged. If S is the empty
3939 string, return it. Otherwise, return a new string with a single
3940 newline character at its end."
3941 (cond
3942 ((not (stringp s)) s)
3943 ((string= "" s) "")
3944 (t (and (string-match "\\(\n[ \t]*\\)*\\'" s)
3945 (replace-match "\n" nil nil s)))))
3947 (defun org-element-normalize-contents (element &optional ignore-first)
3948 "Normalize plain text in ELEMENT's contents.
3950 ELEMENT must only contain plain text and objects.
3952 If optional argument IGNORE-FIRST is non-nil, ignore first line's
3953 indentation to compute maximal common indentation.
3955 Return the normalized element that is element with global
3956 indentation removed from its contents. The function assumes that
3957 indentation is not done with TAB characters."
3958 (let* (ind-list ; for byte-compiler
3959 collect-inds ; for byte-compiler
3960 (collect-inds
3961 (function
3962 ;; Return list of indentations within BLOB. This is done by
3963 ;; walking recursively BLOB and updating IND-LIST along the
3964 ;; way. FIRST-FLAG is non-nil when the first string hasn't
3965 ;; been seen yet. It is required as this string is the only
3966 ;; one whose indentation doesn't happen after a newline
3967 ;; character.
3968 (lambda (blob first-flag)
3969 (mapc
3970 (lambda (object)
3971 (when (and first-flag (stringp object))
3972 (setq first-flag nil)
3973 (string-match "\\`\\( *\\)" object)
3974 (let ((len (length (match-string 1 object))))
3975 ;; An indentation of zero means no string will be
3976 ;; modified. Quit the process.
3977 (if (zerop len) (throw 'zero (setq ind-list nil))
3978 (push len ind-list))))
3979 (cond
3980 ((stringp object)
3981 (let ((start 0))
3982 ;; Avoid matching blank or empty lines.
3983 (while (and (string-match "\n\\( *\\)\\(.\\)" object start)
3984 (not (equal (match-string 2 object) " ")))
3985 (setq start (match-end 0))
3986 (push (length (match-string 1 object)) ind-list))))
3987 ((memq (org-element-type object) org-element-recursive-objects)
3988 (funcall collect-inds object first-flag))))
3989 (org-element-contents blob))))))
3990 ;; Collect indentation list in ELEMENT. Possibly remove first
3991 ;; value if IGNORE-FIRST is non-nil.
3992 (catch 'zero (funcall collect-inds element (not ignore-first)))
3993 (if (not ind-list) element
3994 ;; Build ELEMENT back, replacing each string with the same
3995 ;; string minus common indentation.
3996 (let* (build ; For byte compiler.
3997 (build
3998 (function
3999 (lambda (blob mci first-flag)
4000 ;; Return BLOB with all its strings indentation
4001 ;; shortened from MCI white spaces. FIRST-FLAG is
4002 ;; non-nil when the first string hasn't been seen
4003 ;; yet.
4004 (setcdr (cdr blob)
4005 (mapcar
4006 (lambda (object)
4007 (when (and first-flag (stringp object))
4008 (setq first-flag nil)
4009 (setq object
4010 (replace-regexp-in-string
4011 (format "\\` \\{%d\\}" mci) "" object)))
4012 (cond
4013 ((stringp object)
4014 (replace-regexp-in-string
4015 (format "\n \\{%d\\}" mci) "\n" object))
4016 ((memq (org-element-type object)
4017 org-element-recursive-objects)
4018 (funcall build object mci first-flag))
4019 (t object)))
4020 (org-element-contents blob)))
4021 blob))))
4022 (funcall build element (apply 'min ind-list) (not ignore-first))))))
4026 ;;; The Toolbox
4028 ;; The first move is to implement a way to obtain the smallest element
4029 ;; containing point. This is the job of `org-element-at-point'. It
4030 ;; basically jumps back to the beginning of section containing point
4031 ;; and moves, element after element, with
4032 ;; `org-element--current-element' until the container is found.
4034 ;; At a deeper level, `org-element-context' lists all elements and
4035 ;; objects containing point.
4037 ;; Note: When using `org-element-at-point', secondary values are never
4038 ;; parsed since the function focuses on elements, not on objects.
4040 (defun org-element-at-point (&optional keep-trail)
4041 "Determine closest element around point.
4043 Return value is a list like (TYPE PROPS) where TYPE is the type
4044 of the element and PROPS a plist of properties associated to the
4045 element. Possible types are defined in
4046 `org-element-all-elements'.
4048 As a special case, if point is at the very beginning of a list or
4049 sub-list, returned element will be that list instead of the first
4050 item. In the same way, if point is at the beginning of the first
4051 row of a table, returned element will be the table instead of the
4052 first row.
4054 If optional argument KEEP-TRAIL is non-nil, the function returns
4055 a list of of elements leading to element at point. The list's
4056 CAR is always the element at point. Following positions contain
4057 element's siblings, then parents, siblings of parents, until the
4058 first element of current section."
4059 (org-with-wide-buffer
4060 ;; If at an headline, parse it. It is the sole element that
4061 ;; doesn't require to know about context. Be sure to disallow
4062 ;; secondary string parsing, though.
4063 (if (org-with-limited-levels (org-at-heading-p))
4064 (progn
4065 (beginning-of-line)
4066 (if (not keep-trail) (org-element-headline-parser (point-max) t)
4067 (list (org-element-headline-parser (point-max) t))))
4068 ;; Otherwise move at the beginning of the section containing
4069 ;; point.
4070 (let ((origin (point))
4071 (end (save-excursion (outline-next-heading) (point)))
4072 element type special-flag trail struct prevs)
4073 (org-with-limited-levels
4074 (if (org-before-first-heading-p) (goto-char (point-min))
4075 (org-back-to-heading)
4076 (forward-line)))
4077 (org-skip-whitespace)
4078 (beginning-of-line)
4079 ;; Parse successively each element, skipping those ending
4080 ;; before original position.
4081 (catch 'exit
4082 (while t
4083 (setq element
4084 (org-element--current-element end 'element special-flag struct)
4085 type (car element))
4086 (push element trail)
4087 (cond
4088 ;; 1. Skip any element ending before point or at point.
4089 ((let ((end (org-element-property :end element)))
4090 (when (<= end origin)
4091 (if (> (point-max) end) (goto-char end)
4092 (throw 'exit (if keep-trail trail element))))))
4093 ;; 2. An element containing point is always the element at
4094 ;; point.
4095 ((not (memq type org-element-greater-elements))
4096 (throw 'exit (if keep-trail trail element)))
4097 ;; 3. At any other greater element type, if point is
4098 ;; within contents, move into it. Otherwise, return
4099 ;; that element.
4101 (let ((cbeg (org-element-property :contents-begin element))
4102 (cend (org-element-property :contents-end element)))
4103 (if (or (not cbeg) (not cend) (> cbeg origin) (<= cend origin)
4104 (and (= cbeg origin) (memq type '(plain-list table))))
4105 (throw 'exit (if keep-trail trail 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 list of all elements and objects 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. Possible types are defined in
4121 `org-element-all-elements' and `org-element-all-objects'.
4123 All elements and objects returned belong to the current section
4124 and are ordered from closest to farthest."
4125 (org-with-wide-buffer
4126 (let* ((origin (point))
4127 ;; Remove elements not containing point from trail.
4128 (elements (org-remove-if
4129 (lambda (el)
4130 (or (> (org-element-property :begin el) origin)
4131 (< (org-element-property :end el) origin)))
4132 (org-element-at-point 'keep-trail)))
4133 (element (car elements))
4134 (type (car element)) end)
4135 ;; Check if point is inside an element containing objects or at
4136 ;; a secondary string. In that case, move to beginning of the
4137 ;; element or secondary string and set END to the other side.
4138 (if (not (or (and (eq type 'item)
4139 (let ((tag (org-element-property :tag element)))
4140 (and tag
4141 (progn
4142 (beginning-of-line)
4143 (search-forward tag (point-at-eol))
4144 (goto-char (match-beginning 0))
4145 (and (>= origin (point))
4146 (<= origin
4147 ;; `1+' is required so some
4148 ;; successors can match
4149 ;; properly their object.
4150 (setq end (1+ (match-end 0)))))))))
4151 (and (memq type '(headline inlinetask))
4152 (progn (beginning-of-line)
4153 (skip-chars-forward "* ")
4154 (setq end (point-at-eol))))
4155 (and (memq (car element) '(paragraph table-cell verse-block))
4156 (let ((cbeg (org-element-property
4157 :contents-begin element))
4158 (cend (org-element-property
4159 :contents-end element)))
4160 (and (>= origin cbeg)
4161 (<= origin cend)
4162 (progn (goto-char cbeg) (setq end cend)))))))
4163 elements
4164 (let ((restriction (org-element-restriction element)) candidates)
4165 (catch 'exit
4166 (while (setq candidates (org-element--get-next-object-candidates
4167 end restriction candidates))
4168 (let ((closest-cand (rassq (apply 'min (mapcar 'cdr candidates))
4169 candidates)))
4170 ;; If ORIGIN is before next object in element, there's
4171 ;; no point in looking further.
4172 (if (> (cdr closest-cand) origin) (throw 'exit elements)
4173 (let* ((object
4174 (progn (goto-char (cdr closest-cand))
4175 (funcall (intern (format "org-element-%s-parser"
4176 (car closest-cand))))))
4177 (cbeg (org-element-property :contents-begin object))
4178 (cend (org-element-property :contents-end object)))
4179 (cond
4180 ;; ORIGIN is after OBJECT, so skip it.
4181 ((< (org-element-property :end object) origin)
4182 (goto-char (org-element-property :end object)))
4183 ;; ORIGIN is within a non-recursive object or at an
4184 ;; object boundaries: Return that object.
4185 ((or (not cbeg) (> cbeg origin) (< cend origin))
4186 (throw 'exit (cons object elements)))
4187 ;; Otherwise, move within current object and restrict
4188 ;; search to the end of its contents.
4189 (t (goto-char cbeg)
4190 (setq end cend)
4191 (push object elements)))))))
4192 elements))))))
4195 ;; Once the local structure around point is well understood, it's easy
4196 ;; to implement some replacements for `forward-paragraph'
4197 ;; `backward-paragraph', namely `org-element-forward' and
4198 ;; `org-element-backward'.
4200 ;; Also, `org-transpose-elements' mimics the behaviour of
4201 ;; `transpose-words', at the element's level, whereas
4202 ;; `org-element-drag-forward', `org-element-drag-backward', and
4203 ;; `org-element-up' generalize, respectively, functions
4204 ;; `org-subtree-down', `org-subtree-up' and `outline-up-heading'.
4206 ;; `org-element-unindent-buffer' will, as its name almost suggests,
4207 ;; smartly remove global indentation from buffer, making it possible
4208 ;; to use Org indent mode on a file created with hard indentation.
4210 ;; `org-element-nested-p' and `org-element-swap-A-B' are used
4211 ;; internally by some of the previously cited tools.
4213 (defsubst org-element-nested-p (elem-A elem-B)
4214 "Non-nil when elements ELEM-A and ELEM-B are nested."
4215 (let ((beg-A (org-element-property :begin elem-A))
4216 (beg-B (org-element-property :begin elem-B))
4217 (end-A (org-element-property :end elem-A))
4218 (end-B (org-element-property :end elem-B)))
4219 (or (and (>= beg-A beg-B) (<= end-A end-B))
4220 (and (>= beg-B beg-A) (<= end-B end-A)))))
4222 (defun org-element-swap-A-B (elem-A elem-B)
4223 "Swap elements ELEM-A and ELEM-B.
4224 Assume ELEM-B is after ELEM-A in the buffer. Leave point at the
4225 end of ELEM-A."
4226 (goto-char (org-element-property :begin elem-A))
4227 ;; There are two special cases when an element doesn't start at bol:
4228 ;; the first paragraph in an item or in a footnote definition.
4229 (let ((specialp (not (bolp))))
4230 ;; Only a paragraph without any affiliated keyword can be moved at
4231 ;; ELEM-A position in such a situation. Note that the case of
4232 ;; a footnote definition is impossible: it cannot contain two
4233 ;; paragraphs in a row because it cannot contain a blank line.
4234 (if (and specialp
4235 (or (not (eq (org-element-type elem-B) 'paragraph))
4236 (/= (org-element-property :begin elem-B)
4237 (org-element-property :contents-begin elem-B))))
4238 (error "Cannot swap elements"))
4239 ;; In a special situation, ELEM-A will have no indentation. We'll
4240 ;; give it ELEM-B's (which will in, in turn, have no indentation).
4241 (let* ((ind-B (when specialp
4242 (goto-char (org-element-property :begin elem-B))
4243 (org-get-indentation)))
4244 (beg-A (org-element-property :begin elem-A))
4245 (end-A (save-excursion
4246 (goto-char (org-element-property :end elem-A))
4247 (skip-chars-backward " \r\t\n")
4248 (point-at-eol)))
4249 (beg-B (org-element-property :begin elem-B))
4250 (end-B (save-excursion
4251 (goto-char (org-element-property :end elem-B))
4252 (skip-chars-backward " \r\t\n")
4253 (point-at-eol)))
4254 ;; Store overlays responsible for visibility status. We
4255 ;; also need to store their boundaries as they will be
4256 ;; removed from buffer.
4257 (overlays
4258 (cons
4259 (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
4260 (overlays-in beg-A end-A))
4261 (mapcar (lambda (ov) (list ov (overlay-start ov) (overlay-end ov)))
4262 (overlays-in beg-B end-B))))
4263 ;; Get contents.
4264 (body-A (buffer-substring beg-A end-A))
4265 (body-B (delete-and-extract-region beg-B end-B)))
4266 (goto-char beg-B)
4267 (when specialp
4268 (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
4269 (org-indent-to-column ind-B))
4270 (insert body-A)
4271 ;; Restore ex ELEM-A overlays.
4272 (mapc (lambda (ov)
4273 (move-overlay
4274 (car ov)
4275 (+ (nth 1 ov) (- beg-B beg-A))
4276 (+ (nth 2 ov) (- beg-B beg-A))))
4277 (car overlays))
4278 (goto-char beg-A)
4279 (delete-region beg-A end-A)
4280 (insert body-B)
4281 ;; Restore ex ELEM-B overlays.
4282 (mapc (lambda (ov)
4283 (move-overlay (car ov)
4284 (+ (nth 1 ov) (- beg-A beg-B))
4285 (+ (nth 2 ov) (- beg-A beg-B))))
4286 (cdr overlays))
4287 (goto-char (org-element-property :end elem-B)))))
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 (if (org-with-limited-levels (org-at-heading-p))
4294 (let ((origin (point)))
4295 (org-forward-same-level 1)
4296 (unless (org-with-limited-levels (org-at-heading-p))
4297 (goto-char origin)
4298 (error "Cannot move further down")))
4299 (let* ((trail (org-element-at-point 'keep-trail))
4300 (elem (pop trail))
4301 (end (org-element-property :end elem))
4302 (parent (loop for prev in trail
4303 when (>= (org-element-property :end prev) end)
4304 return prev)))
4305 (cond
4306 ((eobp) (error "Cannot move further down"))
4307 ((and parent (= (org-element-property :contents-end parent) end))
4308 (goto-char (org-element-property :end parent)))
4309 (t (goto-char end))))))
4311 (defun org-element-backward ()
4312 "Move backward by one element.
4313 Move to the previous element at the same level, when possible."
4314 (interactive)
4315 (if (org-with-limited-levels (org-at-heading-p))
4316 ;; At an headline, move to the previous one, if any, or stay
4317 ;; here.
4318 (let ((origin (point)))
4319 (org-backward-same-level 1)
4320 (unless (org-with-limited-levels (org-at-heading-p))
4321 (goto-char origin)
4322 (error "Cannot move further up")))
4323 (let* ((trail (org-element-at-point 'keep-trail))
4324 (elem (car trail))
4325 (prev-elem (nth 1 trail))
4326 (beg (org-element-property :begin elem)))
4327 (cond
4328 ;; Move to beginning of current element if point isn't there
4329 ;; already.
4330 ((/= (point) beg) (goto-char beg))
4331 ((not prev-elem) (error "Cannot move further up"))
4332 (t (goto-char (org-element-property :begin prev-elem)))))))
4334 (defun org-element-up ()
4335 "Move to upper element."
4336 (interactive)
4337 (if (org-with-limited-levels (org-at-heading-p))
4338 (unless (org-up-heading-safe)
4339 (error "No surrounding element"))
4340 (let* ((trail (org-element-at-point 'keep-trail))
4341 (elem (pop trail))
4342 (end (org-element-property :end elem))
4343 (parent (loop for prev in trail
4344 when (>= (org-element-property :end prev) end)
4345 return prev)))
4346 (cond
4347 (parent (goto-char (org-element-property :begin parent)))
4348 ((org-before-first-heading-p) (error "No surrounding element"))
4349 (t (org-back-to-heading))))))
4351 (defun org-element-down ()
4352 "Move to inner element."
4353 (interactive)
4354 (let ((element (org-element-at-point)))
4355 (cond
4356 ((memq (org-element-type element) '(plain-list table))
4357 (goto-char (org-element-property :contents-begin element))
4358 (forward-char))
4359 ((memq (org-element-type element) org-element-greater-elements)
4360 ;; If contents are hidden, first disclose them.
4361 (when (org-element-property :hiddenp element) (org-cycle))
4362 (goto-char (org-element-property :contents-begin element)))
4363 (t (error "No inner element")))))
4365 (defun org-element-drag-backward ()
4366 "Move backward element at point."
4367 (interactive)
4368 (if (org-with-limited-levels (org-at-heading-p)) (org-move-subtree-up)
4369 (let* ((trail (org-element-at-point 'keep-trail))
4370 (elem (car trail))
4371 (prev-elem (nth 1 trail)))
4372 ;; Error out if no previous element or previous element is
4373 ;; a parent of the current one.
4374 (if (or (not prev-elem) (org-element-nested-p elem prev-elem))
4375 (error "Cannot drag element backward")
4376 (let ((pos (point)))
4377 (org-element-swap-A-B prev-elem elem)
4378 (goto-char (+ (org-element-property :begin prev-elem)
4379 (- pos (org-element-property :begin elem)))))))))
4381 (defun org-element-drag-forward ()
4382 "Move forward element at point."
4383 (interactive)
4384 (let* ((pos (point))
4385 (elem (org-element-at-point)))
4386 (when (= (point-max) (org-element-property :end elem))
4387 (error "Cannot drag element forward"))
4388 (goto-char (org-element-property :end elem))
4389 (let ((next-elem (org-element-at-point)))
4390 (when (or (org-element-nested-p elem next-elem)
4391 (and (eq (org-element-type next-elem) 'headline)
4392 (not (eq (org-element-type elem) 'headline))))
4393 (goto-char pos)
4394 (error "Cannot drag element forward"))
4395 ;; Compute new position of point: it's shifted by NEXT-ELEM
4396 ;; body's length (without final blanks) and by the length of
4397 ;; blanks between ELEM and NEXT-ELEM.
4398 (let ((size-next (- (save-excursion
4399 (goto-char (org-element-property :end next-elem))
4400 (skip-chars-backward " \r\t\n")
4401 (forward-line)
4402 ;; Small correction if buffer doesn't end
4403 ;; with a newline character.
4404 (if (and (eolp) (not (bolp))) (1+ (point)) (point)))
4405 (org-element-property :begin next-elem)))
4406 (size-blank (- (org-element-property :end elem)
4407 (save-excursion
4408 (goto-char (org-element-property :end elem))
4409 (skip-chars-backward " \r\t\n")
4410 (forward-line)
4411 (point)))))
4412 (org-element-swap-A-B elem next-elem)
4413 (goto-char (+ pos size-next size-blank))))))
4415 (defun org-element-mark-element ()
4416 "Put point at beginning of this element, mark at end.
4418 Interactively, if this command is repeated or (in Transient Mark
4419 mode) if the mark is active, it marks the next element after the
4420 ones already marked."
4421 (interactive)
4422 (let (deactivate-mark)
4423 (if (or (and (eq last-command this-command) (mark t))
4424 (and transient-mark-mode mark-active))
4425 (set-mark
4426 (save-excursion
4427 (goto-char (mark))
4428 (goto-char (org-element-property :end (org-element-at-point)))))
4429 (let ((element (org-element-at-point)))
4430 (end-of-line)
4431 (push-mark (org-element-property :end element) t t)
4432 (goto-char (org-element-property :begin element))))))
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 (defun org-element-transpose ()
4453 "Transpose current and previous elements, keeping blank lines between.
4454 Point is moved after both elements."
4455 (interactive)
4456 (org-skip-whitespace)
4457 (let ((end (org-element-property :end (org-element-at-point))))
4458 (org-element-drag-backward)
4459 (goto-char end)))
4461 (defun org-element-unindent-buffer ()
4462 "Un-indent the visible part of the buffer.
4463 Relative indentation (between items, inside blocks, etc.) isn't
4464 modified."
4465 (interactive)
4466 (unless (eq major-mode 'org-mode)
4467 (error "Cannot un-indent a buffer not in Org mode"))
4468 (let* ((parse-tree (org-element-parse-buffer 'greater-element))
4469 unindent-tree ; For byte-compiler.
4470 (unindent-tree
4471 (function
4472 (lambda (contents)
4473 (mapc
4474 (lambda (element)
4475 (if (memq (org-element-type element) '(headline section))
4476 (funcall unindent-tree (org-element-contents element))
4477 (save-excursion
4478 (save-restriction
4479 (narrow-to-region
4480 (org-element-property :begin element)
4481 (org-element-property :end element))
4482 (org-do-remove-indentation)))))
4483 (reverse contents))))))
4484 (funcall unindent-tree (org-element-contents parse-tree))))
4487 (provide 'org-element)
4488 ;;; org-element.el ends here