contrib/lisp/org-element.el

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