org-element: Store fixed-with and comment contents without markers
[org-mode/org-mode-NeilSmithlineMods.git] / contrib / lisp / org-element.el
bloba5a273cc937ee80581e1833ff74bcf4dbacd6ca1
1 ;;; org-element.el --- Parser And Applications for Org syntax
3 ;; Copyright (C) 2012 Free Software Foundation, Inc.
5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com>
6 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; This file is not part of GNU Emacs.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; Org syntax can be divided into three categories: "Greater
26 ;; elements", "Elements" and "Objects".
28 ;; Elements are related to the structure of the document. Indeed, all
29 ;; elements are a cover for the document: each position within belongs
30 ;; to at least one element.
32 ;; An element always starts and ends at the beginning of a line. With
33 ;; a few exceptions (namely `babel-call', `clock', `headline', `item',
34 ;; `keyword', `planning', `property-drawer' and `section' types), it
35 ;; can also accept a fixed set of keywords as attributes. Those are
36 ;; called "affiliated keywords" to distinguish them from other
37 ;; keywords, which are full-fledged elements. All affiliated keywords
38 ;; are referenced in `org-element-affiliated-keywords'.
40 ;; Element containing other elements (and only elements) are called
41 ;; greater elements. Concerned types are: `center-block', `drawer',
42 ;; `dynamic-block', `footnote-definition', `headline', `inlinetask',
43 ;; `item', `plain-list', `quote-block', `section' and `special-block'.
45 ;; Other element types are: `babel-call', `clock', `comment',
46 ;; `comment-block', `example-block', `export-block', `fixed-width',
47 ;; `horizontal-rule', `keyword', `latex-environment', `paragraph',
48 ;; `planning', `property-drawer', `quote-section', `src-block',
49 ;; `table', `table-cell', `table-row' and `verse-block'. Among them,
50 ;; `paragraph', `table-cell' and `verse-block' types can contain Org
51 ;; objects and plain text.
53 ;; Objects are related to document's contents. Some of them are
54 ;; recursive. Associated types are of the following: `bold', `code',
55 ;; `entity', `export-snippet', `footnote-reference',
56 ;; `inline-babel-call', `inline-src-block', `italic',
57 ;; `latex-fragment', `line-break', `link', `macro', `radio-target',
58 ;; `statistics-cookie', `strike-through', `subscript', `superscript',
59 ;; `table-cell', `target', `timestamp', `underline' and `verbatim'.
61 ;; Some elements also have special properties whose value can hold
62 ;; objects themselves (i.e. an item tag or an headline name). Such
63 ;; values are called "secondary strings". Any object belongs to
64 ;; either an element or a secondary string.
66 ;; Notwithstanding affiliated keywords, each greater element, element
67 ;; and object has a fixed set of properties attached to it. Among
68 ;; them, three are shared by all types: `:begin' and `:end', which
69 ;; refer to the beginning and ending buffer positions of the
70 ;; considered element or object, and `:post-blank', which holds the
71 ;; number of blank lines, or white spaces, at its end. Greater
72 ;; elements and elements containing objects will also have
73 ;; `:contents-begin' and `:contents-end' properties to delimit
74 ;; contents.
76 ;; Lisp-wise, an element or an object can be represented as a list.
77 ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where:
78 ;; TYPE is a symbol describing the Org element or object.
79 ;; PROPERTIES is the property list attached to it. See docstring of
80 ;; appropriate parsing function to get an exhaustive
81 ;; list.
82 ;; CONTENTS is a list of elements, objects or raw strings contained
83 ;; in the current element or object, when applicable.
85 ;; An Org buffer is a nested list of such elements and objects, whose
86 ;; type is `org-data' and properties is nil.
88 ;; The first part of this file implements a parser and an interpreter
89 ;; for each type of Org syntax.
91 ;; The next two parts introduce four accessors and a function
92 ;; retrieving the element starting at point (respectively
93 ;; `org-element-type', `org-element-property', `org-element-contents',
94 ;; `org-element-restriction' and `org-element-current-element').
96 ;; The following part creates a fully recursive buffer parser. It
97 ;; also provides a tool to map a function to elements or objects
98 ;; matching some criteria in the parse tree. Functions of interest
99 ;; are `org-element-parse-buffer', `org-element-map' and, to a lesser
100 ;; extent, `org-element-parse-secondary-string'.
102 ;; The penultimate part is the cradle of an interpreter for the
103 ;; obtained parse tree: `org-element-interpret-data'.
105 ;; The library ends by furnishing a set of interactive tools for
106 ;; element's navigation and manipulation, mostly based on
107 ;; `org-element-at-point' function.
110 ;;; Code:
112 (eval-when-compile (require 'cl))
113 (require 'org)
114 (declare-function org-inlinetask-goto-end "org-inlinetask" ())
117 ;;; Greater elements
119 ;; For each greater element type, we define a parser and an
120 ;; interpreter.
122 ;; A parser returns the element or object as the list described above.
123 ;; Most of them accepts no argument. Though, exceptions exist. Hence
124 ;; every element containing a secondary string (see
125 ;; `org-element-secondary-value-alist') will accept an optional
126 ;; argument to toggle parsing of that secondary string. Moreover,
127 ;; `item' parser requires current list's structure as its first
128 ;; element.
130 ;; An interpreter accepts two arguments: the list representation of
131 ;; the element or object, and its contents. The latter may be nil,
132 ;; depending on the element or object considered. It returns the
133 ;; appropriate Org syntax, as a string.
135 ;; Parsing functions must follow the naming convention:
136 ;; org-element-TYPE-parser, where TYPE is greater element's type, as
137 ;; defined in `org-element-greater-elements'.
139 ;; Similarly, interpreting functions must follow the naming
140 ;; convention: org-element-TYPE-interpreter.
142 ;; With the exception of `headline' and `item' types, greater elements
143 ;; cannot contain other greater elements of their own type.
145 ;; Beside implementing a parser and an interpreter, adding a new
146 ;; greater element requires to tweak `org-element-current-element'.
147 ;; Moreover, the newly defined type must be added to both
148 ;; `org-element-all-elements' and `org-element-greater-elements'.
151 ;;;; Center Block
153 (defun org-element-center-block-parser ()
154 "Parse a center block.
156 Return a list whose CAR is `center-block' and CDR is a plist
157 containing `:begin', `:end', `:hiddenp', `:contents-begin',
158 `:contents-end' and `:post-blank' keywords.
160 Assume point is at the beginning of the block."
161 (save-excursion
162 (let* ((case-fold-search t)
163 (keywords (org-element-collect-affiliated-keywords))
164 (begin (car keywords))
165 (contents-begin (progn (forward-line) (point)))
166 (hidden (org-truely-invisible-p))
167 (contents-end
168 (progn (re-search-forward "^[ \t]*#\\+END_CENTER" nil t)
169 (point-at-bol)))
170 (pos-before-blank (progn (forward-line) (point)))
171 (end (progn (org-skip-whitespace)
172 (if (eobp) (point) (point-at-bol)))))
173 `(center-block
174 (:begin ,begin
175 :end ,end
176 :hiddenp ,hidden
177 :contents-begin ,contents-begin
178 :contents-end ,contents-end
179 :post-blank ,(count-lines pos-before-blank end)
180 ,@(cadr keywords))))))
182 (defun org-element-center-block-interpreter (center-block contents)
183 "Interpret CENTER-BLOCK element as Org syntax.
184 CONTENTS is the contents of the element."
185 (format "#+BEGIN_CENTER\n%s#+END_CENTER" contents))
188 ;;;; Drawer
190 (defun org-element-drawer-parser ()
191 "Parse a drawer.
193 Return a list whose CAR is `drawer' and CDR is a plist containing
194 `:drawer-name', `:begin', `:end', `:hiddenp', `:contents-begin',
195 `:contents-end' and `:post-blank' keywords.
197 Assume point is at beginning of drawer."
198 (save-excursion
199 (let* ((case-fold-search t)
200 (name (progn (looking-at org-drawer-regexp)
201 (org-match-string-no-properties 1)))
202 (keywords (org-element-collect-affiliated-keywords))
203 (begin (car keywords))
204 (contents-begin (progn (forward-line) (point)))
205 (hidden (org-truely-invisible-p))
206 (contents-end (progn (re-search-forward "^[ \t]*:END:" nil t)
207 (point-at-bol)))
208 (pos-before-blank (progn (forward-line) (point)))
209 (end (progn (org-skip-whitespace)
210 (if (eobp) (point) (point-at-bol)))))
211 `(drawer
212 (:begin ,begin
213 :end ,end
214 :drawer-name ,name
215 :hiddenp ,hidden
216 :contents-begin ,contents-begin
217 :contents-end ,contents-end
218 :post-blank ,(count-lines pos-before-blank end)
219 ,@(cadr keywords))))))
221 (defun org-element-drawer-interpreter (drawer contents)
222 "Interpret DRAWER element as Org syntax.
223 CONTENTS is the contents of the element."
224 (format ":%s:\n%s:END:"
225 (org-element-property :drawer-name drawer)
226 contents))
229 ;;;; Dynamic Block
231 (defun org-element-dynamic-block-parser ()
232 "Parse a dynamic block.
234 Return a list whose CAR is `dynamic-block' and CDR is a plist
235 containing `:block-name', `:begin', `:end', `:hiddenp',
236 `:contents-begin', `:contents-end', `:arguments' and
237 `:post-blank' keywords.
239 Assume point is at beginning of dynamic block."
240 (save-excursion
241 (let* ((case-fold-search t)
242 (name (progn (looking-at org-dblock-start-re)
243 (org-match-string-no-properties 1)))
244 (arguments (org-match-string-no-properties 3))
245 (keywords (org-element-collect-affiliated-keywords))
246 (begin (car keywords))
247 (contents-begin (progn (forward-line) (point)))
248 (hidden (org-truely-invisible-p))
249 (contents-end (progn (re-search-forward org-dblock-end-re nil t)
250 (point-at-bol)))
251 (pos-before-blank (progn (forward-line) (point)))
252 (end (progn (org-skip-whitespace)
253 (if (eobp) (point) (point-at-bol)))))
254 (list 'dynamic-block
255 `(:begin ,begin
256 :end ,end
257 :block-name ,name
258 :arguments ,arguments
259 :hiddenp ,hidden
260 :contents-begin ,contents-begin
261 :contents-end ,contents-end
262 :post-blank ,(count-lines pos-before-blank end)
263 ,@(cadr keywords))))))
265 (defun org-element-dynamic-block-interpreter (dynamic-block contents)
266 "Interpret DYNAMIC-BLOCK element as Org syntax.
267 CONTENTS is the contents of the element."
268 (format "#+BEGIN: %s%s\n%s#+END:"
269 (org-element-property :block-name dynamic-block)
270 (let ((args (org-element-property :arguments dynamic-block)))
271 (and args (concat " " args)))
272 contents))
275 ;;;; Footnote Definition
277 (defun org-element-footnote-definition-parser ()
278 "Parse a footnote definition.
280 Return a list whose CAR is `footnote-definition' and CDR is
281 a plist containing `:label', `:begin' `:end', `:contents-begin',
282 `:contents-end' and `:post-blank' keywords.
284 Assume point is at the beginning of the footnote definition."
285 (save-excursion
286 (looking-at org-footnote-definition-re)
287 (let* ((label (org-match-string-no-properties 1))
288 (keywords (org-element-collect-affiliated-keywords))
289 (begin (car keywords))
290 (contents-begin (progn (search-forward "]")
291 (org-skip-whitespace)
292 (point)))
293 (contents-end (if (progn
294 (end-of-line)
295 (re-search-forward
296 (concat org-outline-regexp-bol "\\|"
297 org-footnote-definition-re "\\|"
298 "^[ \t]*$") nil t))
299 (match-beginning 0)
300 (point-max)))
301 (end (progn (org-skip-whitespace)
302 (if (eobp) (point) (point-at-bol)))))
303 `(footnote-definition
304 (:label ,label
305 :begin ,begin
306 :end ,end
307 :contents-begin ,contents-begin
308 :contents-end ,contents-end
309 :post-blank ,(count-lines contents-end end)
310 ,@(cadr keywords))))))
312 (defun org-element-footnote-definition-interpreter (footnote-definition contents)
313 "Interpret FOOTNOTE-DEFINITION element as Org syntax.
314 CONTENTS is the contents of the footnote-definition."
315 (concat (format "[%s]" (org-element-property :label footnote-definition))
317 contents))
320 ;;;; Headline
322 (defun org-element-headline-parser (&optional raw-secondary-p)
323 "Parse an headline.
325 Return a list whose CAR is `headline' and CDR is a plist
326 containing `:raw-value', `:title', `:begin', `:end',
327 `:pre-blank', `:hiddenp', `:contents-begin' and `:contents-end',
328 `:level', `:priority', `:tags', `:todo-keyword',`:todo-type',
329 `:scheduled', `:deadline', `:timestamp', `:clock', `:category',
330 `:quotedp', `:archivedp', `:commentedp' and `:footnote-section-p'
331 keywords.
333 The plist also contains any property set in the property drawer,
334 with its name in lowercase, the underscores replaced with hyphens
335 and colons at the beginning (i.e. `:custom-id').
337 When RAW-SECONDARY-P is non-nil, headline's title will not be
338 parsed as a secondary string, but as a plain string instead.
340 Assume point is at beginning of the headline."
341 (save-excursion
342 (let* ((components (org-heading-components))
343 (level (nth 1 components))
344 (todo (nth 2 components))
345 (todo-type
346 (and todo (if (member todo org-done-keywords) 'done 'todo)))
347 (tags (let ((raw-tags (nth 5 components)))
348 (and raw-tags (org-split-string raw-tags ":"))))
349 (raw-value (nth 4 components))
350 (quotedp
351 (let ((case-fold-search nil))
352 (string-match (format "^%s +" org-quote-string) raw-value)))
353 (commentedp
354 (let ((case-fold-search nil))
355 (string-match (format "^%s +" org-comment-string) raw-value)))
356 (archivedp (member org-archive-tag tags))
357 (footnote-section-p (and org-footnote-section
358 (string= org-footnote-section raw-value)))
359 (standard-props (let (plist)
360 (mapc
361 (lambda (p)
362 (let ((p-name (downcase (car p))))
363 (while (string-match "_" p-name)
364 (setq p-name
365 (replace-match "-" nil nil p-name)))
366 (setq p-name (intern (concat ":" p-name)))
367 (setq plist
368 (plist-put plist p-name (cdr p)))))
369 (org-entry-properties nil 'standard))
370 plist))
371 (time-props (org-entry-properties nil 'special "CLOCK"))
372 (scheduled (cdr (assoc "SCHEDULED" time-props)))
373 (deadline (cdr (assoc "DEADLINE" time-props)))
374 (clock (cdr (assoc "CLOCK" time-props)))
375 (timestamp (cdr (assoc "TIMESTAMP" time-props)))
376 (begin (point))
377 (pos-after-head (save-excursion (forward-line) (point)))
378 (contents-begin (save-excursion (forward-line)
379 (org-skip-whitespace)
380 (if (eobp) (point) (point-at-bol))))
381 (hidden (save-excursion (forward-line) (org-truely-invisible-p)))
382 (end (progn (goto-char (org-end-of-subtree t t))))
383 (contents-end (progn (skip-chars-backward " \r\t\n")
384 (forward-line)
385 (point)))
386 title)
387 ;; Clean RAW-VALUE from any quote or comment string.
388 (when (or quotedp commentedp)
389 (setq raw-value
390 (replace-regexp-in-string
391 (concat "\\(" org-quote-string "\\|" org-comment-string "\\) +")
393 raw-value)))
394 ;; Clean TAGS from archive tag, if any.
395 (when archivedp (setq tags (delete org-archive-tag tags)))
396 ;; Then get TITLE.
397 (setq title
398 (if raw-secondary-p raw-value
399 (org-element-parse-secondary-string
400 raw-value (org-element-restriction 'headline))))
401 `(headline
402 (:raw-value ,raw-value
403 :title ,title
404 :begin ,begin
405 :end ,end
406 :pre-blank ,(count-lines pos-after-head contents-begin)
407 :hiddenp ,hidden
408 :contents-begin ,contents-begin
409 :contents-end ,contents-end
410 :level ,level
411 :priority ,(nth 3 components)
412 :tags ,tags
413 :todo-keyword ,todo
414 :todo-type ,todo-type
415 :scheduled ,scheduled
416 :deadline ,deadline
417 :timestamp ,timestamp
418 :clock ,clock
419 :post-blank ,(count-lines contents-end end)
420 :footnote-section-p ,footnote-section-p
421 :archivedp ,archivedp
422 :commentedp ,commentedp
423 :quotedp ,quotedp
424 ,@standard-props)))))
426 (defun org-element-headline-interpreter (headline contents)
427 "Interpret HEADLINE element as Org syntax.
428 CONTENTS is the contents of the element."
429 (let* ((level (org-element-property :level headline))
430 (todo (org-element-property :todo-keyword headline))
431 (priority (org-element-property :priority headline))
432 (title (org-element-interpret-data
433 (org-element-property :title headline)))
434 (tags (let ((tag-list (if (org-element-property :archivedp headline)
435 (cons org-archive-tag
436 (org-element-property :tags headline))
437 (org-element-property :tags headline))))
438 (and tag-list
439 (format ":%s:" (mapconcat 'identity tag-list ":")))))
440 (commentedp (org-element-property :commentedp headline))
441 (quotedp (org-element-property :quotedp headline))
442 (pre-blank (or (org-element-property :pre-blank headline) 0))
443 (heading (concat (make-string level ?*)
444 (and todo (concat " " todo))
445 (and quotedp (concat " " org-quote-string))
446 (and commentedp (concat " " org-comment-string))
447 (and priority
448 (format " [#%s]" (char-to-string priority)))
449 (cond ((and org-footnote-section
450 (org-element-property
451 :footnote-section-p headline))
452 (concat " " org-footnote-section))
453 (title (concat " " title))))))
454 (concat heading
455 ;; Align tags.
456 (when tags
457 (cond
458 ((zerop org-tags-column) (format " %s" tags))
459 ((< org-tags-column 0)
460 (concat
461 (make-string
462 (max (- (+ org-tags-column (length heading) (length tags))) 1)
464 tags))
466 (concat
467 (make-string (max (- org-tags-column (length heading)) 1) ? )
468 tags))))
469 (make-string (1+ pre-blank) 10)
470 contents)))
473 ;;;; Inlinetask
475 (defun org-element-inlinetask-parser (&optional raw-secondary-p)
476 "Parse an inline task.
478 Return a list whose CAR is `inlinetask' and CDR is a plist
479 containing `:title', `:begin', `:end', `:hiddenp',
480 `:contents-begin' and `:contents-end', `:level', `:priority',
481 `:tags', `:todo-keyword', `:todo-type', `:scheduled',
482 `:deadline', `:timestamp', `:clock' and `:post-blank' keywords.
484 The plist also contains any property set in the property drawer,
485 with its name in lowercase, the underscores replaced with hyphens
486 and colons at the beginning (i.e. `:custom-id').
488 When optional argument RAW-SECONDARY-P is non-nil, inline-task's
489 title will not be parsed as a secondary string, but as a plain
490 string instead.
492 Assume point is at beginning of the inline task."
493 (save-excursion
494 (let* ((keywords (org-element-collect-affiliated-keywords))
495 (begin (car keywords))
496 (components (org-heading-components))
497 (todo (nth 2 components))
498 (todo-type (and todo
499 (if (member todo org-done-keywords) 'done 'todo)))
500 (tags (let ((raw-tags (nth 5 components)))
501 (and raw-tags (org-split-string raw-tags ":"))))
502 (title (if raw-secondary-p (nth 4 components)
503 (org-element-parse-secondary-string
504 (nth 4 components)
505 (org-element-restriction 'inlinetask))))
506 (standard-props (let (plist)
507 (mapc
508 (lambda (p)
509 (let ((p-name (downcase (car p))))
510 (while (string-match "_" p-name)
511 (setq p-name
512 (replace-match "-" nil nil p-name)))
513 (setq p-name (intern (concat ":" p-name)))
514 (setq plist
515 (plist-put plist p-name (cdr p)))))
516 (org-entry-properties nil 'standard))
517 plist))
518 (time-props (org-entry-properties nil 'special "CLOCK"))
519 (scheduled (cdr (assoc "SCHEDULED" time-props)))
520 (deadline (cdr (assoc "DEADLINE" time-props)))
521 (clock (cdr (assoc "CLOCK" time-props)))
522 (timestamp (cdr (assoc "TIMESTAMP" time-props)))
523 (contents-begin (save-excursion (forward-line) (point)))
524 (hidden (org-truely-invisible-p))
525 (pos-before-blank (org-inlinetask-goto-end))
526 ;; In the case of a single line task, CONTENTS-BEGIN and
527 ;; CONTENTS-END might overlap.
528 (contents-end (max contents-begin
529 (if (not (bolp)) (point-at-bol)
530 (save-excursion (forward-line -1) (point)))))
531 (end (progn (org-skip-whitespace)
532 (if (eobp) (point) (point-at-bol)))))
533 `(inlinetask
534 (:title ,title
535 :begin ,begin
536 :end ,end
537 :hiddenp ,(and (> contents-end contents-begin) hidden)
538 :contents-begin ,contents-begin
539 :contents-end ,contents-end
540 :level ,(nth 1 components)
541 :priority ,(nth 3 components)
542 :tags ,tags
543 :todo-keyword ,todo
544 :todo-type ,todo-type
545 :scheduled ,scheduled
546 :deadline ,deadline
547 :timestamp ,timestamp
548 :clock ,clock
549 :post-blank ,(count-lines pos-before-blank end)
550 ,@standard-props
551 ,@(cadr keywords))))))
553 (defun org-element-inlinetask-interpreter (inlinetask contents)
554 "Interpret INLINETASK element as Org syntax.
555 CONTENTS is the contents of inlinetask."
556 (let* ((level (org-element-property :level inlinetask))
557 (todo (org-element-property :todo-keyword inlinetask))
558 (priority (org-element-property :priority inlinetask))
559 (title (org-element-interpret-data
560 (org-element-property :title inlinetask)))
561 (tags (let ((tag-list (org-element-property :tags inlinetask)))
562 (and tag-list
563 (format ":%s:" (mapconcat 'identity tag-list ":")))))
564 (task (concat (make-string level ?*)
565 (and todo (concat " " todo))
566 (and priority
567 (format " [#%s]" (char-to-string priority)))
568 (and title (concat " " title)))))
569 (concat task
570 ;; Align tags.
571 (when tags
572 (cond
573 ((zerop org-tags-column) (format " %s" tags))
574 ((< org-tags-column 0)
575 (concat
576 (make-string
577 (max (- (+ org-tags-column (length task) (length tags))) 1)
579 tags))
581 (concat
582 (make-string (max (- org-tags-column (length task)) 1) ? )
583 tags))))
584 ;; Prefer degenerate inlinetasks when there are no
585 ;; contents.
586 (when contents
587 (concat "\n"
588 contents
589 (make-string level ?*) " END")))))
592 ;;;; Item
594 (defun org-element-item-parser (struct &optional raw-secondary-p)
595 "Parse an item.
597 STRUCT is the structure of the plain list.
599 Return a list whose CAR is `item' and CDR is a plist containing
600 `:bullet', `:begin', `:end', `:contents-begin', `:contents-end',
601 `:checkbox', `:counter', `:tag', `:structure', `:hiddenp' and
602 `:post-blank' keywords.
604 When optional argument RAW-SECONDARY-P is non-nil, item's tag, if
605 any, will not be parsed as a secondary string, but as a plain
606 string instead.
608 Assume point is at the beginning of the item."
609 (save-excursion
610 (beginning-of-line)
611 (let* ((begin (point))
612 (bullet (org-list-get-bullet (point) struct))
613 (checkbox (let ((box (org-list-get-checkbox begin struct)))
614 (cond ((equal "[ ]" box) 'off)
615 ((equal "[X]" box) 'on)
616 ((equal "[-]" box) 'trans))))
617 (counter (let ((c (org-list-get-counter begin struct)))
618 (cond
619 ((not c) nil)
620 ((string-match "[A-Za-z]" c)
621 (- (string-to-char (upcase (match-string 0 c)))
622 64))
623 ((string-match "[0-9]+" c)
624 (string-to-number (match-string 0 c))))))
625 (tag
626 (let ((raw-tag (org-list-get-tag begin struct)))
627 (and raw-tag
628 (if raw-secondary-p raw-tag
629 (org-element-parse-secondary-string
630 raw-tag (org-element-restriction 'item))))))
631 (end (org-list-get-item-end begin struct))
632 (contents-begin (progn (looking-at org-list-full-item-re)
633 (goto-char (match-end 0))
634 (org-skip-whitespace)
635 ;; If first line isn't empty,
636 ;; contents really start at the text
637 ;; after item's meta-data.
638 (if (= (point-at-bol) begin) (point)
639 (point-at-bol))))
640 (hidden (progn (forward-line)
641 (and (not (= (point) end))
642 (org-truely-invisible-p))))
643 (contents-end (progn (goto-char end)
644 (skip-chars-backward " \r\t\n")
645 (forward-line)
646 (point))))
647 `(item
648 (:bullet ,bullet
649 :begin ,begin
650 :end ,end
651 ;; CONTENTS-BEGIN and CONTENTS-END may be mixed
652 ;; up in the case of an empty item separated
653 ;; from the next by a blank line. Thus, ensure
654 ;; the former is always the smallest of two.
655 :contents-begin ,(min contents-begin contents-end)
656 :contents-end ,(max contents-begin contents-end)
657 :checkbox ,checkbox
658 :counter ,counter
659 :tag ,tag
660 :hiddenp ,hidden
661 :structure ,struct
662 :post-blank ,(count-lines contents-end end))))))
664 (defun org-element-item-interpreter (item contents)
665 "Interpret ITEM element as Org syntax.
666 CONTENTS is the contents of the element."
667 (let* ((bullet
668 (let* ((beg (org-element-property :begin item))
669 (struct (org-element-property :structure item))
670 (pre (org-list-prevs-alist struct))
671 (bul (org-element-property :bullet item)))
672 (org-list-bullet-string
673 (if (not (eq (org-list-get-list-type beg struct pre) 'ordered)) "-"
674 (let ((num
675 (car
676 (last
677 (org-list-get-item-number
678 beg struct pre (org-list-parents-alist struct))))))
679 (format "%d%s"
681 (if (eq org-plain-list-ordered-item-terminator ?\)) ")"
682 ".")))))))
683 (checkbox (org-element-property :checkbox item))
684 (counter (org-element-property :counter item))
685 (tag (let ((tag (org-element-property :tag item)))
686 (and tag (org-element-interpret-data tag))))
687 ;; Compute indentation.
688 (ind (make-string (length bullet) 32)))
689 ;; Indent contents.
690 (concat
691 bullet
692 (and counter (format "[@%d] " counter))
693 (cond
694 ((eq checkbox 'on) "[X] ")
695 ((eq checkbox 'off) "[ ] ")
696 ((eq checkbox 'trans) "[-] "))
697 (and tag (format "%s :: " tag))
698 (org-trim
699 (replace-regexp-in-string "\\(^\\)[ \t]*\\S-" ind contents nil nil 1)))))
702 ;;;; Plain List
704 (defun org-element-plain-list-parser (&optional structure)
705 "Parse a plain list.
707 Optional argument STRUCTURE, when non-nil, is the structure of
708 the plain list being parsed.
710 Return a list whose CAR is `plain-list' and CDR is a plist
711 containing `:type', `:begin', `:end', `:contents-begin' and
712 `:contents-end', `:level', `:structure' and `:post-blank'
713 keywords.
715 Assume point is at the beginning of the list."
716 (save-excursion
717 (let* ((struct (or structure (org-list-struct)))
718 (prevs (org-list-prevs-alist struct))
719 (parents (org-list-parents-alist struct))
720 (type (org-list-get-list-type (point) struct prevs))
721 (contents-begin (point))
722 (keywords (org-element-collect-affiliated-keywords))
723 (begin (car keywords))
724 (contents-end
725 (goto-char (org-list-get-list-end (point) struct prevs)))
726 (end (save-excursion (org-skip-whitespace)
727 (if (eobp) (point) (point-at-bol))))
728 (level 0))
729 ;; Get list level.
730 (let ((item contents-begin))
731 (while (setq item
732 (org-list-get-parent
733 (org-list-get-list-begin item struct prevs)
734 struct parents))
735 (incf level)))
736 ;; Blank lines below list belong to the top-level list only.
737 (when (> level 0)
738 (setq end (min (org-list-get-bottom-point struct)
739 (progn (org-skip-whitespace)
740 (if (eobp) (point) (point-at-bol))))))
741 ;; Return value.
742 `(plain-list
743 (:type ,type
744 :begin ,begin
745 :end ,end
746 :contents-begin ,contents-begin
747 :contents-end ,contents-end
748 :level ,level
749 :structure ,struct
750 :post-blank ,(count-lines contents-end end)
751 ,@(cadr keywords))))))
753 (defun org-element-plain-list-interpreter (plain-list contents)
754 "Interpret PLAIN-LIST element as Org syntax.
755 CONTENTS is the contents of the element."
756 contents)
759 ;;;; Quote Block
761 (defun org-element-quote-block-parser ()
762 "Parse a quote block.
764 Return a list whose CAR is `quote-block' and CDR is a plist
765 containing `:begin', `:end', `:hiddenp', `:contents-begin',
766 `:contents-end' and `:post-blank' keywords.
768 Assume point is at the beginning of the block."
769 (save-excursion
770 (let* ((case-fold-search t)
771 (keywords (org-element-collect-affiliated-keywords))
772 (begin (car keywords))
773 (contents-begin (progn (forward-line) (point)))
774 (hidden (org-truely-invisible-p))
775 (contents-end (progn (re-search-forward "^[ \t]*#\\+END_QUOTE" nil t)
776 (point-at-bol)))
777 (pos-before-blank (progn (forward-line) (point)))
778 (end (progn (org-skip-whitespace)
779 (if (eobp) (point) (point-at-bol)))))
780 `(quote-block
781 (:begin ,begin
782 :end ,end
783 :hiddenp ,hidden
784 :contents-begin ,contents-begin
785 :contents-end ,contents-end
786 :post-blank ,(count-lines pos-before-blank end)
787 ,@(cadr keywords))))))
789 (defun org-element-quote-block-interpreter (quote-block contents)
790 "Interpret QUOTE-BLOCK element as Org syntax.
791 CONTENTS is the contents of the element."
792 (format "#+BEGIN_QUOTE\n%s#+END_QUOTE" contents))
795 ;;;; Section
797 (defun org-element-section-parser ()
798 "Parse a section.
800 Return a list whose CAR is `section' and CDR is a plist
801 containing `:begin', `:end', `:contents-begin', `contents-end'
802 and `:post-blank' keywords."
803 (save-excursion
804 ;; Beginning of section is the beginning of the first non-blank
805 ;; line after previous headline.
806 (org-with-limited-levels
807 (let ((begin
808 (save-excursion
809 (outline-previous-heading)
810 (if (not (org-at-heading-p)) (point)
811 (forward-line) (org-skip-whitespace) (point-at-bol))))
812 (end (progn (outline-next-heading) (point)))
813 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
814 (forward-line)
815 (point))))
816 `(section
817 (:begin ,begin
818 :end ,end
819 :contents-begin ,begin
820 :contents-end ,pos-before-blank
821 :post-blank ,(count-lines pos-before-blank end)))))))
823 (defun org-element-section-interpreter (section contents)
824 "Interpret SECTION element as Org syntax.
825 CONTENTS is the contents of the element."
826 contents)
829 ;;;; Special Block
831 (defun org-element-special-block-parser ()
832 "Parse a special block.
834 Return a list whose CAR is `special-block' and CDR is a plist
835 containing `:type', `:begin', `:end', `:hiddenp',
836 `:contents-begin', `:contents-end' and `:post-blank' keywords.
838 Assume point is at the beginning of the block."
839 (save-excursion
840 (let* ((case-fold-search t)
841 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\([-A-Za-z0-9]+\\)")
842 (org-match-string-no-properties 1)))
843 (keywords (org-element-collect-affiliated-keywords))
844 (begin (car keywords))
845 (contents-begin (progn (forward-line) (point)))
846 (hidden (org-truely-invisible-p))
847 (contents-end
848 (progn (re-search-forward (concat "^[ \t]*#\\+END_" type) nil t)
849 (point-at-bol)))
850 (pos-before-blank (progn (forward-line) (point)))
851 (end (progn (org-skip-whitespace)
852 (if (eobp) (point) (point-at-bol)))))
853 `(special-block
854 (:type ,type
855 :begin ,begin
856 :end ,end
857 :hiddenp ,hidden
858 :contents-begin ,contents-begin
859 :contents-end ,contents-end
860 :post-blank ,(count-lines pos-before-blank end)
861 ,@(cadr keywords))))))
863 (defun org-element-special-block-interpreter (special-block contents)
864 "Interpret SPECIAL-BLOCK element as Org syntax.
865 CONTENTS is the contents of the element."
866 (let ((block-type (org-element-property :type special-block)))
867 (format "#+BEGIN_%s\n%s#+END_%s" block-type contents block-type)))
871 ;;; Elements
873 ;; For each element, a parser and an interpreter are also defined.
874 ;; Both follow the same naming convention used for greater elements.
876 ;; Also, as for greater elements, adding a new element type is done
877 ;; through the following steps: implement a parser and an interpreter,
878 ;; tweak `org-element-current-element' so that it recognizes the new
879 ;; type and add that new type to `org-element-all-elements'.
881 ;; As a special case, when the newly defined type is a block type,
882 ;; `org-element-non-recursive-block-alist' has to be modified
883 ;; accordingly.
886 ;;;; Babel Call
888 (defun org-element-babel-call-parser ()
889 "Parse a babel call.
891 Return a list whose CAR is `babel-call' and CDR is a plist
892 containing `:begin', `:end', `:info' and `:post-blank' as
893 keywords."
894 (save-excursion
895 (let ((info (progn (looking-at org-babel-block-lob-one-liner-regexp)
896 (org-babel-lob-get-info)))
897 (begin (point-at-bol))
898 (pos-before-blank (progn (forward-line) (point)))
899 (end (progn (org-skip-whitespace)
900 (if (eobp) (point) (point-at-bol)))))
901 `(babel-call
902 (:begin ,begin
903 :end ,end
904 :info ,info
905 :post-blank ,(count-lines pos-before-blank end))))))
907 (defun org-element-babel-call-interpreter (babel-call contents)
908 "Interpret BABEL-CALL element as Org syntax.
909 CONTENTS is nil."
910 (let* ((babel-info (org-element-property :info babel-call))
911 (main (car babel-info))
912 (post-options (nth 1 babel-info)))
913 (concat "#+CALL: "
914 (if (not (string-match "\\[\\(\\[.*?\\]\\)\\]" main)) main
915 ;; Remove redundant square brackets.
916 (replace-match (match-string 1 main) nil nil main))
917 (and post-options (format "[%s]" post-options)))))
920 ;;;; Clock
922 (defun org-element-clock-parser ()
923 "Parse a clock.
925 Return a list whose CAR is `clock' and CDR is a plist containing
926 `:status', `:value', `:time', `:begin', `:end' and `:post-blank'
927 as keywords."
928 (save-excursion
929 (let* ((case-fold-search nil)
930 (begin (point))
931 (value (progn (search-forward org-clock-string (line-end-position) t)
932 (org-skip-whitespace)
933 (looking-at "\\[.*\\]")
934 (org-match-string-no-properties 0)))
935 (time (and (progn (goto-char (match-end 0))
936 (looking-at " +=> +\\(\\S-+\\)[ \t]*$"))
937 (org-match-string-no-properties 1)))
938 (status (if time 'closed 'running))
939 (post-blank (let ((before-blank (progn (forward-line) (point))))
940 (org-skip-whitespace)
941 (unless (eobp) (beginning-of-line))
942 (count-lines before-blank (point))))
943 (end (point)))
944 `(clock (:status ,status
945 :value ,value
946 :time ,time
947 :begin ,begin
948 :end ,end
949 :post-blank ,post-blank)))))
951 (defun org-element-clock-interpreter (clock contents)
952 "Interpret CLOCK element as Org syntax.
953 CONTENTS is nil."
954 (concat org-clock-string " "
955 (org-element-property :value clock)
956 (let ((time (org-element-property :time clock)))
957 (and time
958 (concat " => "
959 (apply 'format
960 "%2s:%02s"
961 (org-split-string time ":")))))))
964 ;;;; Comment
966 (defun org-element-comment-parser ()
967 "Parse a comment.
969 Return a list whose CAR is `comment' and CDR is a plist
970 containing `:begin', `:end', `:value' and `:post-blank'
971 keywords.
973 Assume point is at comment beginning."
974 (save-excursion
975 (let* ((keywords (org-element-collect-affiliated-keywords))
976 (begin (car keywords))
977 value
978 (com-end
979 ;; Get comments ending. This may not be accurate if
980 ;; commented lines within an item are followed by
981 ;; commented lines outside of a list. Though, parser will
982 ;; always get it right as it already knows surrounding
983 ;; element and has narrowed buffer to its contents.
984 (progn
985 (while (looking-at "\\(\\(# ?\\)[^+]\\|[ \t]*#\\+\\( \\|$\\)\\)")
986 ;; Accumulate lines without leading hash and plus sign
987 ;; if any. First whitespace is also ignored.
988 (setq value
989 (concat value
990 (buffer-substring-no-properties
991 (or (match-end 2) (match-end 3)) (point-at-eol))
992 "\n"))
993 (forward-line))
994 (point)))
995 (end (progn (goto-char com-end)
996 (org-skip-whitespace)
997 (if (eobp) (point) (point-at-bol)))))
998 `(comment
999 (:begin ,begin
1000 :end ,end
1001 :value ,value
1002 :post-blank ,(count-lines com-end end)
1003 ,@(cadr keywords))))))
1005 (defun org-element-comment-interpreter (comment contents)
1006 "Interpret COMMENT element as Org syntax.
1007 CONTENTS is nil."
1008 (replace-regexp-in-string
1009 "^" "#+ "
1010 (substring (org-element-property :value comment) 0 -1)))
1013 ;;;; Comment Block
1015 (defun org-element-comment-block-parser ()
1016 "Parse an export block.
1018 Return a list whose CAR is `comment-block' and CDR is a plist
1019 containing `:begin', `:end', `:hiddenp', `:value' and
1020 `:post-blank' keywords.
1022 Assume point is at comment block beginning."
1023 (save-excursion
1024 (let* ((case-fold-search t)
1025 (keywords (org-element-collect-affiliated-keywords))
1026 (begin (car keywords))
1027 (contents-begin (progn (forward-line) (point)))
1028 (hidden (org-truely-invisible-p))
1029 (contents-end
1030 (progn (re-search-forward "^[ \t]*#\\+END_COMMENT" nil t)
1031 (point-at-bol)))
1032 (pos-before-blank (progn (forward-line) (point)))
1033 (end (progn (org-skip-whitespace)
1034 (if (eobp) (point) (point-at-bol))))
1035 (value (buffer-substring-no-properties contents-begin contents-end)))
1036 `(comment-block
1037 (:begin ,begin
1038 :end ,end
1039 :value ,value
1040 :hiddenp ,hidden
1041 :post-blank ,(count-lines pos-before-blank end)
1042 ,@(cadr keywords))))))
1044 (defun org-element-comment-block-interpreter (comment-block contents)
1045 "Interpret COMMENT-BLOCK element as Org syntax.
1046 CONTENTS is nil."
1047 (format "#+BEGIN_COMMENT\n%s#+END_COMMENT"
1048 (org-remove-indentation (org-element-property :value comment-block))))
1051 ;;;; Example Block
1053 (defun org-element-example-block-parser ()
1054 "Parse an example block.
1056 Return a list whose CAR is `example-block' and CDR is a plist
1057 containing `:begin', `:end', `:number-lines', `:preserve-indent',
1058 `:retain-labels', `:use-labels', `:label-fmt', `:hiddenp',
1059 `:switches', `:value' and `:post-blank' keywords."
1060 (save-excursion
1061 (let* ((case-fold-search t)
1062 (switches
1063 (progn (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
1064 (org-match-string-no-properties 1)))
1065 ;; Switches analysis
1066 (number-lines (cond ((not switches) nil)
1067 ((string-match "-n\\>" switches) 'new)
1068 ((string-match "+n\\>" switches) 'continued)))
1069 (preserve-indent (and switches (string-match "-i\\>" switches)))
1070 ;; Should labels be retained in (or stripped from) example
1071 ;; blocks?
1072 (retain-labels
1073 (or (not switches)
1074 (not (string-match "-r\\>" switches))
1075 (and number-lines (string-match "-k\\>" switches))))
1076 ;; What should code-references use - labels or
1077 ;; line-numbers?
1078 (use-labels
1079 (or (not switches)
1080 (and retain-labels (not (string-match "-k\\>" switches)))))
1081 (label-fmt (and switches
1082 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
1083 (match-string 1 switches)))
1084 ;; Standard block parsing.
1085 (keywords (org-element-collect-affiliated-keywords))
1086 (begin (car keywords))
1087 (contents-begin (progn (forward-line) (point)))
1088 (hidden (org-truely-invisible-p))
1089 (contents-end
1090 (progn (re-search-forward "^[ \t]*#\\+END_EXAMPLE" nil t)
1091 (point-at-bol)))
1092 (value (buffer-substring-no-properties contents-begin contents-end))
1093 (pos-before-blank (progn (forward-line) (point)))
1094 (end (progn (org-skip-whitespace)
1095 (if (eobp) (point) (point-at-bol)))))
1096 `(example-block
1097 (:begin ,begin
1098 :end ,end
1099 :value ,value
1100 :switches ,switches
1101 :number-lines ,number-lines
1102 :preserve-indent ,preserve-indent
1103 :retain-labels ,retain-labels
1104 :use-labels ,use-labels
1105 :label-fmt ,label-fmt
1106 :hiddenp ,hidden
1107 :post-blank ,(count-lines pos-before-blank end)
1108 ,@(cadr keywords))))))
1110 (defun org-element-example-block-interpreter (example-block contents)
1111 "Interpret EXAMPLE-BLOCK element as Org syntax.
1112 CONTENTS is nil."
1113 (let ((switches (org-element-property :switches example-block)))
1114 (concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
1115 (org-remove-indentation
1116 (org-element-property :value example-block))
1117 "#+END_EXAMPLE")))
1120 ;;;; Export Block
1122 (defun org-element-export-block-parser ()
1123 "Parse an export block.
1125 Return a list whose CAR is `export-block' and CDR is a plist
1126 containing `:begin', `:end', `:type', `:hiddenp', `:value' and
1127 `:post-blank' keywords.
1129 Assume point is at export-block beginning."
1130 (save-excursion
1131 (let* ((case-fold-search t)
1132 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\([A-Za-z0-9]+\\)")
1133 (upcase (org-match-string-no-properties 1))))
1134 (keywords (org-element-collect-affiliated-keywords))
1135 (begin (car keywords))
1136 (contents-begin (progn (forward-line) (point)))
1137 (hidden (org-truely-invisible-p))
1138 (contents-end
1139 (progn (re-search-forward (concat "^[ \t]*#\\+END_" type) nil t)
1140 (point-at-bol)))
1141 (pos-before-blank (progn (forward-line) (point)))
1142 (end (progn (org-skip-whitespace)
1143 (if (eobp) (point) (point-at-bol))))
1144 (value (buffer-substring-no-properties contents-begin contents-end)))
1145 `(export-block
1146 (:begin ,begin
1147 :end ,end
1148 :type ,type
1149 :value ,value
1150 :hiddenp ,hidden
1151 :post-blank ,(count-lines pos-before-blank end)
1152 ,@(cadr keywords))))))
1154 (defun org-element-export-block-interpreter (export-block contents)
1155 "Interpret EXPORT-BLOCK element as Org syntax.
1156 CONTENTS is nil."
1157 (let ((type (org-element-property :type export-block)))
1158 (concat (format "#+BEGIN_%s\n" type)
1159 (org-element-property :value export-block)
1160 (format "#+END_%s" type))))
1163 ;;;; Fixed-width
1165 (defun org-element-fixed-width-parser ()
1166 "Parse a fixed-width section.
1168 Return a list whose CAR is `fixed-width' and CDR is a plist
1169 containing `:begin', `:end', `:value' and `:post-blank' keywords.
1171 Assume point is at the beginning of the fixed-width area."
1172 (save-excursion
1173 (let* ((keywords (org-element-collect-affiliated-keywords))
1174 (begin (car keywords))
1175 value
1176 (end-area
1177 ;; Ending position may not be accurate if fixed-width
1178 ;; lines within an item are followed by fixed-width lines
1179 ;; outside of a list. Though, parser will always get it
1180 ;; right as it already knows surrounding element and has
1181 ;; narrowed buffer to its contents.
1182 (progn
1183 (while (looking-at "[ \t]*:\\( \\|$\\)")
1184 ;, Accumulate text without starting colons.
1185 (setq value
1186 (concat value
1187 (buffer-substring-no-properties
1188 (match-end 0) (point-at-eol))
1189 "\n"))
1190 (forward-line))
1191 (point)))
1192 (end (progn (org-skip-whitespace)
1193 (if (eobp) (point) (point-at-bol)))))
1194 `(fixed-width
1195 (:begin ,begin
1196 :end ,end
1197 :value ,value
1198 :post-blank ,(count-lines end-area end)
1199 ,@(cadr keywords))))))
1201 (defun org-element-fixed-width-interpreter (fixed-width contents)
1202 "Interpret FIXED-WIDTH element as Org syntax.
1203 CONTENTS is nil."
1204 (replace-regexp-in-string
1205 "^" ": " (substring (org-element-property :value fixed-width) 0 -1)))
1208 ;;;; Horizontal Rule
1210 (defun org-element-horizontal-rule-parser ()
1211 "Parse an horizontal rule.
1213 Return a list whose CAR is `horizontal-rule' and CDR is a plist
1214 containing `:begin', `:end' and `:post-blank' keywords."
1215 (save-excursion
1216 (let* ((keywords (org-element-collect-affiliated-keywords))
1217 (begin (car keywords))
1218 (post-hr (progn (forward-line) (point)))
1219 (end (progn (org-skip-whitespace)
1220 (if (eobp) (point) (point-at-bol)))))
1221 `(horizontal-rule
1222 (:begin ,begin
1223 :end ,end
1224 :post-blank ,(count-lines post-hr end)
1225 ,@(cadr keywords))))))
1227 (defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
1228 "Interpret HORIZONTAL-RULE element as Org syntax.
1229 CONTENTS is nil."
1230 "-----")
1233 ;;;; Keyword
1235 (defun org-element-keyword-parser ()
1236 "Parse a keyword at point.
1238 Return a list whose CAR is `keyword' and CDR is a plist
1239 containing `:key', `:value', `:begin', `:end' and `:post-blank'
1240 keywords."
1241 (save-excursion
1242 (let* ((case-fold-search t)
1243 (begin (point))
1244 (key (progn (looking-at
1245 "[ \t]*#\\+\\(\\(?:[a-z]+\\)\\(?:_[a-z]+\\)*\\):")
1246 (upcase (org-match-string-no-properties 1))))
1247 (value (org-trim (buffer-substring-no-properties
1248 (match-end 0) (point-at-eol))))
1249 (pos-before-blank (progn (forward-line) (point)))
1250 (end (progn (org-skip-whitespace)
1251 (if (eobp) (point) (point-at-bol)))))
1252 `(keyword
1253 (:key ,key
1254 :value ,value
1255 :begin ,begin
1256 :end ,end
1257 :post-blank ,(count-lines pos-before-blank end))))))
1259 (defun org-element-keyword-interpreter (keyword contents)
1260 "Interpret KEYWORD element as Org syntax.
1261 CONTENTS is nil."
1262 (format "#+%s: %s"
1263 (org-element-property :key keyword)
1264 (org-element-property :value keyword)))
1267 ;;;; Latex Environment
1269 (defun org-element-latex-environment-parser ()
1270 "Parse a LaTeX environment.
1272 Return a list whose CAR is `latex-environment' and CDR is a plist
1273 containing `:begin', `:end', `:value' and `:post-blank'
1274 keywords.
1276 Assume point is at the beginning of the latex environment."
1277 (save-excursion
1278 (let* ((case-fold-search t)
1279 (contents-begin (point))
1280 (keywords (org-element-collect-affiliated-keywords))
1281 (begin (car keywords))
1282 (contents-end (progn (re-search-forward "^[ \t]*\\\\end")
1283 (forward-line)
1284 (point)))
1285 (value (buffer-substring-no-properties contents-begin contents-end))
1286 (end (progn (org-skip-whitespace)
1287 (if (eobp) (point) (point-at-bol)))))
1288 `(latex-environment
1289 (:begin ,begin
1290 :end ,end
1291 :value ,value
1292 :post-blank ,(count-lines contents-end end)
1293 ,@(cadr keywords))))))
1295 (defun org-element-latex-environment-interpreter (latex-environment contents)
1296 "Interpret LATEX-ENVIRONMENT element as Org syntax.
1297 CONTENTS is nil."
1298 (org-element-property :value latex-environment))
1301 ;;;; Paragraph
1303 (defun org-element-paragraph-parser ()
1304 "Parse a paragraph.
1306 Return a list whose CAR is `paragraph' and CDR is a plist
1307 containing `:begin', `:end', `:contents-begin' and
1308 `:contents-end' and `:post-blank' keywords.
1310 Assume point is at the beginning of the paragraph."
1311 (save-excursion
1312 (let* ((contents-begin (point))
1313 (keywords (org-element-collect-affiliated-keywords))
1314 (begin (car keywords))
1315 (contents-end
1316 (progn (end-of-line)
1317 (if (re-search-forward org-element-paragraph-separate nil 'm)
1318 (progn (forward-line -1) (end-of-line) (point))
1319 (point))))
1320 (pos-before-blank (progn (forward-line) (point)))
1321 (end (progn (org-skip-whitespace)
1322 (if (eobp) (point) (point-at-bol)))))
1323 `(paragraph
1324 (:begin ,begin
1325 :end ,end
1326 :contents-begin ,contents-begin
1327 :contents-end ,contents-end
1328 :post-blank ,(count-lines pos-before-blank end)
1329 ,@(cadr keywords))))))
1331 (defun org-element-paragraph-interpreter (paragraph contents)
1332 "Interpret PARAGRAPH element as Org syntax.
1333 CONTENTS is the contents of the element."
1334 contents)
1337 ;;;; Planning
1339 (defun org-element-planning-parser ()
1340 "Parse a planning.
1342 Return a list whose CAR is `planning' and CDR is a plist
1343 containing `:closed', `:deadline', `:scheduled', `:begin', `:end'
1344 and `:post-blank' keywords."
1345 (save-excursion
1346 (let* ((case-fold-search nil)
1347 (begin (point))
1348 (post-blank (let ((before-blank (progn (forward-line) (point))))
1349 (org-skip-whitespace)
1350 (unless (eobp) (beginning-of-line))
1351 (count-lines before-blank (point))))
1352 (end (point))
1353 closed deadline scheduled)
1354 (goto-char begin)
1355 (while (re-search-forward org-keyword-time-not-clock-regexp
1356 (line-end-position) t)
1357 (goto-char (match-end 1))
1358 (org-skip-whitespace)
1359 (let ((time (buffer-substring-no-properties (point) (match-end 0)))
1360 (keyword (match-string 1)))
1361 (cond ((equal keyword org-closed-string) (setq closed time))
1362 ((equal keyword org-deadline-string) (setq deadline time))
1363 (t (setq scheduled time)))))
1364 `(planning
1365 (:closed ,closed
1366 :deadline ,deadline
1367 :scheduled ,scheduled
1368 :begin ,begin
1369 :end ,end
1370 :post-blank ,post-blank)))))
1372 (defun org-element-planning-interpreter (planning contents)
1373 "Interpret PLANNING element as Org syntax.
1374 CONTENTS is nil."
1375 (mapconcat
1376 'identity
1377 (delq nil
1378 (list (let ((closed (org-element-property :closed planning)))
1379 (when closed (concat org-closed-string " " closed)))
1380 (let ((deadline (org-element-property :deadline planning)))
1381 (when deadline (concat org-deadline-string " " deadline)))
1382 (let ((scheduled (org-element-property :scheduled planning)))
1383 (when scheduled (concat org-scheduled-string " " scheduled)))))
1384 " "))
1387 ;;;; Property Drawer
1389 (defun org-element-property-drawer-parser ()
1390 "Parse a property drawer.
1392 Return a list whose CAR is `property-drawer' and CDR is a plist
1393 containing `:begin', `:end', `:hiddenp', `:contents-begin',
1394 `:contents-end', `:properties' and `:post-blank' keywords.
1396 Assume point is at the beginning of the property drawer."
1397 (save-excursion
1398 (let ((case-fold-search t)
1399 (begin (point))
1400 (prop-begin (progn (forward-line) (point)))
1401 (hidden (org-truely-invisible-p))
1402 (properties
1403 (let (val)
1404 (while (not (looking-at "^[ \t]*:END:"))
1405 (when (looking-at "[ \t]*:\\([A-Za-z][-_A-Za-z0-9]*\\):")
1406 (push (cons (org-match-string-no-properties 1)
1407 (org-trim
1408 (buffer-substring-no-properties
1409 (match-end 0) (point-at-eol))))
1410 val))
1411 (forward-line))
1412 val))
1413 (prop-end (progn (re-search-forward "^[ \t]*:END:" nil t)
1414 (point-at-bol)))
1415 (pos-before-blank (progn (forward-line) (point)))
1416 (end (progn (org-skip-whitespace)
1417 (if (eobp) (point) (point-at-bol)))))
1418 `(property-drawer
1419 (:begin ,begin
1420 :end ,end
1421 :hiddenp ,hidden
1422 :properties ,properties
1423 :post-blank ,(count-lines pos-before-blank end))))))
1425 (defun org-element-property-drawer-interpreter (property-drawer contents)
1426 "Interpret PROPERTY-DRAWER element as Org syntax.
1427 CONTENTS is nil."
1428 (let ((props (org-element-property :properties property-drawer)))
1429 (concat
1430 ":PROPERTIES:\n"
1431 (mapconcat (lambda (p)
1432 (format org-property-format (format ":%s:" (car p)) (cdr p)))
1433 (nreverse props) "\n")
1434 "\n:END:")))
1437 ;;;; Quote Section
1439 (defun org-element-quote-section-parser ()
1440 "Parse a quote section.
1442 Return a list whose CAR is `quote-section' and CDR is a plist
1443 containing `:begin', `:end', `:value' and `:post-blank' keywords.
1445 Assume point is at beginning of the section."
1446 (save-excursion
1447 (let* ((begin (point))
1448 (end (progn (org-with-limited-levels (outline-next-heading))
1449 (point)))
1450 (pos-before-blank (progn (skip-chars-backward " \r\t\n")
1451 (forward-line)
1452 (point)))
1453 (value (buffer-substring-no-properties begin pos-before-blank)))
1454 `(quote-section
1455 (:begin ,begin
1456 :end ,end
1457 :value ,value
1458 :post-blank ,(count-lines pos-before-blank end))))))
1460 (defun org-element-quote-section-interpreter (quote-section contents)
1461 "Interpret QUOTE-SECTION element as Org syntax.
1462 CONTENTS is nil."
1463 (org-element-property :value quote-section))
1466 ;;;; Src Block
1468 (defun org-element-src-block-parser ()
1469 "Parse a src block.
1471 Return a list whose CAR is `src-block' and CDR is a plist
1472 containing `:language', `:switches', `:parameters', `:begin',
1473 `:end', `:hiddenp', `:contents-begin', `:contents-end',
1474 `:number-lines', `:retain-labels', `:use-labels', `:label-fmt',
1475 `:preserve-indent', `:value' and `:post-blank' keywords.
1477 Assume point is at the beginning of the block."
1478 (save-excursion
1479 (let* ((case-fold-search t)
1480 (contents-begin (point))
1481 ;; Get affiliated keywords.
1482 (keywords (org-element-collect-affiliated-keywords))
1483 ;; Get beginning position.
1484 (begin (car keywords))
1485 ;; Get language as a string.
1486 (language
1487 (progn
1488 (looking-at
1489 (concat "^[ \t]*#\\+BEGIN_SRC"
1490 "\\(?: +\\(\\S-+\\)\\)?"
1491 "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
1492 "\\(.*\\)[ \t]*$"))
1493 (org-match-string-no-properties 1)))
1494 ;; Get switches.
1495 (switches (org-match-string-no-properties 2))
1496 ;; Get parameters.
1497 (parameters (org-match-string-no-properties 3))
1498 ;; Switches analysis
1499 (number-lines (cond ((not switches) nil)
1500 ((string-match "-n\\>" switches) 'new)
1501 ((string-match "+n\\>" switches) 'continued)))
1502 (preserve-indent (and switches (string-match "-i\\>" switches)))
1503 (label-fmt (and switches
1504 (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
1505 (match-string 1 switches)))
1506 ;; Should labels be retained in (or stripped from) src
1507 ;; blocks?
1508 (retain-labels
1509 (or (not switches)
1510 (not (string-match "-r\\>" switches))
1511 (and number-lines (string-match "-k\\>" switches))))
1512 ;; What should code-references use - labels or
1513 ;; line-numbers?
1514 (use-labels
1515 (or (not switches)
1516 (and retain-labels (not (string-match "-k\\>" switches)))))
1517 ;; Get position at end of block.
1518 (contents-end (progn (re-search-forward "^[ \t]*#\\+END_SRC" nil t)
1519 (forward-line)
1520 (point)))
1521 ;; Retrieve code.
1522 (value (buffer-substring-no-properties
1523 (save-excursion (goto-char contents-begin)
1524 (forward-line)
1525 (point))
1526 (match-beginning 0)))
1527 ;; Get position after ending blank lines.
1528 (end (progn (org-skip-whitespace)
1529 (if (eobp) (point) (point-at-bol))))
1530 ;; Get visibility status.
1531 (hidden (progn (goto-char contents-begin)
1532 (forward-line)
1533 (org-truely-invisible-p))))
1534 `(src-block
1535 (:language ,language
1536 :switches ,(and (org-string-nw-p switches)
1537 (org-trim switches))
1538 :parameters ,(and (org-string-nw-p parameters)
1539 (org-trim parameters))
1540 :begin ,begin
1541 :end ,end
1542 :number-lines ,number-lines
1543 :preserve-indent ,preserve-indent
1544 :retain-labels ,retain-labels
1545 :use-labels ,use-labels
1546 :label-fmt ,label-fmt
1547 :hiddenp ,hidden
1548 :value ,value
1549 :post-blank ,(count-lines contents-end end)
1550 ,@(cadr keywords))))))
1552 (defun org-element-src-block-interpreter (src-block contents)
1553 "Interpret SRC-BLOCK element as Org syntax.
1554 CONTENTS is nil."
1555 (let ((lang (org-element-property :language src-block))
1556 (switches (org-element-property :switches src-block))
1557 (params (org-element-property :parameters src-block))
1558 (value (let ((val (org-element-property :value src-block)))
1559 (cond
1561 (org-src-preserve-indentation val)
1562 ((zerop org-edit-src-content-indentation)
1563 (org-remove-indentation val))
1565 (let ((ind (make-string
1566 org-edit-src-content-indentation 32)))
1567 (replace-regexp-in-string
1568 "\\(^\\)[ \t]*\\S-" ind
1569 (org-remove-indentation val) nil nil 1)))))))
1570 (concat (format "#+BEGIN_SRC%s\n"
1571 (concat (and lang (concat " " lang))
1572 (and switches (concat " " switches))
1573 (and params (concat " " params))))
1574 value
1575 "#+END_SRC")))
1578 ;;;; Table
1580 (defun org-element-table-parser ()
1581 "Parse a table at point.
1583 Return a list whose CAR is `table' and CDR is a plist containing
1584 `:begin', `:end', `:tblfm', `:type', `:contents-begin',
1585 `:contents-end', `:value' and `:post-blank' keywords.
1587 Assume point is at the beginning of the table."
1588 (save-excursion
1589 (let* ((case-fold-search t)
1590 (table-begin (point))
1591 (type (if (org-at-table.el-p) 'table.el 'org))
1592 (keywords (org-element-collect-affiliated-keywords))
1593 (begin (car keywords))
1594 (table-end (goto-char (marker-position (org-table-end t))))
1595 (tblfm (when (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
1596 (prog1 (org-match-string-no-properties 1)
1597 (forward-line))))
1598 (pos-before-blank (point))
1599 (end (progn (org-skip-whitespace)
1600 (if (eobp) (point) (point-at-bol)))))
1601 `(table
1602 (:begin ,begin
1603 :end ,end
1604 :type ,type
1605 :tblfm ,tblfm
1606 ;; Only `org' tables have contents. `table.el' tables
1607 ;; use a `:value' property to store raw table as
1608 ;; a string.
1609 :contents-begin ,(and (eq type 'org) table-begin)
1610 :contents-end ,(and (eq type 'org) table-end)
1611 :value ,(and (eq type 'table.el)
1612 (buffer-substring-no-properties
1613 table-begin table-end))
1614 :post-blank ,(count-lines pos-before-blank end)
1615 ,@(cadr keywords))))))
1617 (defun org-element-table-interpreter (table contents)
1618 "Interpret TABLE element as Org syntax.
1619 CONTENTS is nil."
1620 (if (eq (org-element-property :type table) 'table.el)
1621 (org-remove-indentation (org-element-property :value table))
1622 (concat (with-temp-buffer (insert contents)
1623 (org-table-align)
1624 (buffer-string))
1625 (when (org-element-property :tblfm table)
1626 (format "#+TBLFM: " (org-element-property :tblfm table))))))
1629 ;;;; Table Row
1631 (defun org-element-table-row-parser ()
1632 "Parse table row at point.
1634 Return a list whose CAR is `table-row' and CDR is a plist
1635 containing `:begin', `:end', `:contents-begin', `:contents-end',
1636 `:type' and `:post-blank' keywords."
1637 (save-excursion
1638 (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
1639 (begin (point))
1640 ;; A table rule has no contents. In that case, ensure
1641 ;; CONTENTS-BEGIN matches CONTENTS-END.
1642 (contents-begin (if (eq type 'standard)
1643 (progn (search-forward "|") (point))
1644 (end-of-line)
1645 (skip-chars-backward " \r\t\n")
1646 (point)))
1647 (contents-end (progn (end-of-line)
1648 (skip-chars-backward " \r\t\n")
1649 (point)))
1650 (end (progn (forward-line) (point))))
1651 `(table-row
1652 (:type ,type
1653 :begin ,begin
1654 :end ,end
1655 :contents-begin ,contents-begin
1656 :contents-end ,contents-end
1657 :post-blank 0)))))
1659 (defun org-element-table-row-interpreter (table-row contents)
1660 "Interpret TABLE-ROW element as Org syntax.
1661 CONTENTS is the contents of the table row."
1662 (if (eq (org-element-property :type table-row) 'rule) "|-"
1663 (concat "| " contents)))
1666 ;;;; Verse Block
1668 (defun org-element-verse-block-parser ()
1669 "Parse a verse block.
1671 Return a list whose CAR is `verse-block' and CDR is a plist
1672 containing `:begin', `:end', `:contents-begin', `:contents-end',
1673 `:hiddenp' and `:post-blank' keywords.
1675 Assume point is at beginning of the block."
1676 (save-excursion
1677 (let* ((case-fold-search t)
1678 (keywords (org-element-collect-affiliated-keywords))
1679 (begin (car keywords))
1680 (hidden (progn (forward-line) (org-truely-invisible-p)))
1681 (contents-begin (point))
1682 (contents-end
1683 (progn
1684 (re-search-forward (concat "^[ \t]*#\\+END_VERSE") nil t)
1685 (point-at-bol)))
1686 (pos-before-blank (progn (forward-line) (point)))
1687 (end (progn (org-skip-whitespace)
1688 (if (eobp) (point) (point-at-bol)))))
1689 `(verse-block
1690 (:begin ,begin
1691 :end ,end
1692 :contents-begin ,contents-begin
1693 :contents-end ,contents-end
1694 :hiddenp ,hidden
1695 :post-blank ,(count-lines pos-before-blank end)
1696 ,@(cadr keywords))))))
1698 (defun org-element-verse-block-interpreter (verse-block contents)
1699 "Interpret VERSE-BLOCK element as Org syntax.
1700 CONTENTS is verse block contents."
1701 (format "#+BEGIN_VERSE\n%s#+END_VERSE" contents))
1705 ;;; Objects
1707 ;; Unlike to elements, interstices can be found between objects.
1708 ;; That's why, along with the parser, successor functions are provided
1709 ;; for each object. Some objects share the same successor (i.e. `code'
1710 ;; and `verbatim' objects).
1712 ;; A successor must accept a single argument bounding the search. It
1713 ;; will return either a cons cell whose CAR is the object's type, as
1714 ;; a symbol, and CDR the position of its next occurrence, or nil.
1716 ;; Successors follow the naming convention:
1717 ;; org-element-NAME-successor, where NAME is the name of the
1718 ;; successor, as defined in `org-element-all-successors'.
1720 ;; Some object types (i.e. `emphasis') are recursive. Restrictions on
1721 ;; object types they can contain will be specified in
1722 ;; `org-element-object-restrictions'.
1724 ;; Adding a new type of object is simple. Implement a successor,
1725 ;; a parser, and an interpreter for it, all following the naming
1726 ;; convention. Register type in `org-element-all-objects' and
1727 ;; successor in `org-element-all-successors'. Maybe tweak
1728 ;; restrictions about it, and that's it.
1731 ;;;; Bold
1733 (defun org-element-bold-parser ()
1734 "Parse bold object at point.
1736 Return a list whose CAR is `bold' and CDR is a plist with
1737 `:begin', `:end', `:contents-begin' and `:contents-end' and
1738 `:post-blank' keywords.
1740 Assume point is at the first star marker."
1741 (save-excursion
1742 (unless (bolp) (backward-char 1))
1743 (looking-at org-emph-re)
1744 (let ((begin (match-beginning 2))
1745 (contents-begin (match-beginning 4))
1746 (contents-end (match-end 4))
1747 (post-blank (progn (goto-char (match-end 2))
1748 (skip-chars-forward " \t")))
1749 (end (point)))
1750 `(bold
1751 (:begin ,begin
1752 :end ,end
1753 :contents-begin ,contents-begin
1754 :contents-end ,contents-end
1755 :post-blank ,post-blank)))))
1757 (defun org-element-bold-interpreter (bold contents)
1758 "Interpret BOLD object as Org syntax.
1759 CONTENTS is the contents of the object."
1760 (format "*%s*" contents))
1762 (defun org-element-text-markup-successor (limit)
1763 "Search for the next text-markup object.
1765 LIMIT bounds the search.
1767 Return value is a cons cell whose CAR is a symbol among `bold',
1768 `italic', `underline', `strike-through', `code' and `verbatim'
1769 and CDR is beginning position."
1770 (save-excursion
1771 (unless (bolp) (backward-char))
1772 (when (re-search-forward org-emph-re limit t)
1773 (let ((marker (match-string 3)))
1774 (cons (cond
1775 ((equal marker "*") 'bold)
1776 ((equal marker "/") 'italic)
1777 ((equal marker "_") 'underline)
1778 ((equal marker "+") 'strike-through)
1779 ((equal marker "~") 'code)
1780 ((equal marker "=") 'verbatim)
1781 (t (error "Unknown marker at %d" (match-beginning 3))))
1782 (match-beginning 2))))))
1785 ;;;; Code
1787 (defun org-element-code-parser ()
1788 "Parse code object at point.
1790 Return a list whose CAR is `code' and CDR is a plist with
1791 `:value', `:begin', `:end' and `:post-blank' keywords.
1793 Assume point is at the first tilde marker."
1794 (save-excursion
1795 (unless (bolp) (backward-char 1))
1796 (looking-at org-emph-re)
1797 (let ((begin (match-beginning 2))
1798 (value (org-match-string-no-properties 4))
1799 (post-blank (progn (goto-char (match-end 2))
1800 (skip-chars-forward " \t")))
1801 (end (point)))
1802 `(code
1803 (:value ,value
1804 :begin ,begin
1805 :end ,end
1806 :post-blank ,post-blank)))))
1808 (defun org-element-code-interpreter (code contents)
1809 "Interpret CODE object as Org syntax.
1810 CONTENTS is nil."
1811 (format "~%s~" (org-element-property :value code)))
1814 ;;;; Entity
1816 (defun org-element-entity-parser ()
1817 "Parse entity at point.
1819 Return a list whose CAR is `entity' and CDR a plist with
1820 `:begin', `:end', `:latex', `:latex-math-p', `:html', `:latin1',
1821 `:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as
1822 keywords.
1824 Assume point is at the beginning of the entity."
1825 (save-excursion
1826 (looking-at "\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|{}\\|[^[:alpha:]]\\)")
1827 (let* ((value (org-entity-get (match-string 1)))
1828 (begin (match-beginning 0))
1829 (bracketsp (string= (match-string 2) "{}"))
1830 (post-blank (progn (goto-char (match-end 1))
1831 (when bracketsp (forward-char 2))
1832 (skip-chars-forward " \t")))
1833 (end (point)))
1834 `(entity
1835 (:name ,(car value)
1836 :latex ,(nth 1 value)
1837 :latex-math-p ,(nth 2 value)
1838 :html ,(nth 3 value)
1839 :ascii ,(nth 4 value)
1840 :latin1 ,(nth 5 value)
1841 :utf-8 ,(nth 6 value)
1842 :begin ,begin
1843 :end ,end
1844 :use-brackets-p ,bracketsp
1845 :post-blank ,post-blank)))))
1847 (defun org-element-entity-interpreter (entity contents)
1848 "Interpret ENTITY object as Org syntax.
1849 CONTENTS is nil."
1850 (concat "\\"
1851 (org-element-property :name entity)
1852 (when (org-element-property :use-brackets-p entity) "{}")))
1854 (defun org-element-latex-or-entity-successor (limit)
1855 "Search for the next latex-fragment or entity object.
1857 LIMIT bounds the search.
1859 Return value is a cons cell whose CAR is `entity' or
1860 `latex-fragment' and CDR is beginning position."
1861 (save-excursion
1862 (let ((matchers (plist-get org-format-latex-options :matchers))
1863 ;; ENTITY-RE matches both LaTeX commands and Org entities.
1864 (entity-re
1865 "\\\\\\(frac[13][24]\\|[a-zA-Z]+\\)\\($\\|[^[:alpha:]\n]\\)"))
1866 (when (re-search-forward
1867 (concat (mapconcat (lambda (e) (nth 1 (assoc e org-latex-regexps)))
1868 matchers "\\|")
1869 "\\|" entity-re)
1870 limit t)
1871 (goto-char (match-beginning 0))
1872 (if (looking-at entity-re)
1873 ;; Determine if it's a real entity or a LaTeX command.
1874 (cons (if (org-entity-get (match-string 1)) 'entity 'latex-fragment)
1875 (match-beginning 0))
1876 ;; No entity nor command: point is at a LaTeX fragment.
1877 ;; Determine its type to get the correct beginning position.
1878 (cons 'latex-fragment
1879 (catch 'return
1880 (mapc (lambda (e)
1881 (when (looking-at (nth 1 (assoc e org-latex-regexps)))
1882 (throw 'return
1883 (match-beginning
1884 (nth 2 (assoc e org-latex-regexps))))))
1885 matchers)
1886 (point))))))))
1889 ;;;; Export Snippet
1891 (defun org-element-export-snippet-parser ()
1892 "Parse export snippet at point.
1894 Return a list whose CAR is `export-snippet' and CDR a plist with
1895 `:begin', `:end', `:back-end', `:value' and `:post-blank' as
1896 keywords.
1898 Assume point is at the beginning of the snippet."
1899 (save-excursion
1900 (looking-at "<\\([-A-Za-z0-9]+\\)@")
1901 (let* ((begin (point))
1902 (back-end (org-match-string-no-properties 1))
1903 (inner-begin (match-end 0))
1904 (inner-end
1905 (let ((count 1))
1906 (goto-char inner-begin)
1907 (while (and (> count 0) (re-search-forward "[<>]" nil t))
1908 (if (equal (match-string 0) "<") (incf count) (decf count)))
1909 (1- (point))))
1910 (value (buffer-substring-no-properties inner-begin inner-end))
1911 (post-blank (skip-chars-forward " \t"))
1912 (end (point)))
1913 `(export-snippet
1914 (:back-end ,back-end
1915 :value ,value
1916 :begin ,begin
1917 :end ,end
1918 :post-blank ,post-blank)))))
1920 (defun org-element-export-snippet-interpreter (export-snippet contents)
1921 "Interpret EXPORT-SNIPPET object as Org syntax.
1922 CONTENTS is nil."
1923 (format "<%s@%s>"
1924 (org-element-property :back-end export-snippet)
1925 (org-element-property :value export-snippet)))
1927 (defun org-element-export-snippet-successor (limit)
1928 "Search for the next export-snippet object.
1930 LIMIT bounds the search.
1932 Return value is a cons cell whose CAR is `export-snippet' CDR is
1933 its beginning position."
1934 (save-excursion
1935 (catch 'exit
1936 (while (re-search-forward "<[-A-Za-z0-9]+@" limit t)
1937 (save-excursion
1938 (let ((beg (match-beginning 0))
1939 (count 1))
1940 (while (re-search-forward "[<>]" limit t)
1941 (if (equal (match-string 0) "<") (incf count) (decf count))
1942 (when (zerop count)
1943 (throw 'exit (cons 'export-snippet beg))))))))))
1946 ;;;; Footnote Reference
1948 (defun org-element-footnote-reference-parser ()
1949 "Parse footnote reference at point.
1951 Return a list whose CAR is `footnote-reference' and CDR a plist
1952 with `:label', `:type', `:inline-definition', `:begin', `:end'
1953 and `:post-blank' as keywords."
1954 (save-excursion
1955 (looking-at org-footnote-re)
1956 (let* ((begin (point))
1957 (label (or (org-match-string-no-properties 2)
1958 (org-match-string-no-properties 3)
1959 (and (match-string 1)
1960 (concat "fn:" (org-match-string-no-properties 1)))))
1961 (type (if (or (not label) (match-string 1)) 'inline 'standard))
1962 (inner-begin (match-end 0))
1963 (inner-end
1964 (let ((count 1))
1965 (forward-char)
1966 (while (and (> count 0) (re-search-forward "[][]" nil t))
1967 (if (equal (match-string 0) "[") (incf count) (decf count)))
1968 (1- (point))))
1969 (post-blank (progn (goto-char (1+ inner-end))
1970 (skip-chars-forward " \t")))
1971 (end (point))
1972 (inline-definition
1973 (and (eq type 'inline)
1974 (org-element-parse-secondary-string
1975 (buffer-substring inner-begin inner-end)
1976 (org-element-restriction 'footnote-reference)))))
1977 `(footnote-reference
1978 (:label ,label
1979 :type ,type
1980 :inline-definition ,inline-definition
1981 :begin ,begin
1982 :end ,end
1983 :post-blank ,post-blank)))))
1985 (defun org-element-footnote-reference-interpreter (footnote-reference contents)
1986 "Interpret FOOTNOTE-REFERENCE object as Org syntax.
1987 CONTENTS is nil."
1988 (let ((label (or (org-element-property :label footnote-reference) "fn:"))
1989 (def
1990 (let ((inline-def
1991 (org-element-property :inline-definition footnote-reference)))
1992 (if (not inline-def) ""
1993 (concat ":" (org-element-interpret-data inline-def))))))
1994 (format "[%s]" (concat label def))))
1996 (defun org-element-footnote-reference-successor (limit)
1997 "Search for the next footnote-reference object.
1999 LIMIT bounds the search.
2001 Return value is a cons cell whose CAR is `footnote-reference' and
2002 CDR is beginning position."
2003 (save-excursion
2004 (catch 'exit
2005 (while (re-search-forward org-footnote-re limit t)
2006 (save-excursion
2007 (let ((beg (match-beginning 0))
2008 (count 1))
2009 (backward-char)
2010 (while (re-search-forward "[][]" limit t)
2011 (if (equal (match-string 0) "[") (incf count) (decf count))
2012 (when (zerop count)
2013 (throw 'exit (cons 'footnote-reference beg))))))))))
2016 ;;;; Inline Babel Call
2018 (defun org-element-inline-babel-call-parser ()
2019 "Parse inline babel call at point.
2021 Return a list whose CAR is `inline-babel-call' and CDR a plist
2022 with `:begin', `:end', `:info' and `:post-blank' as keywords.
2024 Assume point is at the beginning of the babel call."
2025 (save-excursion
2026 (unless (bolp) (backward-char))
2027 (looking-at org-babel-inline-lob-one-liner-regexp)
2028 (let ((info (save-match-data (org-babel-lob-get-info)))
2029 (begin (match-end 1))
2030 (post-blank (progn (goto-char (match-end 0))
2031 (skip-chars-forward " \t")))
2032 (end (point)))
2033 `(inline-babel-call
2034 (:begin ,begin
2035 :end ,end
2036 :info ,info
2037 :post-blank ,post-blank)))))
2039 (defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
2040 "Interpret INLINE-BABEL-CALL object as Org syntax.
2041 CONTENTS is nil."
2042 (let* ((babel-info (org-element-property :info inline-babel-call))
2043 (main-source (car babel-info))
2044 (post-options (nth 1 babel-info)))
2045 (concat "call_"
2046 (if (string-match "\\[\\(\\[.*?\\]\\)\\]" main-source)
2047 ;; Remove redundant square brackets.
2048 (replace-match
2049 (match-string 1 main-source) nil nil main-source)
2050 main-source)
2051 (and post-options (format "[%s]" post-options)))))
2053 (defun org-element-inline-babel-call-successor (limit)
2054 "Search for the next inline-babel-call object.
2056 LIMIT bounds the search.
2058 Return value is a cons cell whose CAR is `inline-babel-call' and
2059 CDR is beginning position."
2060 (save-excursion
2061 ;; Use a simplified version of
2062 ;; org-babel-inline-lob-one-liner-regexp as regexp for more speed.
2063 (when (re-search-forward
2064 "\\(?:babel\\|call\\)_\\([^()\n]+?\\)\\(\\[\\(.*\\)\\]\\|\\(\\)\\)(\\([^\n]*\\))\\(\\[\\(.*?\\)\\]\\)?"
2065 limit t)
2066 (cons 'inline-babel-call (match-beginning 0)))))
2069 ;;;; Inline Src Block
2071 (defun org-element-inline-src-block-parser ()
2072 "Parse inline source block at point.
2074 Return a list whose CAR is `inline-src-block' and CDR a plist
2075 with `:begin', `:end', `:language', `:value', `:parameters' and
2076 `:post-blank' as keywords.
2078 Assume point is at the beginning of the inline src block."
2079 (save-excursion
2080 (unless (bolp) (backward-char))
2081 (looking-at org-babel-inline-src-block-regexp)
2082 (let ((begin (match-beginning 1))
2083 (language (org-match-string-no-properties 2))
2084 (parameters (org-match-string-no-properties 4))
2085 (value (org-match-string-no-properties 5))
2086 (post-blank (progn (goto-char (match-end 0))
2087 (skip-chars-forward " \t")))
2088 (end (point)))
2089 `(inline-src-block
2090 (:language ,language
2091 :value ,value
2092 :parameters ,parameters
2093 :begin ,begin
2094 :end ,end
2095 :post-blank ,post-blank)))))
2097 (defun org-element-inline-src-block-interpreter (inline-src-block contents)
2098 "Interpret INLINE-SRC-BLOCK object as Org syntax.
2099 CONTENTS is nil."
2100 (let ((language (org-element-property :language inline-src-block))
2101 (arguments (org-element-property :parameters inline-src-block))
2102 (body (org-element-property :value inline-src-block)))
2103 (format "src_%s%s{%s}"
2104 language
2105 (if arguments (format "[%s]" arguments) "")
2106 body)))
2108 (defun org-element-inline-src-block-successor (limit)
2109 "Search for the next inline-babel-call element.
2111 LIMIT bounds the search.
2113 Return value is a cons cell whose CAR is `inline-babel-call' and
2114 CDR is beginning position."
2115 (save-excursion
2116 (when (re-search-forward org-babel-inline-src-block-regexp limit t)
2117 (cons 'inline-src-block (match-beginning 1)))))
2119 ;;;; Italic
2121 (defun org-element-italic-parser ()
2122 "Parse italic object at point.
2124 Return a list whose CAR is `italic' and CDR is a plist with
2125 `:begin', `:end', `:contents-begin' and `:contents-end' and
2126 `:post-blank' keywords.
2128 Assume point is at the first slash marker."
2129 (save-excursion
2130 (unless (bolp) (backward-char 1))
2131 (looking-at org-emph-re)
2132 (let ((begin (match-beginning 2))
2133 (contents-begin (match-beginning 4))
2134 (contents-end (match-end 4))
2135 (post-blank (progn (goto-char (match-end 2))
2136 (skip-chars-forward " \t")))
2137 (end (point)))
2138 `(italic
2139 (:begin ,begin
2140 :end ,end
2141 :contents-begin ,contents-begin
2142 :contents-end ,contents-end
2143 :post-blank ,post-blank)))))
2145 (defun org-element-italic-interpreter (italic contents)
2146 "Interpret ITALIC object as Org syntax.
2147 CONTENTS is the contents of the object."
2148 (format "/%s/" contents))
2151 ;;;; Latex Fragment
2153 (defun org-element-latex-fragment-parser ()
2154 "Parse latex fragment at point.
2156 Return a list whose CAR is `latex-fragment' and CDR a plist with
2157 `:value', `:begin', `:end', and `:post-blank' as keywords.
2159 Assume point is at the beginning of the latex fragment."
2160 (save-excursion
2161 (let* ((begin (point))
2162 (substring-match
2163 (catch 'exit
2164 (mapc (lambda (e)
2165 (let ((latex-regexp (nth 1 (assoc e org-latex-regexps))))
2166 (when (or (looking-at latex-regexp)
2167 (and (not (bobp))
2168 (save-excursion
2169 (backward-char)
2170 (looking-at latex-regexp))))
2171 (throw 'exit (nth 2 (assoc e org-latex-regexps))))))
2172 (plist-get org-format-latex-options :matchers))
2173 ;; None found: it's a macro.
2174 (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
2176 (value (match-string-no-properties substring-match))
2177 (post-blank (progn (goto-char (match-end substring-match))
2178 (skip-chars-forward " \t")))
2179 (end (point)))
2180 `(latex-fragment
2181 (:value ,value
2182 :begin ,begin
2183 :end ,end
2184 :post-blank ,post-blank)))))
2186 (defun org-element-latex-fragment-interpreter (latex-fragment contents)
2187 "Interpret LATEX-FRAGMENT object as Org syntax.
2188 CONTENTS is nil."
2189 (org-element-property :value latex-fragment))
2191 ;;;; Line Break
2193 (defun org-element-line-break-parser ()
2194 "Parse line break at point.
2196 Return a list whose CAR is `line-break', and CDR a plist with
2197 `:begin', `:end' and `:post-blank' keywords.
2199 Assume point is at the beginning of the line break."
2200 (let ((begin (point))
2201 (end (save-excursion (forward-line) (point))))
2202 `(line-break (:begin ,begin :end ,end :post-blank 0))))
2204 (defun org-element-line-break-interpreter (line-break contents)
2205 "Interpret LINE-BREAK object as Org syntax.
2206 CONTENTS is nil."
2207 "\\\\\n")
2209 (defun org-element-line-break-successor (limit)
2210 "Search for the next line-break object.
2212 LIMIT bounds the search.
2214 Return value is a cons cell whose CAR is `line-break' and CDR is
2215 beginning position."
2216 (save-excursion
2217 (let ((beg (and (re-search-forward "[^\\\\]\\(\\\\\\\\\\)[ \t]*$" limit t)
2218 (goto-char (match-beginning 1)))))
2219 ;; A line break can only happen on a non-empty line.
2220 (when (and beg (re-search-backward "\\S-" (point-at-bol) t))
2221 (cons 'line-break beg)))))
2224 ;;;; Link
2226 (defun org-element-link-parser ()
2227 "Parse link at point.
2229 Return a list whose CAR is `link' and CDR a plist with `:type',
2230 `:path', `:raw-link', `:begin', `:end', `:contents-begin',
2231 `:contents-end' and `:post-blank' as keywords.
2233 Assume point is at the beginning of the link."
2234 (save-excursion
2235 (let ((begin (point))
2236 end contents-begin contents-end link-end post-blank path type
2237 raw-link link)
2238 (cond
2239 ;; Type 1: Text targeted from a radio target.
2240 ((and org-target-link-regexp (looking-at org-target-link-regexp))
2241 (setq type "radio"
2242 link-end (match-end 0)
2243 path (org-match-string-no-properties 0)))
2244 ;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
2245 ((looking-at org-bracket-link-regexp)
2246 (setq contents-begin (match-beginning 3)
2247 contents-end (match-end 3)
2248 link-end (match-end 0)
2249 ;; RAW-LINK is the original link.
2250 raw-link (org-match-string-no-properties 1)
2251 link (org-translate-link
2252 (org-link-expand-abbrev
2253 (org-link-unescape raw-link))))
2254 ;; Determine TYPE of link and set PATH accordingly.
2255 (cond
2256 ;; File type.
2257 ((or (file-name-absolute-p link) (string-match "^\\.\\.?/" link))
2258 (setq type "file" path link))
2259 ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
2260 ((string-match org-link-re-with-space3 link)
2261 (setq type (match-string 1 link) path (match-string 2 link)))
2262 ;; Id type: PATH is the id.
2263 ((string-match "^id:\\([-a-f0-9]+\\)" link)
2264 (setq type "id" path (match-string 1 link)))
2265 ;; Code-ref type: PATH is the name of the reference.
2266 ((string-match "^(\\(.*\\))$" link)
2267 (setq type "coderef" path (match-string 1 link)))
2268 ;; Custom-id type: PATH is the name of the custom id.
2269 ((= (aref link 0) ?#)
2270 (setq type "custom-id" path (substring link 1)))
2271 ;; Fuzzy type: Internal link either matches a target, an
2272 ;; headline name or nothing. PATH is the target or
2273 ;; headline's name.
2274 (t (setq type "fuzzy" path link))))
2275 ;; Type 3: Plain link, i.e. http://orgmode.org
2276 ((looking-at org-plain-link-re)
2277 (setq raw-link (org-match-string-no-properties 0)
2278 type (org-match-string-no-properties 1)
2279 path (org-match-string-no-properties 2)
2280 link-end (match-end 0)))
2281 ;; Type 4: Angular link, i.e. <http://orgmode.org>
2282 ((looking-at org-angle-link-re)
2283 (setq raw-link (buffer-substring-no-properties
2284 (match-beginning 1) (match-end 2))
2285 type (org-match-string-no-properties 1)
2286 path (org-match-string-no-properties 2)
2287 link-end (match-end 0))))
2288 ;; In any case, deduce end point after trailing white space from
2289 ;; LINK-END variable.
2290 (setq post-blank (progn (goto-char link-end) (skip-chars-forward " \t"))
2291 end (point))
2292 `(link
2293 (:type ,type
2294 :path ,path
2295 :raw-link ,(or raw-link path)
2296 :begin ,begin
2297 :end ,end
2298 :contents-begin ,contents-begin
2299 :contents-end ,contents-end
2300 :post-blank ,post-blank)))))
2302 (defun org-element-link-interpreter (link contents)
2303 "Interpret LINK object as Org syntax.
2304 CONTENTS is the contents of the object, or nil."
2305 (let ((type (org-element-property :type link))
2306 (raw-link (org-element-property :raw-link link)))
2307 (if (string= type "radio") raw-link
2308 (format "[[%s]%s]"
2309 raw-link
2310 (if contents (format "[%s]" contents) "")))))
2312 (defun org-element-link-successor (limit)
2313 "Search for the next link object.
2315 LIMIT bounds the search.
2317 Return value is a cons cell whose CAR is `link' and CDR is
2318 beginning position."
2319 (save-excursion
2320 (let ((link-regexp
2321 (if (not org-target-link-regexp) org-any-link-re
2322 (concat org-any-link-re "\\|" org-target-link-regexp))))
2323 (when (re-search-forward link-regexp limit t)
2324 (cons 'link (match-beginning 0))))))
2327 ;;;; Macro
2329 (defun org-element-macro-parser ()
2330 "Parse macro at point.
2332 Return a list whose CAR is `macro' and CDR a plist with `:key',
2333 `:args', `:begin', `:end', `:value' and `:post-blank' as
2334 keywords.
2336 Assume point is at the macro."
2337 (save-excursion
2338 (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
2339 (let ((begin (point))
2340 (key (downcase (org-match-string-no-properties 1)))
2341 (value (org-match-string-no-properties 0))
2342 (post-blank (progn (goto-char (match-end 0))
2343 (skip-chars-forward " \t")))
2344 (end (point))
2345 (args (let ((args (org-match-string-no-properties 3)) args2)
2346 (when args
2347 (setq args (org-split-string args ","))
2348 (while args
2349 (while (string-match "\\\\\\'" (car args))
2350 ;; Repair bad splits.
2351 (setcar (cdr args) (concat (substring (car args) 0 -1)
2352 "," (nth 1 args)))
2353 (pop args))
2354 (push (pop args) args2))
2355 (mapcar 'org-trim (nreverse args2))))))
2356 `(macro
2357 (:key ,key
2358 :value ,value
2359 :args ,args
2360 :begin ,begin
2361 :end ,end
2362 :post-blank ,post-blank)))))
2364 (defun org-element-macro-interpreter (macro contents)
2365 "Interpret MACRO object as Org syntax.
2366 CONTENTS is nil."
2367 (org-element-property :value macro))
2369 (defun org-element-macro-successor (limit)
2370 "Search for the next macro object.
2372 LIMIT bounds the search.
2374 Return value is cons cell whose CAR is `macro' and CDR is
2375 beginning position."
2376 (save-excursion
2377 (when (re-search-forward
2378 "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}"
2379 limit t)
2380 (cons 'macro (match-beginning 0)))))
2383 ;;;; Radio-target
2385 (defun org-element-radio-target-parser ()
2386 "Parse radio target at point.
2388 Return a list whose CAR is `radio-target' and CDR a plist with
2389 `:begin', `:end', `:contents-begin', `:contents-end', `:value'
2390 and `:post-blank' as keywords.
2392 Assume point is at the radio target."
2393 (save-excursion
2394 (looking-at org-radio-target-regexp)
2395 (let ((begin (point))
2396 (contents-begin (match-beginning 1))
2397 (contents-end (match-end 1))
2398 (value (org-match-string-no-properties 1))
2399 (post-blank (progn (goto-char (match-end 0))
2400 (skip-chars-forward " \t")))
2401 (end (point)))
2402 `(radio-target
2403 (:begin ,begin
2404 :end ,end
2405 :contents-begin ,contents-begin
2406 :contents-end ,contents-end
2407 :post-blank ,post-blank
2408 :value ,value)))))
2410 (defun org-element-radio-target-interpreter (target contents)
2411 "Interpret TARGET object as Org syntax.
2412 CONTENTS is the contents of the object."
2413 (concat "<<<" contents ">>>"))
2415 (defun org-element-radio-target-successor (limit)
2416 "Search for the next radio-target object.
2418 LIMIT bounds the search.
2420 Return value is a cons cell whose CAR is `radio-target' and CDR
2421 is beginning position."
2422 (save-excursion
2423 (when (re-search-forward org-radio-target-regexp limit t)
2424 (cons 'radio-target (match-beginning 0)))))
2427 ;;;; Statistics Cookie
2429 (defun org-element-statistics-cookie-parser ()
2430 "Parse statistics cookie at point.
2432 Return a list whose CAR is `statistics-cookie', and CDR a plist
2433 with `:begin', `:end', `:value' and `:post-blank' keywords.
2435 Assume point is at the beginning of the statistics-cookie."
2436 (save-excursion
2437 (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
2438 (let* ((begin (point))
2439 (value (buffer-substring-no-properties
2440 (match-beginning 0) (match-end 0)))
2441 (post-blank (progn (goto-char (match-end 0))
2442 (skip-chars-forward " \t")))
2443 (end (point)))
2444 `(statistics-cookie
2445 (:begin ,begin
2446 :end ,end
2447 :value ,value
2448 :post-blank ,post-blank)))))
2450 (defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
2451 "Interpret STATISTICS-COOKIE object as Org syntax.
2452 CONTENTS is nil."
2453 (org-element-property :value statistics-cookie))
2455 (defun org-element-statistics-cookie-successor (limit)
2456 "Search for the next statistics cookie object.
2458 LIMIT bounds the search.
2460 Return value is a cons cell whose CAR is `statistics-cookie' and
2461 CDR is beginning position."
2462 (save-excursion
2463 (when (re-search-forward "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]" limit t)
2464 (cons 'statistics-cookie (match-beginning 0)))))
2467 ;;;; Strike-Through
2469 (defun org-element-strike-through-parser ()
2470 "Parse strike-through object at point.
2472 Return a list whose CAR is `strike-through' and CDR is a plist
2473 with `:begin', `:end', `:contents-begin' and `:contents-end' and
2474 `:post-blank' keywords.
2476 Assume point is at the first plus sign marker."
2477 (save-excursion
2478 (unless (bolp) (backward-char 1))
2479 (looking-at org-emph-re)
2480 (let ((begin (match-beginning 2))
2481 (contents-begin (match-beginning 4))
2482 (contents-end (match-end 4))
2483 (post-blank (progn (goto-char (match-end 2))
2484 (skip-chars-forward " \t")))
2485 (end (point)))
2486 `(strike-through
2487 (:begin ,begin
2488 :end ,end
2489 :contents-begin ,contents-begin
2490 :contents-end ,contents-end
2491 :post-blank ,post-blank)))))
2493 (defun org-element-strike-through-interpreter (strike-through contents)
2494 "Interpret STRIKE-THROUGH object as Org syntax.
2495 CONTENTS is the contents of the object."
2496 (format "+%s+" contents))
2499 ;;;; Subscript
2501 (defun org-element-subscript-parser ()
2502 "Parse subscript at point.
2504 Return a list whose CAR is `subscript' and CDR a plist with
2505 `:begin', `:end', `:contents-begin', `:contents-end',
2506 `:use-brackets-p' and `:post-blank' as keywords.
2508 Assume point is at the underscore."
2509 (save-excursion
2510 (unless (bolp) (backward-char))
2511 (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp)
2513 (not (looking-at org-match-substring-regexp))))
2514 (begin (match-beginning 2))
2515 (contents-begin (or (match-beginning 5)
2516 (match-beginning 3)))
2517 (contents-end (or (match-end 5) (match-end 3)))
2518 (post-blank (progn (goto-char (match-end 0))
2519 (skip-chars-forward " \t")))
2520 (end (point)))
2521 `(subscript
2522 (:begin ,begin
2523 :end ,end
2524 :use-brackets-p ,bracketsp
2525 :contents-begin ,contents-begin
2526 :contents-end ,contents-end
2527 :post-blank ,post-blank)))))
2529 (defun org-element-subscript-interpreter (subscript contents)
2530 "Interpret SUBSCRIPT object as Org syntax.
2531 CONTENTS is the contents of the object."
2532 (format
2533 (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s")
2534 contents))
2536 (defun org-element-sub/superscript-successor (limit)
2537 "Search for the next sub/superscript object.
2539 LIMIT bounds the search.
2541 Return value is a cons cell whose CAR is either `subscript' or
2542 `superscript' and CDR is beginning position."
2543 (save-excursion
2544 (when (re-search-forward org-match-substring-regexp limit t)
2545 (cons (if (string= (match-string 2) "_") 'subscript 'superscript)
2546 (match-beginning 2)))))
2549 ;;;; Superscript
2551 (defun org-element-superscript-parser ()
2552 "Parse superscript at point.
2554 Return a list whose CAR is `superscript' and CDR a plist with
2555 `:begin', `:end', `:contents-begin', `:contents-end',
2556 `:use-brackets-p' and `:post-blank' as keywords.
2558 Assume point is at the caret."
2559 (save-excursion
2560 (unless (bolp) (backward-char))
2561 (let ((bracketsp (if (looking-at org-match-substring-with-braces-regexp) t
2562 (not (looking-at org-match-substring-regexp))))
2563 (begin (match-beginning 2))
2564 (contents-begin (or (match-beginning 5)
2565 (match-beginning 3)))
2566 (contents-end (or (match-end 5) (match-end 3)))
2567 (post-blank (progn (goto-char (match-end 0))
2568 (skip-chars-forward " \t")))
2569 (end (point)))
2570 `(superscript
2571 (:begin ,begin
2572 :end ,end
2573 :use-brackets-p ,bracketsp
2574 :contents-begin ,contents-begin
2575 :contents-end ,contents-end
2576 :post-blank ,post-blank)))))
2578 (defun org-element-superscript-interpreter (superscript contents)
2579 "Interpret SUPERSCRIPT object as Org syntax.
2580 CONTENTS is the contents of the object."
2581 (format
2582 (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s")
2583 contents))
2586 ;;;; Table Cell
2588 (defun org-element-table-cell-parser ()
2589 "Parse table cell at point.
2591 Return a list whose CAR is `table-cell' and CDR is a plist
2592 containing `:begin', `:end', `:contents-begin', `:contents-end'
2593 and `:post-blank' keywords."
2594 (looking-at "[ \t]*\\(.*?\\)[ \t]*|")
2595 (let* ((begin (match-beginning 0))
2596 (end (match-end 0))
2597 (contents-begin (match-beginning 1))
2598 (contents-end (match-end 1)))
2599 `(table-cell
2600 (:begin ,begin
2601 :end ,end
2602 :contents-begin ,contents-begin
2603 :contents-end ,contents-end
2604 :post-blank 0))))
2606 (defun org-element-table-cell-interpreter (table-cell contents)
2607 "Interpret TABLE-CELL element as Org syntax.
2608 CONTENTS is the contents of the cell, or nil."
2609 (concat " " contents " |"))
2611 (defun org-element-table-cell-successor (limit)
2612 "Search for the next table-cell object.
2614 LIMIT bounds the search.
2616 Return value is a cons cell whose CAR is `table-cell' and CDR is
2617 beginning position."
2618 (when (looking-at "[ \t]*.*?[ \t]+|") (cons 'table-cell (point))))
2621 ;;;; Target
2623 (defun org-element-target-parser ()
2624 "Parse target at point.
2626 Return a list whose CAR is `target' and CDR a plist with
2627 `:begin', `:end', `:value' and `:post-blank' as keywords.
2629 Assume point is at the target."
2630 (save-excursion
2631 (looking-at org-target-regexp)
2632 (let ((begin (point))
2633 (value (org-match-string-no-properties 1))
2634 (post-blank (progn (goto-char (match-end 0))
2635 (skip-chars-forward " \t")))
2636 (end (point)))
2637 `(target
2638 (:begin ,begin
2639 :end ,end
2640 :value ,value
2641 :post-blank ,post-blank)))))
2643 (defun org-element-target-interpreter (target contents)
2644 "Interpret TARGET object as Org syntax.
2645 CONTENTS is nil."
2646 (format "<<%s>>" (org-element-property :value target)))
2648 (defun org-element-target-successor (limit)
2649 "Search for the next target object.
2651 LIMIT bounds the search.
2653 Return value is a cons cell whose CAR is `target' and CDR is
2654 beginning position."
2655 (save-excursion
2656 (when (re-search-forward org-target-regexp limit t)
2657 (cons 'target (match-beginning 0)))))
2660 ;;;; Timestamp
2662 (defun org-element-timestamp-parser ()
2663 "Parse time stamp at point.
2665 Return a list whose CAR is `timestamp', and CDR a plist with
2666 `:type', `:begin', `:end', `:value' and `:post-blank' keywords.
2668 Assume point is at the beginning of the timestamp."
2669 (save-excursion
2670 (let* ((begin (point))
2671 (type (cond
2672 ((looking-at org-tsr-regexp)
2673 (if (match-string 2) 'active-range 'active))
2674 ((looking-at org-tsr-regexp-both)
2675 (if (match-string 2) 'inactive-range 'inactive))
2676 ((looking-at
2677 (concat
2678 "\\(<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
2679 "\\|"
2680 "\\(<%%\\(([^>\n]+)\\)>\\)"))
2681 'diary)))
2682 (value (org-match-string-no-properties 0))
2683 (post-blank (progn (goto-char (match-end 0))
2684 (skip-chars-forward " \t")))
2685 (end (point)))
2686 `(timestamp
2687 (:type ,type
2688 :value ,value
2689 :begin ,begin
2690 :end ,end
2691 :post-blank ,post-blank)))))
2693 (defun org-element-timestamp-interpreter (timestamp contents)
2694 "Interpret TIMESTAMP object as Org syntax.
2695 CONTENTS is nil."
2696 (org-element-property :value timestamp))
2698 (defun org-element-timestamp-successor (limit)
2699 "Search for the next timestamp object.
2701 LIMIT bounds the search.
2703 Return value is a cons cell whose CAR is `timestamp' and CDR is
2704 beginning position."
2705 (save-excursion
2706 (when (re-search-forward
2707 (concat org-ts-regexp-both
2708 "\\|"
2709 "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)"
2710 "\\|"
2711 "\\(?:<%%\\(?:([^>\n]+)\\)>\\)")
2712 limit t)
2713 (cons 'timestamp (match-beginning 0)))))
2716 ;;;; Underline
2718 (defun org-element-underline-parser ()
2719 "Parse underline object at point.
2721 Return a list whose CAR is `underline' and CDR is a plist with
2722 `:begin', `:end', `:contents-begin' and `:contents-end' and
2723 `:post-blank' keywords.
2725 Assume point is at the first underscore marker."
2726 (save-excursion
2727 (unless (bolp) (backward-char 1))
2728 (looking-at org-emph-re)
2729 (let ((begin (match-beginning 2))
2730 (contents-begin (match-beginning 4))
2731 (contents-end (match-end 4))
2732 (post-blank (progn (goto-char (match-end 2))
2733 (skip-chars-forward " \t")))
2734 (end (point)))
2735 `(underline
2736 (:begin ,begin
2737 :end ,end
2738 :contents-begin ,contents-begin
2739 :contents-end ,contents-end
2740 :post-blank ,post-blank)))))
2742 (defun org-element-underline-interpreter (underline contents)
2743 "Interpret UNDERLINE object as Org syntax.
2744 CONTENTS is the contents of the object."
2745 (format "_%s_" contents))
2748 ;;;; Verbatim
2750 (defun org-element-verbatim-parser ()
2751 "Parse verbatim object at point.
2753 Return a list whose CAR is `verbatim' and CDR is a plist with
2754 `:value', `:begin', `:end' and `:post-blank' keywords.
2756 Assume point is at the first equal sign marker."
2757 (save-excursion
2758 (unless (bolp) (backward-char 1))
2759 (looking-at org-emph-re)
2760 (let ((begin (match-beginning 2))
2761 (value (org-match-string-no-properties 4))
2762 (post-blank (progn (goto-char (match-end 2))
2763 (skip-chars-forward " \t")))
2764 (end (point)))
2765 `(verbatim
2766 (:value ,value
2767 :begin ,begin
2768 :end ,end
2769 :post-blank ,post-blank)))))
2771 (defun org-element-verbatim-interpreter (verbatim contents)
2772 "Interpret VERBATIM object as Org syntax.
2773 CONTENTS is nil."
2774 (format "=%s=" (org-element-property :value verbatim)))
2778 ;;; Definitions And Rules
2780 ;; Define elements, greater elements and specify recursive objects,
2781 ;; along with the affiliated keywords recognized. Also set up
2782 ;; restrictions on recursive objects combinations.
2784 ;; These variables really act as a control center for the parsing
2785 ;; process.
2786 (defconst org-element-paragraph-separate
2787 (concat "\f" "\\|" "^[ \t]*$" "\\|"
2788 ;; Headlines and inlinetasks.
2789 org-outline-regexp-bol "\\|"
2790 ;; Comments, blocks (any type), keywords and babel calls.
2791 "^[ \t]*#\\+" "\\|" "^#\\(?: \\|$\\)" "\\|"
2792 ;; Lists.
2793 (org-item-beginning-re) "\\|"
2794 ;; Fixed-width, drawers (any type) and tables.
2795 "^[ \t]*[:|]" "\\|"
2796 ;; Footnote definitions.
2797 org-footnote-definition-re "\\|"
2798 ;; Horizontal rules.
2799 "^[ \t]*-\\{5,\\}[ \t]*$" "\\|"
2800 ;; LaTeX environments.
2801 "^[ \t]*\\\\\\(begin\\|end\\)"
2802 ;; Planning and Clock lines.
2803 "^[ \t]*\\(?:"
2804 org-clock-string "\\|"
2805 org-closed-string "\\|"
2806 org-deadline-string "\\|"
2807 org-scheduled-string "\\)")
2808 "Regexp to separate paragraphs in an Org buffer.")
2810 (defconst org-element-all-elements
2811 '(center-block clock comment comment-block drawer dynamic-block example-block
2812 export-block fixed-width footnote-definition headline
2813 horizontal-rule inlinetask item keyword latex-environment
2814 babel-call paragraph plain-list planning property-drawer
2815 quote-block quote-section section special-block src-block table
2816 table-row verse-block)
2817 "Complete list of element types.")
2819 (defconst org-element-greater-elements
2820 '(center-block drawer dynamic-block footnote-definition headline inlinetask
2821 item plain-list quote-block section special-block table)
2822 "List of recursive element types aka Greater Elements.")
2824 (defconst org-element-all-successors
2825 '(export-snippet footnote-reference inline-babel-call inline-src-block
2826 latex-or-entity line-break link macro radio-target
2827 statistics-cookie sub/superscript table-cell target
2828 text-markup timestamp)
2829 "Complete list of successors.")
2831 (defconst org-element-object-successor-alist
2832 '((subscript . sub/superscript) (superscript . sub/superscript)
2833 (bold . text-markup) (code . text-markup) (italic . text-markup)
2834 (strike-through . text-markup) (underline . text-markup)
2835 (verbatim . text-markup) (entity . latex-or-entity)
2836 (latex-fragment . latex-or-entity))
2837 "Alist of translations between object type and successor name.
2839 Sharing the same successor comes handy when, for example, the
2840 regexp matching one object can also match the other object.")
2842 (defconst org-element-all-objects
2843 '(bold code entity export-snippet footnote-reference inline-babel-call
2844 inline-src-block italic line-break latex-fragment link macro
2845 radio-target statistics-cookie strike-through subscript superscript
2846 table-cell target timestamp underline verbatim)
2847 "Complete list of object types.")
2849 (defconst org-element-recursive-objects
2850 '(bold italic link macro subscript radio-target strike-through superscript
2851 table-cell underline)
2852 "List of recursive object types.")
2854 (defconst org-element-non-recursive-block-alist
2855 '(("ASCII" . export-block)
2856 ("COMMENT" . comment-block)
2857 ("DOCBOOK" . export-block)
2858 ("EXAMPLE" . example-block)
2859 ("HTML" . export-block)
2860 ("LATEX" . export-block)
2861 ("ODT" . export-block)
2862 ("SRC" . src-block)
2863 ("VERSE" . verse-block))
2864 "Alist between non-recursive block name and their element type.")
2866 (defconst org-element-affiliated-keywords
2867 '("ATTR_ASCII" "ATTR_DOCBOOK" "ATTR_HTML" "ATTR_LATEX" "ATTR_ODT" "CAPTION"
2868 "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" "RESULTS"
2869 "SOURCE" "SRCNAME" "TBLNAME")
2870 "List of affiliated keywords as strings.")
2872 (defconst org-element-keyword-translation-alist
2873 '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME")
2874 ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME")
2875 ("RESULT" . "RESULTS") ("HEADERS" . "HEADER"))
2876 "Alist of usual translations for keywords.
2877 The key is the old name and the value the new one. The property
2878 holding their value will be named after the translated name.")
2880 (defconst org-element-multiple-keywords
2881 '("ATTR_ASCII" "ATTR_DOCBOOK" "ATTR_HTML" "ATTR_LATEX" "ATTR_ODT" "HEADER")
2882 "List of affiliated keywords that can occur more that once in an element.
2884 Their value will be consed into a list of strings, which will be
2885 returned as the value of the property.
2887 This list is checked after translations have been applied. See
2888 `org-element-keyword-translation-alist'.")
2890 (defconst org-element-parsed-keywords '("AUTHOR" "CAPTION" "TITLE")
2891 "List of keywords whose value can be parsed.
2893 Their value will be stored as a secondary string: a list of
2894 strings and objects.
2896 This list is checked after translations have been applied. See
2897 `org-element-keyword-translation-alist'.")
2899 (defconst org-element-dual-keywords '("CAPTION" "RESULTS")
2900 "List of keywords which can have a secondary value.
2902 In Org syntax, they can be written with optional square brackets
2903 before the colons. For example, results keyword can be
2904 associated to a hash value with the following:
2906 #+RESULTS[hash-string]: some-source
2908 This list is checked after translations have been applied. See
2909 `org-element-keyword-translation-alist'.")
2911 (defconst org-element-object-restrictions
2912 `((bold entity export-snippet inline-babel-call inline-src-block link
2913 radio-target sub/superscript target text-markup timestamp)
2914 (footnote-reference entity export-snippet footnote-reference
2915 inline-babel-call inline-src-block latex-fragment
2916 line-break link macro radio-target sub/superscript
2917 target text-markup timestamp)
2918 (headline entity inline-babel-call inline-src-block latex-fragment link
2919 macro radio-target statistics-cookie sub/superscript text-markup
2920 timestamp)
2921 (inlinetask entity inline-babel-call inline-src-block latex-fragment link
2922 macro radio-target sub/superscript text-markup timestamp)
2923 (italic entity export-snippet inline-babel-call inline-src-block link
2924 radio-target sub/superscript target text-markup timestamp)
2925 (item entity inline-babel-call latex-fragment macro radio-target
2926 sub/superscript target text-markup)
2927 (keyword entity latex-fragment macro sub/superscript text-markup)
2928 (link entity export-snippet inline-babel-call inline-src-block
2929 latex-fragment link sub/superscript text-markup)
2930 (macro macro)
2931 (paragraph ,@org-element-all-successors)
2932 (radio-target entity export-snippet latex-fragment sub/superscript)
2933 (strike-through entity export-snippet inline-babel-call inline-src-block
2934 link radio-target sub/superscript target text-markup
2935 timestamp)
2936 (subscript entity export-snippet inline-babel-call inline-src-block
2937 latex-fragment sub/superscript text-markup)
2938 (superscript entity export-snippet inline-babel-call inline-src-block
2939 latex-fragment sub/superscript text-markup)
2940 (table-cell entity export-snippet latex-fragment link macro radio-target
2941 sub/superscript target text-markup timestamp)
2942 (table-row table-cell)
2943 (underline entity export-snippet inline-babel-call inline-src-block link
2944 radio-target sub/superscript target text-markup timestamp)
2945 (verse-block entity footnote-reference inline-babel-call inline-src-block
2946 latex-fragment line-break link macro radio-target
2947 sub/superscript target text-markup timestamp))
2948 "Alist of objects restrictions.
2950 CAR is an element or object type containing objects and CDR is
2951 a list of successors that will be called within an element or
2952 object of such type.
2954 For example, in a `radio-target' object, one can only find
2955 entities, export snippets, latex-fragments, subscript and
2956 superscript.
2958 This alist also applies to secondary string. For example, an
2959 `headline' type element doesn't directly contain objects, but
2960 still has an entry since one of its properties (`:title') does.")
2962 (defconst org-element-secondary-value-alist
2963 '((headline . :title)
2964 (inlinetask . :title)
2965 (item . :tag)
2966 (footnote-reference . :inline-definition))
2967 "Alist between element types and location of secondary value.")
2971 ;;; Accessors
2973 ;; Provide four accessors: `org-element-type', `org-element-property'
2974 ;; `org-element-contents' and `org-element-restriction'.
2976 (defun org-element-type (element)
2977 "Return type of element ELEMENT.
2979 The function returns the type of the element or object provided.
2980 It can also return the following special value:
2981 `plain-text' for a string
2982 `org-data' for a complete document
2983 nil in any other case."
2984 (cond
2985 ((not (consp element)) (and (stringp element) 'plain-text))
2986 ((symbolp (car element)) (car element))))
2988 (defun org-element-property (property element)
2989 "Extract the value from the PROPERTY of an ELEMENT."
2990 (plist-get (nth 1 element) property))
2992 (defun org-element-contents (element)
2993 "Extract contents from an ELEMENT."
2994 (and (consp element) (nthcdr 2 element)))
2996 (defun org-element-restriction (element)
2997 "Return restriction associated to ELEMENT.
2998 ELEMENT can be an element, an object or a symbol representing an
2999 element or object type."
3000 (cdr (assq (if (symbolp element) element (org-element-type element))
3001 org-element-object-restrictions)))
3005 ;;; Parsing Element Starting At Point
3007 ;; `org-element-current-element' is the core function of this section.
3008 ;; It returns the Lisp representation of the element starting at
3009 ;; point. It uses `org-element--element-block-re' for quick access to
3010 ;; a common regexp.
3012 ;; `org-element-current-element' makes use of special modes. They are
3013 ;; activated for fixed element chaining (i.e. `plain-list' > `item')
3014 ;; or fixed conditional element chaining (i.e. `headline' >
3015 ;; `section'). Special modes are: `section', `quote-section', `item'
3016 ;; and `table-row'.
3018 (defconst org-element--element-block-re
3019 (format "[ \t]*#\\+BEGIN_\\(%s\\)\\(?: \\|$\\)"
3020 (mapconcat
3021 'regexp-quote
3022 (mapcar 'car org-element-non-recursive-block-alist) "\\|"))
3023 "Regexp matching the beginning of a non-recursive block type.
3024 Used internally by `org-element-current-element'.")
3026 (defun org-element-current-element (&optional granularity special structure)
3027 "Parse the element starting at point.
3029 Return value is a list like (TYPE PROPS) where TYPE is the type
3030 of the element and PROPS a plist of properties associated to the
3031 element.
3033 Possible types are defined in `org-element-all-elements'.
3035 Optional argument GRANULARITY determines the depth of the
3036 recursion. Allowed values are `headline', `greater-element',
3037 `element', `object' or nil. When it is broader than `object' (or
3038 nil), secondary values will not be parsed, since they only
3039 contain objects.
3041 Optional argument SPECIAL, when non-nil, can be either `section',
3042 `quote-section', `table-row' and `item'.
3044 If STRUCTURE isn't provided but SPECIAL is set to `item', it will
3045 be computed.
3047 Unlike to `org-element-at-point', this function assumes point is
3048 always at the beginning of the element it has to parse. As such,
3049 it is quicker than its counterpart, albeit more restrictive."
3050 (save-excursion
3051 ;; If point is at an affiliated keyword, try moving to the
3052 ;; beginning of the associated element. If none is found, the
3053 ;; keyword is orphaned and will be treated as plain text.
3054 (when (looking-at org-element--affiliated-re)
3055 (let ((opoint (point)))
3056 (while (looking-at org-element--affiliated-re) (forward-line))
3057 (when (looking-at "[ \t]*$") (goto-char opoint))))
3058 (let ((case-fold-search t)
3059 ;; Determine if parsing depth allows for secondary strings
3060 ;; parsing. It only applies to elements referenced in
3061 ;; `org-element-secondary-value-alist'.
3062 (raw-secondary-p (and granularity (not (eq granularity 'object)))))
3063 (cond
3064 ;; Item
3065 ((eq special 'item)
3066 (org-element-item-parser (or structure (org-list-struct))
3067 raw-secondary-p))
3068 ;; Quote Section.
3069 ((eq special 'quote-section) (org-element-quote-section-parser))
3070 ;; Table Row.
3071 ((eq special 'table-row) (org-element-table-row-parser))
3072 ;; Headline.
3073 ((org-with-limited-levels (org-at-heading-p))
3074 (org-element-headline-parser raw-secondary-p))
3075 ;; Section (must be checked after headline).
3076 ((eq special 'section) (org-element-section-parser))
3077 ;; Planning and Clock.
3078 ((and (looking-at org-planning-or-clock-line-re))
3079 (if (equal (match-string 1) org-clock-string)
3080 (org-element-clock-parser)
3081 (org-element-planning-parser)))
3082 ;; Non-recursive block.
3083 ((when (looking-at org-element--element-block-re)
3084 (let ((type (upcase (match-string 1))))
3085 (if (save-excursion
3086 (re-search-forward
3087 (format "^[ \t]*#\\+END_%s\\(?: \\|$\\)" type) nil t))
3088 (funcall
3089 (intern
3090 (format
3091 "org-element-%s-parser"
3092 (cdr (assoc type org-element-non-recursive-block-alist)))))
3093 (org-element-paragraph-parser)))))
3094 ;; Inlinetask.
3095 ((org-at-heading-p) (org-element-inlinetask-parser raw-secondary-p))
3096 ;; LaTeX Environment or Paragraph if incomplete.
3097 ((looking-at "[ \t]*\\\\begin{")
3098 (if (save-excursion
3099 (re-search-forward "[ \t]*\\\\end{[^}]*}[ \t]*" nil t))
3100 (org-element-latex-environment-parser)
3101 (org-element-paragraph-parser)))
3102 ;; Property Drawer.
3103 ((looking-at org-property-start-re)
3104 (if (save-excursion (re-search-forward org-property-end-re nil t))
3105 (org-element-property-drawer-parser)
3106 (org-element-paragraph-parser)))
3107 ;; Recursive Block, or Paragraph if incomplete.
3108 ((looking-at "[ \t]*#\\+BEGIN_\\([-A-Za-z0-9]+\\)\\(?: \\|$\\)")
3109 (let ((type (upcase (match-string 1))))
3110 (cond
3111 ((not (save-excursion
3112 (re-search-forward
3113 (format "^[ \t]*#\\+END_%s\\(?: \\|$\\)" type) nil t)))
3114 (org-element-paragraph-parser))
3115 ((string= type "CENTER") (org-element-center-block-parser))
3116 ((string= type "QUOTE") (org-element-quote-block-parser))
3117 (t (org-element-special-block-parser)))))
3118 ;; Drawer.
3119 ((looking-at org-drawer-regexp)
3120 (if (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" nil t))
3121 (org-element-drawer-parser)
3122 (org-element-paragraph-parser)))
3123 ((looking-at "[ \t]*:\\( \\|$\\)") (org-element-fixed-width-parser))
3124 ;; Babel Call.
3125 ((looking-at org-babel-block-lob-one-liner-regexp)
3126 (org-element-babel-call-parser))
3127 ;; Dynamic Block or Paragraph if incomplete. This must be
3128 ;; checked before regular keywords since their regexp matches
3129 ;; dynamic blocks too.
3130 ((looking-at "[ \t]*#\\+BEGIN:\\(?: \\|$\\)")
3131 (if (save-excursion
3132 (re-search-forward "^[ \t]*#\\+END:\\(?: \\|$\\)" nil t))
3133 (org-element-dynamic-block-parser)
3134 (org-element-paragraph-parser)))
3135 ;; Keyword, or Paragraph if at an orphaned affiliated keyword.
3136 ((looking-at "[ \t]*#\\+\\([a-z]+\\(:?_[a-z]+\\)*\\):")
3137 (let ((key (upcase (match-string 1))))
3138 (if (or (string= key "TBLFM")
3139 (member key org-element-affiliated-keywords))
3140 (org-element-paragraph-parser)
3141 (org-element-keyword-parser))))
3142 ;; Footnote definition.
3143 ((looking-at org-footnote-definition-re)
3144 (org-element-footnote-definition-parser))
3145 ;; Comment.
3146 ((looking-at "\\(#\\|[ \t]*#\\+\\(?: \\|$\\)\\)")
3147 (org-element-comment-parser))
3148 ;; Horizontal Rule.
3149 ((looking-at "[ \t]*-\\{5,\\}[ \t]*$")
3150 (org-element-horizontal-rule-parser))
3151 ;; Table.
3152 ((org-at-table-p t) (org-element-table-parser))
3153 ;; List or Item.
3154 ((looking-at (org-item-re))
3155 (org-element-plain-list-parser (or structure (org-list-struct))))
3156 ;; Default element: Paragraph.
3157 (t (org-element-paragraph-parser))))))
3160 ;; Most elements can have affiliated keywords. When looking for an
3161 ;; element beginning, we want to move before them, as they belong to
3162 ;; that element, and, in the meantime, collect information they give
3163 ;; into appropriate properties. Hence the following function.
3165 ;; Usage of optional arguments may not be obvious at first glance:
3167 ;; - TRANS-LIST is used to polish keywords names that have evolved
3168 ;; during Org history. In example, even though =result= and
3169 ;; =results= coexist, we want to have them under the same =result=
3170 ;; property. It's also true for "srcname" and "name", where the
3171 ;; latter seems to be preferred nowadays (thus the "name" property).
3173 ;; - CONSED allows to regroup multi-lines keywords under the same
3174 ;; property, while preserving their own identity. This is mostly
3175 ;; used for "attr_latex" and al.
3177 ;; - PARSED prepares a keyword value for export. This is useful for
3178 ;; "caption". Objects restrictions for such keywords are defined in
3179 ;; `org-element-object-restrictions'.
3181 ;; - DUALS is used to take care of keywords accepting a main and an
3182 ;; optional secondary values. For example "results" has its
3183 ;; source's name as the main value, and may have an hash string in
3184 ;; optional square brackets as the secondary one.
3186 ;; A keyword may belong to more than one category.
3188 (defconst org-element--affiliated-re
3189 (format "[ \t]*#\\+\\(%s\\):"
3190 (mapconcat
3191 (lambda (keyword)
3192 (if (member keyword org-element-dual-keywords)
3193 (format "\\(%s\\)\\(?:\\[\\(.*\\)\\]\\)?"
3194 (regexp-quote keyword))
3195 (regexp-quote keyword)))
3196 org-element-affiliated-keywords "\\|"))
3197 "Regexp matching any affiliated keyword.
3199 Keyword name is put in match group 1. Moreover, if keyword
3200 belongs to `org-element-dual-keywords', put the dual value in
3201 match group 2.
3203 Don't modify it, set `org-element-affiliated-keywords' instead.")
3205 (defun org-element-collect-affiliated-keywords (&optional key-re trans-list
3206 consed parsed duals)
3207 "Collect affiliated keywords before point.
3209 Optional argument KEY-RE is a regexp matching keywords, which
3210 puts matched keyword in group 1. It defaults to
3211 `org-element--affiliated-re'.
3213 TRANS-LIST is an alist where key is the keyword and value the
3214 property name it should be translated to, without the colons. It
3215 defaults to `org-element-keyword-translation-alist'.
3217 CONSED is a list of strings. Any keyword belonging to that list
3218 will have its value consed. The check is done after keyword
3219 translation. It defaults to `org-element-multiple-keywords'.
3221 PARSED is a list of strings. Any keyword member of this list
3222 will have its value parsed. The check is done after keyword
3223 translation. If a keyword is a member of both CONSED and PARSED,
3224 it's value will be a list of parsed strings. It defaults to
3225 `org-element-parsed-keywords'.
3227 DUALS is a list of strings. Any keyword member of this list can
3228 have two parts: one mandatory and one optional. Its value is
3229 a cons cell whose car is the former, and the cdr the latter. If
3230 a keyword is a member of both PARSED and DUALS, both values will
3231 be parsed. It defaults to `org-element-dual-keywords'.
3233 Return a list whose car is the position at the first of them and
3234 cdr a plist of keywords and values."
3235 (save-excursion
3236 (let ((case-fold-search t)
3237 (key-re (or key-re org-element--affiliated-re))
3238 (trans-list (or trans-list org-element-keyword-translation-alist))
3239 (consed (or consed org-element-multiple-keywords))
3240 (parsed (or parsed org-element-parsed-keywords))
3241 (duals (or duals org-element-dual-keywords))
3242 ;; RESTRICT is the list of objects allowed in parsed
3243 ;; keywords value.
3244 (restrict (org-element-restriction 'keyword))
3245 output)
3246 (unless (bobp)
3247 (while (and (not (bobp))
3248 (progn (forward-line -1) (looking-at key-re)))
3249 (let* ((raw-kwd (upcase (or (match-string 2) (match-string 1))))
3250 ;; Apply translation to RAW-KWD. From there, KWD is
3251 ;; the official keyword.
3252 (kwd (or (cdr (assoc raw-kwd trans-list)) raw-kwd))
3253 ;; Find main value for any keyword.
3254 (value
3255 (save-match-data
3256 (org-trim
3257 (buffer-substring-no-properties
3258 (match-end 0) (point-at-eol)))))
3259 ;; If KWD is a dual keyword, find its secondary
3260 ;; value. Maybe parse it.
3261 (dual-value
3262 (and (member kwd duals)
3263 (let ((sec (org-match-string-no-properties 3)))
3264 (if (or (not sec) (not (member kwd parsed))) sec
3265 (org-element-parse-secondary-string sec restrict)))))
3266 ;; Attribute a property name to KWD.
3267 (kwd-sym (and kwd (intern (concat ":" (downcase kwd))))))
3268 ;; Now set final shape for VALUE.
3269 (when (member kwd parsed)
3270 (setq value (org-element-parse-secondary-string value restrict)))
3271 (when (member kwd duals)
3272 ;; VALUE is mandatory. Set it to nil if there is none.
3273 (setq value (and value (cons value dual-value))))
3274 (when (member kwd consed)
3275 (setq value (cons value (plist-get output kwd-sym))))
3276 ;; Eventually store the new value in OUTPUT.
3277 (setq output (plist-put output kwd-sym value))))
3278 (unless (looking-at key-re) (forward-line 1)))
3279 (list (point) output))))
3283 ;;; The Org Parser
3285 ;; The two major functions here are `org-element-parse-buffer', which
3286 ;; parses Org syntax inside the current buffer, taking into account
3287 ;; region, narrowing, or even visibility if specified, and
3288 ;; `org-element-parse-secondary-string', which parses objects within
3289 ;; a given string.
3291 ;; The (almost) almighty `org-element-map' allows to apply a function
3292 ;; on elements or objects matching some type, and accumulate the
3293 ;; resulting values. In an export situation, it also skips unneeded
3294 ;; parts of the parse tree.
3296 (defun org-element-parse-buffer (&optional granularity visible-only)
3297 "Recursively parse the buffer and return structure.
3298 If narrowing is in effect, only parse the visible part of the
3299 buffer.
3301 Optional argument GRANULARITY determines the depth of the
3302 recursion. It can be set to the following symbols:
3304 `headline' Only parse headlines.
3305 `greater-element' Don't recurse into greater elements excepted
3306 headlines and sections. Thus, elements
3307 parsed are the top-level ones.
3308 `element' Parse everything but objects and plain text.
3309 `object' Parse the complete buffer (default).
3311 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
3312 elements.
3314 Assume buffer is in Org mode."
3315 (save-excursion
3316 (goto-char (point-min))
3317 (org-skip-whitespace)
3318 (nconc (list 'org-data nil)
3319 (org-element-parse-elements
3320 (point-at-bol) (point-max)
3321 ;; Start in `section' mode so text before the first
3322 ;; headline belongs to a section.
3323 'section nil granularity visible-only nil))))
3325 (defun org-element-parse-secondary-string (string restriction)
3326 "Recursively parse objects in STRING and return structure.
3328 RESTRICTION, when non-nil, is a symbol limiting the object types
3329 that will be looked after."
3330 (with-temp-buffer
3331 (insert string)
3332 (org-element-parse-objects (point-min) (point-max) nil restriction)))
3334 (defun org-element-map (data types fun &optional info first-match no-recursion)
3335 "Map a function on selected elements or objects.
3337 DATA is the parsed tree, as returned by, i.e,
3338 `org-element-parse-buffer'. TYPES is a symbol or list of symbols
3339 of elements or objects types. FUN is the function called on the
3340 matching element or object. It must accept one arguments: the
3341 element or object itself.
3343 When optional argument INFO is non-nil, it should be a plist
3344 holding export options. In that case, parts of the parse tree
3345 not exportable according to that property list will be skipped.
3347 When optional argument FIRST-MATCH is non-nil, stop at the first
3348 match for which FUN doesn't return nil, and return that value.
3350 Optional argument NO-RECURSION is a symbol or a list of symbols
3351 representing elements or objects types. `org-element-map' won't
3352 enter any recursive element or object whose type belongs to that
3353 list. Though, FUN can still be applied on them.
3355 Nil values returned from FUN do not appear in the results."
3356 ;; Ensure TYPES and NO-RECURSION are a list, even of one element.
3357 (unless (listp types) (setq types (list types)))
3358 (unless (listp no-recursion) (setq no-recursion (list no-recursion)))
3359 ;; Recursion depth is determined by --CATEGORY.
3360 (let* ((--category
3361 (cond
3362 ((loop for type in types
3363 always (memq type org-element-greater-elements))
3364 'greater-elements)
3365 ((loop for type in types
3366 always (memq type org-element-all-elements))
3367 'elements)
3368 (t 'objects)))
3369 ;; --RESTRICTS is a list of element types whose secondary
3370 ;; string could possibly contain an object with a type among
3371 ;; TYPES.
3372 (--restricts
3373 (and (eq --category 'objects)
3374 (loop for el in org-element-secondary-value-alist
3375 when
3376 (loop for o in types
3377 thereis (memq o (org-element-restriction (car el))))
3378 collect (car el))))
3379 --acc
3380 (--walk-tree
3381 (function
3382 (lambda (--data)
3383 ;; Recursively walk DATA. INFO, if non-nil, is
3384 ;; a plist holding contextual information.
3385 (mapc
3386 (lambda (--blob)
3387 (unless (and info (member --blob (plist-get info :ignore-list)))
3388 (let ((--type (org-element-type --blob)))
3389 ;; Check if TYPE is matching among TYPES. If so,
3390 ;; apply FUN to --BLOB and accumulate return value
3391 ;; into --ACC (or exit if FIRST-MATCH is non-nil).
3392 (when (memq --type types)
3393 (let ((result (funcall fun --blob)))
3394 (cond ((not result))
3395 (first-match (throw 'first-match result))
3396 (t (push result --acc)))))
3397 ;; If --BLOB has a secondary string that can
3398 ;; contain objects with their type among TYPES,
3399 ;; look into that string.
3400 (when (memq --type --restricts)
3401 (funcall
3402 --walk-tree
3403 `(org-data
3405 ,@(org-element-property
3406 (cdr (assq --type org-element-secondary-value-alist))
3407 --blob))))
3408 ;; Now determine if a recursion into --BLOB is
3409 ;; possible. If so, do it.
3410 (unless (memq --type no-recursion)
3411 (when (or (and (memq --type org-element-greater-elements)
3412 (not (eq --category 'greater-elements)))
3413 (and (memq --type org-element-all-elements)
3414 (not (eq --category 'elements)))
3415 (org-element-contents --blob))
3416 (funcall --walk-tree --blob))))))
3417 (org-element-contents --data))))))
3418 (catch 'first-match
3419 (funcall --walk-tree data)
3420 ;; Return value in a proper order.
3421 (nreverse --acc))))
3423 ;; The following functions are internal parts of the parser.
3425 ;; The first one, `org-element-parse-elements' acts at the element's
3426 ;; level.
3428 ;; The second one, `org-element-parse-objects' applies on all objects
3429 ;; of a paragraph or a secondary string. It uses
3430 ;; `org-element-get-candidates' to optimize the search of the next
3431 ;; object in the buffer.
3433 ;; More precisely, that function looks for every allowed object type
3434 ;; first. Then, it discards failed searches, keeps further matches,
3435 ;; and searches again types matched behind point, for subsequent
3436 ;; calls. Thus, searching for a given type fails only once, and every
3437 ;; object is searched only once at top level (but sometimes more for
3438 ;; nested types).
3440 (defun org-element-parse-elements
3441 (beg end special structure granularity visible-only acc)
3442 "Parse elements between BEG and END positions.
3444 SPECIAL prioritize some elements over the others. It can be set
3445 to `quote-section', `section' `item' or `table-row'.
3447 When value is `item', STRUCTURE will be used as the current list
3448 structure.
3450 GRANULARITY determines the depth of the recursion. See
3451 `org-element-parse-buffer' for more information.
3453 When VISIBLE-ONLY is non-nil, don't parse contents of hidden
3454 elements.
3456 Elements are accumulated into ACC."
3457 (save-excursion
3458 (save-restriction
3459 (narrow-to-region beg end)
3460 (goto-char beg)
3461 ;; When parsing only headlines, skip any text before first one.
3462 (when (and (eq granularity 'headline) (not (org-at-heading-p)))
3463 (org-with-limited-levels (outline-next-heading)))
3464 ;; Main loop start.
3465 (while (not (eobp))
3466 (push
3467 ;; Find current element's type and parse it accordingly to
3468 ;; its category.
3469 (let* ((element (org-element-current-element
3470 granularity special structure))
3471 (type (org-element-type element))
3472 (cbeg (org-element-property :contents-begin element)))
3473 (goto-char (org-element-property :end element))
3474 (cond
3475 ;; Case 1. Simply accumulate element if VISIBLE-ONLY is
3476 ;; true and element is hidden or if it has no contents
3477 ;; anyway.
3478 ((or (and visible-only (org-element-property :hiddenp element))
3479 (not cbeg)) element)
3480 ;; Case 2. Greater element: parse it between
3481 ;; `contents-begin' and `contents-end'. Make sure
3482 ;; GRANULARITY allows the recursion, or ELEMENT is an
3483 ;; headline, in which case going inside is mandatory, in
3484 ;; order to get sub-level headings.
3485 ((and (memq type org-element-greater-elements)
3486 (or (memq granularity '(element object nil))
3487 (and (eq granularity 'greater-element)
3488 (eq type 'section))
3489 (eq type 'headline)))
3490 (org-element-parse-elements
3491 cbeg (org-element-property :contents-end element)
3492 ;; Possibly switch to a special mode.
3493 (case type
3494 (headline
3495 (if (org-element-property :quotedp element) 'quote-section
3496 'section))
3497 (plain-list 'item)
3498 (table 'table-row))
3499 (org-element-property :structure element)
3500 granularity visible-only (nreverse element)))
3501 ;; Case 3. ELEMENT has contents. Parse objects inside,
3502 ;; if GRANULARITY allows it.
3503 ((and cbeg (memq granularity '(object nil)))
3504 (org-element-parse-objects
3505 cbeg (org-element-property :contents-end element)
3506 (nreverse element) (org-element-restriction type)))
3507 ;; Case 4. Else, just accumulate ELEMENT.
3508 (t element)))
3509 acc)))
3510 ;; Return result.
3511 (nreverse acc)))
3513 (defun org-element-parse-objects (beg end acc restriction)
3514 "Parse objects between BEG and END and return recursive structure.
3516 Objects are accumulated in ACC.
3518 RESTRICTION is a list of object types which are allowed in the
3519 current object."
3520 (let ((get-next-object
3521 (function
3522 (lambda (cand)
3523 ;; Return the parsing function associated to the nearest
3524 ;; object among list of candidates CAND.
3525 (let ((pos (apply 'min (mapcar 'cdr cand))))
3526 (save-excursion
3527 (goto-char pos)
3528 (funcall
3529 (intern
3530 (format "org-element-%s-parser" (car (rassq pos cand))))))))))
3531 next-object candidates)
3532 (save-excursion
3533 (goto-char beg)
3534 (while (setq candidates (org-element-get-next-object-candidates
3535 end restriction candidates))
3536 (setq next-object (funcall get-next-object candidates))
3537 ;; 1. Text before any object. Untabify it.
3538 (let ((obj-beg (org-element-property :begin next-object)))
3539 (unless (= (point) obj-beg)
3540 (push (replace-regexp-in-string
3541 "\t" (make-string tab-width ? )
3542 (buffer-substring-no-properties (point) obj-beg))
3543 acc)))
3544 ;; 2. Object...
3545 (let ((obj-end (org-element-property :end next-object))
3546 (cont-beg (org-element-property :contents-begin next-object)))
3547 (push (if (and (memq (car next-object) org-element-recursive-objects)
3548 cont-beg)
3549 ;; ... recursive. The CONT-BEG check is for
3550 ;; links, as some of them might not be recursive
3551 ;; (i.e. plain links).
3552 (save-restriction
3553 (narrow-to-region
3554 cont-beg
3555 (org-element-property :contents-end next-object))
3556 (org-element-parse-objects
3557 (point-min) (point-max)
3558 (nreverse next-object)
3559 ;; Restrict allowed objects.
3560 (org-element-restriction next-object)))
3561 ;; ... not recursive. Accumulate the object.
3562 next-object)
3563 acc)
3564 (goto-char obj-end)))
3565 ;; 3. Text after last object. Untabify it.
3566 (unless (= (point) end)
3567 (push (replace-regexp-in-string
3568 "\t" (make-string tab-width ? )
3569 (buffer-substring-no-properties (point) end))
3570 acc))
3571 ;; Result.
3572 (nreverse acc))))
3574 (defun org-element-get-next-object-candidates (limit restriction objects)
3575 "Return an alist of candidates for the next object.
3577 LIMIT bounds the search, and RESTRICTION narrows candidates to
3578 some object types.
3580 Return value is an alist whose CAR is position and CDR the object
3581 type, as a symbol.
3583 OBJECTS is the previous candidates alist."
3584 (let (next-candidates types-to-search)
3585 ;; If no previous result, search every object type in RESTRICTION.
3586 ;; Otherwise, keep potential candidates (old objects located after
3587 ;; point) and ask to search again those which had matched before.
3588 (if (not objects) (setq types-to-search restriction)
3589 (mapc (lambda (obj)
3590 (if (< (cdr obj) (point)) (push (car obj) types-to-search)
3591 (push obj next-candidates)))
3592 objects))
3593 ;; Call the appropriate successor function for each type to search
3594 ;; and accumulate matches.
3595 (mapc
3596 (lambda (type)
3597 (let* ((successor-fun
3598 (intern
3599 (format "org-element-%s-successor"
3600 (or (cdr (assq type org-element-object-successor-alist))
3601 type))))
3602 (obj (funcall successor-fun limit)))
3603 (and obj (push obj next-candidates))))
3604 types-to-search)
3605 ;; Return alist.
3606 next-candidates))
3610 ;;; Towards A Bijective Process
3612 ;; The parse tree obtained with `org-element-parse-buffer' is really
3613 ;; a snapshot of the corresponding Org buffer. Therefore, it can be
3614 ;; interpreted and expanded into a string with canonical Org syntax.
3615 ;; Hence `org-element-interpret-data'.
3617 ;; The function relies internally on
3618 ;; `org-element-interpret--affiliated-keywords'.
3620 (defun org-element-interpret-data (data &optional parent)
3621 "Interpret DATA as Org syntax.
3623 DATA is a parse tree, an element, an object or a secondary string
3624 to interpret.
3626 Optional argument PARENT is used for recursive calls. It contains
3627 the element or object containing data, or nil.
3629 Return Org syntax as a string."
3630 (let* ((type (org-element-type data))
3631 (results
3632 (cond
3633 ;; Secondary string.
3634 ((not type)
3635 (mapconcat
3636 (lambda (obj) (org-element-interpret-data obj parent))
3637 data ""))
3638 ;; Full Org document.
3639 ((eq type 'org-data)
3640 (mapconcat
3641 (lambda (obj) (org-element-interpret-data obj parent))
3642 (org-element-contents data) ""))
3643 ;; Plain text.
3644 ((stringp data) data)
3645 ;; Element/Object without contents.
3646 ((not (org-element-contents data))
3647 (funcall (intern (format "org-element-%s-interpreter" type))
3648 data nil))
3649 ;; Element/Object with contents.
3651 (let* ((greaterp (memq type org-element-greater-elements))
3652 (objectp (and (not greaterp)
3653 (memq type org-element-recursive-objects)))
3654 (contents
3655 (mapconcat
3656 (lambda (obj) (org-element-interpret-data obj data))
3657 (org-element-contents
3658 (if (or greaterp objectp) data
3659 ;; Elements directly containing objects must
3660 ;; have their indentation normalized first.
3661 (org-element-normalize-contents
3662 data
3663 ;; When normalizing first paragraph of an
3664 ;; item or a footnote-definition, ignore
3665 ;; first line's indentation.
3666 (and (eq type 'paragraph)
3667 (equal data (car (org-element-contents parent)))
3668 (memq (org-element-type parent)
3669 '(footnote-definiton item))))))
3670 "")))
3671 (funcall (intern (format "org-element-%s-interpreter" type))
3672 data
3673 (if greaterp (org-element-normalize-contents contents)
3674 contents)))))))
3675 (if (memq type '(org-data plain-text nil)) results
3676 ;; Build white spaces. If no `:post-blank' property is
3677 ;; specified, assume its value is 0.
3678 (let ((post-blank (or (org-element-property :post-blank data) 0)))
3679 (if (memq type org-element-all-objects)
3680 (concat results (make-string post-blank 32))
3681 (concat
3682 (org-element-interpret--affiliated-keywords data)
3683 (org-element-normalize-string results)
3684 (make-string post-blank 10)))))))
3686 (defun org-element-interpret--affiliated-keywords (element)
3687 "Return ELEMENT's affiliated keywords as Org syntax.
3688 If there is no affiliated keyword, return the empty string."
3689 (let ((keyword-to-org
3690 (function
3691 (lambda (key value)
3692 (let (dual)
3693 (when (member key org-element-dual-keywords)
3694 (setq dual (cdr value) value (car value)))
3695 (concat "#+" key
3696 (and dual
3697 (format "[%s]" (org-element-interpret-data dual)))
3698 ": "
3699 (if (member key org-element-parsed-keywords)
3700 (org-element-interpret-data value)
3701 value)
3702 "\n"))))))
3703 (mapconcat
3704 (lambda (key)
3705 (let ((value (org-element-property (intern (concat ":" (downcase key)))
3706 element)))
3707 (when value
3708 (if (member key org-element-multiple-keywords)
3709 (mapconcat (lambda (line)
3710 (funcall keyword-to-org key line))
3711 value "")
3712 (funcall keyword-to-org key value)))))
3713 ;; Remove translated keywords.
3714 (delq nil
3715 (mapcar
3716 (lambda (key)
3717 (and (not (assoc key org-element-keyword-translation-alist)) key))
3718 org-element-affiliated-keywords))
3719 "")))
3721 ;; Because interpretation of the parse tree must return the same
3722 ;; number of blank lines between elements and the same number of white
3723 ;; space after objects, some special care must be given to white
3724 ;; spaces.
3726 ;; The first function, `org-element-normalize-string', ensures any
3727 ;; string different from the empty string will end with a single
3728 ;; newline character.
3730 ;; The second function, `org-element-normalize-contents', removes
3731 ;; global indentation from the contents of the current element.
3733 (defun org-element-normalize-string (s)
3734 "Ensure string S ends with a single newline character.
3736 If S isn't a string return it unchanged. If S is the empty
3737 string, return it. Otherwise, return a new string with a single
3738 newline character at its end."
3739 (cond
3740 ((not (stringp s)) s)
3741 ((string= "" s) "")
3742 (t (and (string-match "\\(\n[ \t]*\\)*\\'" s)
3743 (replace-match "\n" nil nil s)))))
3745 (defun org-element-normalize-contents (element &optional ignore-first)
3746 "Normalize plain text in ELEMENT's contents.
3748 ELEMENT must only contain plain text and objects.
3750 If optional argument IGNORE-FIRST is non-nil, ignore first line's
3751 indentation to compute maximal common indentation.
3753 Return the normalized element that is element with global
3754 indentation removed from its contents. The function assumes that
3755 indentation is not done with TAB characters."
3756 (let (ind-list
3757 (collect-inds
3758 (function
3759 ;; Return list of indentations within BLOB. This is done by
3760 ;; walking recursively BLOB and updating IND-LIST along the
3761 ;; way. FIRST-FLAG is non-nil when the first string hasn't
3762 ;; been seen yet. It is required as this string is the only
3763 ;; one whose indentation doesn't happen after a newline
3764 ;; character.
3765 (lambda (blob first-flag)
3766 (mapc
3767 (lambda (object)
3768 (when (and first-flag (stringp object))
3769 (setq first-flag nil)
3770 (string-match "\\`\\( *\\)" object)
3771 (let ((len (length (match-string 1 object))))
3772 ;; An indentation of zero means no string will be
3773 ;; modified. Quit the process.
3774 (if (zerop len) (throw 'zero (setq ind-list nil))
3775 (push len ind-list))))
3776 (cond
3777 ((stringp object)
3778 (let ((start 0))
3779 ;; Avoid matching blank or empty lines.
3780 (while (and (string-match "\n\\( *\\)\\(.\\)" object start)
3781 (not (equal (match-string 2 object) " ")))
3782 (setq start (match-end 0))
3783 (push (length (match-string 1 object)) ind-list))))
3784 ((memq (org-element-type object) org-element-recursive-objects)
3785 (funcall collect-inds object first-flag))))
3786 (org-element-contents blob))))))
3787 ;; Collect indentation list in ELEMENT. Possibly remove first
3788 ;; value if IGNORE-FIRST is non-nil.
3789 (catch 'zero (funcall collect-inds element (not ignore-first)))
3790 (if (not ind-list) element
3791 ;; Build ELEMENT back, replacing each string with the same
3792 ;; string minus common indentation.
3793 (let ((build
3794 (function
3795 (lambda (blob mci first-flag)
3796 ;; Return BLOB with all its strings indentation
3797 ;; shortened from MCI white spaces. FIRST-FLAG is
3798 ;; non-nil when the first string hasn't been seen
3799 ;; yet.
3800 (nconc
3801 (list (org-element-type blob) (nth 1 blob))
3802 (mapcar
3803 (lambda (object)
3804 (when (and first-flag (stringp object))
3805 (setq first-flag nil)
3806 (setq object
3807 (replace-regexp-in-string
3808 (format "\\` \\{%d\\}" mci) "" object)))
3809 (cond
3810 ((stringp object)
3811 (replace-regexp-in-string
3812 (format "\n \\{%d\\}" mci) "\n" object))
3813 ((memq (org-element-type object)
3814 org-element-recursive-objects)
3815 (funcall build object mci first-flag))
3816 (t object)))
3817 (org-element-contents blob)))))))
3818 (funcall build element (apply 'min ind-list) (not ignore-first))))))
3822 ;;; The Toolbox
3824 ;; The first move is to implement a way to obtain the smallest element
3825 ;; containing point. This is the job of `org-element-at-point'. It
3826 ;; basically jumps back to the beginning of section containing point
3827 ;; and moves, element after element, with
3828 ;; `org-element-current-element' until the container is found.
3830 ;; Note: When using `org-element-at-point', secondary values are never
3831 ;; parsed since the function focuses on elements, not on objects.
3833 (defun org-element-at-point (&optional keep-trail)
3834 "Determine closest element around point.
3836 Return value is a list like (TYPE PROPS) where TYPE is the type
3837 of the element and PROPS a plist of properties associated to the
3838 element. Possible types are defined in
3839 `org-element-all-elements'.
3841 As a special case, if point is at the very beginning of a list or
3842 sub-list, returned element will be that list instead of the first
3843 item. In the same way, if point is at the beginning of the first
3844 row of a table, returned element will be the table instead of the
3845 first row.
3847 If optional argument KEEP-TRAIL is non-nil, the function returns
3848 a list of of elements leading to element at point. The list's
3849 CAR is always the element at point. Its last item will be the
3850 element's parent, unless element was either the first in its
3851 section (in which case the last item in the list is the first
3852 element of section) or an headline (in which case the list
3853 contains that headline as its single element). Elements
3854 in-between, if any, are siblings of the element at point."
3855 (org-with-wide-buffer
3856 ;; If at an headline, parse it. It is the sole element that
3857 ;; doesn't require to know about context. Be sure to disallow
3858 ;; secondary string parsing, though.
3859 (if (org-with-limited-levels (org-at-heading-p))
3860 (if (not keep-trail) (org-element-headline-parser t)
3861 (list (org-element-headline-parser t)))
3862 ;; Otherwise move at the beginning of the section containing
3863 ;; point.
3864 (let ((origin (point)) element type special-flag trail struct prevs)
3865 (org-with-limited-levels
3866 (if (org-before-first-heading-p) (goto-char (point-min))
3867 (org-back-to-heading)
3868 (forward-line)))
3869 (org-skip-whitespace)
3870 (beginning-of-line)
3871 ;; Starting parsing successively each element with
3872 ;; `org-element-current-element'. Skip those ending before
3873 ;; original position.
3874 (catch 'exit
3875 (while t
3876 (setq element (org-element-current-element
3877 'element special-flag struct)
3878 type (car element))
3879 (when keep-trail (push element trail))
3880 (cond
3881 ;; 1. Skip any element ending before point or at point.
3882 ((let ((end (org-element-property :end element)))
3883 (when (<= end origin)
3884 (if (> (point-max) end) (goto-char end)
3885 (throw 'exit (or trail element))))))
3886 ;; 2. An element containing point is always the element at
3887 ;; point.
3888 ((not (memq type org-element-greater-elements))
3889 (throw 'exit (if keep-trail trail element)))
3890 ;; 3. At a plain list.
3891 ((eq type 'plain-list)
3892 (setq struct (org-element-property :structure element)
3893 prevs (or prevs (org-list-prevs-alist struct)))
3894 (let ((beg (org-element-property :contents-begin element)))
3895 (if (<= origin beg) (throw 'exit (or trail element))
3896 ;; Find the item at this level containing ORIGIN.
3897 (let ((items (org-list-get-all-items beg struct prevs))
3898 parent)
3899 (catch 'local
3900 (mapc
3901 (lambda (pos)
3902 (cond
3903 ;; Item ends before point: skip it.
3904 ((<= (org-list-get-item-end pos struct) origin))
3905 ;; Item contains point: store is in PARENT.
3906 ((<= pos origin) (setq parent pos))
3907 ;; We went too far: return PARENT.
3908 (t (throw 'local nil)))) items))
3909 ;; No parent: no item contained point, though the
3910 ;; plain list does. Point is in the blank lines
3911 ;; after the list: return plain list.
3912 (if (not parent) (throw 'exit (or trail element))
3913 (setq special-flag 'item)
3914 (goto-char parent))))))
3915 ;; 4. At a table.
3916 ((eq type 'table)
3917 (if (eq (org-element-property :type element) 'table.el)
3918 (throw 'exit (or trail element))
3919 (let ((beg (org-element-property :contents-begin element))
3920 (end (org-element-property :contents-end element)))
3921 (if (or (<= origin beg) (>= origin end))
3922 (throw 'exit (or trail element))
3923 (when keep-trail (setq trail (list element)))
3924 (setq special-flag 'table-row)
3925 (narrow-to-region beg end)))))
3926 ;; 4. At any other greater element type, if point is
3927 ;; within contents, move into it. Otherwise, return
3928 ;; that element.
3930 (when (eq type 'item) (setq special-flag nil))
3931 (let ((beg (org-element-property :contents-begin element))
3932 (end (org-element-property :contents-end element)))
3933 (if (or (not beg) (not end) (> beg origin) (< end origin))
3934 (throw 'exit (or trail element))
3935 ;; Reset trail, since we found a parent.
3936 (when keep-trail (setq trail (list element)))
3937 (narrow-to-region beg end)
3938 (goto-char beg)))))))))))
3941 ;; Once the local structure around point is well understood, it's easy
3942 ;; to implement some replacements for `forward-paragraph'
3943 ;; `backward-paragraph', namely `org-element-forward' and
3944 ;; `org-element-backward'.
3946 ;; Also, `org-transpose-elements' mimics the behaviour of
3947 ;; `transpose-words', at the element's level, whereas
3948 ;; `org-element-drag-forward', `org-element-drag-backward', and
3949 ;; `org-element-up' generalize, respectively, functions
3950 ;; `org-subtree-down', `org-subtree-up' and `outline-up-heading'.
3952 ;; `org-element-unindent-buffer' will, as its name almost suggests,
3953 ;; smartly remove global indentation from buffer, making it possible
3954 ;; to use Org indent mode on a file created with hard indentation.
3956 ;; `org-element-nested-p' and `org-element-swap-A-B' are used
3957 ;; internally by some of the previously cited tools.
3959 (defsubst org-element-nested-p (elem-A elem-B)
3960 "Non-nil when elements ELEM-A and ELEM-B are nested."
3961 (let ((beg-A (org-element-property :begin elem-A))
3962 (beg-B (org-element-property :begin elem-B))
3963 (end-A (org-element-property :end elem-A))
3964 (end-B (org-element-property :end elem-B)))
3965 (or (and (>= beg-A beg-B) (<= end-A end-B))
3966 (and (>= beg-B beg-A) (<= end-B end-A)))))
3968 (defun org-element-swap-A-B (elem-A elem-B)
3969 "Swap elements ELEM-A and ELEM-B.
3971 Leave point at the end of ELEM-A."
3972 (goto-char (org-element-property :begin elem-A))
3973 (let* ((beg-A (org-element-property :begin elem-A))
3974 (end-A (save-excursion
3975 (goto-char (org-element-property :end elem-A))
3976 (skip-chars-backward " \r\t\n")
3977 (point-at-eol)))
3978 (beg-B (org-element-property :begin elem-B))
3979 (end-B (save-excursion
3980 (goto-char (org-element-property :end elem-B))
3981 (skip-chars-backward " \r\t\n")
3982 (point-at-eol)))
3983 (body-A (buffer-substring beg-A end-A))
3984 (body-B (delete-and-extract-region beg-B end-B)))
3985 (goto-char beg-B)
3986 (insert body-A)
3987 (goto-char beg-A)
3988 (delete-region beg-A end-A)
3989 (insert body-B)
3990 (goto-char (org-element-property :end elem-B))))
3992 (defun org-element-backward ()
3993 "Move backward by one element.
3994 Move to the previous element at the same level, when possible."
3995 (interactive)
3996 (if (save-excursion (skip-chars-backward " \r\t\n") (bobp))
3997 (error "Cannot move further up")
3998 (let* ((trail (org-element-at-point 'keep-trail))
3999 (element (car trail))
4000 (beg (org-element-property :begin element)))
4001 ;; Move to beginning of current element if point isn't there.
4002 (if (/= (point) beg) (goto-char beg)
4003 (let ((type (org-element-type element)))
4004 (cond
4005 ;; At an headline: move to previous headline at the same
4006 ;; level, a parent, or BOB.
4007 ((eq type 'headline)
4008 (let ((dest (save-excursion (org-backward-same-level 1) (point))))
4009 (if (= (point-min) dest) (error "Cannot move further up")
4010 (goto-char dest))))
4011 ;; At an item: try to move to the previous item, if any.
4012 ((and (eq type 'item)
4013 (let* ((struct (org-element-property :structure element))
4014 (prev (org-list-get-prev-item
4015 beg struct (org-list-prevs-alist struct))))
4016 (when prev (goto-char prev)))))
4017 ;; In any other case, find the previous element in the
4018 ;; trail and move to its beginning. If no previous element
4019 ;; can be found, move to headline.
4020 (t (let ((prev (nth 1 trail)))
4021 (if prev (goto-char (org-element-property :begin prev))
4022 (org-back-to-heading))))))))))
4024 (defun org-element-drag-backward ()
4025 "Drag backward element at point."
4026 (interactive)
4027 (let* ((pos (point))
4028 (elem (org-element-at-point)))
4029 (when (= (progn (goto-char (point-min))
4030 (org-skip-whitespace)
4031 (point-at-bol))
4032 (org-element-property :end elem))
4033 (error "Cannot drag element backward"))
4034 (goto-char (org-element-property :begin elem))
4035 (org-element-backward)
4036 (let ((prev-elem (org-element-at-point)))
4037 (when (or (org-element-nested-p elem prev-elem)
4038 (and (eq (org-element-type elem) 'headline)
4039 (not (eq (org-element-type prev-elem) 'headline))))
4040 (goto-char pos)
4041 (error "Cannot drag element backward"))
4042 ;; Compute new position of point: it's shifted by PREV-ELEM
4043 ;; body's length.
4044 (let ((size-prev (- (org-element-property :end prev-elem)
4045 (org-element-property :begin prev-elem))))
4046 (org-element-swap-A-B prev-elem elem)
4047 (goto-char (- pos size-prev))))))
4049 (defun org-element-drag-forward ()
4050 "Move forward element at point."
4051 (interactive)
4052 (let* ((pos (point))
4053 (elem (org-element-at-point)))
4054 (when (= (point-max) (org-element-property :end elem))
4055 (error "Cannot drag element forward"))
4056 (goto-char (org-element-property :end elem))
4057 (let ((next-elem (org-element-at-point)))
4058 (when (or (org-element-nested-p elem next-elem)
4059 (and (eq (org-element-type next-elem) 'headline)
4060 (not (eq (org-element-type elem) 'headline))))
4061 (goto-char pos)
4062 (error "Cannot drag element forward"))
4063 ;; Compute new position of point: it's shifted by NEXT-ELEM
4064 ;; body's length (without final blanks) and by the length of
4065 ;; blanks between ELEM and NEXT-ELEM.
4066 (let ((size-next (- (save-excursion
4067 (goto-char (org-element-property :end next-elem))
4068 (skip-chars-backward " \r\t\n")
4069 (forward-line)
4070 (point))
4071 (org-element-property :begin next-elem)))
4072 (size-blank (- (org-element-property :end elem)
4073 (save-excursion
4074 (goto-char (org-element-property :end elem))
4075 (skip-chars-backward " \r\t\n")
4076 (forward-line)
4077 (point)))))
4078 (org-element-swap-A-B elem next-elem)
4079 (goto-char (+ pos size-next size-blank))))))
4081 (defun org-element-forward ()
4082 "Move forward by one element.
4083 Move to the next element at the same level, when possible."
4084 (interactive)
4085 (if (eobp) (error "Cannot move further down")
4086 (let* ((trail (org-element-at-point 'keep-trail))
4087 (element (car trail))
4088 (type (org-element-type element))
4089 (end (org-element-property :end element)))
4090 (cond
4091 ;; At an headline, move to next headline at the same level.
4092 ((eq type 'headline) (goto-char end))
4093 ;; At an item. Move to the next item, if possible.
4094 ((and (eq type 'item)
4095 (let* ((struct (org-element-property :structure element))
4096 (prevs (org-list-prevs-alist struct))
4097 (beg (org-element-property :begin element))
4098 (next-item (org-list-get-next-item beg struct prevs)))
4099 (when next-item (goto-char next-item)))))
4100 ;; In any other case, move to element's end, unless this
4101 ;; position is also the end of its parent's contents, in which
4102 ;; case, directly jump to parent's end.
4104 (let ((parent
4105 ;; Determine if TRAIL contains the real parent of ELEMENT.
4106 (and (> (length trail) 1)
4107 (let* ((parent-candidate (car (last trail))))
4108 (and (memq (org-element-type parent-candidate)
4109 org-element-greater-elements)
4110 (>= (org-element-property
4111 :contents-end parent-candidate) end)
4112 parent-candidate)))))
4113 (cond ((not parent) (goto-char end))
4114 ((= (org-element-property :contents-end parent) end)
4115 (goto-char (org-element-property :end parent)))
4116 (t (goto-char end)))))))))
4118 (defun org-element-mark-element ()
4119 "Put point at beginning of this element, mark at end.
4121 Interactively, if this command is repeated or (in Transient Mark
4122 mode) if the mark is active, it marks the next element after the
4123 ones already marked."
4124 (interactive)
4125 (let (deactivate-mark)
4126 (if (or (and (eq last-command this-command) (mark t))
4127 (and transient-mark-mode mark-active))
4128 (set-mark
4129 (save-excursion
4130 (goto-char (mark))
4131 (goto-char (org-element-property :end (org-element-at-point)))))
4132 (let ((element (org-element-at-point)))
4133 (end-of-line)
4134 (push-mark (org-element-property :end element) t t)
4135 (goto-char (org-element-property :begin element))))))
4137 (defun org-narrow-to-element ()
4138 "Narrow buffer to current element."
4139 (interactive)
4140 (let ((elem (org-element-at-point)))
4141 (cond
4142 ((eq (car elem) 'headline)
4143 (narrow-to-region
4144 (org-element-property :begin elem)
4145 (org-element-property :end elem)))
4146 ((memq (car elem) org-element-greater-elements)
4147 (narrow-to-region
4148 (org-element-property :contents-begin elem)
4149 (org-element-property :contents-end elem)))
4151 (narrow-to-region
4152 (org-element-property :begin elem)
4153 (org-element-property :end elem))))))
4155 (defun org-transpose-elements ()
4156 "Transpose current and previous elements, keeping blank lines between.
4157 Point is moved after both elements."
4158 (interactive)
4159 (org-skip-whitespace)
4160 (let ((pos (point))
4161 (cur (org-element-at-point)))
4162 (when (= (save-excursion (goto-char (point-min))
4163 (org-skip-whitespace)
4164 (point-at-bol))
4165 (org-element-property :begin cur))
4166 (error "No previous element"))
4167 (goto-char (org-element-property :begin cur))
4168 (forward-line -1)
4169 (let ((prev (org-element-at-point)))
4170 (when (org-element-nested-p cur prev)
4171 (goto-char pos)
4172 (error "Cannot transpose nested elements"))
4173 (org-element-swap-A-B prev cur))))
4175 (defun org-element-unindent-buffer ()
4176 "Un-indent the visible part of the buffer.
4177 Relative indentation \(between items, inside blocks, etc.\) isn't
4178 modified."
4179 (interactive)
4180 (unless (eq major-mode 'org-mode)
4181 (error "Cannot un-indent a buffer not in Org mode"))
4182 (let* ((parse-tree (org-element-parse-buffer 'greater-element))
4183 unindent-tree ; For byte-compiler.
4184 (unindent-tree
4185 (function
4186 (lambda (contents)
4187 (mapc (lambda (element)
4188 (if (eq (org-element-type element) 'headline)
4189 (funcall unindent-tree
4190 (org-element-contents element))
4191 (save-excursion
4192 (save-restriction
4193 (narrow-to-region
4194 (org-element-property :begin element)
4195 (org-element-property :end element))
4196 (org-do-remove-indentation)))))
4197 (reverse contents))))))
4198 (funcall unindent-tree (org-element-contents parse-tree))))
4200 (defun org-element-up ()
4201 "Move to upper element."
4202 (interactive)
4203 (cond
4204 ((bobp) (error "No surrounding element"))
4205 ((org-with-limited-levels (org-at-heading-p))
4206 (or (org-up-heading-safe) (error "No surronding element")))
4208 (let* ((trail (org-element-at-point 'keep-trail))
4209 (element (car trail))
4210 (type (org-element-type element)))
4211 (cond
4212 ;; At an item, with a parent in the list: move to that parent.
4213 ((and (eq type 'item)
4214 (let* ((beg (org-element-property :begin element))
4215 (struct (org-element-property :structure element))
4216 (parents (org-list-parents-alist struct))
4217 (parentp (org-list-get-parent beg struct parents)))
4218 (and parentp (goto-char parentp)))))
4219 ;; Determine parent in the trail.
4221 (let ((parent
4222 (and (> (length trail) 1)
4223 (let ((parentp (car (last trail))))
4224 (and (memq (org-element-type parentp)
4225 org-element-greater-elements)
4226 (>= (org-element-property :contents-end parentp)
4227 (org-element-property :end element))
4228 parentp)))))
4229 (cond
4230 ;; When parent is found move to its beginning.
4231 (parent (goto-char (org-element-property :begin parent)))
4232 ;; If no parent was found, move to headline above, if any
4233 ;; or return an error.
4234 ((org-before-first-heading-p) (error "No surrounding element"))
4235 (t (org-back-to-heading))))))))))
4237 (defun org-element-down ()
4238 "Move to inner element."
4239 (interactive)
4240 (let ((element (org-element-at-point)))
4241 (cond
4242 ((memq (org-element-type element) '(plain-list table))
4243 (goto-char (org-element-property :contents-begin element))
4244 (forward-char))
4245 ((memq (org-element-type element) org-element-greater-elements)
4246 ;; If contents are hidden, first disclose them.
4247 (when (org-element-property :hiddenp element) (org-cycle))
4248 (goto-char (org-element-property :contents-begin element)))
4249 (t (error "No inner element")))))
4252 (provide 'org-element)
4253 ;;; org-element.el ends here