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