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