org-element.el (340205B)
1 ;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2012-2023 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 <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 ;; 25 ;; See <https://orgmode.org/worg/dev/org-syntax.html> for details about 26 ;; Org syntax. 27 ;; 28 ;; Lisp-wise, a syntax object can be represented as a list. 29 ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: 30 ;; TYPE is a symbol describing the object. 31 ;; PROPERTIES is the property list attached to it. See docstring of 32 ;; appropriate parsing function to get an exhaustive list. 33 ;; CONTENTS is a list of syntax objects or raw strings contained 34 ;; in the current object, when applicable. 35 ;; 36 ;; For the whole document, TYPE is `org-data' and PROPERTIES is nil. 37 ;; 38 ;; The first part of this file defines constants for the Org syntax, 39 ;; while the second one provide accessors and setters functions. 40 ;; 41 ;; The next part implements a parser and an interpreter for each 42 ;; element and object type in Org syntax. 43 ;; 44 ;; The following part creates a fully recursive buffer parser. It 45 ;; also provides a tool to map a function to elements or objects 46 ;; matching some criteria in the parse tree. Functions of interest 47 ;; are `org-element-parse-buffer', `org-element-map' and, to a lesser 48 ;; extent, `org-element-parse-secondary-string'. 49 ;; 50 ;; The penultimate part is the cradle of an interpreter for the 51 ;; obtained parse tree: `org-element-interpret-data'. 52 ;; 53 ;; The library ends by furnishing `org-element-at-point' function, and 54 ;; a way to give information about document structure around point 55 ;; with `org-element-context'. A cache mechanism is also provided for 56 ;; these functions. 57 58 59 ;;; Code: 60 61 (require 'org-macs) 62 (org-assert-version) 63 64 (require 'avl-tree) 65 (require 'ring) 66 (require 'cl-lib) 67 (require 'ol) 68 (require 'org) 69 (require 'org-persist) 70 (require 'org-compat) 71 (require 'org-entities) 72 (require 'org-footnote) 73 (require 'org-list) 74 (require 'org-macs) 75 (require 'org-table) 76 (require 'org-fold-core) 77 78 (declare-function org-at-heading-p "org" (&optional _)) 79 (declare-function org-escape-code-in-string "org-src" (s)) 80 (declare-function org-macro-escape-arguments "org-macro" (&rest args)) 81 (declare-function org-macro-extract-arguments "org-macro" (s)) 82 (declare-function org-reduced-level "org" (l)) 83 (declare-function org-unescape-code-in-string "org-src" (s)) 84 (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) 85 (declare-function outline-next-heading "outline" ()) 86 (declare-function outline-previous-heading "outline" ()) 87 88 (defvar org-complex-heading-regexp) 89 (defvar org-done-keywords) 90 (defvar org-edit-src-content-indentation) 91 (defvar org-match-substring-regexp) 92 (defvar org-odd-levels-only) 93 (defvar org-property-drawer-re) 94 (defvar org-property-format) 95 (defvar org-property-re) 96 (defvar org-src-preserve-indentation) 97 (defvar org-tags-column) 98 (defvar org-todo-regexp) 99 (defvar org-ts-regexp-both) 100 101 102 ;;; Definitions And Rules 103 ;; 104 ;; Define elements, greater elements and specify recursive objects, 105 ;; along with the affiliated keywords recognized. Also set up 106 ;; restrictions on recursive objects combinations. 107 ;; 108 ;; `org-element-update-syntax' builds proper syntax regexps according 109 ;; to current setup. 110 111 (defconst org-element-archive-tag "ARCHIVE" 112 "Tag marking a substree as archived.") 113 114 (defconst org-element-citation-key-re 115 (rx "@" (group (one-or-more (any word "-.:?!`'/*@+|(){}<>&_^$#%~")))) 116 "Regexp matching a citation key. 117 Key is located in match group 1.") 118 119 (defconst org-element-citation-prefix-re 120 (rx "[cite" 121 (opt "/" (group (one-or-more (any "/_-" alnum)))) ;style 122 ":" 123 (zero-or-more (any "\t\n "))) 124 "Regexp matching a citation prefix. 125 Style, if any, is located in match group 1.") 126 127 (defconst org-element-clock-line-re 128 (rx-to-string 129 `(seq 130 line-start (0+ (or ?\t ?\s)) 131 "CLOCK: " 132 (regexp ,org-ts-regexp-inactive) 133 (opt "--" 134 (regexp ,org-ts-regexp-inactive) 135 (1+ (or ?\t ?\s)) "=>" (1+ (or ?\t ?\s)) 136 (1+ digit) ":" digit digit) 137 (0+ (or ?\t ?\s)) 138 line-end)) 139 "Regexp matching a clock line.") 140 141 (defconst org-element-comment-string "COMMENT" 142 "String marker for commented headlines.") 143 144 (defconst org-element-closed-keyword "CLOSED:" 145 "Keyword used to close TODO entries.") 146 147 (defconst org-element-deadline-keyword "DEADLINE:" 148 "Keyword used to mark deadline entries.") 149 150 (defconst org-element-scheduled-keyword "SCHEDULED:" 151 "Keyword used to mark scheduled entries.") 152 153 (defconst org-element-planning-keywords-re 154 (regexp-opt (list org-element-closed-keyword 155 org-element-deadline-keyword 156 org-element-scheduled-keyword)) 157 "Regexp matching any planning line keyword.") 158 159 (defconst org-element-planning-line-re 160 (rx-to-string 161 `(seq line-start (0+ (any ?\s ?\t)) 162 (group (regexp ,org-element-planning-keywords-re)))) 163 "Regexp matching a planning line.") 164 165 (defconst org-element-drawer-re 166 (rx line-start (0+ (any ?\s ?\t)) 167 ":" (group (1+ (any ?- ?_ word))) ":" 168 (0+ (any ?\s ?\t)) line-end) 169 "Regexp matching opening or closing line of a drawer. 170 Drawer's name is located in match group 1.") 171 172 (defconst org-element-dynamic-block-open-re 173 (rx line-start (0+ (any ?\s ?\t)) 174 "#+BEGIN:" (0+ (any ?\s ?\t)) 175 (group (1+ word)) 176 (opt 177 (1+ (any ?\s ?\t)) 178 (group (1+ nonl)))) 179 "Regexp matching the opening line of a dynamic block. 180 Dynamic block's name is located in match group 1. 181 Parameters are in match group 2.") 182 183 (defconst org-element-headline-re 184 (rx line-start (1+ "*") " ") 185 "Regexp matching a headline.") 186 187 (defvar org-element-paragraph-separate nil 188 "Regexp to separate paragraphs in an Org buffer. 189 In the case of lines starting with \"#\" and \":\", this regexp 190 is not sufficient to know if point is at a paragraph ending. See 191 `org-element-paragraph-parser' for more information.") 192 193 (defvar org-element--object-regexp nil 194 "Regexp possibly matching the beginning of an object. 195 This regexp allows false positives. Dedicated parser (e.g., 196 `org-element-bold-parser') will take care of further filtering. 197 Radio links are not matched by this regexp, as they are treated 198 specially in `org-element--object-lex'.") 199 200 (defun org-element--set-regexps () 201 "Build variable syntax regexps." 202 (setq org-element-paragraph-separate 203 (concat "^\\(?:" 204 ;; Headlines, inlinetasks. 205 "\\*+ " "\\|" 206 ;; Footnote definitions. 207 "\\[fn:[-_[:word:]]+\\]" "\\|" 208 ;; Diary sexps. 209 "%%(" "\\|" 210 "[ \t]*\\(?:" 211 ;; Empty lines. 212 "$" "\\|" 213 ;; Tables (any type). 214 "|" "\\|" 215 "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|" 216 ;; Comments, keyword-like or block-like constructs. 217 ;; Blocks and keywords with dual values need to be 218 ;; double-checked. 219 "#\\(?: \\|$\\|\\+\\(?:" 220 "BEGIN_\\S-+" "\\|" 221 "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)" 222 "\\|" 223 ;; Drawers (any type) and fixed-width areas. Drawers 224 ;; need to be double-checked. 225 ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|" 226 ;; Horizontal rules. 227 "-\\{5,\\}[ \t]*$" "\\|" 228 ;; LaTeX environments. 229 "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|" 230 ;; Clock lines. 231 org-element-clock-line-re "\\|" 232 ;; Lists. 233 (let ((term (pcase org-plain-list-ordered-item-terminator 234 (?\) ")") (?. "\\.") (_ "[.)]"))) 235 (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) 236 (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" 237 "\\(?:[ \t]\\|$\\)")) 238 "\\)\\)") 239 org-element--object-regexp 240 (mapconcat #'identity 241 (let ((link-types (regexp-opt (org-link-types)))) 242 (list 243 ;; Sub/superscript. 244 "\\(?:[_^][-{(*+.,[:alnum:]]\\)" 245 ;; Bold, code, italic, strike-through, underline 246 ;; and verbatim. 247 (rx (or "*" "~" "=" "+" "_" "/") (not space)) 248 ;; Plain links. 249 (concat "\\<" link-types ":") 250 ;; Objects starting with "[": citations, 251 ;; footnote reference, statistics cookie, 252 ;; timestamp (inactive) and regular link. 253 (format "\\[\\(?:%s\\)" 254 (mapconcat 255 #'identity 256 (list "cite[:/]" 257 "fn:" 258 "\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)" 259 "\\[") 260 "\\|")) 261 ;; Objects starting with "@": export snippets. 262 "@@" 263 ;; Objects starting with "{": macro. 264 "{{{" 265 ;; Objects starting with "<" : timestamp 266 ;; (active, diary), target, radio target and 267 ;; angular links. 268 (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)") 269 ;; Objects starting with "$": latex fragment. 270 "\\$" 271 ;; Objects starting with "\": line break, 272 ;; entity, latex fragment. 273 "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)" 274 ;; Objects starting with raw text: inline Babel 275 ;; source block, inline Babel call. 276 "\\(?:call\\|src\\)_")) 277 "\\|"))) 278 279 (org-element--set-regexps) 280 281 ;;;###autoload 282 (defun org-element-update-syntax () 283 "Update parser internals." 284 (interactive) 285 (org-element--set-regexps) 286 (org-element-cache-reset 'all)) 287 288 (defconst org-element-all-elements 289 '(babel-call center-block clock comment comment-block diary-sexp drawer 290 dynamic-block example-block export-block fixed-width 291 footnote-definition headline horizontal-rule inlinetask item 292 keyword latex-environment node-property paragraph plain-list 293 planning property-drawer quote-block section 294 special-block src-block table table-row verse-block) 295 "Complete list of element types.") 296 297 (defconst org-element-greater-elements 298 '(center-block drawer dynamic-block footnote-definition headline inlinetask 299 item plain-list property-drawer quote-block section 300 special-block table org-data) 301 "List of recursive element types aka Greater Elements.") 302 303 (defconst org-element-all-objects 304 '(bold citation citation-reference code entity export-snippet 305 footnote-reference inline-babel-call inline-src-block italic line-break 306 latex-fragment link macro radio-target statistics-cookie strike-through 307 subscript superscript table-cell target timestamp underline verbatim) 308 "Complete list of object types.") 309 310 (defconst org-element-recursive-objects 311 '(bold citation footnote-reference italic link subscript radio-target 312 strike-through superscript table-cell underline) 313 "List of recursive object types.") 314 315 (defconst org-element-object-containers 316 (append org-element-recursive-objects '(paragraph table-row verse-block)) 317 "List of object or element types that can directly contain objects.") 318 319 (defconst org-element-affiliated-keywords 320 '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" 321 "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") 322 "List of affiliated keywords as strings. 323 By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") 324 are affiliated keywords and need not to be in this list.") 325 326 (defconst org-element-keyword-translation-alist 327 '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME") 328 ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME") 329 ("RESULT" . "RESULTS") ("HEADERS" . "HEADER")) 330 "Alist of usual translations for keywords. 331 The key is the old name and the value the new one. The property 332 holding their value will be named after the translated name.") 333 334 (defconst org-element-multiple-keywords '("CAPTION" "HEADER") 335 "List of affiliated keywords that can occur more than once in an element. 336 337 Their value will be consed into a list of strings, which will be 338 returned as the value of the property. 339 340 This list is checked after translations have been applied. See 341 `org-element-keyword-translation-alist'. 342 343 By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") 344 allow multiple occurrences and need not to be in this list.") 345 346 (defconst org-element-parsed-keywords '("CAPTION") 347 "List of affiliated keywords whose value can be parsed. 348 349 Their value will be stored as a secondary string: a list of 350 strings and objects. 351 352 This list is checked after translations have been applied. See 353 `org-element-keyword-translation-alist'.") 354 355 (defconst org-element--parsed-properties-alist 356 (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k))))) 357 org-element-parsed-keywords) 358 "Alist of parsed keywords and associated properties. 359 This is generated from `org-element-parsed-keywords', which 360 see.") 361 362 (defconst org-element-dual-keywords '("CAPTION" "RESULTS") 363 "List of affiliated keywords which can have a secondary value. 364 365 In Org syntax, they can be written with optional square brackets 366 before the colons. For example, RESULTS keyword can be 367 associated to a hash value with the following: 368 369 #+RESULTS[hash-string]: some-source 370 371 This list is checked after translations have been applied. See 372 `org-element-keyword-translation-alist'.") 373 374 (defconst org-element--affiliated-re 375 (format "[ \t]*#\\+\\(?:%s\\):[ \t]*" 376 (concat 377 ;; Dual affiliated keywords. 378 (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?" 379 (regexp-opt org-element-dual-keywords)) 380 "\\|" 381 ;; Regular affiliated keywords. 382 (format "\\(?1:%s\\)" 383 (regexp-opt 384 (cl-remove-if 385 (lambda (k) (member k org-element-dual-keywords)) 386 org-element-affiliated-keywords))) 387 "\\|" 388 ;; Export attributes. 389 "\\(?1:ATTR_[-_A-Za-z0-9]+\\)")) 390 "Regexp matching any affiliated keyword. 391 392 Keyword name is put in match group 1. Moreover, if keyword 393 belongs to `org-element-dual-keywords', put the dual value in 394 match group 2. 395 396 Don't modify it, set `org-element-affiliated-keywords' instead.") 397 398 (defconst org-element-object-restrictions 399 (let* ((minimal-set '(bold code entity italic latex-fragment strike-through 400 subscript superscript underline verbatim)) 401 (standard-set 402 (remq 'citation-reference (remq 'table-cell org-element-all-objects))) 403 (standard-set-no-line-break (remq 'line-break standard-set))) 404 `((bold ,@standard-set) 405 (citation citation-reference) 406 (citation-reference ,@minimal-set) 407 (footnote-reference ,@standard-set) 408 (headline ,@standard-set-no-line-break) 409 (inlinetask ,@standard-set-no-line-break) 410 (italic ,@standard-set) 411 (item ,@standard-set-no-line-break) 412 (keyword ,@(remq 'footnote-reference standard-set)) 413 ;; Ignore all links in a link description. Also ignore 414 ;; radio-targets and line breaks. 415 (link export-snippet inline-babel-call inline-src-block macro 416 statistics-cookie ,@minimal-set) 417 (paragraph ,@standard-set) 418 ;; Remove any variable object from radio target as it would 419 ;; prevent it from being properly recognized. 420 (radio-target ,@minimal-set) 421 (strike-through ,@standard-set) 422 (subscript ,@standard-set) 423 (superscript ,@standard-set) 424 ;; Ignore inline babel call and inline source block as formulas 425 ;; are possible. Also ignore line breaks and statistics 426 ;; cookies. 427 (table-cell citation export-snippet footnote-reference link macro 428 radio-target target timestamp ,@minimal-set) 429 (table-row table-cell) 430 (underline ,@standard-set) 431 (verse-block ,@standard-set))) 432 "Alist of objects restrictions. 433 434 key is an element or object type containing objects and value is 435 a list of types that can be contained within an element or object 436 of such type. 437 438 This alist also applies to secondary string. For example, an 439 `headline' type element doesn't directly contain objects, but 440 still has an entry since one of its properties (`:title') does.") 441 442 (defconst org-element-secondary-value-alist 443 '((citation :prefix :suffix) 444 (headline :title) 445 (inlinetask :title) 446 (item :tag) 447 (citation-reference :prefix :suffix)) 448 "Alist between element types and locations of secondary values.") 449 450 (defconst org-element--pair-round-table 451 (let ((table (make-char-table 'syntax-table '(2)))) 452 (modify-syntax-entry ?\( "()" table) 453 (modify-syntax-entry ?\) ")(" table) 454 table) 455 "Table used internally to pair only round brackets.") 456 457 (defconst org-element--pair-square-table 458 (let ((table (make-char-table 'syntax-table '(2)))) 459 (modify-syntax-entry ?\[ "(]" table) 460 (modify-syntax-entry ?\] ")[" table) 461 table) 462 "Table used internally to pair only square brackets.") 463 464 (defconst org-element--pair-curly-table 465 (let ((table (make-char-table 'syntax-table '(2)))) 466 (modify-syntax-entry ?\{ "(}" table) 467 (modify-syntax-entry ?\} "){" table) 468 table) 469 "Table used internally to pair only curly brackets.") 470 471 (defun org-element--parse-paired-brackets (char) 472 "Parse paired brackets at point. 473 CHAR is the opening bracket to consider, as a character. Return 474 contents between brackets, as a string, or nil. Also move point 475 past the brackets." 476 (when (eq char (char-after)) 477 (let ((syntax-table (pcase char 478 (?\{ org-element--pair-curly-table) 479 (?\[ org-element--pair-square-table) 480 (?\( org-element--pair-round-table) 481 (_ nil))) 482 (pos (point))) 483 (when syntax-table 484 (with-syntax-table syntax-table 485 (let ((end (ignore-errors (scan-lists pos 1 0)))) 486 (when end 487 (goto-char end) 488 (buffer-substring-no-properties (1+ pos) (1- end))))))))) 489 490 491 ;;; Accessors and Setters 492 ;; 493 ;; Provide four accessors: `org-element-type', `org-element-property' 494 ;; `org-element-contents' and `org-element-restriction'. 495 ;; 496 ;; Setter functions allow modification of elements by side effect. 497 ;; There is `org-element-put-property', `org-element-set-contents'. 498 ;; These low-level functions are useful to build a parse tree. 499 ;; 500 ;; `org-element-adopt-elements', `org-element-set-element', 501 ;; `org-element-extract-element' and `org-element-insert-before' are 502 ;; high-level functions useful to modify a parse tree. 503 ;; 504 ;; `org-element-secondary-p' is a predicate used to know if a given 505 ;; object belongs to a secondary string. `org-element-class' tells if 506 ;; some parsed data is an element or an object, handling pseudo 507 ;; elements and objects. `org-element-copy' returns an element or 508 ;; object, stripping its parent property in the process. 509 510 (defsubst org-element-type (element) 511 "Return type of ELEMENT. 512 513 The function returns the type of the element or object provided. 514 It can also return the following special value: 515 `plain-text' for a string 516 `org-data' for a complete document 517 nil in any other case." 518 (cond 519 ((not (consp element)) (and (stringp element) 'plain-text)) 520 ((symbolp (car element)) (car element)))) 521 522 (defsubst org-element-property (property element) 523 "Extract the value from the PROPERTY of an ELEMENT." 524 (if (stringp element) (get-text-property 0 property element) 525 (plist-get (nth 1 element) property))) 526 527 (defsubst org-element-contents (element) 528 "Extract contents from an ELEMENT." 529 (cond ((not (consp element)) nil) 530 ((symbolp (car element)) (nthcdr 2 element)) 531 (t element))) 532 533 (defsubst org-element-restriction (element) 534 "Return restriction associated to ELEMENT. 535 ELEMENT can be an element, an object or a symbol representing an 536 element or object type." 537 (cdr (assq (if (symbolp element) element (org-element-type element)) 538 org-element-object-restrictions))) 539 540 (defsubst org-element-put-property (element property value) 541 "In ELEMENT set PROPERTY to VALUE. 542 Return modified element." 543 (if (stringp element) (org-add-props element nil property value) 544 (setcar (cdr element) (plist-put (nth 1 element) property value)) 545 element)) 546 547 (defsubst org-element-set-contents (element &rest contents) 548 "Set ELEMENT's contents to CONTENTS. 549 Return ELEMENT." 550 (cond ((null element) contents) 551 ((not (symbolp (car element))) contents) 552 ((cdr element) (setcdr (cdr element) contents) element) 553 (t (nconc element contents)))) 554 555 (defun org-element-secondary-p (object) 556 "Non-nil when OBJECT directly belongs to a secondary string. 557 Return value is the property name, as a keyword, or nil." 558 (let* ((parent (org-element-property :parent object)) 559 (properties (cdr (assq (org-element-type parent) 560 org-element-secondary-value-alist)))) 561 (catch 'exit 562 (dolist (p properties) 563 (and (memq object (org-element-property p parent)) 564 (throw 'exit p)))))) 565 566 (defsubst org-element-class (datum &optional parent) 567 "Return class for ELEMENT, as a symbol. 568 Class is either `element' or `object'. Optional argument PARENT 569 is the element or object containing DATUM. It defaults to the 570 value of DATUM `:parent' property." 571 (let ((type (org-element-type datum)) 572 (parent (or parent (org-element-property :parent datum)))) 573 (cond 574 ;; Trivial cases. 575 ((memq type org-element-all-objects) 'object) 576 ((memq type org-element-all-elements) 'element) 577 ;; Special cases. 578 ((eq type 'org-data) 'element) 579 ((eq type 'plain-text) 'object) 580 ((not type) 'object) 581 ;; Pseudo object or elements. Make a guess about its class. 582 ;; Basically a pseudo object is contained within another object, 583 ;; a secondary string or a container element. 584 ((not parent) 'element) 585 (t 586 (let ((parent-type (org-element-type parent))) 587 (cond ((not parent-type) 'object) 588 ((memq parent-type org-element-object-containers) 'object) 589 ((org-element-secondary-p datum) 'object) 590 (t 'element))))))) 591 592 (defsubst org-element-adopt-elements (parent &rest children) 593 "Append elements to the contents of another element. 594 595 PARENT is an element or object. CHILDREN can be elements, 596 objects, or a strings. 597 598 The function takes care of setting `:parent' property for CHILD. 599 Return parent element." 600 (declare (indent 1)) 601 (if (not children) parent 602 ;; Link every child to PARENT. If PARENT is nil, it is a secondary 603 ;; string: parent is the list itself. 604 (dolist (child children) 605 (when child 606 (org-element-put-property child :parent (or parent children)))) 607 ;; Add CHILDREN at the end of PARENT contents. 608 (when parent 609 (apply #'org-element-set-contents 610 parent 611 (nconc (org-element-contents parent) children))) 612 ;; Return modified PARENT element. 613 (or parent children))) 614 615 (defun org-element-extract-element (element) 616 "Extract ELEMENT from parse tree. 617 Remove element from the parse tree by side-effect, and return it 618 with its `:parent' property stripped out." 619 (let ((parent (org-element-property :parent element)) 620 (secondary (org-element-secondary-p element))) 621 (if secondary 622 (org-element-put-property 623 parent secondary 624 (delq element (org-element-property secondary parent))) 625 (apply #'org-element-set-contents 626 parent 627 (delq element (org-element-contents parent)))) 628 ;; Return ELEMENT with its :parent removed. 629 (org-element-put-property element :parent nil))) 630 631 (defun org-element-insert-before (element location) 632 "Insert ELEMENT before LOCATION in parse tree. 633 LOCATION is an element, object or string within the parse tree. 634 Parse tree is modified by side effect." 635 (let* ((parent (org-element-property :parent location)) 636 (property (org-element-secondary-p location)) 637 (siblings (if property (org-element-property property parent) 638 (org-element-contents parent))) 639 ;; Special case: LOCATION is the first element of an 640 ;; independent secondary string (e.g. :title property). Add 641 ;; ELEMENT in-place. 642 (specialp (and (not property) 643 (eq siblings parent) 644 (eq (car parent) location)))) 645 ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS. 646 (cond (specialp) 647 ((or (null siblings) (eq (car siblings) location)) 648 (push element siblings)) 649 ((null location) (nconc siblings (list element))) 650 (t 651 (let ((index (cl-position location siblings))) 652 (unless index (error "No location found to insert element")) 653 (push element (cdr (nthcdr (1- index) siblings)))))) 654 ;; Store SIBLINGS at appropriate place in parse tree. 655 (cond 656 (specialp (setcdr parent (copy-sequence parent)) (setcar parent element)) 657 (property (org-element-put-property parent property siblings)) 658 (t (apply #'org-element-set-contents parent siblings))) 659 ;; Set appropriate :parent property. 660 (org-element-put-property element :parent parent))) 661 662 (defconst org-element--cache-element-properties 663 '(:cached 664 :org-element--cache-sync-key) 665 "List of element properties used internally by cache.") 666 667 (defun org-element-set-element (old new) 668 "Replace element or object OLD with element or object NEW. 669 The function takes care of setting `:parent' property for NEW." 670 ;; Ensure OLD and NEW have the same parent. 671 (org-element-put-property new :parent (org-element-property :parent old)) 672 (dolist (p org-element--cache-element-properties) 673 (when (org-element-property p old) 674 (org-element-put-property new p (org-element-property p old)))) 675 (if (or (memq (org-element-type old) '(plain-text nil)) 676 (memq (org-element-type new) '(plain-text nil))) 677 ;; We cannot replace OLD with NEW since one of them is not an 678 ;; object or element. We take the long path. 679 (progn (org-element-insert-before new old) 680 (org-element-extract-element old)) 681 ;; Since OLD is going to be changed into NEW by side-effect, first 682 ;; make sure that every element or object within NEW has OLD as 683 ;; parent. 684 (dolist (blob (org-element-contents new)) 685 (org-element-put-property blob :parent old)) 686 ;; Transfer contents. 687 (apply #'org-element-set-contents old (org-element-contents new)) 688 ;; Overwrite OLD's properties with NEW's. 689 (setcar (cdr old) (nth 1 new)) 690 ;; Transfer type. 691 (setcar old (car new)))) 692 693 (defun org-element-create (type &optional props &rest children) 694 "Create a new element of type TYPE. 695 Optional argument PROPS, when non-nil, is a plist defining the 696 properties of the element. CHILDREN can be elements, objects or 697 strings." 698 (apply #'org-element-adopt-elements (list type props) children)) 699 700 (defun org-element-copy (datum) 701 "Return a copy of DATUM. 702 DATUM is an element, object, string or nil. `:parent' property 703 is cleared and contents are removed in the process." 704 (when datum 705 (let ((type (org-element-type datum))) 706 (pcase type 707 (`org-data (list 'org-data nil)) 708 (`plain-text (substring-no-properties datum)) 709 (`nil (copy-sequence datum)) 710 (_ 711 (let ((element-copy (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil)))) 712 ;; We cannot simply return the copies property list. When 713 ;; DATUM is i.e. a headline, it's property list (`:title' 714 ;; in case of headline) can contain parsed objects. The 715 ;; objects will contain `:parent' property set to the DATUM 716 ;; itself. When copied, these inner `:parent' property 717 ;; values will contain incorrect object decoupled from 718 ;; DATUM. Changes to the DATUM copy will not longer be 719 ;; reflected in the `:parent' properties. So, we need to 720 ;; reassign inner `:parent' properties to the DATUM copy 721 ;; explicitly. 722 (org-element-map element-copy (cons 'plain-text org-element-all-objects) 723 (lambda (obj) (when (equal datum (org-element-property :parent obj)) 724 (org-element-put-property obj :parent element-copy)))) 725 element-copy)))))) 726 727 728 729 ;;; Greater elements 730 ;; 731 ;; For each greater element type, we define a parser and an 732 ;; interpreter. 733 ;; 734 ;; A parser returns the element or object as the list described above. 735 ;; Most of them accepts no argument. Though, exceptions exist. Hence 736 ;; every element containing a secondary string (see 737 ;; `org-element-secondary-value-alist') will accept an optional 738 ;; argument to toggle parsing of these secondary strings. Moreover, 739 ;; `item' parser requires current list's structure as its first 740 ;; element. 741 ;; 742 ;; An interpreter accepts two arguments: the list representation of 743 ;; the element or object, and its contents. The latter may be nil, 744 ;; depending on the element or object considered. It returns the 745 ;; appropriate Org syntax, as a string. 746 ;; 747 ;; Parsing functions must follow the naming convention: 748 ;; org-element-TYPE-parser, where TYPE is greater element's type, as 749 ;; defined in `org-element-greater-elements'. 750 ;; 751 ;; Similarly, interpreting functions must follow the naming 752 ;; convention: org-element-TYPE-interpreter. 753 ;; 754 ;; With the exception of `headline' and `item' types, greater elements 755 ;; cannot contain other greater elements of their own type. 756 ;; 757 ;; Beside implementing a parser and an interpreter, adding a new 758 ;; greater element requires tweaking `org-element--current-element'. 759 ;; Moreover, the newly defined type must be added to both 760 ;; `org-element-all-elements' and `org-element-greater-elements'. 761 762 763 ;;;; Center Block 764 765 (defun org-element-center-block-parser (limit affiliated) 766 "Parse a center block. 767 768 LIMIT bounds the search. AFFILIATED is a list of which CAR is 769 the buffer position at the beginning of the first affiliated 770 keyword and CDR is a plist of affiliated keywords along with 771 their value. 772 773 Return a list whose CAR is `center-block' and CDR is a plist 774 containing `:begin', `:end', `:contents-begin', `:contents-end', 775 `:post-blank' and `:post-affiliated' keywords. 776 777 Assume point is at the beginning of the block." 778 (let ((case-fold-search t)) 779 (if (not (save-excursion 780 (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t))) 781 ;; Incomplete block: parse it as a paragraph. 782 (org-element-paragraph-parser limit affiliated) 783 (let ((block-end-line (match-beginning 0))) 784 (let* ((begin (car affiliated)) 785 (post-affiliated (point)) 786 ;; Empty blocks have no contents. 787 (contents-begin (progn (forward-line) 788 (and (< (point) block-end-line) 789 (point)))) 790 (contents-end (and contents-begin block-end-line)) 791 (pos-before-blank (progn (goto-char block-end-line) 792 (forward-line) 793 (point))) 794 (end (save-excursion 795 (skip-chars-forward " \r\t\n" limit) 796 (if (eobp) (point) (line-beginning-position))))) 797 (list 'center-block 798 (nconc 799 (list :begin begin 800 :end end 801 :contents-begin contents-begin 802 :contents-end contents-end 803 :post-blank (count-lines pos-before-blank end) 804 :post-affiliated post-affiliated) 805 (cdr affiliated)))))))) 806 807 (defun org-element-center-block-interpreter (_ contents) 808 "Interpret a center-block element as Org syntax. 809 CONTENTS is the contents of the element." 810 (format "#+begin_center\n%s#+end_center" contents)) 811 812 813 ;;;; Drawer 814 815 (defun org-element-drawer-parser (limit affiliated) 816 "Parse a drawer. 817 818 LIMIT bounds the search. AFFILIATED is a list of which CAR is 819 the buffer position at the beginning of the first affiliated 820 keyword and CDR is a plist of affiliated keywords along with 821 their value. 822 823 Return a list whose CAR is `drawer' and CDR is a plist containing 824 `:drawer-name', `:begin', `:end', `:contents-begin', 825 `:contents-end', `:post-blank' and `:post-affiliated' keywords. 826 827 Assume point is at beginning of drawer." 828 (let ((case-fold-search t)) 829 (if (not (save-excursion 830 (goto-char (min limit (line-end-position))) 831 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) 832 ;; Incomplete drawer: parse it as a paragraph. 833 (org-element-paragraph-parser limit affiliated) 834 (save-excursion 835 (let* ((drawer-end-line (match-beginning 0)) 836 (name 837 (progn 838 (looking-at org-element-drawer-re) 839 (match-string-no-properties 1))) 840 (begin (car affiliated)) 841 (post-affiliated (point)) 842 ;; Empty drawers have no contents. 843 (contents-begin (progn (forward-line) 844 (and (< (point) drawer-end-line) 845 (point)))) 846 (contents-end (and contents-begin drawer-end-line)) 847 (pos-before-blank (progn (goto-char drawer-end-line) 848 (forward-line) 849 (point))) 850 (end (progn (skip-chars-forward " \r\t\n" limit) 851 (if (eobp) (point) (line-beginning-position))))) 852 (list 'drawer 853 (nconc 854 (list :begin begin 855 :end end 856 :drawer-name name 857 :contents-begin contents-begin 858 :contents-end contents-end 859 :post-blank (count-lines pos-before-blank end) 860 :post-affiliated post-affiliated) 861 (cdr affiliated)))))))) 862 863 (defun org-element-drawer-interpreter (drawer contents) 864 "Interpret DRAWER element as Org syntax. 865 CONTENTS is the contents of the element." 866 (format ":%s:\n%s:END:" 867 (org-element-property :drawer-name drawer) 868 contents)) 869 870 871 ;;;; Dynamic Block 872 873 (defun org-element-dynamic-block-parser (limit affiliated) 874 "Parse a dynamic block. 875 876 LIMIT bounds the search. AFFILIATED is a list of which CAR is 877 the buffer position at the beginning of the first affiliated 878 keyword and CDR is a plist of affiliated keywords along with 879 their value. 880 881 Return a list whose CAR is `dynamic-block' and CDR is a plist 882 containing `:block-name', `:begin', `:end', `:contents-begin', 883 `:contents-end', `:arguments', `:post-blank' and 884 `:post-affiliated' keywords. 885 886 Assume point is at beginning of dynamic block." 887 (let ((case-fold-search t)) 888 (if (not (save-excursion 889 (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) 890 ;; Incomplete block: parse it as a paragraph. 891 (org-element-paragraph-parser limit affiliated) 892 (let ((block-end-line (match-beginning 0))) 893 (save-excursion 894 (let* ((name (progn 895 (looking-at org-element-dynamic-block-open-re) 896 (match-string-no-properties 1))) 897 (arguments (match-string-no-properties 2)) 898 (begin (car affiliated)) 899 (post-affiliated (point)) 900 ;; Empty blocks have no contents. 901 (contents-begin (progn (forward-line) 902 (and (< (point) block-end-line) 903 (point)))) 904 (contents-end (and contents-begin block-end-line)) 905 (pos-before-blank (progn (goto-char block-end-line) 906 (forward-line) 907 (point))) 908 (end (progn (skip-chars-forward " \r\t\n" limit) 909 (if (eobp) (point) (line-beginning-position))))) 910 (list 'dynamic-block 911 (nconc 912 (list :begin begin 913 :end end 914 :block-name name 915 :arguments arguments 916 :contents-begin contents-begin 917 :contents-end contents-end 918 :post-blank (count-lines pos-before-blank end) 919 :post-affiliated post-affiliated) 920 (cdr affiliated))))))))) 921 922 (defun org-element-dynamic-block-interpreter (dynamic-block contents) 923 "Interpret DYNAMIC-BLOCK element as Org syntax. 924 CONTENTS is the contents of the element." 925 (format "#+begin: %s%s\n%s#+end:" 926 (org-element-property :block-name dynamic-block) 927 (let ((args (org-element-property :arguments dynamic-block))) 928 (if args (concat " " args) "")) 929 contents)) 930 931 932 ;;;; Footnote Definition 933 934 (defconst org-element--footnote-separator 935 (concat org-element-headline-re "\\|" 936 org-footnote-definition-re "\\|" 937 "^\\([ \t]*\n\\)\\{2,\\}") 938 "Regexp used as a footnote definition separator.") 939 940 (defun org-element-footnote-definition-parser (limit affiliated) 941 "Parse a footnote definition. 942 943 LIMIT bounds the search. AFFILIATED is a list of which CAR is 944 the buffer position at the beginning of the first affiliated 945 keyword and CDR is a plist of affiliated keywords along with 946 their value. 947 948 Return a list whose CAR is `footnote-definition' and CDR is 949 a plist containing `:label', `:begin' `:end', `:contents-begin', 950 `:contents-end', `:pre-blank',`:post-blank' and 951 `:post-affiliated' keywords. 952 953 Assume point is at the beginning of the footnote definition." 954 (save-excursion 955 (let* ((label (progn (looking-at org-footnote-definition-re) 956 (match-string-no-properties 1))) 957 (begin (car affiliated)) 958 (post-affiliated (point)) 959 (end 960 (save-excursion 961 (end-of-line) 962 (cond 963 ((not 964 (re-search-forward org-element--footnote-separator limit t)) 965 limit) 966 ((eq ?\[ (char-after (match-beginning 0))) 967 ;; At a new footnote definition, make sure we end 968 ;; before any affiliated keyword above. 969 (forward-line -1) 970 (while (and (> (point) post-affiliated) 971 (looking-at-p org-element--affiliated-re)) 972 (forward-line -1)) 973 (line-beginning-position 2)) 974 ((eq ?* (char-after (match-beginning 0))) (match-beginning 0)) 975 (t (skip-chars-forward " \r\t\n" limit) 976 (if (= limit (point)) limit (line-beginning-position)))))) 977 (pre-blank 0) 978 (contents-begin 979 (progn (search-forward "]") 980 (skip-chars-forward " \r\t\n" end) 981 (cond ((= (point) end) nil) 982 ((= (line-beginning-position) post-affiliated) (point)) 983 (t 984 (setq pre-blank 985 (count-lines (line-beginning-position) begin)) 986 (line-beginning-position))))) 987 (contents-end 988 (progn (goto-char end) 989 (skip-chars-backward " \r\t\n") 990 (line-beginning-position 2)))) 991 (list 'footnote-definition 992 (nconc 993 (list :label label 994 :begin begin 995 :end end 996 :contents-begin contents-begin 997 :contents-end (and contents-begin contents-end) 998 :pre-blank pre-blank 999 :post-blank (count-lines contents-end end) 1000 :post-affiliated post-affiliated) 1001 (cdr affiliated)))))) 1002 1003 (defun org-element-footnote-definition-interpreter (footnote-definition contents) 1004 "Interpret FOOTNOTE-DEFINITION element as Org syntax. 1005 CONTENTS is the contents of the footnote-definition." 1006 (let ((pre-blank 1007 (min (or (org-element-property :pre-blank footnote-definition) 1008 ;; 0 is specific to paragraphs at the beginning of 1009 ;; the footnote definition, so we use 1 as 1010 ;; a fall-back value, which is more universal. 1011 1) 1012 ;; Footnote ends after more than two consecutive empty 1013 ;; lines: limit ourselves to 2 newline characters. 1014 2))) 1015 (concat (format "[fn:%s]" (org-element-property :label footnote-definition)) 1016 (if (= pre-blank 0) (concat " " (org-trim contents)) 1017 (concat (make-string pre-blank ?\n) contents))))) 1018 1019 ;;;; Headline 1020 1021 (defun org-element--get-node-properties (&optional at-point-p?) 1022 "Return node properties for headline or property drawer at point. 1023 Upcase property names. It avoids confusion between properties 1024 obtained through property drawer and default properties from the 1025 parser (e.g. `:end' and :END:). Return value is a plist. 1026 1027 When AT-POINT-P? is nil, assume that point as at a headline. Otherwise 1028 parse properties for property drawer at point." 1029 (save-excursion 1030 (unless at-point-p? 1031 (forward-line) 1032 (when (looking-at-p org-element-planning-line-re) (forward-line))) 1033 (when (looking-at org-property-drawer-re) 1034 (forward-line) 1035 (let ((end (match-end 0)) properties) 1036 (while (< (line-end-position) end) 1037 (looking-at org-property-re) 1038 (let* ((property-name (concat ":" (upcase (match-string 2)))) 1039 (property-name-symbol (intern property-name)) 1040 (property-value (match-string-no-properties 3))) 1041 (cond 1042 ((and (plist-member properties property-name-symbol) 1043 (string-match-p "\\+$" property-name)) 1044 (let ((val (plist-get properties property-name-symbol))) 1045 (if (listp val) 1046 (setq properties 1047 (plist-put properties 1048 property-name-symbol 1049 (append (plist-get properties property-name-symbol) 1050 (list property-value)))) 1051 (plist-put properties property-name-symbol (list val property-value))))) 1052 (t (setq properties (plist-put properties property-name-symbol property-value))))) 1053 (forward-line)) 1054 properties)))) 1055 1056 (defun org-element--get-time-properties () 1057 "Return time properties associated to headline at point. 1058 Return value is a plist." 1059 (save-excursion 1060 (when (progn (forward-line) (looking-at org-element-planning-line-re)) 1061 (let ((end (line-end-position)) 1062 plist) 1063 (while (re-search-forward org-element-planning-keywords-re end t) 1064 (skip-chars-forward " \t") 1065 (let ((keyword (match-string 0)) 1066 (time (org-element-timestamp-parser))) 1067 (cond ((equal keyword org-element-scheduled-keyword) 1068 (setq plist (plist-put plist :scheduled time))) 1069 ((equal keyword org-element-deadline-keyword) 1070 (setq plist (plist-put plist :deadline time))) 1071 (t (setq plist (plist-put plist :closed time)))))) 1072 plist)))) 1073 1074 (defun org-element-headline-parser (&optional _ raw-secondary-p) 1075 "Parse a headline. 1076 1077 Return a list whose CAR is `headline' and CDR is a plist 1078 containing `:raw-value', `:title', `:begin', `:end', 1079 `:pre-blank', `:contents-begin' and `:contents-end', `:level', 1080 `:priority', `:tags', `:todo-keyword', `:todo-type', `:scheduled', 1081 `:deadline', `:closed', `:archivedp', `:commentedp' 1082 `:footnote-section-p', `:post-blank' and `:post-affiliated' 1083 keywords. 1084 1085 The plist also contains any property set in the property drawer, 1086 with its name in upper cases and colons added at the 1087 beginning (e.g., `:CUSTOM_ID'). 1088 1089 When RAW-SECONDARY-P is non-nil, headline's title will not be 1090 parsed as a secondary string, but as a plain string instead. 1091 1092 Assume point is at beginning of the headline." 1093 (save-excursion 1094 (let* ((begin (point)) 1095 (true-level (prog1 (skip-chars-forward "*") 1096 (skip-chars-forward " \t"))) 1097 (level (org-reduced-level true-level)) 1098 (todo (and org-todo-regexp 1099 (let (case-fold-search) (looking-at (concat org-todo-regexp " "))) 1100 (progn (goto-char (match-end 0)) 1101 (skip-chars-forward " \t") 1102 (match-string 1)))) 1103 (todo-type 1104 (and todo (if (member todo org-done-keywords) 'done 'todo))) 1105 (priority (and (looking-at "\\[#.\\][ \t]*") 1106 (progn (goto-char (match-end 0)) 1107 (aref (match-string 0) 2)))) 1108 (commentedp 1109 (and (let ((case-fold-search nil)) 1110 (looking-at org-element-comment-string)) 1111 (goto-char (match-end 0)) 1112 (when (looking-at-p "\\(?:[ \t]\\|$\\)") 1113 (point)))) 1114 (title-start (prog1 (point) 1115 (unless (or todo priority commentedp) 1116 ;; Headline like "* :tag:" 1117 (skip-chars-backward " \t")))) 1118 (tags (when (re-search-forward 1119 "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" 1120 (line-end-position) 1121 'move) 1122 (goto-char (match-beginning 0)) 1123 (org-split-string (match-string 1) ":"))) 1124 (title-end (point)) 1125 (raw-value (org-trim 1126 (buffer-substring-no-properties title-start title-end))) 1127 (archivedp (member org-element-archive-tag tags)) 1128 (footnote-section-p (and org-footnote-section 1129 (string= org-footnote-section raw-value))) 1130 (standard-props (org-element--get-node-properties)) 1131 (time-props (org-element--get-time-properties)) 1132 (end 1133 (save-excursion 1134 (let ((re (rx-to-string 1135 `(seq line-start (** 1 ,true-level "*") " ")))) 1136 (if (re-search-forward re nil t) 1137 (line-beginning-position) 1138 (point-max))))) 1139 (contents-begin (save-excursion 1140 (forward-line) 1141 (skip-chars-forward " \r\t\n" end) 1142 (and (/= (point) end) (line-beginning-position)))) 1143 (contents-end (and contents-begin 1144 (progn (goto-char end) 1145 (skip-chars-backward " \r\t\n") 1146 (line-beginning-position 2)))) 1147 (robust-begin (and contents-begin 1148 (progn (goto-char contents-begin) 1149 (when (looking-at-p org-element-planning-line-re) 1150 (forward-line)) 1151 (when (looking-at org-property-drawer-re) 1152 (goto-char (match-end 0))) 1153 ;; If there is :pre-blank, we 1154 ;; need to be careful about 1155 ;; robust beginning. 1156 (max (if (< (+ 2 contents-begin) contents-end) 1157 (+ 2 contents-begin) 1158 0) 1159 (point))))) 1160 (robust-end (and robust-begin 1161 (when (> (- contents-end 2) robust-begin) 1162 (- contents-end 2))))) 1163 (unless robust-end (setq robust-begin nil)) 1164 (let ((headline 1165 (list 'headline 1166 (nconc 1167 (list :raw-value raw-value 1168 :begin begin 1169 :end end 1170 :pre-blank 1171 (if (not contents-begin) 0 1172 (1- (count-lines begin contents-begin))) 1173 :contents-begin contents-begin 1174 :contents-end contents-end 1175 :robust-begin robust-begin 1176 :robust-end robust-end 1177 :level level 1178 :priority priority 1179 :tags tags 1180 :todo-keyword todo 1181 :todo-type todo-type 1182 :post-blank 1183 (if contents-end 1184 (count-lines contents-end end) 1185 (1- (count-lines begin end))) 1186 :footnote-section-p footnote-section-p 1187 :archivedp archivedp 1188 :commentedp commentedp 1189 :post-affiliated begin) 1190 time-props 1191 standard-props)))) 1192 (org-element-put-property 1193 headline :title 1194 (if raw-secondary-p raw-value 1195 (org-element--parse-objects 1196 (progn (goto-char title-start) 1197 (skip-chars-forward " \t") 1198 (point)) 1199 (progn (goto-char title-end) 1200 (skip-chars-backward " \t") 1201 (point)) 1202 nil 1203 (org-element-restriction 'headline) 1204 headline))))))) 1205 1206 (defun org-element-headline-interpreter (headline contents) 1207 "Interpret HEADLINE element as Org syntax. 1208 CONTENTS is the contents of the element." 1209 (let* ((level (org-element-property :level headline)) 1210 (todo (org-element-property :todo-keyword headline)) 1211 (priority (org-element-property :priority headline)) 1212 (title (org-element-interpret-data 1213 (org-element-property :title headline))) 1214 (tags (let ((tag-list (org-element-property :tags headline))) 1215 (and tag-list 1216 (format ":%s:" (mapconcat #'identity tag-list ":"))))) 1217 (commentedp (org-element-property :commentedp headline)) 1218 (pre-blank (or (org-element-property :pre-blank headline) 0)) 1219 (heading 1220 (concat (make-string (if org-odd-levels-only (1- (* level 2)) level) 1221 ?*) 1222 (and todo (concat " " todo)) 1223 (and commentedp (concat " " org-element-comment-string)) 1224 (and priority (format " [#%c]" priority)) 1225 " " 1226 (if (and org-footnote-section 1227 (org-element-property :footnote-section-p headline)) 1228 org-footnote-section 1229 title)))) 1230 (concat 1231 heading 1232 ;; Align tags. 1233 (when tags 1234 (cond 1235 ((zerop org-tags-column) (format " %s" tags)) 1236 ((< org-tags-column 0) 1237 (concat 1238 (make-string 1239 (max (- (+ org-tags-column (length heading) (length tags))) 1) 1240 ?\s) 1241 tags)) 1242 (t 1243 (concat 1244 (make-string (max (- org-tags-column (length heading)) 1) ?\s) 1245 tags)))) 1246 (make-string (1+ pre-blank) ?\n) 1247 contents))) 1248 1249 ;;;; org-data 1250 1251 (defun org-element--get-global-node-properties () 1252 "Return node properties associated with the whole Org buffer. 1253 Upcase property names. It avoids confusion between properties 1254 obtained through property drawer and default properties from the 1255 parser (e.g. `:end' and :END:). Return value is a plist." 1256 (org-with-wide-buffer 1257 (goto-char (point-min)) 1258 (while (and (org-at-comment-p) (bolp)) (forward-line)) 1259 (org-element--get-node-properties t))) 1260 1261 1262 (defvar org-element-org-data-parser--recurse nil) 1263 (defun org-element-org-data-parser (&optional _) 1264 "Parse org-data." 1265 (org-with-wide-buffer 1266 (let* ((begin 1) 1267 (contents-begin (progn 1268 (goto-char 1) 1269 (org-skip-whitespace) 1270 (beginning-of-line) 1271 (point))) 1272 (end (point-max)) 1273 (pos-before-blank (progn (goto-char (point-max)) 1274 (skip-chars-backward " \r\t\n") 1275 (line-beginning-position 2))) 1276 (robust-end (when (> (- pos-before-blank 2) contents-begin) 1277 (- pos-before-blank 2))) 1278 (robust-begin (when (and robust-end 1279 (< (+ 2 contents-begin) pos-before-blank)) 1280 (or 1281 (org-with-wide-buffer 1282 (goto-char (point-min)) 1283 (while (and (org-at-comment-p) (bolp)) (forward-line)) 1284 (when (looking-at org-property-drawer-re) 1285 (goto-char (match-end 0)) 1286 (skip-chars-backward " \t") 1287 (min robust-end (point)))) 1288 (+ 2 contents-begin)))) 1289 (category (cond ((null org-category) 1290 (when (org-with-base-buffer nil 1291 buffer-file-name) 1292 (file-name-sans-extension 1293 (file-name-nondirectory 1294 (org-with-base-buffer nil 1295 buffer-file-name))))) 1296 ((symbolp org-category) (symbol-name org-category)) 1297 (t org-category))) 1298 (category (catch 'buffer-category 1299 (unless org-element-org-data-parser--recurse 1300 (org-with-point-at end 1301 ;; Avoid recursive calls from 1302 ;; `org-element-at-point-no-context'. 1303 (let ((org-element-org-data-parser--recurse t)) 1304 (while (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t) 1305 (org-element-with-disabled-cache 1306 (let ((element (org-element-at-point-no-context))) 1307 (when (eq (org-element-type element) 'keyword) 1308 (throw 'buffer-category 1309 (org-element-property :value element))))))))) 1310 category)) 1311 (properties (org-element--get-global-node-properties))) 1312 (unless (plist-get properties :CATEGORY) 1313 (setq properties (plist-put properties :CATEGORY category))) 1314 (list 'org-data 1315 (nconc 1316 (list :begin begin 1317 :contents-begin contents-begin 1318 :contents-end pos-before-blank 1319 :end end 1320 :robust-begin robust-begin 1321 :robust-end robust-end 1322 :post-blank (count-lines pos-before-blank end) 1323 :post-affiliated begin 1324 :path (buffer-file-name) 1325 :mode 'org-data) 1326 properties))))) 1327 1328 (defun org-element-org-data-interpreter (_ contents) 1329 "Interpret ORG-DATA element as Org syntax. 1330 CONTENTS is the contents of the element." 1331 contents) 1332 1333 ;;;; Inlinetask 1334 1335 (defun org-element-inlinetask-parser (limit &optional raw-secondary-p) 1336 "Parse an inline task. 1337 1338 Return a list whose CAR is `inlinetask' and CDR is a plist 1339 containing `:title', `:begin', `:end', `:pre-blank', 1340 `:contents-begin' and `:contents-end', `:level', `:priority', 1341 `:raw-value', `:tags', `:todo-keyword', `:todo-type', 1342 `:scheduled', `:deadline', `:closed', `:post-blank' and 1343 `:post-affiliated' keywords. 1344 1345 The plist also contains any property set in the property drawer, 1346 with its name in upper cases and colons added at the 1347 beginning (e.g., `:CUSTOM_ID'). 1348 1349 When optional argument RAW-SECONDARY-P is non-nil, inline-task's 1350 title will not be parsed as a secondary string, but as a plain 1351 string instead. 1352 1353 Assume point is at beginning of the inline task." 1354 (save-excursion 1355 (let* ((begin (point)) 1356 (level (prog1 (org-reduced-level (skip-chars-forward "*")) 1357 (skip-chars-forward " \t"))) 1358 (todo (and org-todo-regexp 1359 (let (case-fold-search) (looking-at org-todo-regexp)) 1360 (progn (goto-char (match-end 0)) 1361 (skip-chars-forward " \t") 1362 (match-string 0)))) 1363 (todo-type (and todo 1364 (if (member todo org-done-keywords) 'done 'todo))) 1365 (priority (and (looking-at "\\[#.\\][ \t]*") 1366 (progn (goto-char (match-end 0)) 1367 (aref (match-string 0) 2)))) 1368 (commentedp 1369 (and (let ((case-fold-search nil)) 1370 (looking-at org-element-comment-string)) 1371 (goto-char (match-end 0)) 1372 (when (looking-at-p "\\(?:[ \t]\\|$\\)") 1373 (point)))) 1374 (title-start (prog1 (point) 1375 (unless (or todo priority commentedp) 1376 ;; Headline like "* :tag:" 1377 (skip-chars-backward " \t")))) 1378 (tags (when (re-search-forward 1379 "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" 1380 (line-end-position) 1381 'move) 1382 (goto-char (match-beginning 0)) 1383 (org-split-string (match-string 1) ":"))) 1384 (title-end (point)) 1385 (raw-value (org-trim 1386 (buffer-substring-no-properties title-start title-end))) 1387 (archivedp (member org-element-archive-tag tags)) 1388 (task-end (save-excursion 1389 (end-of-line) 1390 (and (re-search-forward org-element-headline-re limit t) 1391 (looking-at-p "[ \t]*END[ \t]*$") 1392 (line-beginning-position)))) 1393 (standard-props (and task-end (org-element--get-node-properties))) 1394 (time-props (and task-end (org-element--get-time-properties))) 1395 (contents-begin (and task-end 1396 (< (point) task-end) 1397 (progn 1398 (forward-line) 1399 (skip-chars-forward " \t\n") 1400 (line-beginning-position)))) 1401 (contents-end (and contents-begin task-end)) 1402 (end (progn (when task-end (goto-char task-end)) 1403 (forward-line) 1404 (skip-chars-forward " \r\t\n" limit) 1405 (if (eobp) (point) (line-beginning-position)))) 1406 (inlinetask 1407 (list 'inlinetask 1408 (nconc 1409 (list :raw-value raw-value 1410 :begin begin 1411 :end end 1412 :pre-blank 1413 (if (not contents-begin) 0 1414 (1- (count-lines begin contents-begin))) 1415 :contents-begin contents-begin 1416 :contents-end contents-end 1417 :level level 1418 :priority priority 1419 :tags tags 1420 :todo-keyword todo 1421 :todo-type todo-type 1422 :post-blank (1- (count-lines (or task-end begin) end)) 1423 :post-affiliated begin 1424 :archivedp archivedp 1425 :commentedp commentedp) 1426 time-props 1427 standard-props)))) 1428 (org-element-put-property 1429 inlinetask :title 1430 (if raw-secondary-p raw-value 1431 (org-element--parse-objects 1432 (progn (goto-char title-start) 1433 (skip-chars-forward " \t") 1434 (point)) 1435 (progn (goto-char title-end) 1436 (skip-chars-backward " \t") 1437 (point)) 1438 nil 1439 (org-element-restriction 'inlinetask) 1440 inlinetask)))))) 1441 1442 (defun org-element-inlinetask-interpreter (inlinetask contents) 1443 "Interpret INLINETASK element as Org syntax. 1444 CONTENTS is the contents of inlinetask." 1445 (let* ((level (org-element-property :level inlinetask)) 1446 (todo (org-element-property :todo-keyword inlinetask)) 1447 (priority (org-element-property :priority inlinetask)) 1448 (title (org-element-interpret-data 1449 (org-element-property :title inlinetask))) 1450 (tags (let ((tag-list (org-element-property :tags inlinetask))) 1451 (and tag-list 1452 (format ":%s:" (mapconcat 'identity tag-list ":"))))) 1453 (task (concat (make-string level ?*) 1454 (and todo (concat " " todo)) 1455 (and priority (format " [#%c]" priority)) 1456 (and title (concat " " title))))) 1457 (concat task 1458 ;; Align tags. 1459 (when tags 1460 (cond 1461 ((zerop org-tags-column) (format " %s" tags)) 1462 ((< org-tags-column 0) 1463 (concat 1464 (make-string 1465 (max (- (+ org-tags-column (length task) (length tags))) 1) 1466 ?\s) 1467 tags)) 1468 (t 1469 (concat 1470 (make-string (max (- org-tags-column (length task)) 1) ?\s) 1471 tags)))) 1472 ;; Prefer degenerate inlinetasks when there are no 1473 ;; contents. 1474 (when contents 1475 (concat "\n" 1476 contents 1477 (make-string level ?*) " end"))))) 1478 1479 1480 ;;;; Item 1481 1482 (defun org-element-item-parser (_ struct &optional raw-secondary-p) 1483 "Parse an item. 1484 1485 STRUCT is the structure of the plain list. 1486 1487 Return a list whose CAR is `item' and CDR is a plist containing 1488 `:bullet', `:begin', `:end', `:contents-begin', `:contents-end', 1489 `:checkbox', `:counter', `:tag', `:structure', `:pre-blank', 1490 `:post-blank' and `:post-affiliated' keywords. 1491 1492 When optional argument RAW-SECONDARY-P is non-nil, item's tag, if 1493 any, will not be parsed as a secondary string, but as a plain 1494 string instead. 1495 1496 Assume point is at the beginning of the item." 1497 (save-excursion 1498 (beginning-of-line) 1499 (looking-at org-list-full-item-re) 1500 (let* ((begin (point)) 1501 (bullet (match-string-no-properties 1)) 1502 (checkbox (let ((box (match-string 3))) 1503 (cond ((equal "[ ]" box) 'off) 1504 ((equal "[X]" box) 'on) 1505 ((equal "[-]" box) 'trans)))) 1506 (counter (let ((c (match-string 2))) 1507 (save-match-data 1508 (cond 1509 ((not c) nil) 1510 ((string-match "[A-Za-z]" c) 1511 (- (string-to-char (upcase (match-string 0 c))) 1512 64)) 1513 ((string-match "[0-9]+" c) 1514 (string-to-number (match-string 0 c))))))) 1515 (end (progn (goto-char (nth 6 (assq (point) struct))) 1516 (if (bolp) (point) (line-beginning-position 2)))) 1517 (pre-blank 0) 1518 (contents-begin 1519 (progn 1520 (goto-char 1521 ;; Ignore tags in un-ordered lists: they are just 1522 ;; a part of item's body. 1523 (if (and (match-beginning 4) 1524 (save-match-data (string-match "[.)]" bullet))) 1525 (match-beginning 4) 1526 (match-end 0))) 1527 (skip-chars-forward " \r\t\n" end) 1528 (cond ((= (point) end) nil) 1529 ;; If first line isn't empty, contents really 1530 ;; start at the text after item's meta-data. 1531 ((= (line-beginning-position) begin) (point)) 1532 (t 1533 (setq pre-blank 1534 (count-lines (line-beginning-position) begin)) 1535 (line-beginning-position))))) 1536 (contents-end (and contents-begin 1537 (progn (goto-char end) 1538 (skip-chars-backward " \r\t\n") 1539 (line-beginning-position 2)))) 1540 (item 1541 (list 'item 1542 (list :bullet bullet 1543 :begin begin 1544 :end end 1545 :contents-begin contents-begin 1546 :contents-end contents-end 1547 :checkbox checkbox 1548 :counter counter 1549 :structure struct 1550 :pre-blank pre-blank 1551 :post-blank (count-lines (or contents-end begin) end) 1552 :post-affiliated begin)))) 1553 (org-element-put-property 1554 item :tag 1555 (let ((raw (org-list-get-tag begin struct))) 1556 (when raw 1557 (if raw-secondary-p raw 1558 (org-element--parse-objects 1559 (match-beginning 4) (match-end 4) nil 1560 (org-element-restriction 'item) 1561 item)))))))) 1562 1563 (defun org-element-item-interpreter (item contents) 1564 "Interpret ITEM element as Org syntax. 1565 CONTENTS is the contents of the element." 1566 (let ((tag (pcase (org-element-property :tag item) 1567 (`nil nil) 1568 (tag (format "%s :: " (org-element-interpret-data tag))))) 1569 (bullet 1570 (org-list-bullet-string 1571 (cond 1572 ((not (string-match-p "[0-9a-zA-Z]" 1573 (org-element-property :bullet item))) "- ") 1574 ((eq org-plain-list-ordered-item-terminator ?\)) "1)") 1575 (t "1."))))) 1576 (concat 1577 bullet 1578 (pcase (org-element-property :counter item) 1579 (`nil nil) 1580 (counter (format "[@%d] " counter))) 1581 (pcase (org-element-property :checkbox item) 1582 (`on "[X] ") 1583 (`off "[ ] ") 1584 (`trans "[-] ") 1585 (_ nil)) 1586 tag 1587 (when contents 1588 (let* ((ind (make-string (if tag 5 (length bullet)) ?\s)) 1589 (pre-blank 1590 (min (or (org-element-property :pre-blank item) 1591 ;; 0 is specific to paragraphs at the 1592 ;; beginning of the item, so we use 1 as 1593 ;; a fall-back value, which is more universal. 1594 1) 1595 ;; Lists ends after more than two consecutive 1596 ;; empty lines: limit ourselves to 2 newline 1597 ;; characters. 1598 2)) 1599 (contents (replace-regexp-in-string 1600 "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) 1601 (if (= pre-blank 0) (org-trim contents) 1602 (concat (make-string pre-blank ?\n) contents))))))) 1603 1604 1605 ;;;; Plain List 1606 1607 (defun org-element--list-struct (limit) 1608 ;; Return structure of list at point. Internal function. See 1609 ;; `org-list-struct' for details. 1610 (let ((case-fold-search t) 1611 (top-ind limit) 1612 (item-re (org-item-re)) 1613 (inlinetask-re (and (featurep 'org-inlinetask) 1614 (boundp 'org-inlinetask-min-level) 1615 (boundp 'org-inlinetask-max-level) 1616 (format "^\\*\\{%d,%d\\}+ " 1617 org-inlinetask-min-level 1618 org-inlinetask-max-level))) 1619 items struct) 1620 (save-excursion 1621 (catch :exit 1622 (while t 1623 (cond 1624 ;; At limit: end all items. 1625 ((>= (point) limit) 1626 (let ((end (progn (skip-chars-backward " \r\t\n") 1627 (line-beginning-position 2)))) 1628 (dolist (item items) (setcar (nthcdr 6 item) end))) 1629 (throw :exit (sort (nconc items struct) #'car-less-than-car))) 1630 ;; At list end: end all items. 1631 ((looking-at org-list-end-re) 1632 (dolist (item items) (setcar (nthcdr 6 item) (point))) 1633 (throw :exit (sort (nconc items struct) #'car-less-than-car))) 1634 ;; At a new item: end previous sibling. 1635 ((looking-at item-re) 1636 (let ((ind (save-excursion (skip-chars-forward " \t") 1637 (org-current-text-column)))) 1638 (setq top-ind (min top-ind ind)) 1639 (while (and items (<= ind (nth 1 (car items)))) 1640 (let ((item (pop items))) 1641 (setcar (nthcdr 6 item) (point)) 1642 (push item struct))) 1643 (push (progn (looking-at org-list-full-item-re) 1644 (let ((bullet (match-string-no-properties 1))) 1645 (list (point) 1646 ind 1647 bullet 1648 (match-string-no-properties 2) ; counter 1649 (match-string-no-properties 3) ; checkbox 1650 ;; Description tag. 1651 (and (save-match-data 1652 (string-match "[-+*]" bullet)) 1653 (match-string-no-properties 4)) 1654 ;; Ending position, unknown so far. 1655 nil))) 1656 items)) 1657 (forward-line)) 1658 ;; Skip empty lines. 1659 ((looking-at "^[ \t]*$") (forward-line)) 1660 ;; Skip inline tasks and blank lines along the way. 1661 ((and inlinetask-re (looking-at inlinetask-re)) 1662 (forward-line) 1663 (let ((origin (point))) 1664 (when (re-search-forward inlinetask-re limit t) 1665 (if (looking-at-p "END[ \t]*$") (forward-line) 1666 (goto-char origin))))) 1667 ;; At some text line. Check if it ends any previous item. 1668 (t 1669 (let ((ind (save-excursion 1670 (skip-chars-forward " \t") 1671 (org-current-text-column))) 1672 (end (save-excursion 1673 (skip-chars-backward " \r\t\n") 1674 (line-beginning-position 2)))) 1675 (while (<= ind (nth 1 (car items))) 1676 (let ((item (pop items))) 1677 (setcar (nthcdr 6 item) end) 1678 (push item struct) 1679 (unless items 1680 (throw :exit (sort struct #'car-less-than-car)))))) 1681 ;; Skip blocks (any type) and drawers contents. 1682 (cond 1683 ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)") 1684 (re-search-forward 1685 (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1)) 1686 limit t))) 1687 ((and (looking-at org-element-drawer-re) 1688 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) 1689 (forward-line)))))))) 1690 1691 (defun org-element-plain-list-parser (limit affiliated structure) 1692 "Parse a plain list. 1693 1694 LIMIT bounds the search. AFFILIATED is a list of which CAR is 1695 the buffer position at the beginning of the first affiliated 1696 keyword and CDR is a plist of affiliated keywords along with 1697 their value. STRUCTURE is the structure of the plain list being 1698 parsed. 1699 1700 Return a list whose CAR is `plain-list' and CDR is a plist 1701 containing `:type', `:begin', `:end', `:contents-begin' and 1702 `:contents-end', `:structure', `:post-blank' and 1703 `:post-affiliated' keywords. 1704 1705 Assume point is at the beginning of the list." 1706 (save-excursion 1707 (let* ((struct (or structure (org-element--list-struct limit))) 1708 (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) 1709 ((nth 5 (assq (point) struct)) 'descriptive) 1710 (t 'unordered))) 1711 (contents-begin (point)) 1712 (begin (car affiliated)) 1713 (contents-end (let* ((item (assq contents-begin struct)) 1714 (ind (nth 1 item)) 1715 (pos (nth 6 item))) 1716 (while (and (setq item (assq pos struct)) 1717 (= (nth 1 item) ind)) 1718 (setq pos (nth 6 item))) 1719 pos)) 1720 (end (progn (goto-char contents-end) 1721 (skip-chars-forward " \r\t\n" limit) 1722 (if (= (point) limit) limit (line-beginning-position))))) 1723 ;; Return value. 1724 (list 'plain-list 1725 (nconc 1726 (list :type type 1727 :begin begin 1728 :end end 1729 :contents-begin contents-begin 1730 :contents-end contents-end 1731 :structure struct 1732 :post-blank (count-lines contents-end end) 1733 :post-affiliated contents-begin) 1734 (cdr affiliated)))))) 1735 1736 (defun org-element-plain-list-interpreter (_ contents) 1737 "Interpret plain-list element as Org syntax. 1738 CONTENTS is the contents of the element." 1739 (with-temp-buffer 1740 (insert contents) 1741 (goto-char (point-min)) 1742 (org-list-repair) 1743 (buffer-string))) 1744 1745 1746 ;;;; Property Drawer 1747 1748 (defun org-element-property-drawer-parser (limit) 1749 "Parse a property drawer. 1750 1751 LIMIT bounds the search. 1752 1753 Return a list whose car is `property-drawer' and cdr is a plist 1754 containing `:begin', `:end', `:contents-begin', `:contents-end', 1755 `:post-blank' and `:post-affiliated' keywords. 1756 1757 Assume point is at the beginning of the property drawer." 1758 (save-excursion 1759 (let ((case-fold-search t) 1760 (begin (point)) 1761 (contents-begin (line-beginning-position 2))) 1762 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t) 1763 (let ((contents-end (and (> (match-beginning 0) contents-begin) 1764 (match-beginning 0))) 1765 (before-blank (progn (forward-line) (point))) 1766 (end (progn (skip-chars-forward " \r\t\n" limit) 1767 (if (eobp) (point) (line-beginning-position))))) 1768 (list 'property-drawer 1769 (list :begin begin 1770 :end end 1771 :contents-begin (and contents-end contents-begin) 1772 :contents-end contents-end 1773 :post-blank (count-lines before-blank end) 1774 :post-affiliated begin)))))) 1775 1776 (defun org-element-property-drawer-interpreter (_ contents) 1777 "Interpret property-drawer element as Org syntax. 1778 CONTENTS is the properties within the drawer." 1779 (format ":PROPERTIES:\n%s:END:" contents)) 1780 1781 1782 ;;;; Quote Block 1783 1784 (defun org-element-quote-block-parser (limit affiliated) 1785 "Parse a quote block. 1786 1787 LIMIT bounds the search. AFFILIATED is a list of which CAR is 1788 the buffer position at the beginning of the first affiliated 1789 keyword and CDR is a plist of affiliated keywords along with 1790 their value. 1791 1792 Return a list whose CAR is `quote-block' and CDR is a plist 1793 containing `:begin', `:end', `:contents-begin', `:contents-end', 1794 `:post-blank' and `:post-affiliated' keywords. 1795 1796 Assume point is at the beginning of the block." 1797 (let ((case-fold-search t)) 1798 (if (not (save-excursion 1799 (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t))) 1800 ;; Incomplete block: parse it as a paragraph. 1801 (org-element-paragraph-parser limit affiliated) 1802 (let ((block-end-line (match-beginning 0))) 1803 (save-excursion 1804 (let* ((begin (car affiliated)) 1805 (post-affiliated (point)) 1806 ;; Empty blocks have no contents. 1807 (contents-begin (progn (forward-line) 1808 (and (< (point) block-end-line) 1809 (point)))) 1810 (contents-end (and contents-begin block-end-line)) 1811 (pos-before-blank (progn (goto-char block-end-line) 1812 (forward-line) 1813 (point))) 1814 (end (progn (skip-chars-forward " \r\t\n" limit) 1815 (if (eobp) (point) (line-beginning-position))))) 1816 (list 'quote-block 1817 (nconc 1818 (list :begin begin 1819 :end end 1820 :contents-begin contents-begin 1821 :contents-end contents-end 1822 :post-blank (count-lines pos-before-blank end) 1823 :post-affiliated post-affiliated) 1824 (cdr affiliated))))))))) 1825 1826 (defun org-element-quote-block-interpreter (_ contents) 1827 "Interpret quote-block element as Org syntax. 1828 CONTENTS is the contents of the element." 1829 (format "#+begin_quote\n%s#+end_quote" contents)) 1830 1831 1832 ;;;; Section 1833 1834 (defun org-element-section-parser (_) 1835 "Parse a section. 1836 1837 Return a list whose CAR is `section' and CDR is a plist 1838 containing `:begin', `:end', `:contents-begin', `contents-end', 1839 `:post-blank' and `:post-affiliated' keywords." 1840 (save-excursion 1841 ;; Beginning of section is the beginning of the first non-blank 1842 ;; line after previous headline. 1843 (let* ((begin (point)) 1844 (end (progn (org-with-limited-levels (outline-next-heading)) 1845 (point))) 1846 (pos-before-blank (progn (skip-chars-backward " \r\t\n") 1847 (line-beginning-position 2))) 1848 (robust-end (when (> (- pos-before-blank 2) begin) 1849 (- pos-before-blank 2))) 1850 (robust-begin (when robust-end begin)) 1851 ) 1852 (list 'section 1853 (list :begin begin 1854 :end end 1855 :contents-begin begin 1856 :contents-end pos-before-blank 1857 :robust-begin robust-begin 1858 :robust-end robust-end 1859 :post-blank (count-lines pos-before-blank end) 1860 :post-affiliated begin))))) 1861 1862 (defun org-element-section-interpreter (_ contents) 1863 "Interpret section element as Org syntax. 1864 CONTENTS is the contents of the element." 1865 contents) 1866 1867 1868 ;;;; Special Block 1869 1870 (defun org-element-special-block-parser (limit affiliated) 1871 "Parse a special block. 1872 1873 LIMIT bounds the search. AFFILIATED is a list of which CAR is 1874 the buffer position at the beginning of the first affiliated 1875 keyword and CDR is a plist of affiliated keywords along with 1876 their value. 1877 1878 Return a list whose CAR is `special-block' and CDR is a plist 1879 containing `:type', `:parameters', `:begin', `:end', 1880 `:contents-begin', `:contents-end', `:post-blank' and 1881 `:post-affiliated' keywords. 1882 1883 Assume point is at the beginning of the block." 1884 (let* ((case-fold-search t) 1885 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)[ \t]*\\(.*\\)[ \t]*$") 1886 (match-string-no-properties 1))) 1887 (parameters (match-string-no-properties 2))) 1888 (if (not (save-excursion 1889 (re-search-forward 1890 (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) 1891 limit t))) 1892 ;; Incomplete block: parse it as a paragraph. 1893 (org-element-paragraph-parser limit affiliated) 1894 (let ((block-end-line (match-beginning 0))) 1895 (save-excursion 1896 (let* ((begin (car affiliated)) 1897 (post-affiliated (point)) 1898 ;; Empty blocks have no contents. 1899 (contents-begin (progn (forward-line) 1900 (and (< (point) block-end-line) 1901 (point)))) 1902 (contents-end (and contents-begin block-end-line)) 1903 (pos-before-blank (progn (goto-char block-end-line) 1904 (forward-line) 1905 (point))) 1906 (end (progn (skip-chars-forward " \r\t\n" limit) 1907 (if (eobp) (point) (line-beginning-position))))) 1908 (list 'special-block 1909 (nconc 1910 (list :type type 1911 :parameters (and (org-string-nw-p parameters) 1912 (org-trim parameters)) 1913 :begin begin 1914 :end end 1915 :contents-begin contents-begin 1916 :contents-end contents-end 1917 :post-blank (count-lines pos-before-blank end) 1918 :post-affiliated post-affiliated) 1919 (cdr affiliated))))))))) 1920 1921 (defun org-element-special-block-interpreter (special-block contents) 1922 "Interpret SPECIAL-BLOCK element as Org syntax. 1923 CONTENTS is the contents of the element." 1924 (let ((block-type (org-element-property :type special-block)) 1925 (parameters (org-element-property :parameters special-block))) 1926 (format "#+begin_%s%s\n%s#+end_%s" block-type 1927 (if parameters (concat " " parameters) "") 1928 (or contents "") block-type))) 1929 1930 1931 1932 ;;; Elements 1933 ;; 1934 ;; For each element, a parser and an interpreter are also defined. 1935 ;; Both follow the same naming convention used for greater elements. 1936 ;; 1937 ;; Also, as for greater elements, adding a new element type is done 1938 ;; through the following steps: implement a parser and an interpreter, 1939 ;; tweak `org-element--current-element' so that it recognizes the new 1940 ;; type and add that new type to `org-element-all-elements'. 1941 1942 1943 ;;;; Babel Call 1944 1945 (defun org-element-babel-call-parser (limit affiliated) 1946 "Parse a babel call. 1947 1948 LIMIT bounds the search. AFFILIATED is a list of which car is 1949 the buffer position at the beginning of the first affiliated 1950 keyword and cdr is a plist of affiliated keywords along with 1951 their value. 1952 1953 Return a list whose car is `babel-call' and cdr is a plist 1954 containing `:call', `:inside-header', `:arguments', 1955 `:end-header', `:begin', `:end', `:value', `:post-blank' and 1956 `:post-affiliated' as keywords." 1957 (save-excursion 1958 (let* ((begin (car affiliated)) 1959 (post-affiliated (point)) 1960 (before-blank (line-beginning-position 2)) 1961 (value (progn (search-forward ":" before-blank t) 1962 (skip-chars-forward " \t") 1963 (org-trim 1964 (buffer-substring-no-properties 1965 (point) (line-end-position))))) 1966 (call 1967 (or (org-string-nw-p 1968 (buffer-substring-no-properties 1969 (point) (progn (skip-chars-forward "^[]()" before-blank) 1970 (point)))))) 1971 (inside-header (org-element--parse-paired-brackets ?\[)) 1972 (arguments (org-string-nw-p 1973 (org-element--parse-paired-brackets ?\())) 1974 (end-header 1975 (org-string-nw-p 1976 (org-trim 1977 (buffer-substring-no-properties (point) (line-end-position))))) 1978 (end (progn (forward-line) 1979 (skip-chars-forward " \r\t\n" limit) 1980 (if (eobp) (point) (line-beginning-position))))) 1981 (list 'babel-call 1982 (nconc 1983 (list :call call 1984 :inside-header inside-header 1985 :arguments arguments 1986 :end-header end-header 1987 :begin begin 1988 :end end 1989 :value value 1990 :post-blank (count-lines before-blank end) 1991 :post-affiliated post-affiliated) 1992 (cdr affiliated)))))) 1993 1994 (defun org-element-babel-call-interpreter (babel-call _) 1995 "Interpret BABEL-CALL element as Org syntax." 1996 (concat "#+call: " 1997 (org-element-property :call babel-call) 1998 (let ((h (org-element-property :inside-header babel-call))) 1999 (and h (format "[%s]" h))) 2000 (concat "(" (org-element-property :arguments babel-call) ")") 2001 (let ((h (org-element-property :end-header babel-call))) 2002 (and h (concat " " h))))) 2003 2004 2005 ;;;; Clock 2006 2007 (defun org-element-clock-parser (limit) 2008 "Parse a clock. 2009 2010 LIMIT bounds the search. 2011 2012 Return a list whose CAR is `clock' and CDR is a plist containing 2013 `:status', `:value', `:time', `:begin', `:end', `:post-blank' and 2014 `:post-affiliated' as keywords." 2015 (save-excursion 2016 (let* ((case-fold-search nil) 2017 (begin (point)) 2018 (value (progn (search-forward "CLOCK:" (line-end-position) t) 2019 (skip-chars-forward " \t") 2020 (org-element-timestamp-parser))) 2021 (duration (and (search-forward " => " (line-end-position) t) 2022 (progn (skip-chars-forward " \t") 2023 (looking-at "\\(\\S-+\\)[ \t]*$")) 2024 (match-string-no-properties 1))) 2025 (status (if duration 'closed 'running)) 2026 (post-blank (let ((before-blank (progn (forward-line) (point)))) 2027 (skip-chars-forward " \r\t\n" limit) 2028 (skip-chars-backward " \t") 2029 (unless (bolp) (end-of-line)) 2030 (count-lines before-blank (point)))) 2031 (end (point))) 2032 (list 'clock 2033 (list :status status 2034 :value value 2035 :duration duration 2036 :begin begin 2037 :end end 2038 :post-blank post-blank 2039 :post-affiliated begin))))) 2040 2041 (defun org-element-clock-interpreter (clock _) 2042 "Interpret CLOCK element as Org syntax." 2043 (concat "CLOCK: " 2044 (org-element-timestamp-interpreter 2045 (org-element-property :value clock) nil) 2046 (let ((duration (org-element-property :duration clock))) 2047 (and duration 2048 (concat " => " 2049 (apply 'format 2050 "%2s:%02s" 2051 (org-split-string duration ":"))))))) 2052 2053 2054 ;;;; Comment 2055 2056 (defun org-element-comment-parser (limit) 2057 "Parse a comment. 2058 2059 LIMIT bounds the search. 2060 2061 Return a list whose CAR is `comment' and CDR is a plist 2062 containing `:begin', `:end', `:value', `:post-blank', 2063 `:post-affiliated' keywords. 2064 2065 Assume point is at comment beginning." 2066 (save-excursion 2067 (let* ((begin (point)) 2068 (value (prog2 (looking-at "[ \t]*# ?") 2069 (buffer-substring-no-properties 2070 (match-end 0) (line-end-position)) 2071 (forward-line))) 2072 (com-end 2073 ;; Get comments ending. 2074 (progn 2075 (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)")) 2076 ;; Accumulate lines without leading hash and first 2077 ;; whitespace. 2078 (setq value 2079 (concat value 2080 "\n" 2081 (buffer-substring-no-properties 2082 (match-end 0) (line-end-position)))) 2083 (forward-line)) 2084 (point))) 2085 (end (progn (goto-char com-end) 2086 (skip-chars-forward " \r\t\n" limit) 2087 (if (eobp) (point) (line-beginning-position))))) 2088 (list 'comment 2089 (list :begin begin 2090 :end end 2091 :value value 2092 :post-blank (count-lines com-end end) 2093 :post-affiliated begin))))) 2094 2095 (defun org-element-comment-interpreter (comment _) 2096 "Interpret COMMENT element as Org syntax. 2097 CONTENTS is nil." 2098 (replace-regexp-in-string "^" "# " (org-element-property :value comment))) 2099 2100 2101 ;;;; Comment Block 2102 2103 (defun org-element-comment-block-parser (limit affiliated) 2104 "Parse an export block. 2105 2106 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2107 the buffer position at the beginning of the first affiliated 2108 keyword and CDR is a plist of affiliated keywords along with 2109 their value. 2110 2111 Return a list whose CAR is `comment-block' and CDR is a plist 2112 containing `:begin', `:end', `:value', `:post-blank' and 2113 `:post-affiliated' keywords. 2114 2115 Assume point is at comment block beginning." 2116 (let ((case-fold-search t)) 2117 (if (not (save-excursion 2118 (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t))) 2119 ;; Incomplete block: parse it as a paragraph. 2120 (org-element-paragraph-parser limit affiliated) 2121 (let ((contents-end (match-beginning 0))) 2122 (save-excursion 2123 (let* ((begin (car affiliated)) 2124 (post-affiliated (point)) 2125 (contents-begin (progn (forward-line) (point))) 2126 (pos-before-blank (progn (goto-char contents-end) 2127 (forward-line) 2128 (point))) 2129 (end (progn (skip-chars-forward " \r\t\n" limit) 2130 (if (eobp) (point) (line-beginning-position)))) 2131 (value (buffer-substring-no-properties 2132 contents-begin contents-end))) 2133 (list 'comment-block 2134 (nconc 2135 (list :begin begin 2136 :end end 2137 :value value 2138 :post-blank (count-lines pos-before-blank end) 2139 :post-affiliated post-affiliated) 2140 (cdr affiliated))))))))) 2141 2142 (defun org-element-comment-block-interpreter (comment-block _) 2143 "Interpret COMMENT-BLOCK element as Org syntax." 2144 (format "#+begin_comment\n%s#+end_comment" 2145 (org-element-normalize-string 2146 (org-remove-indentation 2147 (org-element-property :value comment-block))))) 2148 2149 2150 ;;;; Diary Sexp 2151 2152 (defun org-element-diary-sexp-parser (limit affiliated) 2153 "Parse a diary sexp. 2154 2155 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2156 the buffer position at the beginning of the first affiliated 2157 keyword and CDR is a plist of affiliated keywords along with 2158 their value. 2159 2160 Return a list whose CAR is `diary-sexp' and CDR is a plist 2161 containing `:begin', `:end', `:value', `:post-blank' and 2162 `:post-affiliated' keywords." 2163 (save-excursion 2164 (let ((begin (car affiliated)) 2165 (post-affiliated (point)) 2166 (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") 2167 (match-string-no-properties 1))) 2168 (pos-before-blank (progn (forward-line) (point))) 2169 (end (progn (skip-chars-forward " \r\t\n" limit) 2170 (if (eobp) (point) (line-beginning-position))))) 2171 (list 'diary-sexp 2172 (nconc 2173 (list :value value 2174 :begin begin 2175 :end end 2176 :post-blank (count-lines pos-before-blank end) 2177 :post-affiliated post-affiliated) 2178 (cdr affiliated)))))) 2179 2180 (defun org-element-diary-sexp-interpreter (diary-sexp _) 2181 "Interpret DIARY-SEXP as Org syntax." 2182 (org-element-property :value diary-sexp)) 2183 2184 2185 ;;;; Example Block 2186 2187 (defun org-element-example-block-parser (limit affiliated) 2188 "Parse an example block. 2189 2190 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2191 the buffer position at the beginning of the first affiliated 2192 keyword and CDR is a plist of affiliated keywords along with 2193 their value. 2194 2195 Return a list whose CAR is `example-block' and CDR is a plist 2196 containing `:begin', `:end', `:number-lines', `:preserve-indent', 2197 `:retain-labels', `:use-labels', `:label-fmt', `:switches', 2198 `:value', `:post-blank' and `:post-affiliated' keywords." 2199 (let ((case-fold-search t)) 2200 (if (not (save-excursion 2201 (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) 2202 ;; Incomplete block: parse it as a paragraph. 2203 (org-element-paragraph-parser limit affiliated) 2204 (let ((contents-end (match-beginning 0))) 2205 (save-excursion 2206 (let* ((switches 2207 (progn 2208 (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") 2209 (match-string-no-properties 1))) 2210 ;; Switches analysis. 2211 (number-lines 2212 (and switches 2213 (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" 2214 switches) 2215 (cons 2216 (if (equal (match-string 1 switches) "-") 2217 'new 2218 'continued) 2219 (if (not (match-end 2)) 0 2220 ;; Subtract 1 to give number of lines before 2221 ;; first line. 2222 (1- (string-to-number (match-string 2 switches))))))) 2223 (preserve-indent 2224 (and switches (string-match "-i\\>" switches))) 2225 ;; Should labels be retained in (or stripped from) example 2226 ;; blocks? 2227 (retain-labels 2228 (or (not switches) 2229 (not (string-match "-r\\>" switches)) 2230 (and number-lines (string-match "-k\\>" switches)))) 2231 ;; What should code-references use - labels or 2232 ;; line-numbers? 2233 (use-labels 2234 (or (not switches) 2235 (and retain-labels 2236 (not (string-match "-k\\>" switches))))) 2237 (label-fmt 2238 (and switches 2239 (string-match "-l +\"\\([^\"\n]+\\)\"" switches) 2240 (match-string 1 switches))) 2241 ;; Standard block parsing. 2242 (begin (car affiliated)) 2243 (post-affiliated (point)) 2244 (contents-begin (line-beginning-position 2)) 2245 (value (org-unescape-code-in-string 2246 (buffer-substring-no-properties 2247 contents-begin contents-end))) 2248 (pos-before-blank (progn (goto-char contents-end) 2249 (forward-line) 2250 (point))) 2251 (end (progn (skip-chars-forward " \r\t\n" limit) 2252 (if (eobp) (point) (line-beginning-position))))) 2253 (list 'example-block 2254 (nconc 2255 (list :begin begin 2256 :end end 2257 :value value 2258 :switches switches 2259 :number-lines number-lines 2260 :preserve-indent preserve-indent 2261 :retain-labels retain-labels 2262 :use-labels use-labels 2263 :label-fmt label-fmt 2264 :post-blank (count-lines pos-before-blank end) 2265 :post-affiliated post-affiliated) 2266 (cdr affiliated))))))))) 2267 2268 (defun org-element-example-block-interpreter (example-block _) 2269 "Interpret EXAMPLE-BLOCK element as Org syntax." 2270 (let ((switches (org-element-property :switches example-block)) 2271 (value 2272 (let ((val (org-element-property :value example-block))) 2273 (cond 2274 ((or org-src-preserve-indentation 2275 (org-element-property :preserve-indent example-block)) 2276 val) 2277 ((= 0 org-edit-src-content-indentation) 2278 (org-remove-indentation val)) 2279 (t 2280 (let ((ind (make-string org-edit-src-content-indentation ?\s))) 2281 (replace-regexp-in-string "^[ \t]*\\S-" 2282 (concat ind "\\&") 2283 (org-remove-indentation val)))))))) 2284 (concat "#+begin_example" (and switches (concat " " switches)) "\n" 2285 (org-element-normalize-string (org-escape-code-in-string value)) 2286 "#+end_example"))) 2287 2288 2289 ;;;; Export Block 2290 2291 (defun org-element-export-block-parser (limit affiliated) 2292 "Parse an export block. 2293 2294 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2295 the buffer position at the beginning of the first affiliated 2296 keyword and CDR is a plist of affiliated keywords along with 2297 their value. 2298 2299 Return a list whose CAR is `export-block' and CDR is a plist 2300 containing `:begin', `:end', `:type', `:value', `:post-blank' and 2301 `:post-affiliated' keywords. 2302 2303 Assume point is at export-block beginning." 2304 (let* ((case-fold-search t)) 2305 (if (not (save-excursion 2306 (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t))) 2307 ;; Incomplete block: parse it as a paragraph. 2308 (org-element-paragraph-parser limit affiliated) 2309 (save-excursion 2310 (let* ((contents-end (match-beginning 0)) 2311 (backend 2312 (progn 2313 (looking-at 2314 "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$") 2315 (match-string-no-properties 1))) 2316 (begin (car affiliated)) 2317 (post-affiliated (point)) 2318 (contents-begin (progn (forward-line) (point))) 2319 (pos-before-blank (progn (goto-char contents-end) 2320 (forward-line) 2321 (point))) 2322 (end (progn (skip-chars-forward " \r\t\n" limit) 2323 (if (eobp) (point) (line-beginning-position)))) 2324 (value (org-unescape-code-in-string 2325 (buffer-substring-no-properties contents-begin 2326 contents-end)))) 2327 (list 'export-block 2328 (nconc 2329 (list :type (and backend (upcase backend)) 2330 :begin begin 2331 :end end 2332 :value value 2333 :post-blank (count-lines pos-before-blank end) 2334 :post-affiliated post-affiliated) 2335 (cdr affiliated)))))))) 2336 2337 (defun org-element-export-block-interpreter (export-block _) 2338 "Interpret EXPORT-BLOCK element as Org syntax." 2339 (format "#+begin_export %s\n%s#+end_export" 2340 (org-element-property :type export-block) 2341 (org-element-property :value export-block))) 2342 2343 2344 ;;;; Fixed-width 2345 2346 (defun org-element-fixed-width-parser (limit affiliated) 2347 "Parse a fixed-width section. 2348 2349 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2350 the buffer position at the beginning of the first affiliated 2351 keyword and CDR is a plist of affiliated keywords along with 2352 their value. 2353 2354 Return a list whose CAR is `fixed-width' and CDR is a plist 2355 containing `:begin', `:end', `:value', `:post-blank' and 2356 `:post-affiliated' keywords. 2357 2358 Assume point is at the beginning of the fixed-width area." 2359 (save-excursion 2360 (let* ((begin (car affiliated)) 2361 (post-affiliated (point)) 2362 (end-area 2363 (progn 2364 (while (and (< (point) limit) 2365 (looking-at "[ \t]*:\\( \\|$\\)")) 2366 (forward-line)) 2367 (if (bolp) (line-end-position 0) (point)))) 2368 (end (progn (skip-chars-forward " \r\t\n" limit) 2369 (if (eobp) (point) (line-beginning-position))))) 2370 (list 'fixed-width 2371 (nconc 2372 (list :begin begin 2373 :end end 2374 :value (replace-regexp-in-string 2375 "^[ \t]*: ?" "" 2376 (buffer-substring-no-properties post-affiliated 2377 end-area)) 2378 :post-blank (count-lines end-area end) 2379 :post-affiliated post-affiliated) 2380 (cdr affiliated)))))) 2381 2382 (defun org-element-fixed-width-interpreter (fixed-width _) 2383 "Interpret FIXED-WIDTH element as Org syntax." 2384 (let ((value (org-element-property :value fixed-width))) 2385 (and value (replace-regexp-in-string "^" ": " value)))) 2386 2387 2388 ;;;; Horizontal Rule 2389 2390 (defun org-element-horizontal-rule-parser (limit affiliated) 2391 "Parse an horizontal rule. 2392 2393 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2394 the buffer position at the beginning of the first affiliated 2395 keyword and CDR is a plist of affiliated keywords along with 2396 their value. 2397 2398 Return a list whose CAR is `horizontal-rule' and CDR is a plist 2399 containing `:begin', `:end', `:post-blank' and `:post-affiliated' 2400 keywords." 2401 (save-excursion 2402 (let ((begin (car affiliated)) 2403 (post-affiliated (point)) 2404 (post-hr (progn (forward-line) (point))) 2405 (end (progn (skip-chars-forward " \r\t\n" limit) 2406 (if (eobp) (point) (line-beginning-position))))) 2407 (list 'horizontal-rule 2408 (nconc 2409 (list :begin begin 2410 :end end 2411 :post-blank (count-lines post-hr end) 2412 :post-affiliated post-affiliated) 2413 (cdr affiliated)))))) 2414 2415 (defun org-element-horizontal-rule-interpreter (&rest _) 2416 "Interpret HORIZONTAL-RULE element as Org syntax." 2417 "-----") 2418 2419 2420 ;;;; Keyword 2421 2422 (defun org-element-keyword-parser (limit affiliated) 2423 "Parse a keyword at point. 2424 2425 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2426 the buffer position at the beginning of the first affiliated 2427 keyword and CDR is a plist of affiliated keywords along with 2428 their value. 2429 2430 Return a list whose CAR is a normalized `keyword' (uppercase) and 2431 CDR is a plist containing `:key', `:value', `:begin', `:end', 2432 `:post-blank' and `:post-affiliated' keywords." 2433 (save-excursion 2434 ;; An orphaned affiliated keyword is considered as a regular 2435 ;; keyword. In this case AFFILIATED is nil, so we take care of 2436 ;; this corner case. 2437 (let ((begin (or (car affiliated) (point))) 2438 (post-affiliated (point)) 2439 (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):") 2440 (upcase (match-string-no-properties 1)))) 2441 (value (org-trim (buffer-substring-no-properties 2442 (match-end 0) (line-end-position)))) 2443 (pos-before-blank (progn (forward-line) (point))) 2444 (end (progn (skip-chars-forward " \r\t\n" limit) 2445 (if (eobp) (point) (line-beginning-position))))) 2446 (list 'keyword 2447 (nconc 2448 (list :key key 2449 :value value 2450 :begin begin 2451 :end end 2452 :post-blank (count-lines pos-before-blank end) 2453 :post-affiliated post-affiliated) 2454 (cdr affiliated)))))) 2455 2456 (defun org-element-keyword-interpreter (keyword _) 2457 "Interpret KEYWORD element as Org syntax." 2458 (format "#+%s: %s" 2459 (downcase (org-element-property :key keyword)) 2460 (org-element-property :value keyword))) 2461 2462 2463 ;;;; Latex Environment 2464 2465 (defconst org-element--latex-begin-environment 2466 "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}" 2467 "Regexp matching the beginning of a LaTeX environment. 2468 The environment is captured by the first group. 2469 2470 See also `org-element--latex-end-environment'.") 2471 2472 (defconst org-element--latex-end-environment 2473 "\\\\end{%s}[ \t]*$" 2474 "Format string matching the ending of a LaTeX environment. 2475 See also `org-element--latex-begin-environment'.") 2476 2477 (defun org-element-latex-environment-parser (limit affiliated) 2478 "Parse a LaTeX environment. 2479 2480 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2481 the buffer position at the beginning of the first affiliated 2482 keyword and CDR is a plist of affiliated keywords along with 2483 their value. 2484 2485 Return a list whose CAR is `latex-environment' and CDR is a plist 2486 containing `:begin', `:end', `:value', `:post-blank' and 2487 `:post-affiliated' keywords. 2488 2489 Assume point is at the beginning of the latex environment." 2490 (save-excursion 2491 (let ((case-fold-search t) 2492 (code-begin (point))) 2493 (looking-at org-element--latex-begin-environment) 2494 (if (not (re-search-forward (format org-element--latex-end-environment 2495 (regexp-quote (match-string 1))) 2496 limit t)) 2497 ;; Incomplete latex environment: parse it as a paragraph. 2498 (org-element-paragraph-parser limit affiliated) 2499 (let* ((code-end (progn (forward-line) (point))) 2500 (begin (car affiliated)) 2501 (value (buffer-substring-no-properties code-begin code-end)) 2502 (end (progn (skip-chars-forward " \r\t\n" limit) 2503 (if (eobp) (point) (line-beginning-position))))) 2504 (list 'latex-environment 2505 (nconc 2506 (list :begin begin 2507 :end end 2508 :value value 2509 :post-blank (count-lines code-end end) 2510 :post-affiliated code-begin) 2511 (cdr affiliated)))))))) 2512 2513 (defun org-element-latex-environment-interpreter (latex-environment _) 2514 "Interpret LATEX-ENVIRONMENT element as Org syntax." 2515 (org-element-property :value latex-environment)) 2516 2517 2518 ;;;; Node Property 2519 2520 (defun org-element-node-property-parser (limit) 2521 "Parse a node-property at point. 2522 2523 LIMIT bounds the search. 2524 2525 Return a list whose CAR is `node-property' and CDR is a plist 2526 containing `:key', `:value', `:begin', `:end', `:post-blank' and 2527 `:post-affiliated' keywords." 2528 (looking-at org-property-re) 2529 (let ((case-fold-search t) 2530 (begin (point)) 2531 (key (match-string-no-properties 2)) 2532 (value (match-string-no-properties 3)) 2533 (end (save-excursion 2534 (end-of-line) 2535 (if (re-search-forward org-property-re limit t) 2536 (line-beginning-position) 2537 limit)))) 2538 (list 'node-property 2539 (list :key key 2540 :value value 2541 :begin begin 2542 :end end 2543 :post-blank 0 2544 :post-affiliated begin)))) 2545 2546 (defun org-element-node-property-interpreter (node-property _) 2547 "Interpret NODE-PROPERTY element as Org syntax." 2548 (format org-property-format 2549 (format ":%s:" (org-element-property :key node-property)) 2550 (or (org-element-property :value node-property) ""))) 2551 2552 2553 ;;;; Paragraph 2554 2555 (defun org-element-paragraph-parser (limit affiliated) 2556 "Parse a paragraph. 2557 2558 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2559 the buffer position at the beginning of the first affiliated 2560 keyword and CDR is a plist of affiliated keywords along with 2561 their value. 2562 2563 Return a list whose CAR is `paragraph' and CDR is a plist 2564 containing `:begin', `:end', `:contents-begin' and 2565 `:contents-end', `:post-blank' and `:post-affiliated' keywords. 2566 2567 Assume point is at the beginning of the paragraph." 2568 (save-excursion 2569 (let* ((begin (car affiliated)) 2570 (contents-begin (point)) 2571 (before-blank 2572 (let ((case-fold-search t)) 2573 (end-of-line) 2574 ;; A matching `org-element-paragraph-separate' is not 2575 ;; necessarily the end of the paragraph. In particular, 2576 ;; drawers, blocks or LaTeX environments opening lines 2577 ;; must be closed. Moreover keywords with a secondary 2578 ;; value must belong to "dual keywords". 2579 (while (not 2580 (cond 2581 ((not (and (re-search-forward 2582 org-element-paragraph-separate limit 'move) 2583 (progn (beginning-of-line) t)))) 2584 ((looking-at org-element-drawer-re) 2585 (save-excursion 2586 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) 2587 ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") 2588 (save-excursion 2589 (re-search-forward 2590 (format "^[ \t]*#\\+END_%s[ \t]*$" 2591 (regexp-quote (match-string 1))) 2592 limit t))) 2593 ((looking-at org-element--latex-begin-environment) 2594 (save-excursion 2595 (re-search-forward 2596 (format org-element--latex-end-environment 2597 (regexp-quote (match-string 1))) 2598 limit t))) 2599 ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:") 2600 (member-ignore-case (match-string 1) 2601 org-element-dual-keywords)) 2602 ;; Everything else is unambiguous. 2603 (t))) 2604 (end-of-line)) 2605 (if (= (point) limit) limit 2606 (goto-char (line-beginning-position))))) 2607 (contents-end (save-excursion 2608 (skip-chars-backward " \r\t\n" contents-begin) 2609 (line-beginning-position 2))) 2610 (end (progn (skip-chars-forward " \r\t\n" limit) 2611 (if (eobp) (point) (line-beginning-position))))) 2612 (list 'paragraph 2613 (nconc 2614 (list :begin begin 2615 :end end 2616 :contents-begin contents-begin 2617 :contents-end contents-end 2618 :post-blank (count-lines before-blank end) 2619 :post-affiliated contents-begin) 2620 (cdr affiliated)))))) 2621 2622 (defun org-element-paragraph-interpreter (_ contents) 2623 "Interpret paragraph element as Org syntax. 2624 CONTENTS is the contents of the element." 2625 contents) 2626 2627 2628 ;;;; Planning 2629 2630 (defun org-element-planning-parser (limit) 2631 "Parse a planning. 2632 2633 LIMIT bounds the search. 2634 2635 Return a list whose CAR is `planning' and CDR is a plist 2636 containing `:closed', `:deadline', `:scheduled', `:begin', 2637 `:end', `:post-blank' and `:post-affiliated' keywords." 2638 (save-excursion 2639 (let* ((case-fold-search nil) 2640 (begin (point)) 2641 (post-blank (let ((before-blank (progn (forward-line) (point)))) 2642 (skip-chars-forward " \r\t\n" limit) 2643 (skip-chars-backward " \t") 2644 (unless (bolp) (end-of-line)) 2645 (count-lines before-blank (point)))) 2646 (end (point)) 2647 closed deadline scheduled) 2648 (goto-char begin) 2649 (while (re-search-forward org-element-planning-keywords-re end t) 2650 (skip-chars-forward " \t" end) 2651 (let ((keyword (match-string 0)) 2652 (time (org-element-timestamp-parser))) 2653 (cond 2654 ((equal keyword org-element-closed-keyword) (setq closed time)) 2655 ((equal keyword org-element-deadline-keyword) (setq deadline time)) 2656 (t (setq scheduled time))))) 2657 (list 'planning 2658 (list :closed closed 2659 :deadline deadline 2660 :scheduled scheduled 2661 :begin begin 2662 :end end 2663 :post-blank post-blank 2664 :post-affiliated begin))))) 2665 2666 (defun org-element-planning-interpreter (planning _) 2667 "Interpret PLANNING element as Org syntax." 2668 (mapconcat 2669 #'identity 2670 (delq nil 2671 (list (let ((deadline (org-element-property :deadline planning))) 2672 (when deadline 2673 (concat org-element-deadline-keyword " " 2674 (org-element-timestamp-interpreter deadline nil)))) 2675 (let ((scheduled (org-element-property :scheduled planning))) 2676 (when scheduled 2677 (concat org-element-scheduled-keyword " " 2678 (org-element-timestamp-interpreter scheduled nil)))) 2679 (let ((closed (org-element-property :closed planning))) 2680 (when closed 2681 (concat org-element-closed-keyword " " 2682 (org-element-timestamp-interpreter closed nil)))))) 2683 " ")) 2684 2685 2686 ;;;; Src Block 2687 2688 (defun org-element-src-block-parser (limit affiliated) 2689 "Parse a source block. 2690 2691 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2692 the buffer position at the beginning of the first affiliated 2693 keyword and CDR is a plist of affiliated keywords along with 2694 their value. 2695 2696 Return a list whose CAR is `src-block' and CDR is a plist 2697 containing `:language', `:switches', `:parameters', `:begin', 2698 `:end', `:number-lines', `:retain-labels', `:use-labels', 2699 `:label-fmt', `:preserve-indent', `:value', `:post-blank' and 2700 `:post-affiliated' keywords. 2701 2702 Assume point is at the beginning of the block." 2703 (let ((case-fold-search t)) 2704 (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$" 2705 limit t))) 2706 ;; Incomplete block: parse it as a paragraph. 2707 (org-element-paragraph-parser limit affiliated) 2708 (let ((contents-end (match-beginning 0))) 2709 (save-excursion 2710 (let* ((begin (car affiliated)) 2711 (post-affiliated (point)) 2712 ;; Get language as a string. 2713 (language 2714 (progn 2715 (looking-at 2716 "^[ \t]*#\\+BEGIN_SRC\ 2717 \\(?: +\\(\\S-+\\)\\)?\ 2718 \\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\ 2719 \\(.*\\)[ \t]*$") 2720 (match-string-no-properties 1))) 2721 ;; Get switches. 2722 (switches (match-string-no-properties 2)) 2723 ;; Get parameters. 2724 (parameters (match-string-no-properties 3)) 2725 ;; Switches analysis. 2726 (number-lines 2727 (and switches 2728 (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" 2729 switches) 2730 (cons 2731 (if (equal (match-string 1 switches) "-") 2732 'new 2733 'continued) 2734 (if (not (match-end 2)) 0 2735 ;; Subtract 1 to give number of lines before 2736 ;; first line. 2737 (1- (string-to-number (match-string 2 switches))))))) 2738 (preserve-indent (and switches 2739 (string-match "-i\\>" switches))) 2740 (label-fmt 2741 (and switches 2742 (string-match "-l +\"\\([^\"\n]+\\)\"" switches) 2743 (match-string 1 switches))) 2744 ;; Should labels be retained in (or stripped from) 2745 ;; source blocks? 2746 (retain-labels 2747 (or (not switches) 2748 (not (string-match "-r\\>" switches)) 2749 (and number-lines (string-match "-k\\>" switches)))) 2750 ;; What should code-references use - labels or 2751 ;; line-numbers? 2752 (use-labels 2753 (or (not switches) 2754 (and retain-labels 2755 (not (string-match "-k\\>" switches))))) 2756 ;; Retrieve code. 2757 (value (org-unescape-code-in-string 2758 (buffer-substring-no-properties 2759 (line-beginning-position 2) contents-end))) 2760 (pos-before-blank (progn (goto-char contents-end) 2761 (forward-line) 2762 (point))) 2763 ;; Get position after ending blank lines. 2764 (end (progn (skip-chars-forward " \r\t\n" limit) 2765 (if (eobp) (point) (line-beginning-position))))) 2766 (list 'src-block 2767 (nconc 2768 (list :language language 2769 :switches (and (org-string-nw-p switches) 2770 (org-trim switches)) 2771 :parameters (and (org-string-nw-p parameters) 2772 (org-trim parameters)) 2773 :begin begin 2774 :end end 2775 :number-lines number-lines 2776 :preserve-indent preserve-indent 2777 :retain-labels retain-labels 2778 :use-labels use-labels 2779 :label-fmt label-fmt 2780 :value value 2781 :post-blank (count-lines pos-before-blank end) 2782 :post-affiliated post-affiliated) 2783 (cdr affiliated))))))))) 2784 2785 (defun org-element-src-block-interpreter (src-block _) 2786 "Interpret SRC-BLOCK element as Org syntax." 2787 (let ((lang (org-element-property :language src-block)) 2788 (switches (org-element-property :switches src-block)) 2789 (params (org-element-property :parameters src-block)) 2790 (value 2791 (let ((val (org-element-property :value src-block))) 2792 (cond 2793 ((or org-src-preserve-indentation 2794 (org-element-property :preserve-indent src-block)) 2795 val) 2796 ((zerop org-edit-src-content-indentation) 2797 (org-remove-indentation val)) 2798 (t 2799 (let ((ind (make-string org-edit-src-content-indentation ?\s))) 2800 (replace-regexp-in-string "^[ \t]*\\S-" 2801 (concat ind "\\&") 2802 (org-remove-indentation val)))))))) 2803 (format "#+begin_src%s\n%s#+end_src" 2804 (concat (and lang (concat " " lang)) 2805 (and switches (concat " " switches)) 2806 (and params (concat " " params))) 2807 (org-element-normalize-string (org-escape-code-in-string value))))) 2808 2809 2810 ;;;; Table 2811 2812 (defun org-element-table-parser (limit affiliated) 2813 "Parse a table at point. 2814 2815 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2816 the buffer position at the beginning of the first affiliated 2817 keyword and CDR is a plist of affiliated keywords along with 2818 their value. 2819 2820 Return a list whose CAR is `table' and CDR is a plist containing 2821 `:begin', `:end', `:tblfm', `:type', `:contents-begin', 2822 `:contents-end', `:value', `:post-blank' and `:post-affiliated' 2823 keywords. 2824 2825 Assume point is at the beginning of the table." 2826 (save-excursion 2827 (let* ((case-fold-search t) 2828 (table-begin (point)) 2829 (type (if (looking-at "[ \t]*|") 'org 'table.el)) 2830 (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)" 2831 (if (eq type 'org) "" "+"))) 2832 (begin (car affiliated)) 2833 (table-end 2834 (if (re-search-forward end-re limit 'move) 2835 (goto-char (match-beginning 0)) 2836 (point))) 2837 (tblfm (let (acc) 2838 (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") 2839 (push (match-string-no-properties 1) acc) 2840 (forward-line)) 2841 acc)) 2842 (pos-before-blank (point)) 2843 (end (progn (skip-chars-forward " \r\t\n" limit) 2844 (if (eobp) (point) (line-beginning-position))))) 2845 (list 'table 2846 (nconc 2847 (list :begin begin 2848 :end end 2849 :type type 2850 :tblfm tblfm 2851 ;; Only `org' tables have contents. `table.el' tables 2852 ;; use a `:value' property to store raw table as 2853 ;; a string. 2854 :contents-begin (and (eq type 'org) table-begin) 2855 :contents-end (and (eq type 'org) table-end) 2856 :value (and (eq type 'table.el) 2857 (buffer-substring-no-properties 2858 table-begin table-end)) 2859 :post-blank (count-lines pos-before-blank end) 2860 :post-affiliated table-begin) 2861 (cdr affiliated)))))) 2862 2863 (defun org-element-table-interpreter (table contents) 2864 "Interpret TABLE element as Org syntax. 2865 CONTENTS is a string, if table's type is `org', or nil." 2866 (if (eq (org-element-property :type table) 'table.el) 2867 (org-remove-indentation (org-element-property :value table)) 2868 (concat (with-temp-buffer (insert contents) 2869 (org-table-align) 2870 (buffer-string)) 2871 (mapconcat (lambda (fm) (concat "#+TBLFM: " fm)) 2872 (reverse (org-element-property :tblfm table)) 2873 "\n")))) 2874 2875 2876 ;;;; Table Row 2877 2878 (defun org-element-table-row-parser (_) 2879 "Parse table row at point. 2880 2881 Return a list whose CAR is `table-row' and CDR is a plist 2882 containing `:begin', `:end', `:contents-begin', `:contents-end', 2883 `:type', `:post-blank' and `:post-affiliated' keywords." 2884 (save-excursion 2885 (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) 2886 (begin (point)) 2887 ;; A table rule has no contents. In that case, ensure 2888 ;; CONTENTS-BEGIN matches CONTENTS-END. 2889 (contents-begin (and (eq type 'standard) (search-forward "|"))) 2890 (contents-end (and (eq type 'standard) 2891 (progn 2892 (end-of-line) 2893 (skip-chars-backward " \t") 2894 (point)))) 2895 (end (line-beginning-position 2))) 2896 (list 'table-row 2897 (list :type type 2898 :begin begin 2899 :end end 2900 :contents-begin contents-begin 2901 :contents-end contents-end 2902 :post-blank 0 2903 :post-affiliated begin))))) 2904 2905 (defun org-element-table-row-interpreter (table-row contents) 2906 "Interpret TABLE-ROW element as Org syntax. 2907 CONTENTS is the contents of the table row." 2908 (if (eq (org-element-property :type table-row) 'rule) "|-" 2909 (concat "|" contents))) 2910 2911 2912 ;;;; Verse Block 2913 2914 (defun org-element-verse-block-parser (limit affiliated) 2915 "Parse a verse block. 2916 2917 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2918 the buffer position at the beginning of the first affiliated 2919 keyword and CDR is a plist of affiliated keywords along with 2920 their value. 2921 2922 Return a list whose CAR is `verse-block' and CDR is a plist 2923 containing `:begin', `:end', `:contents-begin', `:contents-end', 2924 `:post-blank' and `:post-affiliated' keywords. 2925 2926 Assume point is at beginning of the block." 2927 (let ((case-fold-search t)) 2928 (if (not (save-excursion 2929 (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t))) 2930 ;; Incomplete block: parse it as a paragraph. 2931 (org-element-paragraph-parser limit affiliated) 2932 (let ((contents-end (match-beginning 0))) 2933 (save-excursion 2934 (let* ((begin (car affiliated)) 2935 (post-affiliated (point)) 2936 (contents-begin (progn (forward-line) (point))) 2937 (pos-before-blank (progn (goto-char contents-end) 2938 (forward-line) 2939 (point))) 2940 (end (progn (skip-chars-forward " \r\t\n" limit) 2941 (if (eobp) (point) (line-beginning-position))))) 2942 (list 'verse-block 2943 (nconc 2944 (list :begin begin 2945 :end end 2946 :contents-begin contents-begin 2947 :contents-end contents-end 2948 :post-blank (count-lines pos-before-blank end) 2949 :post-affiliated post-affiliated) 2950 (cdr affiliated))))))))) 2951 2952 (defun org-element-verse-block-interpreter (_ contents) 2953 "Interpret verse-block element as Org syntax. 2954 CONTENTS is verse block contents." 2955 (format "#+begin_verse\n%s#+end_verse" contents)) 2956 2957 2958 2959 ;;; Objects 2960 ;; 2961 ;; Unlike to elements, raw text can be found between objects. Hence, 2962 ;; `org-element--object-lex' is provided to find the next object in 2963 ;; buffer. 2964 ;; 2965 ;; Some object types (e.g., `italic') are recursive. Restrictions on 2966 ;; object types they can contain will be specified in 2967 ;; `org-element-object-restrictions'. 2968 ;; 2969 ;; Creating a new type of object requires to alter 2970 ;; `org-element--object-regexp' and `org-element--object-lex', add the 2971 ;; new type in `org-element-all-objects', and possibly add 2972 ;; restrictions in `org-element-object-restrictions'. 2973 2974 ;;;; Bold 2975 2976 (defun org-element--parse-generic-emphasis (mark type) 2977 "Parse emphasis object at point, if any. 2978 2979 MARK is the delimiter string used. TYPE is a symbol among 2980 `bold', `code', `italic', `strike-through', `underline', and 2981 `verbatim'. 2982 2983 Assume point is at first MARK." 2984 (save-excursion 2985 (let ((origin (point))) 2986 (unless (bolp) (forward-char -1)) 2987 (let ((opening-re 2988 (rx-to-string 2989 `(seq (or line-start (any space ?- ?\( ?' ?\" ?\{)) 2990 ,mark 2991 (not space))))) 2992 (when (looking-at opening-re) 2993 (goto-char (1+ origin)) 2994 (let ((closing-re 2995 (rx-to-string 2996 `(seq 2997 (not space) 2998 (group ,mark) 2999 (or (any space ?- ?. ?, ?\; ?: ?! ?? ?' ?\" ?\) ?\} ?\\ ?\[) 3000 line-end))))) 3001 (when (re-search-forward closing-re nil t) 3002 (let ((closing (match-end 1))) 3003 (goto-char closing) 3004 (let* ((post-blank (skip-chars-forward " \t")) 3005 (contents-begin (1+ origin)) 3006 (contents-end (1- closing))) 3007 (list type 3008 (append 3009 (list :begin origin 3010 :end (point) 3011 :post-blank post-blank) 3012 (if (memq type '(code verbatim)) 3013 (list :value 3014 (and (memq type '(code verbatim)) 3015 (buffer-substring 3016 contents-begin contents-end))) 3017 (list :contents-begin contents-begin 3018 :contents-end contents-end))))))))))))) 3019 3020 (defun org-element-bold-parser () 3021 "Parse bold object at point, if any. 3022 3023 When at a bold object, return a list whose car is `bold' and cdr 3024 is a plist with `:begin', `:end', `:contents-begin' and 3025 `:contents-end' and `:post-blank' keywords. Otherwise, return 3026 nil. 3027 3028 Assume point is at the first star marker." 3029 (org-element--parse-generic-emphasis "*" 'bold)) 3030 3031 (defun org-element-bold-interpreter (_ contents) 3032 "Interpret bold object as Org syntax. 3033 CONTENTS is the contents of the object." 3034 (format "*%s*" contents)) 3035 3036 3037 ;;;; Citation 3038 3039 (defun org-element-citation-parser () 3040 "Parse citation object at point, if any. 3041 3042 When at a citation object, return a list whose car is `citation' 3043 and cdr is a plist with `:style', `:prefix', `:suffix', `:begin', 3044 `:end', `:contents-begin', `:contents-end', and `:post-blank' 3045 keywords. Otherwise, return nil. 3046 3047 Assume point is at the beginning of the citation." 3048 (when (looking-at org-element-citation-prefix-re) 3049 (let* ((begin (point)) 3050 (style (and (match-end 1) 3051 (match-string-no-properties 1))) 3052 ;; Ignore blanks between cite type and prefix or key. 3053 (start (match-end 0)) 3054 (closing (with-syntax-table org-element--pair-square-table 3055 (ignore-errors (scan-lists begin 1 0))))) 3056 (save-excursion 3057 (when (and closing 3058 (re-search-forward org-element-citation-key-re closing t)) 3059 ;; Find prefix, if any. 3060 (let ((first-key-end (match-end 0)) 3061 (types (org-element-restriction 'citation-reference)) 3062 (cite 3063 (list 'citation 3064 (list :style style 3065 :begin begin 3066 :post-blank (progn 3067 (goto-char closing) 3068 (skip-chars-forward " \t")) 3069 :end (point))))) 3070 ;; `:contents-begin' depends on the presence of 3071 ;; a non-empty common prefix. 3072 (goto-char first-key-end) 3073 (if (not (search-backward ";" start t)) 3074 (org-element-put-property cite :contents-begin start) 3075 (when (< start (point)) 3076 (org-element-put-property 3077 cite :prefix 3078 (org-element--parse-objects start (point) nil types cite))) 3079 (forward-char) 3080 (org-element-put-property cite :contents-begin (point))) 3081 ;; `:contents-end' depends on the presence of a non-empty 3082 ;; common suffix. 3083 (goto-char (1- closing)) 3084 (skip-chars-backward " \r\t\n") 3085 (let ((end (point))) 3086 (if (or (not (search-backward ";" first-key-end t)) 3087 (re-search-forward org-element-citation-key-re end t)) 3088 (org-element-put-property cite :contents-end end) 3089 (forward-char) 3090 (when (< (point) end) 3091 (org-element-put-property 3092 cite :suffix 3093 (org-element--parse-objects (point) end nil types cite))) 3094 (org-element-put-property cite :contents-end (point)))) 3095 cite)))))) 3096 3097 (defun org-element-citation-interpreter (citation contents) 3098 "Interpret CITATION object as Org syntax. 3099 CONTENTS is the contents of the object, as a string." 3100 (let ((prefix (org-element-property :prefix citation)) 3101 (suffix (org-element-property :suffix citation)) 3102 (style (org-element-property :style citation))) 3103 (concat "[cite" 3104 (and style (concat "/" style)) 3105 ":" 3106 (and prefix (concat (org-element-interpret-data prefix) ";")) 3107 (if suffix 3108 (concat contents (org-element-interpret-data suffix)) 3109 ;; Remove spurious semicolon. 3110 (substring contents nil -1)) 3111 "]"))) 3112 3113 3114 ;;;; Citation Reference 3115 3116 (defun org-element-citation-reference-parser () 3117 "Parse citation reference object at point, if any. 3118 3119 When at a reference, return a list whose car is 3120 `citation-reference', and cdr is a plist with `:key', 3121 `:prefix', `:suffix', `:begin', `:end', and `:post-blank' keywords. 3122 3123 Assume point is at the beginning of the reference." 3124 (save-excursion 3125 (let ((begin (point))) 3126 (when (re-search-forward org-element-citation-key-re nil t) 3127 (let* ((key (match-string-no-properties 1)) 3128 (key-start (match-beginning 0)) 3129 (key-end (match-end 0)) 3130 (separator (search-forward ";" nil t)) 3131 (end (or separator (point-max))) 3132 (suffix-end (if separator (1- end) end)) 3133 (types (org-element-restriction 'citation-reference)) 3134 (reference 3135 (list 'citation-reference 3136 (list :key key 3137 :begin begin 3138 :end end 3139 :post-blank 0)))) 3140 (when (< begin key-start) 3141 (org-element-put-property 3142 reference :prefix 3143 (org-element--parse-objects begin key-start nil types reference))) 3144 (when (< key-end suffix-end) 3145 (org-element-put-property 3146 reference :suffix 3147 (org-element--parse-objects key-end suffix-end nil types reference))) 3148 reference))))) 3149 3150 (defun org-element-citation-reference-interpreter (citation-reference _) 3151 "Interpret CITATION-REFERENCE object as Org syntax." 3152 (concat (org-element-interpret-data 3153 (org-element-property :prefix citation-reference)) 3154 "@" (org-element-property :key citation-reference) 3155 (org-element-interpret-data 3156 (org-element-property :suffix citation-reference)) 3157 ";")) 3158 3159 3160 ;;;; Code 3161 3162 (defun org-element-code-parser () 3163 "Parse code object at point, if any. 3164 3165 When at a code object, return a list whose car is `code' and cdr 3166 is a plist with `:value', `:begin', `:end' and `:post-blank' 3167 keywords. Otherwise, return nil. 3168 3169 Assume point is at the first tilde marker." 3170 (org-element--parse-generic-emphasis "~" 'code)) 3171 3172 (defun org-element-code-interpreter (code _) 3173 "Interpret CODE object as Org syntax." 3174 (format "~%s~" (org-element-property :value code))) 3175 3176 3177 ;;;; Entity 3178 3179 (defun org-element-entity-parser () 3180 "Parse entity at point, if any. 3181 3182 When at an entity, return a list whose car is `entity' and cdr 3183 a plist with `:begin', `:end', `:latex', `:latex-math-p', 3184 `:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and 3185 `:post-blank' as keywords. Otherwise, return nil. 3186 3187 Assume point is at the beginning of the entity." 3188 (catch 'no-object 3189 (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)") 3190 (save-excursion 3191 (let* ((value (or (org-entity-get (match-string 1)) 3192 (throw 'no-object nil))) 3193 (begin (match-beginning 0)) 3194 (bracketsp (string= (match-string 2) "{}")) 3195 (post-blank (progn (goto-char (match-end 1)) 3196 (when bracketsp (forward-char 2)) 3197 (skip-chars-forward " \t"))) 3198 (end (point))) 3199 (list 'entity 3200 (list :name (car value) 3201 :latex (nth 1 value) 3202 :latex-math-p (nth 2 value) 3203 :html (nth 3 value) 3204 :ascii (nth 4 value) 3205 :latin1 (nth 5 value) 3206 :utf-8 (nth 6 value) 3207 :begin begin 3208 :end end 3209 :use-brackets-p bracketsp 3210 :post-blank post-blank))))))) 3211 3212 (defun org-element-entity-interpreter (entity _) 3213 "Interpret ENTITY object as Org syntax." 3214 (concat "\\" 3215 (org-element-property :name entity) 3216 (when (org-element-property :use-brackets-p entity) "{}"))) 3217 3218 3219 ;;;; Export Snippet 3220 3221 (defun org-element-export-snippet-parser () 3222 "Parse export snippet at point. 3223 3224 When at an export snippet, return a list whose car is 3225 `export-snippet' and cdr a plist with `:begin', `:end', 3226 `:back-end', `:value' and `:post-blank' as keywords. Otherwise, 3227 return nil. 3228 3229 Assume point is at the beginning of the snippet." 3230 (save-excursion 3231 (let (contents-end) 3232 (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):") 3233 (setq contents-end 3234 (save-match-data (goto-char (match-end 0)) 3235 (when 3236 (re-search-forward "@@" nil t) 3237 (match-beginning 0))))) 3238 (let* ((begin (match-beginning 0)) 3239 (back-end (match-string-no-properties 1)) 3240 (value (buffer-substring-no-properties 3241 (match-end 0) contents-end)) 3242 (post-blank (skip-chars-forward " \t")) 3243 (end (point))) 3244 (list 'export-snippet 3245 (list :back-end back-end 3246 :value value 3247 :begin begin 3248 :end end 3249 :post-blank post-blank))))))) 3250 3251 (defun org-element-export-snippet-interpreter (export-snippet _) 3252 "Interpret EXPORT-SNIPPET object as Org syntax." 3253 (format "@@%s:%s@@" 3254 (org-element-property :back-end export-snippet) 3255 (org-element-property :value export-snippet))) 3256 3257 3258 ;;;; Footnote Reference 3259 3260 (defun org-element-footnote-reference-parser () 3261 "Parse footnote reference at point, if any. 3262 3263 When at a footnote reference, return a list whose car is 3264 `footnote-reference' and cdr a plist with `:label', `:type', 3265 `:begin', `:end', `:contents-begin', `:contents-end' and 3266 `:post-blank' as keywords. Otherwise, return nil." 3267 (when (looking-at org-footnote-re) 3268 (let ((closing (with-syntax-table org-element--pair-square-table 3269 (ignore-errors (scan-lists (point) 1 0))))) 3270 (when closing 3271 (save-excursion 3272 (let* ((begin (point)) 3273 (label (match-string-no-properties 1)) 3274 (inner-begin (match-end 0)) 3275 (inner-end (1- closing)) 3276 (type (if (match-end 2) 'inline 'standard)) 3277 (post-blank (progn (goto-char closing) 3278 (skip-chars-forward " \t"))) 3279 (end (point))) 3280 (list 'footnote-reference 3281 (list :label label 3282 :type type 3283 :begin begin 3284 :end end 3285 :contents-begin (and (eq type 'inline) inner-begin) 3286 :contents-end (and (eq type 'inline) inner-end) 3287 :post-blank post-blank)))))))) 3288 3289 (defun org-element-footnote-reference-interpreter (footnote-reference contents) 3290 "Interpret FOOTNOTE-REFERENCE object as Org syntax. 3291 CONTENTS is its definition, when inline, or nil." 3292 (format "[fn:%s%s]" 3293 (or (org-element-property :label footnote-reference) "") 3294 (if contents (concat ":" contents) ""))) 3295 3296 3297 ;;;; Inline Babel Call 3298 3299 (defun org-element-inline-babel-call-parser () 3300 "Parse inline babel call at point, if any. 3301 3302 When at an inline babel call, return a list whose car is 3303 `inline-babel-call' and cdr a plist with `:call', 3304 `:inside-header', `:arguments', `:end-header', `:begin', `:end', 3305 `:value' and `:post-blank' as keywords. Otherwise, return nil. 3306 3307 Assume point is at the beginning of the babel call." 3308 (save-excursion 3309 (catch :no-object 3310 (when (let ((case-fold-search nil)) 3311 (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]")) 3312 (goto-char (match-end 1)) 3313 (let* ((begin (match-beginning 0)) 3314 (call (match-string-no-properties 1)) 3315 (inside-header 3316 (let ((p (org-element--parse-paired-brackets ?\[))) 3317 (and (org-string-nw-p p) 3318 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3319 (arguments (org-string-nw-p 3320 (or (org-element--parse-paired-brackets ?\() 3321 ;; Parenthesis are mandatory. 3322 (throw :no-object nil)))) 3323 (end-header 3324 (let ((p (org-element--parse-paired-brackets ?\[))) 3325 (and (org-string-nw-p p) 3326 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3327 (value (buffer-substring-no-properties begin (point))) 3328 (post-blank (skip-chars-forward " \t")) 3329 (end (point))) 3330 (list 'inline-babel-call 3331 (list :call call 3332 :inside-header inside-header 3333 :arguments arguments 3334 :end-header end-header 3335 :begin begin 3336 :end end 3337 :value value 3338 :post-blank post-blank))))))) 3339 3340 (defun org-element-inline-babel-call-interpreter (inline-babel-call _) 3341 "Interpret INLINE-BABEL-CALL object as Org syntax." 3342 (concat "call_" 3343 (org-element-property :call inline-babel-call) 3344 (let ((h (org-element-property :inside-header inline-babel-call))) 3345 (and h (format "[%s]" h))) 3346 "(" (org-element-property :arguments inline-babel-call) ")" 3347 (let ((h (org-element-property :end-header inline-babel-call))) 3348 (and h (format "[%s]" h))))) 3349 3350 3351 ;;;; Inline Src Block 3352 3353 (defun org-element-inline-src-block-parser () 3354 "Parse inline source block at point, if any. 3355 3356 When at an inline source block, return a list whose car is 3357 `inline-src-block' and cdr a plist with `:begin', `:end', 3358 `:language', `:value', `:parameters' and `:post-blank' as 3359 keywords. Otherwise, return nil. 3360 3361 Assume point is at the beginning of the inline source block." 3362 (save-excursion 3363 (catch :no-object 3364 (when (let ((case-fold-search nil)) 3365 (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]")) 3366 (goto-char (match-end 1)) 3367 (let ((begin (match-beginning 0)) 3368 (language (match-string-no-properties 1)) 3369 (parameters 3370 (let ((p (org-element--parse-paired-brackets ?\[))) 3371 (and (org-string-nw-p p) 3372 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3373 (value (or (org-element--parse-paired-brackets ?\{) 3374 (throw :no-object nil))) 3375 (post-blank (skip-chars-forward " \t"))) 3376 (list 'inline-src-block 3377 (list :language language 3378 :value value 3379 :parameters parameters 3380 :begin begin 3381 :end (point) 3382 :post-blank post-blank))))))) 3383 3384 (defun org-element-inline-src-block-interpreter (inline-src-block _) 3385 "Interpret INLINE-SRC-BLOCK object as Org syntax." 3386 (let ((language (org-element-property :language inline-src-block)) 3387 (arguments (org-element-property :parameters inline-src-block)) 3388 (body (org-element-property :value inline-src-block))) 3389 (format "src_%s%s{%s}" 3390 language 3391 (if arguments (format "[%s]" arguments) "") 3392 body))) 3393 3394 ;;;; Italic 3395 3396 (defun org-element-italic-parser () 3397 "Parse italic object at point, if any. 3398 3399 When at an italic object, return a list whose car is `italic' and 3400 cdr is a plist with `:begin', `:end', `:contents-begin' and 3401 `:contents-end' and `:post-blank' keywords. Otherwise, return 3402 nil. 3403 3404 Assume point is at the first slash marker." 3405 (org-element--parse-generic-emphasis "/" 'italic)) 3406 3407 (defun org-element-italic-interpreter (_ contents) 3408 "Interpret italic object as Org syntax. 3409 CONTENTS is the contents of the object." 3410 (format "/%s/" contents)) 3411 3412 3413 ;;;; Latex Fragment 3414 3415 (defun org-element-latex-fragment-parser () 3416 "Parse LaTeX fragment at point, if any. 3417 3418 When at a LaTeX fragment, return a list whose car is 3419 `latex-fragment' and cdr a plist with `:value', `:begin', `:end', 3420 and `:post-blank' as keywords. Otherwise, return nil. 3421 3422 Assume point is at the beginning of the LaTeX fragment." 3423 (catch 'no-object 3424 (save-excursion 3425 (let* ((begin (point)) 3426 (after-fragment 3427 (cond 3428 ((not (eq ?$ (char-after))) 3429 (pcase (char-after (1+ (point))) 3430 (?\( (search-forward "\\)" nil t)) 3431 (?\[ (search-forward "\\]" nil t)) 3432 (_ 3433 ;; Macro. 3434 (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\ 3435 \\|\\({[^{}\n]*}\\)\\)*") 3436 (match-end 0))))) 3437 ((eq ?$ (char-after (1+ (point)))) 3438 (search-forward "$$" nil t 2)) 3439 (t 3440 (and (not (eq ?$ (char-before))) 3441 (not (memq (char-after (1+ (point))) 3442 '(?\s ?\t ?\n ?, ?. ?\;))) 3443 (search-forward "$" nil t 2) 3444 (not (memq (char-before (match-beginning 0)) 3445 '(?\s ?\t ?\n ?, ?.))) 3446 (looking-at-p 3447 "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)") 3448 (point))))) 3449 (post-blank 3450 (if (not after-fragment) (throw 'no-object nil) 3451 (goto-char after-fragment) 3452 (skip-chars-forward " \t"))) 3453 (end (point))) 3454 (list 'latex-fragment 3455 (list :value (buffer-substring-no-properties begin after-fragment) 3456 :begin begin 3457 :end end 3458 :post-blank post-blank)))))) 3459 3460 (defun org-element-latex-fragment-interpreter (latex-fragment _) 3461 "Interpret LATEX-FRAGMENT object as Org syntax." 3462 (org-element-property :value latex-fragment)) 3463 3464 ;;;; Line Break 3465 3466 (defun org-element-line-break-parser () 3467 "Parse line break at point, if any. 3468 3469 When at a line break, return a list whose car is `line-break', 3470 and cdr a plist with `:begin', `:end' and `:post-blank' keywords. 3471 Otherwise, return nil. 3472 3473 Assume point is at the beginning of the line break." 3474 (when (and (looking-at-p "\\\\\\\\[ \t]*$") 3475 (not (eq (char-before) ?\\))) 3476 (list 'line-break 3477 (list :begin (point) 3478 :end (line-beginning-position 2) 3479 :post-blank 0)))) 3480 3481 (defun org-element-line-break-interpreter (&rest _) 3482 "Interpret LINE-BREAK object as Org syntax." 3483 "\\\\\n") 3484 3485 3486 ;;;; Link 3487 3488 (defun org-element-link-parser () 3489 "Parse link at point, if any. 3490 3491 When at a link, return a list whose car is `link' and cdr a plist 3492 with `:type', `:path', `:format', `:raw-link', `:application', 3493 `:search-option', `:begin', `:end', `:contents-begin', 3494 `:contents-end' and `:post-blank' as keywords. Otherwise, return 3495 nil. 3496 3497 Assume point is at the beginning of the link." 3498 (catch 'no-object 3499 (let ((begin (point)) 3500 end contents-begin contents-end link-end post-blank path type format 3501 raw-link search-option application) 3502 (cond 3503 ;; Type 1: Text targeted from a radio target. 3504 ((and org-target-link-regexp 3505 (save-excursion (or (bolp) (backward-char)) 3506 (looking-at org-target-link-regexp))) 3507 (setq type "radio") 3508 (setq format 'plain) 3509 (setq link-end (match-end 1)) 3510 (setq path (match-string-no-properties 1)) 3511 (setq contents-begin (match-beginning 1)) 3512 (setq contents-end (match-end 1))) 3513 ;; Type 2: Standard link, i.e. [[https://orgmode.org][website]] 3514 ((looking-at org-link-bracket-re) 3515 (setq format 'bracket) 3516 (setq contents-begin (match-beginning 2)) 3517 (setq contents-end (match-end 2)) 3518 (setq link-end (match-end 0)) 3519 ;; RAW-LINK is the original link. Decode any encoding. 3520 ;; Expand any abbreviation in it. 3521 ;; 3522 ;; Also treat any newline character and associated 3523 ;; indentation as a single space character. This is not 3524 ;; compatible with RFC 3986, which requires to ignore 3525 ;; them altogether. However, doing so would require 3526 ;; users to encode spaces on the fly when writing links 3527 ;; (e.g., insert [[shell:ls%20*.org]] instead of 3528 ;; [[shell:ls *.org]], which defeats Org's focus on 3529 ;; simplicity. 3530 (setq raw-link (org-link-expand-abbrev 3531 (org-link-unescape 3532 (replace-regexp-in-string 3533 "[ \t]*\n[ \t]*" " " 3534 (match-string-no-properties 1))))) 3535 ;; Determine TYPE of link and set PATH accordingly. According 3536 ;; to RFC 3986, remove whitespaces from URI in external links. 3537 ;; In internal ones, treat indentation as a single space. 3538 (cond 3539 ;; File type. 3540 ((or (file-name-absolute-p raw-link) 3541 (string-match "\\`\\.\\.?/" raw-link)) 3542 (setq type "file") 3543 (setq path raw-link)) 3544 ;; Explicit type (http, irc, bbdb...). 3545 ((string-match org-link-types-re raw-link) 3546 (setq type (match-string 1 raw-link)) 3547 (setq path (substring raw-link (match-end 0)))) 3548 ;; Code-ref type: PATH is the name of the reference. 3549 ((and (string-match-p "\\`(" raw-link) 3550 (string-match-p ")\\'" raw-link)) 3551 (setq type "coderef") 3552 (setq path (substring raw-link 1 -1))) 3553 ;; Custom-id type: PATH is the name of the custom id. 3554 ((= (string-to-char raw-link) ?#) 3555 (setq type "custom-id") 3556 (setq path (substring raw-link 1))) 3557 ;; Fuzzy type: Internal link either matches a target, an 3558 ;; headline name or nothing. PATH is the target or 3559 ;; headline's name. 3560 (t 3561 (setq type "fuzzy") 3562 (setq path raw-link)))) 3563 ;; Type 3: Plain link, e.g., https://orgmode.org 3564 ((looking-at org-link-plain-re) 3565 (setq format 'plain) 3566 (setq raw-link (match-string-no-properties 0)) 3567 (setq type (match-string-no-properties 1)) 3568 (setq link-end (match-end 0)) 3569 (setq path (match-string-no-properties 2))) 3570 ;; Type 4: Angular link, e.g., <https://orgmode.org>. Unlike to 3571 ;; bracket links, follow RFC 3986 and remove any extra 3572 ;; whitespace in URI. 3573 ((looking-at org-link-angle-re) 3574 (setq format 'angle) 3575 (setq type (match-string-no-properties 1)) 3576 (setq link-end (match-end 0)) 3577 (setq raw-link 3578 (buffer-substring-no-properties 3579 (match-beginning 1) (match-end 2))) 3580 (setq path (replace-regexp-in-string 3581 "[ \t]*\n[ \t]*" "" (match-string-no-properties 2)))) 3582 (t (throw 'no-object nil))) 3583 ;; In any case, deduce end point after trailing white space from 3584 ;; LINK-END variable. 3585 (save-excursion 3586 (setq post-blank 3587 (progn (goto-char link-end) (skip-chars-forward " \t"))) 3588 (setq end (point))) 3589 ;; Special "file"-type link processing. Extract opening 3590 ;; application and search option, if any. Also normalize URI. 3591 (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) 3592 (setq application (match-string 1 type)) 3593 (setq type "file") 3594 (when (string-match "::\\(.*\\)\\'" path) 3595 (setq search-option (match-string 1 path)) 3596 (setq path (replace-match "" nil nil path))) 3597 (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) 3598 ;; Translate link, if `org-link-translation-function' is set. 3599 (let ((trans (and (functionp org-link-translation-function) 3600 (funcall org-link-translation-function type path)))) 3601 (when trans 3602 (setq type (car trans)) 3603 (setq path (cdr trans)))) 3604 (list 'link 3605 (list :type type 3606 :path path 3607 :format format 3608 :raw-link (or raw-link path) 3609 :application application 3610 :search-option search-option 3611 :begin begin 3612 :end end 3613 :contents-begin contents-begin 3614 :contents-end contents-end 3615 :post-blank post-blank))))) 3616 3617 (defun org-element-link-interpreter (link contents) 3618 "Interpret LINK object as Org syntax. 3619 CONTENTS is the contents of the object, or nil." 3620 (let ((type (org-element-property :type link)) 3621 (path (org-element-property :path link))) 3622 (if (string= type "radio") path 3623 (let ((fmt (pcase (org-element-property :format link) 3624 ;; Links with contents and internal links have to 3625 ;; use bracket syntax. Ignore `:format' in these 3626 ;; cases. This is also the default syntax when the 3627 ;; property is not defined, e.g., when the object 3628 ;; was crafted by the user. 3629 ((guard contents) 3630 (format "[[%%s][%s]]" 3631 ;; Since this is going to be used as 3632 ;; a format string, escape percent signs 3633 ;; in description. 3634 (replace-regexp-in-string "%" "%%" contents))) 3635 ((or `bracket 3636 `nil 3637 (guard (member type '("coderef" "custom-id" "fuzzy")))) 3638 "[[%s]]") 3639 ;; Otherwise, just obey to `:format'. 3640 (`angle "<%s>") 3641 (`plain "%s") 3642 (f (error "Wrong `:format' value: %s" f))))) 3643 (format fmt 3644 (pcase type 3645 ("coderef" (format "(%s)" path)) 3646 ("custom-id" (concat "#" path)) 3647 ("file" 3648 (let ((app (org-element-property :application link)) 3649 (opt (org-element-property :search-option link))) 3650 (concat type (and app (concat "+" app)) ":" 3651 path 3652 (and opt (concat "::" opt))))) 3653 ("fuzzy" path) 3654 (_ (concat type ":" path)))))))) 3655 3656 3657 ;;;; Macro 3658 3659 (defun org-element-macro-parser () 3660 "Parse macro at point, if any. 3661 3662 When at a macro, return a list whose car is `macro' and cdr 3663 a plist with `:key', `:args', `:begin', `:end', `:value' and 3664 `:post-blank' as keywords. Otherwise, return nil. 3665 3666 Assume point is at the macro." 3667 (save-excursion 3668 (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}") 3669 (let ((begin (point)) 3670 (key (downcase (match-string-no-properties 1))) 3671 (value (match-string-no-properties 0)) 3672 (post-blank (progn (goto-char (match-end 0)) 3673 (skip-chars-forward " \t"))) 3674 (end (point)) 3675 (args (pcase (match-string-no-properties 3) 3676 (`nil nil) 3677 (a (org-macro-extract-arguments 3678 (replace-regexp-in-string 3679 "[ \t\r\n]+" " " (org-trim a))))))) 3680 (list 'macro 3681 (list :key key 3682 :value value 3683 :args args 3684 :begin begin 3685 :end end 3686 :post-blank post-blank)))))) 3687 3688 (defun org-element-macro-interpreter (macro _) 3689 "Interpret MACRO object as Org syntax." 3690 (format "{{{%s%s}}}" 3691 (org-element-property :key macro) 3692 (pcase (org-element-property :args macro) 3693 (`nil "") 3694 (args (format "(%s)" (apply #'org-macro-escape-arguments args)))))) 3695 3696 3697 ;;;; Radio-target 3698 3699 (defun org-element-radio-target-parser () 3700 "Parse radio target at point, if any. 3701 3702 When at a radio target, return a list whose car is `radio-target' 3703 and cdr a plist with `:begin', `:end', `:contents-begin', 3704 `:contents-end', `:value' and `:post-blank' as keywords. 3705 Otherwise, return nil. 3706 3707 Assume point is at the radio target." 3708 (save-excursion 3709 (when (looking-at org-radio-target-regexp) 3710 (let ((begin (point)) 3711 (contents-begin (match-beginning 1)) 3712 (contents-end (match-end 1)) 3713 (value (match-string-no-properties 1)) 3714 (post-blank (progn (goto-char (match-end 0)) 3715 (skip-chars-forward " \t"))) 3716 (end (point))) 3717 (list 'radio-target 3718 (list :begin begin 3719 :end end 3720 :contents-begin contents-begin 3721 :contents-end contents-end 3722 :post-blank post-blank 3723 :value value)))))) 3724 3725 (defun org-element-radio-target-interpreter (_ contents) 3726 "Interpret target object as Org syntax. 3727 CONTENTS is the contents of the object." 3728 (concat "<<<" contents ">>>")) 3729 3730 3731 ;;;; Statistics Cookie 3732 3733 (defun org-element-statistics-cookie-parser () 3734 "Parse statistics cookie at point, if any. 3735 3736 When at a statistics cookie, return a list whose car is 3737 `statistics-cookie', and cdr a plist with `:begin', `:end', 3738 `:value' and `:post-blank' keywords. Otherwise, return nil. 3739 3740 Assume point is at the beginning of the statistics-cookie." 3741 (save-excursion 3742 (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") 3743 (let* ((begin (point)) 3744 (value (buffer-substring-no-properties 3745 (match-beginning 0) (match-end 0))) 3746 (post-blank (progn (goto-char (match-end 0)) 3747 (skip-chars-forward " \t"))) 3748 (end (point))) 3749 (list 'statistics-cookie 3750 (list :begin begin 3751 :end end 3752 :value value 3753 :post-blank post-blank)))))) 3754 3755 (defun org-element-statistics-cookie-interpreter (statistics-cookie _) 3756 "Interpret STATISTICS-COOKIE object as Org syntax." 3757 (org-element-property :value statistics-cookie)) 3758 3759 3760 ;;;; Strike-Through 3761 3762 (defun org-element-strike-through-parser () 3763 "Parse strike-through object at point, if any. 3764 3765 When at a strike-through object, return a list whose car is 3766 `strike-through' and cdr is a plist with `:begin', `:end', 3767 `:contents-begin' and `:contents-end' and `:post-blank' keywords. 3768 Otherwise, return nil. 3769 3770 Assume point is at the first plus sign marker." 3771 (org-element--parse-generic-emphasis "+" 'strike-through)) 3772 3773 (defun org-element-strike-through-interpreter (_ contents) 3774 "Interpret strike-through object as Org syntax. 3775 CONTENTS is the contents of the object." 3776 (format "+%s+" contents)) 3777 3778 3779 ;;;; Subscript 3780 3781 (defun org-element-subscript-parser () 3782 "Parse subscript at point, if any. 3783 3784 When at a subscript object, return a list whose car is 3785 `subscript' and cdr a plist with `:begin', `:end', 3786 `:contents-begin', `:contents-end', `:use-brackets-p' and 3787 `:post-blank' as keywords. Otherwise, return nil. 3788 3789 Assume point is at the underscore." 3790 (save-excursion 3791 (unless (bolp) (backward-char)) 3792 (when (looking-at org-match-substring-regexp) 3793 (let ((bracketsp (match-beginning 4)) 3794 (begin (match-beginning 2)) 3795 (contents-begin (or (match-beginning 4) 3796 (match-beginning 3))) 3797 (contents-end (or (match-end 4) (match-end 3))) 3798 (post-blank (progn (goto-char (match-end 0)) 3799 (skip-chars-forward " \t"))) 3800 (end (point))) 3801 (list 'subscript 3802 (list :begin begin 3803 :end end 3804 :use-brackets-p bracketsp 3805 :contents-begin contents-begin 3806 :contents-end contents-end 3807 :post-blank post-blank)))))) 3808 3809 (defun org-element-subscript-interpreter (subscript contents) 3810 "Interpret SUBSCRIPT object as Org syntax. 3811 CONTENTS is the contents of the object." 3812 (format 3813 (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") 3814 contents)) 3815 3816 3817 ;;;; Superscript 3818 3819 (defun org-element-superscript-parser () 3820 "Parse superscript at point, if any. 3821 3822 When at a superscript object, return a list whose car is 3823 `superscript' and cdr a plist with `:begin', `:end', 3824 `:contents-begin', `:contents-end', `:use-brackets-p' and 3825 `:post-blank' as keywords. Otherwise, return nil. 3826 3827 Assume point is at the caret." 3828 (save-excursion 3829 (unless (bolp) (backward-char)) 3830 (when (looking-at org-match-substring-regexp) 3831 (let ((bracketsp (match-beginning 4)) 3832 (begin (match-beginning 2)) 3833 (contents-begin (or (match-beginning 4) 3834 (match-beginning 3))) 3835 (contents-end (or (match-end 4) (match-end 3))) 3836 (post-blank (progn (goto-char (match-end 0)) 3837 (skip-chars-forward " \t"))) 3838 (end (point))) 3839 (list 'superscript 3840 (list :begin begin 3841 :end end 3842 :use-brackets-p bracketsp 3843 :contents-begin contents-begin 3844 :contents-end contents-end 3845 :post-blank post-blank)))))) 3846 3847 (defun org-element-superscript-interpreter (superscript contents) 3848 "Interpret SUPERSCRIPT object as Org syntax. 3849 CONTENTS is the contents of the object." 3850 (format 3851 (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") 3852 contents)) 3853 3854 3855 ;;;; Table Cell 3856 3857 (defun org-element-table-cell-parser () 3858 "Parse table cell at point. 3859 Return a list whose car is `table-cell' and cdr is a plist 3860 containing `:begin', `:end', `:contents-begin', `:contents-end' 3861 and `:post-blank' keywords." 3862 (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)") 3863 (let* ((begin (match-beginning 0)) 3864 (end (match-end 0)) 3865 (contents-begin (match-beginning 1)) 3866 (contents-end (match-end 1))) 3867 (list 'table-cell 3868 (list :begin begin 3869 :end end 3870 :contents-begin contents-begin 3871 :contents-end contents-end 3872 :post-blank 0)))) 3873 3874 (defun org-element-table-cell-interpreter (_ contents) 3875 "Interpret table-cell element as Org syntax. 3876 CONTENTS is the contents of the cell, or nil." 3877 (concat " " contents " |")) 3878 3879 3880 ;;;; Target 3881 3882 (defun org-element-target-parser () 3883 "Parse target at point, if any. 3884 3885 When at a target, return a list whose car is `target' and cdr 3886 a plist with `:begin', `:end', `:value' and `:post-blank' as 3887 keywords. Otherwise, return nil. 3888 3889 Assume point is at the target." 3890 (save-excursion 3891 (when (looking-at org-target-regexp) 3892 (let ((begin (point)) 3893 (value (match-string-no-properties 1)) 3894 (post-blank (progn (goto-char (match-end 0)) 3895 (skip-chars-forward " \t"))) 3896 (end (point))) 3897 (list 'target 3898 (list :begin begin 3899 :end end 3900 :value value 3901 :post-blank post-blank)))))) 3902 3903 (defun org-element-target-interpreter (target _) 3904 "Interpret TARGET object as Org syntax." 3905 (format "<<%s>>" (org-element-property :value target))) 3906 3907 3908 ;;;; Timestamp 3909 3910 (defconst org-element--timestamp-regexp 3911 (concat org-ts-regexp-both 3912 "\\|" 3913 "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" 3914 "\\|" 3915 "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") 3916 "Regexp matching any timestamp type object.") 3917 3918 (defun org-element-timestamp-parser () 3919 "Parse time stamp at point, if any. 3920 3921 When at a time stamp, return a list whose car is `timestamp', and 3922 cdr a plist with `:type', `:raw-value', `:year-start', 3923 `:month-start', `:day-start', `:hour-start', `:minute-start', 3924 `:year-end', `:month-end', `:day-end', `:hour-end', 3925 `:minute-end', `:repeater-type', `:repeater-value', 3926 `:repeater-unit', `:warning-type', `:warning-value', 3927 `:warning-unit', `:begin', `:end' and `:post-blank' keywords. 3928 Otherwise, return nil. 3929 3930 Assume point is at the beginning of the timestamp." 3931 (when (looking-at-p org-element--timestamp-regexp) 3932 (save-excursion 3933 (let* ((begin (point)) 3934 (activep (eq (char-after) ?<)) 3935 (raw-value 3936 (progn 3937 (looking-at (concat "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\(" 3938 org-ts-regexp-both 3939 "\\)\\)?")) 3940 (match-string-no-properties 0))) 3941 (date-start (match-string-no-properties 1)) 3942 (date-end (match-string 3)) 3943 (diaryp (match-beginning 2)) 3944 (post-blank (progn (goto-char (match-end 0)) 3945 (skip-chars-forward " \t"))) 3946 (end (point)) 3947 (time-range 3948 (and (not diaryp) 3949 (string-match 3950 "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" 3951 date-start) 3952 (cons (string-to-number (match-string 2 date-start)) 3953 (string-to-number (match-string 3 date-start))))) 3954 (type (cond (diaryp 'diary) 3955 ((and activep (or date-end time-range)) 'active-range) 3956 (activep 'active) 3957 ((or date-end time-range) 'inactive-range) 3958 (t 'inactive))) 3959 (repeater-props 3960 (and (not diaryp) 3961 (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" 3962 raw-value) 3963 (list 3964 :repeater-type 3965 (let ((type (match-string 1 raw-value))) 3966 (cond ((equal "++" type) 'catch-up) 3967 ((equal ".+" type) 'restart) 3968 (t 'cumulate))) 3969 :repeater-value (string-to-number (match-string 2 raw-value)) 3970 :repeater-unit 3971 (pcase (string-to-char (match-string 3 raw-value)) 3972 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) 3973 (warning-props 3974 (and (not diaryp) 3975 (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) 3976 (list 3977 :warning-type (if (match-string 1 raw-value) 'first 'all) 3978 :warning-value (string-to-number (match-string 2 raw-value)) 3979 :warning-unit 3980 (pcase (string-to-char (match-string 3 raw-value)) 3981 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) 3982 year-start month-start day-start hour-start minute-start year-end 3983 month-end day-end hour-end minute-end) 3984 ;; Parse date-start. 3985 (unless diaryp 3986 (let ((date (org-parse-time-string date-start t))) 3987 (setq year-start (nth 5 date) 3988 month-start (nth 4 date) 3989 day-start (nth 3 date) 3990 hour-start (nth 2 date) 3991 minute-start (nth 1 date)))) 3992 ;; Compute date-end. It can be provided directly in time-stamp, 3993 ;; or extracted from time range. Otherwise, it defaults to the 3994 ;; same values as date-start. 3995 (unless diaryp 3996 (let ((date (and date-end (org-parse-time-string date-end t)))) 3997 (setq year-end (or (nth 5 date) year-start) 3998 month-end (or (nth 4 date) month-start) 3999 day-end (or (nth 3 date) day-start) 4000 hour-end (or (nth 2 date) (car time-range) hour-start) 4001 minute-end (or (nth 1 date) (cdr time-range) minute-start)))) 4002 (list 'timestamp 4003 (nconc (list :type type 4004 :raw-value raw-value 4005 :year-start year-start 4006 :month-start month-start 4007 :day-start day-start 4008 :hour-start hour-start 4009 :minute-start minute-start 4010 :year-end year-end 4011 :month-end month-end 4012 :day-end day-end 4013 :hour-end hour-end 4014 :minute-end minute-end 4015 :begin begin 4016 :end end 4017 :post-blank post-blank) 4018 repeater-props 4019 warning-props)))))) 4020 4021 (defun org-element-timestamp-interpreter (timestamp _) 4022 "Interpret TIMESTAMP object as Org syntax." 4023 (let* ((repeat-string 4024 (concat 4025 (pcase (org-element-property :repeater-type timestamp) 4026 (`cumulate "+") (`catch-up "++") (`restart ".+")) 4027 (let ((val (org-element-property :repeater-value timestamp))) 4028 (and val (number-to-string val))) 4029 (pcase (org-element-property :repeater-unit timestamp) 4030 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) 4031 (warning-string 4032 (concat 4033 (pcase (org-element-property :warning-type timestamp) 4034 (`first "--") (`all "-")) 4035 (let ((val (org-element-property :warning-value timestamp))) 4036 (and val (number-to-string val))) 4037 (pcase (org-element-property :warning-unit timestamp) 4038 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) 4039 (build-ts-string 4040 ;; Build an Org timestamp string from TIME. ACTIVEP is 4041 ;; non-nil when time stamp is active. If WITH-TIME-P is 4042 ;; non-nil, add a time part. HOUR-END and MINUTE-END 4043 ;; specify a time range in the timestamp. REPEAT-STRING is 4044 ;; the repeater string, if any. 4045 (lambda (time activep &optional with-time-p hour-end minute-end) 4046 (let ((ts (format-time-string 4047 (org-time-stamp-format with-time-p) 4048 time))) 4049 (when (and hour-end minute-end) 4050 (string-match "[012]?[0-9]:[0-5][0-9]" ts) 4051 (setq ts 4052 (replace-match 4053 (format "\\&-%02d:%02d" hour-end minute-end) 4054 nil nil ts))) 4055 (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) 4056 (dolist (s (list repeat-string warning-string)) 4057 (when (org-string-nw-p s) 4058 (setq ts (concat (substring ts 0 -1) 4059 " " 4060 s 4061 (substring ts -1))))) 4062 ;; Return value. 4063 ts))) 4064 (type (org-element-property :type timestamp))) 4065 (pcase type 4066 ((or `active `inactive) 4067 (let* ((minute-start (org-element-property :minute-start timestamp)) 4068 (minute-end (org-element-property :minute-end timestamp)) 4069 (hour-start (org-element-property :hour-start timestamp)) 4070 (hour-end (org-element-property :hour-end timestamp)) 4071 (time-range-p (and hour-start hour-end minute-start minute-end 4072 (or (/= hour-start hour-end) 4073 (/= minute-start minute-end))))) 4074 (funcall 4075 build-ts-string 4076 (org-encode-time 0 4077 (or minute-start 0) 4078 (or hour-start 0) 4079 (org-element-property :day-start timestamp) 4080 (org-element-property :month-start timestamp) 4081 (org-element-property :year-start timestamp)) 4082 (eq type 'active) 4083 (and hour-start minute-start) 4084 (and time-range-p hour-end) 4085 (and time-range-p minute-end)))) 4086 ((or `active-range `inactive-range) 4087 (let ((minute-start (org-element-property :minute-start timestamp)) 4088 (minute-end (org-element-property :minute-end timestamp)) 4089 (hour-start (org-element-property :hour-start timestamp)) 4090 (hour-end (org-element-property :hour-end timestamp))) 4091 (concat 4092 (funcall 4093 build-ts-string (org-encode-time 4094 0 4095 (or minute-start 0) 4096 (or hour-start 0) 4097 (org-element-property :day-start timestamp) 4098 (org-element-property :month-start timestamp) 4099 (org-element-property :year-start timestamp)) 4100 (eq type 'active-range) 4101 (and hour-start minute-start)) 4102 "--" 4103 (funcall build-ts-string 4104 (org-encode-time 4105 0 4106 (or minute-end 0) 4107 (or hour-end 0) 4108 (org-element-property :day-end timestamp) 4109 (org-element-property :month-end timestamp) 4110 (org-element-property :year-end timestamp)) 4111 (eq type 'active-range) 4112 (and hour-end minute-end))))) 4113 (_ (org-element-property :raw-value timestamp))))) 4114 4115 4116 ;;;; Underline 4117 4118 (defun org-element-underline-parser () 4119 "Parse underline object at point, if any. 4120 4121 When at an underline object, return a list whose car is 4122 `underline' and cdr is a plist with `:begin', `:end', 4123 `:contents-begin' and `:contents-end' and `:post-blank' keywords. 4124 Otherwise, return nil. 4125 4126 Assume point is at the first underscore marker." 4127 (org-element--parse-generic-emphasis "_" 'underline)) 4128 4129 (defun org-element-underline-interpreter (_ contents) 4130 "Interpret underline object as Org syntax. 4131 CONTENTS is the contents of the object." 4132 (format "_%s_" contents)) 4133 4134 4135 ;;;; Verbatim 4136 4137 (defun org-element-verbatim-parser () 4138 "Parse verbatim object at point, if any. 4139 4140 When at a verbatim object, return a list whose car is `verbatim' 4141 and cdr is a plist with `:value', `:begin', `:end' and 4142 `:post-blank' keywords. Otherwise, return nil. 4143 4144 Assume point is at the first equal sign marker." 4145 (org-element--parse-generic-emphasis "=" 'verbatim)) 4146 4147 (defun org-element-verbatim-interpreter (verbatim _) 4148 "Interpret VERBATIM object as Org syntax." 4149 (format "=%s=" (org-element-property :value verbatim))) 4150 4151 4152 4153 ;;; Parsing Element Starting At Point 4154 ;; 4155 ;; `org-element--current-element' is the core function of this section. 4156 ;; It returns the Lisp representation of the element starting at 4157 ;; point. 4158 4159 (defvar org-element--cache-sync-requests); Declared later 4160 (defun org-element--current-element (limit &optional granularity mode structure add-to-cache) 4161 "Parse the element starting at point. 4162 4163 Return value is a list like (TYPE PROPS) where TYPE is the type 4164 of the element and PROPS a plist of properties associated to the 4165 element. 4166 4167 Possible types are defined in `org-element-all-elements'. 4168 4169 LIMIT bounds the search. 4170 4171 Optional argument GRANULARITY determines the depth of the 4172 recursion. Allowed values are `headline', `greater-element', 4173 `element', `object' or nil. When it is broader than `object' (or 4174 nil), secondary values will not be parsed, since they only 4175 contain objects. 4176 4177 Optional argument MODE, when non-nil, can be either 4178 `first-section', `item', `node-property', `planning', 4179 `property-drawer', `section', `table-row', or `top-comment'. 4180 4181 4182 If STRUCTURE isn't provided but MODE is set to `item', it will be 4183 computed. 4184 4185 Optional argument ADD-TO-CACHE, when non-nil, and when cache is active, 4186 will also add current element to cache if it is not yet there. Use 4187 this argument with care, as validity of the element in parse tree is 4188 not checked. 4189 4190 This function assumes point is always at the beginning of the 4191 element it has to parse." 4192 (let* ((element (and (not (buffer-narrowed-p)) 4193 (org-element--cache-active-p) 4194 (not org-element--cache-sync-requests) 4195 (org-element--cache-find (point) t))) 4196 (element (progn (while (and element 4197 (not (and (eq (point) (org-element-property :begin element)) 4198 (eq mode (org-element-property :mode element))))) 4199 (setq element (org-element-property :parent element))) 4200 element)) 4201 (old-element element) 4202 (element (when 4203 (pcase (org-element-property :granularity element) 4204 (`nil t) 4205 (`object t) 4206 (`element (not (memq granularity '(nil object)))) 4207 (`greater-element (not (memq granularity '(nil object element)))) 4208 (`headline (eq granularity 'headline))) 4209 element))) 4210 (if element 4211 element 4212 (save-excursion 4213 (let ((case-fold-search t) 4214 ;; Determine if parsing depth allows for secondary strings 4215 ;; parsing. It only applies to elements referenced in 4216 ;; `org-element-secondary-value-alist'. 4217 (raw-secondary-p (and granularity (not (eq granularity 'object)))) 4218 result) 4219 (setq 4220 result 4221 (cond 4222 ;; Item. 4223 ((eq mode 'item) 4224 (org-element-item-parser limit structure raw-secondary-p)) 4225 ;; Table Row. 4226 ((eq mode 'table-row) (org-element-table-row-parser limit)) 4227 ;; Node Property. 4228 ((eq mode 'node-property) (org-element-node-property-parser limit)) 4229 ;; Headline. 4230 ((org-with-limited-levels (looking-at-p org-outline-regexp-bol)) 4231 (org-element-headline-parser limit raw-secondary-p)) 4232 ;; Sections (must be checked after headline). 4233 ((eq mode 'section) (org-element-section-parser limit)) 4234 ((eq mode 'first-section) 4235 (org-element-section-parser 4236 (or (save-excursion (org-with-limited-levels (outline-next-heading))) 4237 limit))) 4238 ;; Comments. 4239 ((looking-at "^[ \t]*#\\(?: \\|$\\)") 4240 (org-element-comment-parser limit)) 4241 ;; Planning. 4242 ((and (eq mode 'planning) 4243 (eq ?* (char-after (line-beginning-position 0))) 4244 (looking-at org-element-planning-line-re)) 4245 (org-element-planning-parser limit)) 4246 ;; Property drawer. 4247 ((and (pcase mode 4248 (`planning (eq ?* (char-after (line-beginning-position 0)))) 4249 ((or `property-drawer `top-comment) 4250 (save-excursion 4251 (beginning-of-line 0) 4252 (not (looking-at "[[:blank:]]*$")))) 4253 (_ nil)) 4254 (looking-at org-property-drawer-re)) 4255 (org-element-property-drawer-parser limit)) 4256 ;; When not at bol, point is at the beginning of an item or 4257 ;; a footnote definition: next item is always a paragraph. 4258 ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) 4259 ;; Clock. 4260 ((looking-at org-element-clock-line-re) 4261 (org-element-clock-parser limit)) 4262 ;; Inlinetask. 4263 ((looking-at "^\\*+ ") 4264 (org-element-inlinetask-parser limit raw-secondary-p)) 4265 ;; From there, elements can have affiliated keywords. 4266 (t (let ((affiliated (org-element--collect-affiliated-keywords 4267 limit (memq granularity '(nil object))))) 4268 (cond 4269 ;; Jumping over affiliated keywords put point off-limits. 4270 ;; Parse them as regular keywords. 4271 ((and (cdr affiliated) (>= (point) limit)) 4272 (goto-char (car affiliated)) 4273 (org-element-keyword-parser limit nil)) 4274 ;; LaTeX Environment. 4275 ((looking-at org-element--latex-begin-environment) 4276 (org-element-latex-environment-parser limit affiliated)) 4277 ;; Drawer. 4278 ((looking-at org-element-drawer-re) 4279 (org-element-drawer-parser limit affiliated)) 4280 ;; Fixed Width 4281 ((looking-at "[ \t]*:\\( \\|$\\)") 4282 (org-element-fixed-width-parser limit affiliated)) 4283 ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and 4284 ;; Keywords. 4285 ((looking-at "[ \t]*#\\+") 4286 (goto-char (match-end 0)) 4287 (cond 4288 ((looking-at "BEGIN_\\(\\S-+\\)") 4289 (beginning-of-line) 4290 (funcall (pcase (upcase (match-string 1)) 4291 ("CENTER" #'org-element-center-block-parser) 4292 ("COMMENT" #'org-element-comment-block-parser) 4293 ("EXAMPLE" #'org-element-example-block-parser) 4294 ("EXPORT" #'org-element-export-block-parser) 4295 ("QUOTE" #'org-element-quote-block-parser) 4296 ("SRC" #'org-element-src-block-parser) 4297 ("VERSE" #'org-element-verse-block-parser) 4298 (_ #'org-element-special-block-parser)) 4299 limit 4300 affiliated)) 4301 ((looking-at "CALL:") 4302 (beginning-of-line) 4303 (org-element-babel-call-parser limit affiliated)) 4304 ((save-excursion 4305 (beginning-of-line) 4306 (looking-at org-element-dynamic-block-open-re)) 4307 (beginning-of-line) 4308 (org-element-dynamic-block-parser limit affiliated)) 4309 ((looking-at "\\S-+:") 4310 (beginning-of-line) 4311 (org-element-keyword-parser limit affiliated)) 4312 (t 4313 (beginning-of-line) 4314 (org-element-paragraph-parser limit affiliated)))) 4315 ;; Footnote Definition. 4316 ((looking-at org-footnote-definition-re) 4317 (org-element-footnote-definition-parser limit affiliated)) 4318 ;; Horizontal Rule. 4319 ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") 4320 (org-element-horizontal-rule-parser limit affiliated)) 4321 ;; Diary Sexp. 4322 ((looking-at "%%(") 4323 (org-element-diary-sexp-parser limit affiliated)) 4324 ;; Table. 4325 ((or (looking-at "[ \t]*|") 4326 ;; There is no strict definition of a table.el 4327 ;; table. Try to prevent false positive while being 4328 ;; quick. 4329 (let ((rule-regexp 4330 (rx (zero-or-more (any " \t")) 4331 "+" 4332 (one-or-more (one-or-more "-") "+") 4333 (zero-or-more (any " \t")) 4334 eol)) 4335 (non-table.el-line 4336 (rx bol 4337 (zero-or-more (any " \t")) 4338 (or eol (not (any "+| \t"))))) 4339 (next (line-beginning-position 2))) 4340 ;; Start with a full rule. 4341 (and 4342 (looking-at rule-regexp) 4343 (< next limit) ;no room for a table.el table 4344 (save-excursion 4345 (end-of-line) 4346 (cond 4347 ;; Must end with a full rule. 4348 ((not (re-search-forward non-table.el-line limit 'move)) 4349 (if (bolp) (forward-line -1) (beginning-of-line)) 4350 (looking-at rule-regexp)) 4351 ;; Ignore pseudo-tables with a single 4352 ;; rule. 4353 ((= next (line-beginning-position)) 4354 nil) 4355 ;; Must end with a full rule. 4356 (t 4357 (forward-line -1) 4358 (looking-at rule-regexp))))))) 4359 (org-element-table-parser limit affiliated)) 4360 ;; List. 4361 ((looking-at (org-item-re)) 4362 (org-element-plain-list-parser 4363 limit affiliated 4364 (or structure (org-element--list-struct limit)))) 4365 ;; Default element: Paragraph. 4366 (t (org-element-paragraph-parser limit affiliated))))))) 4367 (when result 4368 (org-element-put-property result :mode mode) 4369 (org-element-put-property result :granularity granularity)) 4370 (when (and (not (buffer-narrowed-p)) 4371 (org-element--cache-active-p) 4372 (not org-element--cache-sync-requests) 4373 add-to-cache) 4374 (if (not old-element) 4375 (setq result (org-element--cache-put result)) 4376 (org-element-set-element old-element result) 4377 (setq result old-element))) 4378 result))))) 4379 4380 4381 ;; Most elements can have affiliated keywords. When looking for an 4382 ;; element beginning, we want to move before them, as they belong to 4383 ;; that element, and, in the meantime, collect information they give 4384 ;; into appropriate properties. Hence the following function. 4385 4386 (defun org-element--collect-affiliated-keywords (limit parse) 4387 "Collect affiliated keywords from point down to LIMIT. 4388 4389 Return a list whose CAR is the position at the first of them and 4390 CDR a plist of keywords and values and move point to the 4391 beginning of the first line after them. 4392 4393 As a special case, if element doesn't start at the beginning of 4394 the line (e.g., a paragraph starting an item), CAR is current 4395 position of point and CDR is nil. 4396 4397 When PARSE is non-nil, values from keywords belonging to 4398 `org-element-parsed-keywords' are parsed as secondary strings." 4399 (if (not (bolp)) (list (point)) 4400 (let ((case-fold-search t) 4401 (origin (point)) 4402 ;; RESTRICT is the list of objects allowed in parsed 4403 ;; keywords value. If PARSE is nil, no object is allowed. 4404 (restrict (and parse (org-element-restriction 'keyword))) 4405 output) 4406 (while (and (< (point) limit) (looking-at org-element--affiliated-re)) 4407 (let* ((raw-kwd (upcase (match-string 1))) 4408 ;; Apply translation to RAW-KWD. From there, KWD is 4409 ;; the official keyword. 4410 (kwd (or (cdr (assoc raw-kwd 4411 org-element-keyword-translation-alist)) 4412 raw-kwd)) 4413 ;; PARSED? is non-nil when keyword should have its 4414 ;; value parsed. 4415 (parsed? (member kwd org-element-parsed-keywords)) 4416 ;; Find main value for any keyword. 4417 (value 4418 (let ((beg (match-end 0)) 4419 (end (save-excursion 4420 (end-of-line) 4421 (skip-chars-backward " \t") 4422 (point)))) 4423 (if parsed? 4424 (save-match-data 4425 (org-element--parse-objects beg end nil restrict)) 4426 (org-trim (buffer-substring-no-properties beg end))))) 4427 ;; If KWD is a dual keyword, find its secondary value. 4428 ;; Maybe parse it. 4429 (dual? (member kwd org-element-dual-keywords)) 4430 (dual-value 4431 (and dual? 4432 (let ((sec (match-string-no-properties 2))) 4433 (cond 4434 ((and sec parsed?) 4435 (save-match-data 4436 (org-element--parse-objects 4437 (match-beginning 2) (match-end 2) nil restrict))) 4438 (sec sec))))) 4439 ;; Attribute a property name to KWD. 4440 (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) 4441 ;; Now set final shape for VALUE. 4442 (when dual? 4443 (setq value (and (or value dual-value) (cons value dual-value)))) 4444 (when (or (member kwd org-element-multiple-keywords) 4445 ;; Attributes can always appear on multiple lines. 4446 (string-match "^ATTR_" kwd)) 4447 (setq value (cons value (plist-get output kwd-sym)))) 4448 ;; Eventually store the new value in OUTPUT. 4449 (setq output (plist-put output kwd-sym value)) 4450 ;; Move to next keyword. 4451 (forward-line))) 4452 ;; If affiliated keywords are orphaned: move back to first one. 4453 ;; They will be parsed as a paragraph. 4454 (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil)) 4455 ;; Return value. 4456 (cons origin output)))) 4457 4458 4459 4460 ;;; The Org Parser 4461 ;; 4462 ;; The two major functions here are `org-element-parse-buffer', which 4463 ;; parses Org syntax inside the current buffer, taking into account 4464 ;; region, narrowing, or even visibility if specified, and 4465 ;; `org-element-parse-secondary-string', which parses objects within 4466 ;; a given string. 4467 ;; 4468 ;; The (almost) almighty `org-element-map' allows applying a function 4469 ;; on elements or objects matching some type, and accumulating the 4470 ;; resulting values. In an export situation, it also skips unneeded 4471 ;; parts of the parse tree. 4472 4473 (defun org-element-parse-buffer (&optional granularity visible-only) 4474 "Recursively parse the buffer and return structure. 4475 If narrowing is in effect, only parse the visible part of the 4476 buffer. 4477 4478 Optional argument GRANULARITY determines the depth of the 4479 recursion. It can be set to the following symbols: 4480 4481 `headline' Only parse headlines. 4482 `greater-element' Don't recurse into greater elements except 4483 headlines and sections. Thus, elements 4484 parsed are the top-level ones. 4485 `element' Parse everything but objects and plain text. 4486 `object' Parse the complete buffer (default). 4487 4488 When VISIBLE-ONLY is non-nil, don't parse contents of hidden 4489 elements. 4490 4491 An element or object is represented as a list with the 4492 pattern (TYPE PROPERTIES CONTENTS), where : 4493 4494 TYPE is a symbol describing the element or object. See 4495 `org-element-all-elements' and `org-element-all-objects' for an 4496 exhaustive list of such symbols. One can retrieve it with 4497 `org-element-type' function. 4498 4499 PROPERTIES is the list of attributes attached to the element or 4500 object, as a plist. Although most of them are specific to the 4501 element or object type, all types share `:begin', `:end', 4502 `:post-blank' and `:parent' properties, which respectively 4503 refer to buffer position where the element or object starts, 4504 ends, the number of white spaces or blank lines after it, and 4505 the element or object containing it. Properties values can be 4506 obtained by using `org-element-property' function. 4507 4508 CONTENTS is a list of elements, objects or raw strings 4509 contained in the current element or object, when applicable. 4510 One can access them with `org-element-contents' function. 4511 4512 The Org buffer has `org-data' as type and nil as properties. 4513 `org-element-map' function can be used to find specific elements 4514 or objects within the parse tree. 4515 4516 This function assumes that current major mode is `org-mode'." 4517 (save-excursion 4518 (goto-char (point-min)) 4519 (let ((org-data (org-element-org-data-parser)) 4520 (gc-cons-threshold #x40000000)) 4521 (org-skip-whitespace) 4522 (org-element--parse-elements 4523 (line-beginning-position) (point-max) 4524 ;; Start in `first-section' mode so text before the first 4525 ;; headline belongs to a section. 4526 'first-section nil granularity visible-only org-data)))) 4527 4528 (defun org-element-parse-secondary-string (string restriction &optional parent) 4529 "Recursively parse objects in STRING and return structure. 4530 4531 RESTRICTION is a symbol limiting the object types that will be 4532 looked after. 4533 4534 Optional argument PARENT, when non-nil, is the element or object 4535 containing the secondary string. It is used to set correctly 4536 `:parent' property within the string. 4537 4538 If STRING is the empty string or nil, return nil." 4539 (cond 4540 ((not string) nil) 4541 ((equal string "") nil) 4542 (t (let ((local-variables (buffer-local-variables))) 4543 (with-temp-buffer 4544 (dolist (v local-variables) 4545 (ignore-errors 4546 (if (symbolp v) (makunbound v) 4547 ;; Don't set file name to avoid mishandling hooks (bug#44524) 4548 (unless (memq (car v) '(buffer-file-name buffer-file-truename)) 4549 (set (make-local-variable (car v)) (cdr v)))))) 4550 ;; Transferring local variables may put the temporary buffer 4551 ;; into a read-only state. Make sure we can insert STRING. 4552 (let ((inhibit-read-only t)) (insert string)) 4553 ;; Prevent "Buffer *temp* modified; kill anyway?". 4554 (restore-buffer-modified-p nil) 4555 (org-element--parse-objects 4556 (point-min) (point-max) nil restriction parent)))))) 4557 4558 (defun org-element-map 4559 (data types fun &optional info first-match no-recursion with-affiliated) 4560 "Map a function on selected elements or objects. 4561 4562 DATA is a parse tree (for example, returned by 4563 `org-element-parse-buffer'), an element, an object, a string, or a 4564 list of such constructs. TYPES is a symbol or list of symbols of 4565 elements or object types (see `org-element-all-elements' and 4566 `org-element-all-objects' for a complete list of types). FUN is the 4567 function called on the matching element or object. It has to accept 4568 one argument: the element or object itself. 4569 4570 When optional argument INFO is non-nil, it should be a plist 4571 holding export options. In that case, parts of the parse tree 4572 not exportable according to that property list will be skipped. 4573 4574 When optional argument FIRST-MATCH is non-nil, stop at the first 4575 match for which FUN doesn't return nil, and return that value. 4576 4577 Optional argument NO-RECURSION is a symbol or a list of symbols 4578 representing elements or objects types. `org-element-map' won't 4579 enter any recursive element or object whose type belongs to that 4580 list. Though, FUN can still be applied on them. 4581 4582 When optional argument WITH-AFFILIATED is non-nil, FUN will also 4583 apply to matching objects within parsed affiliated keywords (see 4584 `org-element-parsed-keywords'). 4585 4586 Nil values returned from FUN do not appear in the results. 4587 4588 4589 Examples: 4590 --------- 4591 4592 Assuming TREE is a variable containing an Org buffer parse tree, 4593 the following example will return a flat list of all `src-block' 4594 and `example-block' elements in it: 4595 4596 (setq tree (org-element-parse-buffer)) 4597 (org-element-map tree \\='(example-block src-block) #\\='identity) 4598 4599 The following snippet will find the first headline with a level 4600 of 1 and a \"phone\" tag, and will return its beginning position: 4601 4602 (org-element-map tree \\='headline 4603 (lambda (hl) 4604 (and (= (org-element-property :level hl) 1) 4605 (member \"phone\" (org-element-property :tags hl)) 4606 (org-element-property :begin hl))) 4607 nil t) 4608 4609 The next example will return a flat list of all `plain-list' type 4610 elements in TREE that are not a sub-list themselves: 4611 4612 (org-element-map tree \\='plain-list #\\='identity nil nil \\='plain-list) 4613 4614 Eventually, this example will return a flat list of all `bold' 4615 type objects containing a `latex-snippet' type object, even 4616 looking into captions: 4617 4618 (org-element-map tree \\='bold 4619 (lambda (b) 4620 (and (org-element-map b \\='latex-snippet #\\='identity nil t) b)) 4621 nil nil nil t)" 4622 (declare (indent 2)) 4623 ;; Ensure TYPES and NO-RECURSION are a list, even of one element. 4624 (let* ((types (if (listp types) types (list types))) 4625 (no-recursion (if (listp no-recursion) no-recursion 4626 (list no-recursion))) 4627 ;; Recursion depth is determined by --CATEGORY. 4628 (--category 4629 (catch :--found 4630 (let ((category 'greater-elements) 4631 (all-objects (cons 'plain-text org-element-all-objects))) 4632 (dolist (type types category) 4633 (cond ((memq type all-objects) 4634 ;; If one object is found, the function has 4635 ;; to recurse into every object. 4636 (throw :--found 'objects)) 4637 ((not (memq type org-element-greater-elements)) 4638 ;; If one regular element is found, the 4639 ;; function has to recurse, at least, into 4640 ;; every element it encounters. 4641 (and (not (eq category 'elements)) 4642 (setq category 'elements)))))))) 4643 (--ignore-list (plist-get info :ignore-list)) 4644 --acc) 4645 (letrec ((--walk-tree 4646 (lambda (--data) 4647 ;; Recursively walk DATA. INFO, if non-nil, is a plist 4648 ;; holding contextual information. 4649 (let ((--type (org-element-type --data))) 4650 (cond 4651 ((not --data)) 4652 ;; Ignored element in an export context. 4653 ((and info (memq --data --ignore-list))) 4654 ;; List of elements or objects. 4655 ((not --type) (mapc --walk-tree --data)) 4656 ;; Unconditionally enter parse trees. 4657 ((eq --type 'org-data) 4658 (mapc --walk-tree (org-element-contents --data))) 4659 (t 4660 ;; Check if TYPE is matching among TYPES. If so, 4661 ;; apply FUN to --DATA and accumulate return value 4662 ;; into --ACC (or exit if FIRST-MATCH is non-nil). 4663 (when (memq --type types) 4664 (let ((result (funcall fun --data))) 4665 (cond ((not result)) 4666 (first-match (throw :--map-first-match result)) 4667 (t (push result --acc))))) 4668 ;; If --DATA has a secondary string that can contain 4669 ;; objects with their type among TYPES, look inside. 4670 (when (and (eq --category 'objects) (not (stringp --data))) 4671 (dolist (p (cdr (assq --type 4672 org-element-secondary-value-alist))) 4673 (funcall --walk-tree (org-element-property p --data)))) 4674 ;; If --DATA has any parsed affiliated keywords and 4675 ;; WITH-AFFILIATED is non-nil, look for objects in 4676 ;; them. 4677 (when (and with-affiliated 4678 (eq --category 'objects) 4679 (eq (org-element-class --data) 'element)) 4680 (dolist (kwd-pair org-element--parsed-properties-alist) 4681 (let ((kwd (car kwd-pair)) 4682 (value (org-element-property (cdr kwd-pair) --data))) 4683 ;; Pay attention to the type of parsed 4684 ;; keyword. In particular, preserve order for 4685 ;; multiple keywords. 4686 (cond 4687 ((not value)) 4688 ((member kwd org-element-dual-keywords) 4689 (if (member kwd org-element-multiple-keywords) 4690 (dolist (line (reverse value)) 4691 (funcall --walk-tree (cdr line)) 4692 (funcall --walk-tree (car line))) 4693 (funcall --walk-tree (cdr value)) 4694 (funcall --walk-tree (car value)))) 4695 ((member kwd org-element-multiple-keywords) 4696 (mapc --walk-tree (reverse value))) 4697 (t (funcall --walk-tree value)))))) 4698 ;; Determine if a recursion into --DATA is possible. 4699 (cond 4700 ;; --TYPE is explicitly removed from recursion. 4701 ((memq --type no-recursion)) 4702 ;; --DATA has no contents. 4703 ((not (org-element-contents --data))) 4704 ;; Looking for greater elements but --DATA is 4705 ;; simply an element or an object. 4706 ((and (eq --category 'greater-elements) 4707 (not (memq --type org-element-greater-elements)))) 4708 ;; Looking for elements but --DATA is an object. 4709 ((and (eq --category 'elements) 4710 (eq (org-element-class --data) 'object))) 4711 ;; In any other case, map contents. 4712 (t (mapc --walk-tree (org-element-contents --data)))))))))) 4713 (catch :--map-first-match 4714 (funcall --walk-tree data) 4715 ;; Return value in a proper order. 4716 (nreverse --acc))))) 4717 4718 ;; The following functions are internal parts of the parser. 4719 ;; 4720 ;; The first one, `org-element--parse-elements' acts at the element's 4721 ;; level. 4722 ;; 4723 ;; The second one, `org-element--parse-objects' applies on all objects 4724 ;; of a paragraph or a secondary string. It calls 4725 ;; `org-element--object-lex' to find the next object in the current 4726 ;; container. 4727 4728 (defsubst org-element--next-mode (mode type parent?) 4729 "Return next mode according to current one. 4730 4731 MODE is a symbol representing the expectation about the next 4732 element or object. Meaningful values are `first-section', 4733 `item', `node-property', `planning', `property-drawer', 4734 `section', `table-row', `top-comment', and nil. 4735 4736 TYPE is the type of the current element or object. 4737 4738 If PARENT? is non-nil, assume the next element or object will be 4739 located inside the current one." 4740 (if parent? 4741 (pcase type 4742 (`headline 'section) 4743 ((and (guard (eq mode 'first-section)) `section) 'top-comment) 4744 ((and (guard (eq mode 'org-data)) `org-data) 'first-section) 4745 ((and (guard (not mode)) `org-data) 'first-section) 4746 (`inlinetask 'planning) 4747 (`plain-list 'item) 4748 (`property-drawer 'node-property) 4749 (`section 'planning) 4750 (`table 'table-row)) 4751 (pcase mode 4752 (`item 'item) 4753 (`node-property 'node-property) 4754 ((and `planning (guard (eq type 'planning))) 'property-drawer) 4755 (`table-row 'table-row) 4756 ((and `top-comment (guard (eq type 'comment))) 'property-drawer)))) 4757 4758 (defun org-element--parse-elements 4759 (beg end mode structure granularity visible-only acc) 4760 "Parse elements between BEG and END positions. 4761 4762 MODE prioritizes some elements over the others. It can be set to 4763 `first-section', `item', `node-property', `planning', 4764 `property-drawer', `section', `table-row', `top-comment', or nil. 4765 4766 When value is `item', STRUCTURE will be used as the current list 4767 structure. 4768 4769 GRANULARITY determines the depth of the recursion. See 4770 `org-element-parse-buffer' for more information. 4771 4772 When VISIBLE-ONLY is non-nil, don't parse contents of hidden 4773 elements. 4774 4775 Elements are accumulated into ACC." 4776 (save-excursion 4777 (goto-char beg) 4778 ;; When parsing only headlines, skip any text before first one. 4779 (when (and (eq granularity 'headline) (not (org-at-heading-p))) 4780 (org-with-limited-levels (outline-next-heading))) 4781 (let (elements) 4782 (while (< (point) end) 4783 ;; Visible only: skip invisible parts due to folding. 4784 (if (and visible-only (org-invisible-p nil t)) 4785 (progn 4786 (goto-char (org-find-visible)) 4787 (when (and (eolp) (not (eobp))) (forward-char))) 4788 ;; Find current element's type and parse it accordingly to 4789 ;; its category. 4790 (let* ((element (org-element-copy 4791 ;; `org-element--current-element' may return cached 4792 ;; elements. Below code reassigns 4793 ;; `:parent' property of the element and 4794 ;; may interfere with cache 4795 ;; synchronization if parent element is not 4796 ;; yet in cache. Moreover, the returned 4797 ;; structure may be altered by caller code 4798 ;; arbitrarily. Hence, we return a copy of 4799 ;; the potentially cached element to make 4800 ;; potential modifications safe for element 4801 ;; cache. 4802 (org-element--current-element 4803 end granularity mode structure))) 4804 (type (org-element-type element)) 4805 (cbeg (org-element-property :contents-begin element))) 4806 (goto-char (org-element-property :end element)) 4807 ;; Fill ELEMENT contents by side-effect. 4808 (cond 4809 ;; If element has no contents, don't modify it. 4810 ((not cbeg)) 4811 ;; Greater element: parse it between `contents-begin' and 4812 ;; `contents-end'. Ensure GRANULARITY allows recursion, 4813 ;; or ELEMENT is a headline, in which case going inside 4814 ;; is mandatory, in order to get sub-level headings. 4815 ((and (memq type org-element-greater-elements) 4816 (or (memq granularity '(element object nil)) 4817 (and (eq granularity 'greater-element) 4818 (eq type 'section)) 4819 (eq type 'headline))) 4820 (org-element--parse-elements 4821 cbeg (org-element-property :contents-end element) 4822 ;; Possibly switch to a special mode. 4823 (org-element--next-mode mode type t) 4824 (and (memq type '(item plain-list)) 4825 (org-element-property :structure element)) 4826 granularity visible-only element)) 4827 ;; ELEMENT has contents. Parse objects inside, if 4828 ;; GRANULARITY allows it. 4829 ((memq granularity '(object nil)) 4830 (org-element--parse-objects 4831 cbeg (org-element-property :contents-end element) element 4832 (org-element-restriction type)))) 4833 (push (org-element-put-property element :parent acc) elements) 4834 ;; Update mode. 4835 (setq mode (org-element--next-mode mode type nil))))) 4836 ;; Return result. 4837 (org-element-put-property acc :granularity granularity) 4838 (apply #'org-element-set-contents acc (nreverse elements))))) 4839 4840 (defun org-element--object-lex (restriction) 4841 "Return next object in current buffer or nil. 4842 RESTRICTION is a list of object types, as symbols, that should be 4843 looked after. This function assumes that the buffer is narrowed 4844 to an appropriate container (e.g., a paragraph)." 4845 (cond 4846 ((memq 'table-cell restriction) (org-element-table-cell-parser)) 4847 ((memq 'citation-reference restriction) 4848 (org-element-citation-reference-parser)) 4849 (t 4850 (let* ((start (point)) 4851 (limit 4852 ;; Object regexp sometimes needs to have a peek at 4853 ;; a character ahead. Therefore, when there is a hard 4854 ;; limit, make it one more than the true beginning of the 4855 ;; radio target. 4856 (save-excursion 4857 (cond ((not org-target-link-regexp) nil) 4858 ((not (memq 'link restriction)) nil) 4859 ((progn 4860 (unless (bolp) (forward-char -1)) 4861 (not (re-search-forward org-target-link-regexp nil t))) 4862 nil) 4863 ;; Since we moved backward, we do not want to 4864 ;; match again an hypothetical 1-character long 4865 ;; radio link before us. Realizing that this can 4866 ;; only happen if such a radio link starts at 4867 ;; beginning of line, we prevent this here. 4868 ((and (= start (1+ (line-beginning-position))) 4869 (= start (match-end 1))) 4870 (and (re-search-forward org-target-link-regexp nil t) 4871 (1+ (match-beginning 1)))) 4872 (t (1+ (match-beginning 1)))))) 4873 found) 4874 (save-excursion 4875 (while (and (not found) 4876 (re-search-forward org-element--object-regexp limit 'move)) 4877 (goto-char (match-beginning 0)) 4878 (let ((result (match-string 0))) 4879 (setq found 4880 (cond 4881 ((string-prefix-p "call_" result t) 4882 (and (memq 'inline-babel-call restriction) 4883 (org-element-inline-babel-call-parser))) 4884 ((string-prefix-p "src_" result t) 4885 (and (memq 'inline-src-block restriction) 4886 (org-element-inline-src-block-parser))) 4887 (t 4888 (pcase (char-after) 4889 (?^ (and (memq 'superscript restriction) 4890 (org-element-superscript-parser))) 4891 (?_ (or (and (memq 'subscript restriction) 4892 (org-element-subscript-parser)) 4893 (and (memq 'underline restriction) 4894 (org-element-underline-parser)))) 4895 (?* (and (memq 'bold restriction) 4896 (org-element-bold-parser))) 4897 (?/ (and (memq 'italic restriction) 4898 (org-element-italic-parser))) 4899 (?~ (and (memq 'code restriction) 4900 (org-element-code-parser))) 4901 (?= (and (memq 'verbatim restriction) 4902 (org-element-verbatim-parser))) 4903 (?+ (and (memq 'strike-through restriction) 4904 (org-element-strike-through-parser))) 4905 (?@ (and (memq 'export-snippet restriction) 4906 (org-element-export-snippet-parser))) 4907 (?{ (and (memq 'macro restriction) 4908 (org-element-macro-parser))) 4909 (?$ (and (memq 'latex-fragment restriction) 4910 (org-element-latex-fragment-parser))) 4911 (?< 4912 (if (eq (aref result 1) ?<) 4913 (or (and (memq 'radio-target restriction) 4914 (org-element-radio-target-parser)) 4915 (and (memq 'target restriction) 4916 (org-element-target-parser))) 4917 (or (and (memq 'timestamp restriction) 4918 (org-element-timestamp-parser)) 4919 (and (memq 'link restriction) 4920 (org-element-link-parser))))) 4921 (?\\ 4922 (if (eq (aref result 1) ?\\) 4923 (and (memq 'line-break restriction) 4924 (org-element-line-break-parser)) 4925 (or (and (memq 'entity restriction) 4926 (org-element-entity-parser)) 4927 (and (memq 'latex-fragment restriction) 4928 (org-element-latex-fragment-parser))))) 4929 (?\[ 4930 (pcase (aref result 1) 4931 ((and ?\[ 4932 (guard (memq 'link restriction))) 4933 (org-element-link-parser)) 4934 ((and ?f 4935 (guard (memq 'footnote-reference restriction))) 4936 (org-element-footnote-reference-parser)) 4937 ((and ?c 4938 (guard (memq 'citation restriction))) 4939 (org-element-citation-parser)) 4940 ((and (or ?% ?/) 4941 (guard (memq 'statistics-cookie restriction))) 4942 (org-element-statistics-cookie-parser)) 4943 (_ 4944 (or (and (memq 'timestamp restriction) 4945 (org-element-timestamp-parser)) 4946 (and (memq 'statistics-cookie restriction) 4947 (org-element-statistics-cookie-parser)))))) 4948 ;; This is probably a plain link. 4949 (_ (and (memq 'link restriction) 4950 (org-element-link-parser))))))) 4951 (or (eobp) (forward-char)))) 4952 (cond (found) 4953 (limit (forward-char -1) 4954 (org-element-link-parser)) ;radio link 4955 (t nil))))))) 4956 4957 (defun org-element--parse-objects (beg end acc restriction &optional parent) 4958 "Parse objects between BEG and END and return recursive structure. 4959 4960 Objects are accumulated in ACC. RESTRICTION is a list of object 4961 successors which are allowed in the current object. 4962 4963 ACC becomes the parent for all parsed objects. However, if ACC 4964 is nil (i.e., a secondary string is being parsed) and optional 4965 argument PARENT is non-nil, use it as the parent for all objects. 4966 Eventually, if both ACC and PARENT are nil, the common parent is 4967 the list of objects itself." 4968 (save-excursion 4969 (save-restriction 4970 (narrow-to-region beg end) 4971 (goto-char (point-min)) 4972 (let (next-object contents) 4973 (while (and (not (eobp)) 4974 (setq next-object (org-element--object-lex restriction))) 4975 ;; Text before any object. 4976 (let ((obj-beg (org-element-property :begin next-object))) 4977 (unless (= (point) obj-beg) 4978 (let ((text (buffer-substring-no-properties (point) obj-beg))) 4979 (push (if acc (org-element-put-property text :parent acc) text) 4980 contents)))) 4981 ;; Object... 4982 (let ((obj-end (org-element-property :end next-object)) 4983 (cont-beg (org-element-property :contents-begin next-object))) 4984 (when acc (org-element-put-property next-object :parent acc)) 4985 (push (if cont-beg 4986 ;; Fill contents of NEXT-OBJECT if possible. 4987 (org-element--parse-objects 4988 cont-beg 4989 (org-element-property :contents-end next-object) 4990 next-object 4991 (org-element-restriction next-object)) 4992 next-object) 4993 contents) 4994 (goto-char obj-end))) 4995 ;; Text after last object. 4996 (unless (eobp) 4997 (let ((text (buffer-substring-no-properties (point) end))) 4998 (push (if acc (org-element-put-property text :parent acc) text) 4999 contents))) 5000 ;; Result. Set appropriate parent. 5001 (if acc (apply #'org-element-set-contents acc (nreverse contents)) 5002 (let* ((contents (nreverse contents)) 5003 (parent (or parent contents))) 5004 (dolist (datum contents contents) 5005 (org-element-put-property datum :parent parent)))))))) 5006 5007 5008 5009 ;;; Towards A Bijective Process 5010 ;; 5011 ;; The parse tree obtained with `org-element-parse-buffer' is really 5012 ;; a snapshot of the corresponding Org buffer. Therefore, it can be 5013 ;; interpreted and expanded into a string with canonical Org syntax. 5014 ;; Hence `org-element-interpret-data'. 5015 ;; 5016 ;; The function relies internally on 5017 ;; `org-element--interpret-affiliated-keywords'. 5018 5019 ;;;###autoload 5020 (defun org-element-interpret-data (data) 5021 "Interpret DATA as Org syntax. 5022 DATA is a parse tree, an element, an object or a secondary string 5023 to interpret. Return Org syntax as a string." 5024 (letrec ((fun 5025 (lambda (data parent) 5026 (let* ((type (org-element-type data)) 5027 ;; Find interpreter for current object or 5028 ;; element. If it doesn't exist (e.g. this is 5029 ;; a pseudo object or element), return contents, 5030 ;; if any. 5031 (interpret 5032 (let ((fun (intern 5033 (format "org-element-%s-interpreter" type)))) 5034 (if (fboundp fun) fun (lambda (_ contents) contents)))) 5035 (results 5036 (cond 5037 ;; Secondary string. 5038 ((not type) 5039 (mapconcat (lambda (obj) (funcall fun obj parent)) 5040 data 5041 "")) 5042 ;; Full Org document. 5043 ((eq type 'org-data) 5044 (mapconcat (lambda (obj) (funcall fun obj parent)) 5045 (org-element-contents data) 5046 "")) 5047 ;; Plain text: return it. 5048 ((stringp data) data) 5049 ;; Element or object without contents. 5050 ((not (org-element-contents data)) 5051 (funcall interpret data nil)) 5052 ;; Element or object with contents. 5053 (t 5054 (funcall 5055 interpret 5056 data 5057 ;; Recursively interpret contents. 5058 (mapconcat 5059 (lambda (datum) (funcall fun datum data)) 5060 (org-element-contents 5061 (if (not (memq type '(paragraph verse-block))) 5062 data 5063 ;; Fix indentation of elements containing 5064 ;; objects. We ignore `table-row' 5065 ;; elements as they are one line long 5066 ;; anyway. 5067 (org-element-normalize-contents 5068 data 5069 ;; When normalizing first paragraph of 5070 ;; an item or a footnote-definition, 5071 ;; ignore first line's indentation. 5072 (and (eq type 'paragraph) 5073 (memq (org-element-type parent) 5074 '(footnote-definition item)) 5075 (eq data (car (org-element-contents parent))) 5076 (eq (org-element-property :pre-blank parent) 5077 0))))) 5078 "")))))) 5079 (if (memq type '(org-data nil)) results 5080 ;; Build white spaces. If no `:post-blank' property 5081 ;; is specified, assume its value is 0. 5082 (let ((blank (or (org-element-property :post-blank data) 0))) 5083 (if (eq (org-element-class data parent) 'object) 5084 (concat results (make-string blank ?\s)) 5085 (concat (org-element--interpret-affiliated-keywords data) 5086 (org-element-normalize-string results) 5087 (make-string blank ?\n))))))))) 5088 (funcall fun data nil))) 5089 5090 (defun org-element--interpret-affiliated-keywords (element) 5091 "Return ELEMENT's affiliated keywords as Org syntax. 5092 If there is no affiliated keyword, return the empty string." 5093 (let ((keyword-to-org 5094 (lambda (key value) 5095 (let (dual) 5096 (when (member key org-element-dual-keywords) 5097 (setq dual (cdr value) value (car value))) 5098 (concat "#+" (downcase key) 5099 (and dual 5100 (format "[%s]" (org-element-interpret-data dual))) 5101 ": " 5102 (if (member key org-element-parsed-keywords) 5103 (org-element-interpret-data value) 5104 value) 5105 "\n"))))) 5106 (mapconcat 5107 (lambda (prop) 5108 (let ((value (org-element-property prop element)) 5109 (keyword (upcase (substring (symbol-name prop) 1)))) 5110 (when value 5111 (if (or (member keyword org-element-multiple-keywords) 5112 ;; All attribute keywords can have multiple lines. 5113 (string-match "^ATTR_" keyword)) 5114 (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) 5115 (reverse value) 5116 "") 5117 (funcall keyword-to-org keyword value))))) 5118 ;; List all ELEMENT's properties matching an attribute line or an 5119 ;; affiliated keyword, but ignore translated keywords since they 5120 ;; cannot belong to the property list. 5121 (cl-loop for prop in (nth 1 element) by 'cddr 5122 when (let ((keyword (upcase (substring (symbol-name prop) 1)))) 5123 (or (string-match "^ATTR_" keyword) 5124 (and 5125 (member keyword org-element-affiliated-keywords) 5126 (not (assoc keyword 5127 org-element-keyword-translation-alist))))) 5128 collect prop) 5129 ""))) 5130 5131 ;; Because interpretation of the parse tree must return the same 5132 ;; number of blank lines between elements and the same number of white 5133 ;; space after objects, some special care must be given to white 5134 ;; spaces. 5135 ;; 5136 ;; The first function, `org-element-normalize-string', ensures any 5137 ;; string different from the empty string will end with a single 5138 ;; newline character. 5139 ;; 5140 ;; The second function, `org-element-normalize-contents', removes 5141 ;; global indentation from the contents of the current element. 5142 5143 (defun org-element-normalize-string (s) 5144 "Ensure string S ends with a single newline character. 5145 5146 If S isn't a string return it unchanged. If S is the empty 5147 string, return it. Otherwise, return a new string with a single 5148 newline character at its end." 5149 (cond 5150 ((not (stringp s)) s) 5151 ((string= "" s) "") 5152 (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) 5153 (replace-match "\n" nil nil s))))) 5154 5155 (defun org-element-normalize-contents (element &optional ignore-first) 5156 "Normalize plain text in ELEMENT's contents. 5157 5158 ELEMENT must only contain plain text and objects. 5159 5160 If optional argument IGNORE-FIRST is non-nil, ignore first line's 5161 indentation to compute maximal common indentation. 5162 5163 Return the normalized element that is element with global 5164 indentation removed from its contents." 5165 (letrec ((find-min-ind 5166 ;; Return minimal common indentation within BLOB. This is 5167 ;; done by walking recursively BLOB and updating MIN-IND 5168 ;; along the way. FIRST-FLAG is non-nil when the next 5169 ;; object is expected to be a string that doesn't start 5170 ;; with a newline character. It happens for strings at 5171 ;; the beginnings of the contents or right after a line 5172 ;; break. 5173 (lambda (blob first-flag min-ind) 5174 (dolist (datum (org-element-contents blob) min-ind) 5175 (when first-flag 5176 (setq first-flag nil) 5177 (cond 5178 ;; Objects cannot start with spaces: in this 5179 ;; case, indentation is 0. 5180 ((not (stringp datum)) (throw :zero 0)) 5181 ((not (string-match 5182 "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum)) 5183 (throw :zero 0)) 5184 ((equal (match-string 2 datum) "\n") 5185 (put-text-property 5186 (match-beginning 1) (match-end 1) 'org-ind 'empty datum)) 5187 (t 5188 (let ((i (string-width (match-string 1 datum)))) 5189 (put-text-property 5190 (match-beginning 1) (match-end 1) 'org-ind i datum) 5191 (setq min-ind (min i min-ind)))))) 5192 (cond 5193 ((stringp datum) 5194 (let ((s 0)) 5195 (while (string-match 5196 "\n\\([ \t]*\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s) 5197 (setq s (match-end 1)) 5198 (cond 5199 ((equal (match-string 1 datum) "") 5200 (unless (member (match-string 2 datum) '("" "\n")) 5201 (throw :zero 0))) 5202 ((equal (match-string 2 datum) "\n") 5203 (put-text-property (match-beginning 1) (match-end 1) 5204 'org-ind 'empty datum)) 5205 (t 5206 (let ((i (string-width (match-string 1 datum)))) 5207 (put-text-property (match-beginning 1) (match-end 1) 5208 'org-ind i datum) 5209 (setq min-ind (min i min-ind)))))))) 5210 ((eq (org-element-type datum) 'line-break) 5211 (setq first-flag t)) 5212 ((memq (org-element-type datum) org-element-recursive-objects) 5213 (setq min-ind 5214 (funcall find-min-ind datum first-flag min-ind))))))) 5215 (min-ind 5216 (catch :zero 5217 (funcall find-min-ind 5218 element (not ignore-first) most-positive-fixnum)))) 5219 (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element 5220 ;; Build ELEMENT back, replacing each string with the same 5221 ;; string minus common indentation. 5222 (letrec ((build 5223 (lambda (datum) 5224 ;; Return DATUM with all its strings indentation 5225 ;; shortened from MIN-IND white spaces. 5226 (setcdr 5227 (cdr datum) 5228 (mapcar 5229 (lambda (object) 5230 (cond 5231 ((stringp object) 5232 (with-temp-buffer 5233 (insert object) 5234 (let ((s (point-min))) 5235 (while (setq s (text-property-not-all 5236 s (point-max) 'org-ind nil)) 5237 (goto-char s) 5238 (let ((i (get-text-property s 'org-ind))) 5239 (delete-region s (progn 5240 (skip-chars-forward " \t") 5241 (point))) 5242 (when (integerp i) (indent-to (- i min-ind)))))) 5243 (buffer-string))) 5244 ((memq (org-element-type object) 5245 org-element-recursive-objects) 5246 (funcall build object)) 5247 (t object))) 5248 (org-element-contents datum))) 5249 datum))) 5250 (funcall build element))))) 5251 5252 5253 5254 ;;; Cache 5255 ;; 5256 ;; Implement a caching mechanism for `org-element-at-point', `org-element-context', and for 5257 ;; fast mapping across Org elements in `org-element-cache-map', which see. 5258 ;; 5259 ;; When cache is enabled, the elements returned by `org-element-at-point' and 5260 ;; `org-element-context' are returned by reference. Altering these elements will 5261 ;; also alter their cache representation. The same is true for 5262 ;; elements passed to mapping function in `org-element-cache-map'. 5263 ;; 5264 ;; Public functions are: `org-element-cache-reset', `org-element-cache-refresh', and 5265 ;; `org-element-cache-map'. 5266 ;; 5267 ;; Cache can be controlled using `org-element-use-cache' and `org-element-cache-persistent'. 5268 ;; `org-element-cache-sync-idle-time', `org-element-cache-sync-duration' and 5269 ;; `org-element-cache-sync-break' can be tweaked to control caching behavior. 5270 ;; 5271 ;; Internally, parsed elements are stored in an AVL tree, 5272 ;; `org-element--cache'. This tree is updated lazily: whenever 5273 ;; a change happens to the buffer, a synchronization request is 5274 ;; registered in `org-element--cache-sync-requests' (see 5275 ;; `org-element--cache-submit-request'). During idle time, requests 5276 ;; are processed by `org-element--cache-sync'. Synchronization also 5277 ;; happens when an element is required from the cache. In this case, 5278 ;; the process stops as soon as the needed element is up-to-date. 5279 ;; 5280 ;; A synchronization request can only apply on a synchronized part of 5281 ;; the cache. Therefore, the cache is updated at least to the 5282 ;; location where the new request applies. Thus, requests are ordered 5283 ;; from left to right and all elements starting before the first 5284 ;; request are correct. This property is used by functions like 5285 ;; `org-element--cache-find' to retrieve elements in the part of the 5286 ;; cache that can be trusted. 5287 ;; 5288 ;; A request applies to every element, starting from its original 5289 ;; location (or key, see below). When a request is processed, it 5290 ;; moves forward and may collide the next one. In this case, both 5291 ;; requests are merged into a new one that starts from that element. 5292 ;; As a consequence, the whole synchronization complexity does not 5293 ;; depend on the number of pending requests, but on the number of 5294 ;; elements the very first request will be applied on. 5295 ;; 5296 ;; Elements cannot be accessed through their beginning position, which 5297 ;; may or may not be up-to-date. Instead, each element in the tree is 5298 ;; associated to a key, obtained with `org-element--cache-key'. This 5299 ;; mechanism is robust enough to preserve total order among elements 5300 ;; even when the tree is only partially synchronized. 5301 ;; 5302 ;; The cache code debugging is fairly complex because cache request 5303 ;; state is often hard to reproduce. An extensive diagnostics 5304 ;; functionality is built into the cache code to assist hunting bugs. 5305 ;; See `org-element--cache-self-verify', `org-element--cache-self-verify-frequency', 5306 ;; `org-element--cache-diagnostics', `org-element--cache-diagnostics-level', 5307 ;; `org-element--cache-diagnostics-ring-size', `org-element--cache-map-statistics', 5308 ;; `org-element--cache-map-statistics-threshold'. 5309 5310 ;;;###autoload 5311 (defvar org-element-use-cache t 5312 "Non-nil when Org parser should cache its results.") 5313 5314 (defvar org-element-cache-persistent t 5315 "Non-nil when cache should persist between Emacs sessions.") 5316 5317 (defvar org-element-cache-sync-idle-time 0.6 5318 "Length, in seconds, of idle time before syncing cache.") 5319 5320 (defvar org-element-cache-sync-duration 0.04 5321 "Maximum duration, as a time value, for a cache synchronization. 5322 If the synchronization is not over after this delay, the process 5323 pauses and resumes after `org-element-cache-sync-break' 5324 seconds.") 5325 5326 (defvar org-element-cache-sync-break 0.3 5327 "Duration, as a time value, of the pause between synchronizations. 5328 See `org-element-cache-sync-duration' for more information.") 5329 5330 (defvar org-element--cache-self-verify t 5331 "Activate extra consistency checks for the cache. 5332 5333 This may cause serious performance degradation depending on the value 5334 of `org-element--cache-self-verify-frequency'. 5335 5336 When set to symbol `backtrace', record and display backtrace log if 5337 any inconsistency is detected.") 5338 5339 (defvar org-element--cache-self-verify-frequency 0.03 5340 "Frequency of cache element verification. 5341 5342 This number is a probability to check an element requested from cache 5343 to be correct. Setting this to a value less than 0.0001 is useless.") 5344 5345 (defvar org-element--cache-diagnostics nil 5346 "Print detailed diagnostics of cache processing.") 5347 5348 (defvar org-element--cache-map-statistics nil 5349 "Print statistics for `org-element-cache-map'.") 5350 5351 (defvar org-element--cache-map-statistics-threshold 0.1 5352 "Time threshold in seconds to log statistics for `org-element-cache-map'.") 5353 5354 (defvar org-element--cache-diagnostics-level 2 5355 "Detail level of the diagnostics.") 5356 5357 (defvar-local org-element--cache-diagnostics-ring nil 5358 "Ring containing last `org-element--cache-diagnostics-ring-size' 5359 cache process log entries.") 5360 5361 (defvar org-element--cache-diagnostics-ring-size 5000 5362 "Size of `org-element--cache-diagnostics-ring'.") 5363 5364 ;;;; Data Structure 5365 5366 (defvar-local org-element--cache nil 5367 "AVL tree used to cache elements. 5368 Each node of the tree contains an element. Comparison is done 5369 with `org-element--cache-compare'. This cache is used in 5370 `org-element-at-point'.") 5371 5372 (defvar-local org-element--headline-cache nil 5373 "AVL tree used to cache headline and inlinetask elements. 5374 Each node of the tree contains an element. Comparison is done 5375 with `org-element--cache-compare'. This cache is used in 5376 `org-element-cache-map'.") 5377 5378 (defconst org-element--cache-hash-size 16 5379 "Cache size for recent cached calls to `org-element--cache-find'. 5380 5381 This extra caching is based on the following paper: 5382 Pugh [Information Processing Letters] (1990) Slow optimally balanced 5383 search strategies vs. cached fast uniformly balanced search 5384 strategies. http://dx.doi.org/10.1016/0020-0190(90)90130-P 5385 5386 Also, see `org-element--cache-hash-left' and `org-element--cache-hash-right'.") 5387 (defvar-local org-element--cache-hash-left nil 5388 "Cached elements from `org-element--cache' for fast O(1) lookup. 5389 When non-nil, it should be a vector representing POS arguments of 5390 `org-element--cache-find' called with nil SIDE argument. 5391 Also, see `org-element--cache-hash-size'.") 5392 (defvar-local org-element--cache-hash-right nil 5393 "Cached elements from `org-element--cache' for fast O(1) lookup. 5394 When non-nil, it should be a vector representing POS arguments of 5395 `org-element--cache-find' called with non-nil, non-`both' SIDE argument. 5396 Also, see `org-element--cache-hash-size'.") 5397 5398 (defvar org-element--cache-hash-statistics '(0 . 0) 5399 "Cons cell storing how Org makes use of `org-element--cache-find' caching. 5400 The car is the number of successful uses and cdr is the total calls to 5401 `org-element--cache-find'.") 5402 (defvar org-element--cache-hash-nocache 0 5403 "Number of calls to `org-element--cache-has' with `both' SIDE argument. 5404 These calls are not cached by hash. See `org-element--cache-hash-size'.") 5405 5406 (defvar-local org-element--cache-size 0 5407 "Size of the `org-element--cache'. 5408 5409 Storing value is variable is faster because `avl-tree-size' is O(N).") 5410 5411 (defvar-local org-element--headline-cache-size 0 5412 "Size of the `org-element--headline-cache'. 5413 5414 Storing value is variable is faster because `avl-tree-size' is O(N).") 5415 5416 (defvar-local org-element--cache-sync-requests nil 5417 "List of pending synchronization requests. 5418 5419 A request is a vector with the following pattern: 5420 5421 [NEXT BEG END OFFSET PARENT PHASE] 5422 5423 Processing a synchronization request consists of three phases: 5424 5425 0. Delete modified elements, 5426 1. Fill missing area in cache, 5427 2. Shift positions and re-parent elements after the changes. 5428 5429 During phase 0, NEXT is the key of the first element to be 5430 removed, BEG and END is buffer position delimiting the 5431 modifications. Elements starting between them (inclusive) are 5432 removed. So are elements whose parent is removed. PARENT, when 5433 non-nil, is the common parent of all the elements between BEG and END. 5434 5435 It is guaranteed that only a single phase 0 request exists at any 5436 moment of time. If it does, it must be the first request in the list. 5437 5438 During phase 1, NEXT is the key of the next known element in 5439 cache and BEG its beginning position. Parse buffer between that 5440 element and the one before it in order to determine the parent of 5441 the next element. Set PARENT to the element containing NEXT. 5442 5443 During phase 2, NEXT is the key of the next element to shift in 5444 the parse tree. All elements starting from this one have their 5445 properties relative to buffer positions shifted by integer 5446 OFFSET and, if they belong to element PARENT, are adopted by it. 5447 5448 PHASE specifies the phase number, as an integer. 5449 5450 For any synchronization request, all the later requests in the cache 5451 must not start at or before END. See `org-element--cache-submit-request'.") 5452 5453 (defvar-local org-element--cache-sync-timer nil 5454 "Timer used for cache synchronization.") 5455 5456 (defvar-local org-element--cache-sync-keys-value nil 5457 "Id value used to identify keys during synchronization. 5458 See `org-element--cache-key' for more information.") 5459 5460 (defvar-local org-element--cache-change-tic nil 5461 "Last `buffer-chars-modified-tick' for registered changes.") 5462 5463 (defvar-local org-element--cache-last-buffer-size nil 5464 "Last value of `buffer-size' for registered changes.") 5465 5466 (defvar org-element--cache-non-modifying-commands 5467 '(org-agenda 5468 org-agenda-redo 5469 org-sparse-tree 5470 org-occur 5471 org-columns 5472 org-columns-redo 5473 org-columns-new 5474 org-columns-delete 5475 org-columns-compute 5476 org-columns-insert-dblock 5477 org-agenda-columns 5478 org-ctrl-c-ctrl-c) 5479 "List of commands that are not expected to change the cache state. 5480 5481 This variable is used to determine when re-parsing buffer is not going 5482 to slow down the command. 5483 5484 If the commands end up modifying the cache, the worst case scenario is 5485 performance drop. So, advicing these commands is safe. Yet, it is 5486 better to remove the commands advised in such a way from this list.") 5487 5488 (defmacro org-element--request-key (request) 5489 "Get NEXT part of a `org-element--cache-sync-requests' REQUEST." 5490 `(aref ,request 0)) 5491 5492 (defmacro org-element--request-beg (request) 5493 "Get BEG part of a `org-element--cache-sync-requests' REQUEST." 5494 `(aref ,request 1)) 5495 5496 (defmacro org-element--request-end (request) 5497 "Get END part of a `org-element--cache-sync-requests' REQUEST." 5498 `(aref ,request 2)) 5499 5500 (defmacro org-element--request-offset (request) 5501 "Get OFFSET part of a `org-element--cache-sync-requests' REQUEST." 5502 `(aref ,request 3)) 5503 5504 (defmacro org-element--request-parent (request) 5505 "Get PARENT part of a `org-element--cache-sync-requests' REQUEST." 5506 `(aref ,request 4)) 5507 5508 (defmacro org-element--request-phase (request) 5509 "Get PHASE part of a `org-element--cache-sync-requests' REQUEST." 5510 `(aref ,request 5)) 5511 5512 (defmacro org-element--format-element (element) 5513 "Format ELEMENT for printing in diagnostics." 5514 `(let ((print-length 50) 5515 (print-level 5)) 5516 (prin1-to-string ,element))) 5517 5518 (defmacro org-element--cache-log-message (format-string &rest args) 5519 "Add a new log message for org-element-cache." 5520 `(when (or org-element--cache-diagnostics 5521 (eq org-element--cache-self-verify 'backtrace)) 5522 (let* ((format-string (concat (format "org-element-cache diagnostics(%s): " 5523 (buffer-name (current-buffer))) 5524 ,format-string)) 5525 (format-string (funcall #'format format-string ,@args))) 5526 (if org-element--cache-diagnostics 5527 (display-warning 'org-element-cache format-string) 5528 (unless org-element--cache-diagnostics-ring 5529 (setq org-element--cache-diagnostics-ring 5530 (make-ring org-element--cache-diagnostics-ring-size))) 5531 (ring-insert org-element--cache-diagnostics-ring format-string))))) 5532 5533 (defmacro org-element--cache-warn (format-string &rest args) 5534 "Raise warning for org-element-cache." 5535 `(let* ((format-string (funcall #'format ,format-string ,@args)) 5536 (format-string 5537 (if (or (not org-element--cache-diagnostics-ring) 5538 (not (eq 'backtrace org-element--cache-self-verify))) 5539 format-string 5540 (prog1 5541 (concat (format "Warning(%s): " 5542 (buffer-name (current-buffer))) 5543 format-string 5544 "\nBacktrace:\n " 5545 (mapconcat #'identity 5546 (ring-elements org-element--cache-diagnostics-ring) 5547 "\n ")) 5548 (setq org-element--cache-diagnostics-ring nil))))) 5549 (if (and (boundp 'org-batch-test) org-batch-test) 5550 (error "%s" (concat "org-element--cache: " format-string)) 5551 (display-warning 'org-element-cache 5552 (concat "org-element--cache: " format-string))))) 5553 5554 (defsubst org-element--cache-key (element) 5555 "Return a unique key for ELEMENT in cache tree. 5556 5557 Keys are used to keep a total order among elements in the cache. 5558 Comparison is done with `org-element--cache-key-less-p'. 5559 5560 When no synchronization is taking place, a key is simply the 5561 beginning position of the element, or that position plus one in 5562 the case of an first item (respectively row) in 5563 a list (respectively a table). They key of a section is its beginning 5564 position minus one. 5565 5566 During a synchronization, the key is the one the element had when 5567 the cache was synchronized for the last time. Elements added to 5568 cache during the synchronization get a new key generated with 5569 `org-element--cache-generate-key'. 5570 5571 Such keys are stored inside the element property 5572 `:org-element--cache-sync-key'. The property is a cons containing 5573 current `org-element--cache-sync-keys-value' and the element key." 5574 (or (when (eq org-element--cache-sync-keys-value (car (org-element-property :org-element--cache-sync-key element))) 5575 (cdr (org-element-property :org-element--cache-sync-key element))) 5576 (let* ((begin (org-element-property :begin element)) 5577 ;; Increase beginning position of items (respectively 5578 ;; table rows) by one, so the first item can get 5579 ;; a different key from its parent list (respectively 5580 ;; table). 5581 (key (if (memq (org-element-type element) '(item table-row)) 5582 (1+ begin) 5583 ;; Decrease beginning position of sections by one, 5584 ;; so that the first element of the section get 5585 ;; different key from the parent section. 5586 (if (eq (org-element-type element) 'section) 5587 (1- begin) 5588 (if (eq (org-element-type element) 'org-data) 5589 (- begin 2) 5590 begin))))) 5591 (when org-element--cache-sync-requests 5592 (org-element-put-property 5593 element 5594 :org-element--cache-sync-key 5595 (cons org-element--cache-sync-keys-value key))) 5596 key))) 5597 5598 (defun org-element--cache-generate-key (lower upper) 5599 "Generate a key between LOWER and UPPER. 5600 5601 LOWER and UPPER are fixnums or lists of same, possibly empty. 5602 5603 If LOWER and UPPER are equals, return LOWER. Otherwise, return 5604 a unique key, as an integer or a list of integers, according to 5605 the following rules: 5606 5607 - LOWER and UPPER are compared level-wise until values differ. 5608 5609 - If, at a given level, LOWER and UPPER differ from more than 5610 2, the new key shares all the levels above with LOWER and 5611 gets a new level. Its value is the mean between LOWER and 5612 UPPER: 5613 5614 (1 2) + (1 4) --> (1 3) 5615 5616 - If LOWER has no value to compare with, it is assumed that its 5617 value is `most-negative-fixnum'. E.g., 5618 5619 (1 1) + (1 1 2) 5620 5621 is equivalent to 5622 5623 (1 1 m) + (1 1 2) 5624 5625 where m is `most-negative-fixnum'. Likewise, if UPPER is 5626 short of levels, the current value is `most-positive-fixnum'. 5627 5628 - If they differ from only one, the new key inherits from 5629 current LOWER level and fork it at the next level. E.g., 5630 5631 (2 1) + (3 3) 5632 5633 is equivalent to 5634 5635 (2 1) + (2 M) 5636 5637 where M is `most-positive-fixnum'. 5638 5639 - If the key is only one level long, it is returned as an 5640 integer: 5641 5642 (1 2) + (3 2) --> 2 5643 5644 When they are not equals, the function assumes that LOWER is 5645 lesser than UPPER, per `org-element--cache-key-less-p'." 5646 (if (equal lower upper) lower 5647 (let ((lower (if (integerp lower) (list lower) lower)) 5648 (upper (if (integerp upper) (list upper) upper)) 5649 skip-upper key) 5650 (catch 'exit 5651 (while t 5652 (let ((min (or (car lower) most-negative-fixnum)) 5653 (max (cond (skip-upper most-positive-fixnum) 5654 ((car upper)) 5655 (t most-positive-fixnum)))) 5656 (if (< (1+ min) max) 5657 (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1)))) 5658 (throw 'exit (if key (nreverse (cons mean key)) mean))) 5659 (when (and (< min max) (not skip-upper)) 5660 ;; When at a given level, LOWER and UPPER differ from 5661 ;; 1, ignore UPPER altogether. Instead create a key 5662 ;; between LOWER and the greatest key with the same 5663 ;; prefix as LOWER so far. 5664 (setq skip-upper t)) 5665 (push min key) 5666 (setq lower (cdr lower) upper (cdr upper))))))))) 5667 5668 (defsubst org-element--cache-key-less-p (a b) 5669 "Non-nil if key A is less than key B. 5670 A and B are either integers or lists of integers, as returned by 5671 `org-element--cache-key'. 5672 5673 Note that it is not reliable to compare buffer position with the cache 5674 keys. They keys may be larger compared to actual element :begin 5675 position." 5676 (if (integerp a) (if (integerp b) (< a b) (<= a (car b))) 5677 (if (integerp b) (< (car a) b) 5678 (catch 'exit 5679 (while (and a b) 5680 (cond ((car-less-than-car a b) (throw 'exit t)) 5681 ((car-less-than-car b a) (throw 'exit nil)) 5682 (t (setq a (cdr a) b (cdr b))))) 5683 ;; If A is empty, either keys are equal (B is also empty) and 5684 ;; we return nil, or A is lesser than B (B is longer) and we 5685 ;; return a non-nil value. 5686 ;; 5687 ;; If A is not empty, B is necessarily empty and A is greater 5688 ;; than B (A is longer). Therefore, return nil. 5689 (and (null a) b))))) 5690 5691 (defun org-element--cache-compare (a b) 5692 "Non-nil when element A is located before element B." 5693 (org-element--cache-key-less-p (org-element--cache-key a) (org-element--cache-key b))) 5694 5695 (defsubst org-element--cache-root () 5696 "Return root value in `org-element--cache' . 5697 This function assumes `org-element--cache' is a valid AVL tree." 5698 (avl-tree--node-left (avl-tree--dummyroot org-element--cache))) 5699 5700 (defsubst org-element--headline-cache-root () 5701 "Return root value in `org-element--headline-cache' . 5702 This function assumes `org-element--headline-cache' is a valid AVL tree." 5703 (avl-tree--node-left (avl-tree--dummyroot org-element--headline-cache))) 5704 5705 ;;;; Tools 5706 5707 ;; FIXME: Ideally, this should be inlined to avoid overheads, but 5708 ;; inlined functions should be declared before the code that uses them 5709 ;; and some code above does use `org-element--cache-active-p'. Moving this 5710 ;; declaration on top would require restructuring the whole cache 5711 ;; section. 5712 (defun org-element--cache-active-p (&optional called-from-cache-change-func-p) 5713 "Non-nil when cache is active in current buffer." 5714 (org-with-base-buffer nil 5715 (and org-element-use-cache 5716 org-element--cache 5717 (or called-from-cache-change-func-p 5718 (eq org-element--cache-change-tic (buffer-chars-modified-tick)) 5719 (and 5720 ;; org-num-mode calls some Org structure analysis functions 5721 ;; that can trigger cache update in the middle of changes. See 5722 ;; `org-num--verify' calling `org-num--skip-value' calling 5723 ;; `org-entry-get' that uses cache. 5724 ;; Forcefully disable cache when called from inside a 5725 ;; modification hook, where `inhibit-modification-hooks' is set 5726 ;; to t. 5727 (not inhibit-modification-hooks) 5728 ;; `combine-change-calls' sets `after-change-functions' to 5729 ;; nil. We need not to use cache inside 5730 ;; `combine-change-calls' because the buffer is potentially 5731 ;; changed without notice (the change will be registered 5732 ;; after exiting the `combine-change-calls' body though). 5733 (catch :inhibited 5734 (org-fold-core-cycle-over-indirect-buffers 5735 (unless (memq #'org-element--cache-after-change after-change-functions) 5736 (throw :inhibited nil))) 5737 t)))))) 5738 5739 ;; FIXME: Remove after we establish that hashing is effective. 5740 (defun org-element-cache-hash-show-statistics () 5741 "Display efficiency of O(1) query cache for `org-element--cache-find'. 5742 5743 This extra caching is based on the following paper: 5744 Pugh [Information Processing Letters] (1990) Slow optimally balanced 5745 search strategies vs. cached fast uniformly balanced search 5746 strategies. http://dx.doi.org/10.1016/0020-0190(90)90130-P 5747 5748 Also, see `org-element--cache-size'." 5749 (interactive) 5750 (message "%.2f%% of cache searches hashed, %.2f%% non-hashable." 5751 (* 100 5752 (/ (float (car org-element--cache-hash-statistics)) 5753 (cdr org-element--cache-hash-statistics))) 5754 (* 100 5755 (/ (float org-element--cache-hash-nocache) 5756 (cdr org-element--cache-hash-statistics))))) 5757 5758 (defun org-element--cache-find (pos &optional side) 5759 "Find element in cache starting at POS or before. 5760 5761 POS refers to a buffer position. 5762 5763 When optional argument SIDE is non-nil, the function checks for 5764 elements starting at or past POS instead. If SIDE is `both', the 5765 function returns a cons cell where car is the first element 5766 starting at or before POS and cdr the first element starting 5767 after POS. 5768 5769 The function can only find elements in the synchronized part of 5770 the cache." 5771 (org-with-base-buffer nil 5772 (let* ((limit (and org-element--cache-sync-requests 5773 (org-element--request-key (car org-element--cache-sync-requests)))) 5774 (node (org-element--cache-root)) 5775 (hash-pos (unless (eq side 'both) 5776 (mod (org-knuth-hash pos) 5777 org-element--cache-hash-size))) 5778 (hashed (if (not side) 5779 (aref org-element--cache-hash-left hash-pos) 5780 (unless (eq side 'both) 5781 (aref org-element--cache-hash-right hash-pos)))) 5782 lower upper) 5783 ;; `org-element--cache-key-less-p' does not accept markers. 5784 (when (markerp pos) (setq pos (marker-position pos))) 5785 (cl-incf (cdr org-element--cache-hash-statistics)) 5786 (when (eq side 'both) (cl-incf org-element--cache-hash-nocache)) 5787 (if (and hashed (not (eq side 'both)) 5788 (or (not limit) 5789 ;; Limit can be a list key. 5790 (org-element--cache-key-less-p 5791 (org-element--cache-key hashed) 5792 limit)) 5793 (= pos (org-element-property :begin hashed)) 5794 ;; We cannot rely on element :begin for elements with 5795 ;; children starting at the same pos. 5796 (not (memq (org-element-type hashed) 5797 '(section org-data table))) 5798 (org-element-property :cached hashed)) 5799 (progn 5800 (cl-incf (car org-element--cache-hash-statistics)) 5801 hashed) 5802 (while node 5803 (let* ((element (avl-tree--node-data node)) 5804 (begin (org-element-property :begin element))) 5805 (cond 5806 ((and limit 5807 (not (org-element--cache-key-less-p 5808 (org-element--cache-key element) limit))) 5809 (setq node (avl-tree--node-left node))) 5810 ((> begin pos) 5811 (setq upper element 5812 node (avl-tree--node-left node))) 5813 ((or (< begin pos) 5814 ;; If the element is section or org-data, we also need 5815 ;; to check the following element. 5816 (memq (org-element-type element) '(section org-data))) 5817 (setq lower element 5818 node (avl-tree--node-right node))) 5819 ;; We found an element in cache starting at POS. If `side' 5820 ;; is `both' we also want the next one in order to generate 5821 ;; a key in-between. 5822 ;; 5823 ;; If the element is the first row or item in a table or 5824 ;; a plain list, we always return the table or the plain 5825 ;; list. 5826 ;; 5827 ;; In any other case, we return the element found. 5828 ((eq side 'both) 5829 (setq lower element) 5830 (setq node (avl-tree--node-right node))) 5831 ((and (memq (org-element-type element) '(item table-row)) 5832 (let ((parent (org-element-property :parent element))) 5833 (and (= (org-element-property :begin element) 5834 (org-element-property :contents-begin parent)) 5835 (setq node nil 5836 lower parent 5837 upper parent))))) 5838 (t 5839 (setq node nil 5840 lower element 5841 upper element))))) 5842 (if (not side) 5843 (aset org-element--cache-hash-left hash-pos lower) 5844 (unless (eq side 'both) 5845 (aset org-element--cache-hash-right hash-pos lower))) 5846 (pcase side 5847 (`both (cons lower upper)) 5848 (`nil lower) 5849 (_ upper)))))) 5850 5851 (defun org-element--cache-put (element) 5852 "Store ELEMENT in current buffer's cache, if allowed." 5853 (org-with-base-buffer nil 5854 (when (org-element--cache-active-p) 5855 (when org-element--cache-sync-requests 5856 ;; During synchronization, first build an appropriate key for 5857 ;; the new element so `avl-tree-enter' can insert it at the 5858 ;; right spot in the cache. 5859 (let* ((keys (org-element--cache-find 5860 (org-element-property :begin element) 'both)) 5861 (new-key (org-element--cache-generate-key 5862 (and (car keys) (org-element--cache-key (car keys))) 5863 (cond ((cdr keys) (org-element--cache-key (cdr keys))) 5864 (org-element--cache-sync-requests 5865 (org-element--request-key (car org-element--cache-sync-requests))))))) 5866 (org-element-put-property 5867 element 5868 :org-element--cache-sync-key 5869 (cons org-element--cache-sync-keys-value new-key)))) 5870 (when (>= org-element--cache-diagnostics-level 2) 5871 (org-element--cache-log-message 5872 "Added new element with %S key: %S" 5873 (org-element-property :org-element--cache-sync-key element) 5874 (org-element--format-element element))) 5875 (org-element-put-property element :cached t) 5876 (when (memq (org-element-type element) '(headline inlinetask)) 5877 (cl-incf org-element--headline-cache-size) 5878 (avl-tree-enter org-element--headline-cache element)) 5879 (cl-incf org-element--cache-size) 5880 (avl-tree-enter org-element--cache element)))) 5881 5882 (defsubst org-element--cache-remove (element) 5883 "Remove ELEMENT from cache. 5884 Assume ELEMENT belongs to cache and that a cache is active." 5885 (org-with-base-buffer nil 5886 (org-element-put-property element :cached nil) 5887 (cl-decf org-element--cache-size) 5888 ;; Invalidate contents of parent. 5889 (when (and (org-element-property :parent element) 5890 (org-element-contents (org-element-property :parent element))) 5891 (org-element-set-contents (org-element-property :parent element) nil)) 5892 (when (memq (org-element-type element) '(headline inlinetask)) 5893 (cl-decf org-element--headline-cache-size) 5894 (avl-tree-delete org-element--headline-cache element)) 5895 (org-element--cache-log-message 5896 "Decreasing cache size to %S" 5897 org-element--cache-size) 5898 (when (< org-element--cache-size 0) 5899 (org-element--cache-warn 5900 "Cache grew to negative size in %S when deleting %S at %S. Cache key: %S. 5901 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)." 5902 (org-element-type element) 5903 (current-buffer) 5904 (org-element-property :begin element) 5905 (org-element-property :org-element--cache-sync-key element)) 5906 (org-element-cache-reset) 5907 (throw 'quit nil)) 5908 (or (avl-tree-delete org-element--cache element) 5909 (progn 5910 ;; This should not happen, but if it is, would be better to know 5911 ;; where it happens. 5912 (org-element--cache-warn 5913 "Failed to delete %S element in %S at %S. The element cache key was %S. 5914 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)." 5915 (org-element-type element) 5916 (current-buffer) 5917 (org-element-property :begin element) 5918 (org-element-property :org-element--cache-sync-key element)) 5919 (org-element-cache-reset) 5920 (throw 'quit nil))))) 5921 5922 ;;;; Synchronization 5923 5924 (defsubst org-element--cache-set-timer (buffer) 5925 "Set idle timer for cache synchronization in BUFFER." 5926 (when org-element--cache-sync-timer 5927 (cancel-timer org-element--cache-sync-timer)) 5928 (setq org-element--cache-sync-timer 5929 (run-with-idle-timer 5930 (let ((idle (current-idle-time))) 5931 (if idle (time-add idle org-element-cache-sync-break) 5932 org-element-cache-sync-idle-time)) 5933 nil 5934 #'org-element--cache-sync 5935 buffer))) 5936 5937 (defsubst org-element--cache-interrupt-p (time-limit) 5938 "Non-nil when synchronization process should be interrupted. 5939 TIME-LIMIT is a time value or nil." 5940 (and time-limit 5941 (or (input-pending-p) 5942 (time-less-p time-limit nil)))) 5943 5944 (defsubst org-element--cache-shift-positions (element offset &optional props) 5945 "Shift ELEMENT properties relative to buffer positions by OFFSET. 5946 5947 Properties containing buffer positions are `:begin', `:end', 5948 `:contents-begin', `:contents-end' and `:structure'. When 5949 optional argument PROPS is a list of keywords, only shift 5950 properties provided in that list. 5951 5952 Properties are modified by side-effect." 5953 (let ((properties (nth 1 element))) 5954 ;; Shift `:structure' property for the first plain list only: it 5955 ;; is the only one that really matters and it prevents from 5956 ;; shifting it more than once. 5957 (when (and (or (not props) (memq :structure props)) 5958 (eq (org-element-type element) 'plain-list) 5959 (not (eq (org-element-type (plist-get properties :parent)) 'item))) 5960 (dolist (item (plist-get properties :structure)) 5961 (cl-incf (car item) offset) 5962 (cl-incf (nth 6 item) offset))) 5963 (dolist (key '( :begin :contents-begin :contents-end :end 5964 :post-affiliated :robust-begin :robust-end)) 5965 (let ((value (and (or (not props) (memq key props)) 5966 (plist-get properties key)))) 5967 (and value (plist-put properties key (+ offset value))))))) 5968 5969 (defvar org-element--cache-interrupt-C-g t 5970 "When non-nil, allow the user to abort `org-element--cache-sync'. 5971 The execution is aborted upon pressing `\\[keyboard-quit]' 5972 `org-element--cache-interrupt-C-g-max-count' times.") 5973 (defvar org-element--cache-interrupt-C-g-max-count 5 5974 "`\\[keyboard-quit]' count to interrupt `org-element--cache-sync'. 5975 See `org-element--cache-interrupt-C-g'.") 5976 (defvar org-element--cache-interrupt-C-g-count 0 5977 "Current number of `org-element--cache-sync' calls. 5978 See `org-element--cache-interrupt-C-g'.") 5979 5980 (defvar org-element--cache-change-warning nil 5981 "Non-nil when a sensitive line is about to be changed. 5982 It is a symbol among nil, t, or a number representing smallest level of 5983 modified headline. The level considers headline levels both before 5984 and after the modification.") 5985 5986 (defun org-element--cache-sync (buffer &optional threshold future-change offset) 5987 "Synchronize cache with recent modification in BUFFER. 5988 5989 When optional argument THRESHOLD is non-nil, do the 5990 synchronization for all elements starting before or at threshold, 5991 then exit. Otherwise, synchronize cache for as long as 5992 `org-element-cache-sync-duration' or until Emacs leaves idle 5993 state. 5994 5995 FUTURE-CHANGE, when non-nil, is a buffer position where changes 5996 not registered yet in the cache are going to happen. OFFSET is the 5997 change offset. It is used in `org-element--cache-submit-request', 5998 where cache is partially updated before current modification are 5999 actually submitted." 6000 (when (buffer-live-p buffer) 6001 (org-with-base-buffer buffer 6002 ;; Do not sync when, for example, in the middle of 6003 ;; `combine-change-calls'. See the commentary inside 6004 ;; `org-element--cache-active-p'. 6005 (when (and org-element--cache-sync-requests (org-element--cache-active-p)) 6006 ;; Check if the buffer have been changed outside visibility of 6007 ;; `org-element--cache-before-change' and `org-element--cache-after-change'. 6008 (if (/= org-element--cache-last-buffer-size (buffer-size)) 6009 (progn 6010 (org-element--cache-warn 6011 "Unregistered buffer modifications detected (%S != %S). Resetting. 6012 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report). 6013 The buffer is: %s\n Current command: %S\n Backtrace:\n%S" 6014 org-element--cache-last-buffer-size 6015 (buffer-size) 6016 (buffer-name (current-buffer)) 6017 this-command 6018 (when (and (fboundp 'backtrace-get-frames) 6019 (fboundp 'backtrace-to-string)) 6020 (backtrace-to-string (backtrace-get-frames 'backtrace)))) 6021 (org-element-cache-reset)) 6022 (let ((inhibit-quit t) request next) 6023 (setq org-element--cache-interrupt-C-g-count 0) 6024 (when org-element--cache-sync-timer 6025 (cancel-timer org-element--cache-sync-timer)) 6026 (let ((time-limit (time-add nil org-element-cache-sync-duration))) 6027 (catch 'org-element--cache-interrupt 6028 (when org-element--cache-sync-requests 6029 (org-element--cache-log-message "Syncing down to %S-%S" (or future-change threshold) threshold)) 6030 (while org-element--cache-sync-requests 6031 (setq request (car org-element--cache-sync-requests) 6032 next (nth 1 org-element--cache-sync-requests)) 6033 (org-element--cache-process-request 6034 request 6035 (when next (org-element--request-key next)) 6036 threshold 6037 (unless threshold time-limit) 6038 future-change 6039 offset) 6040 ;; Re-assign current and next requests. It could have 6041 ;; been altered during phase 1. 6042 (setq request (car org-element--cache-sync-requests) 6043 next (nth 1 org-element--cache-sync-requests)) 6044 ;; Request processed. Merge current and next offsets and 6045 ;; transfer ending position. 6046 (when next 6047 ;; The following requests can only be either phase 1 6048 ;; or phase 2 requests. We need to let them know 6049 ;; that additional shifting happened ahead of them. 6050 (cl-incf (org-element--request-offset next) (org-element--request-offset request)) 6051 (org-element--cache-log-message 6052 "Updating next request offset to %S: %s" 6053 (org-element--request-offset next) 6054 (let ((print-length 10) (print-level 3)) (prin1-to-string next))) 6055 ;; FIXME: END part of the request only matters for 6056 ;; phase 0 requests. However, the only possible 6057 ;; phase 0 request must be the first request in the 6058 ;; list all the time. END position should be 6059 ;; unused. 6060 (setf (org-element--request-end next) (org-element--request-end request))) 6061 (setq org-element--cache-sync-requests 6062 (cdr org-element--cache-sync-requests))))) 6063 ;; If more requests are awaiting, set idle timer accordingly. 6064 ;; Otherwise, reset keys. 6065 (if org-element--cache-sync-requests 6066 (org-element--cache-set-timer buffer) 6067 (setq org-element--cache-change-warning nil) 6068 (setq org-element--cache-sync-keys-value (1+ org-element--cache-sync-keys-value))))))))) 6069 6070 (defun org-element--cache-process-request 6071 (request next-request-key threshold time-limit future-change offset) 6072 "Process synchronization REQUEST for all entries before NEXT. 6073 6074 REQUEST is a vector, built by `org-element--cache-submit-request'. 6075 6076 NEXT-REQUEST-KEY is a cache key of the next request, as returned by 6077 `org-element--cache-key'. 6078 6079 When non-nil, THRESHOLD is a buffer position. Synchronization 6080 stops as soon as a shifted element begins after it. 6081 6082 When non-nil, TIME-LIMIT is a time value. Synchronization stops 6083 after this time or when Emacs exits idle state. 6084 6085 When non-nil, FUTURE-CHANGE is a buffer position where changes not 6086 registered yet in the cache are going to happen. OFFSET is the 6087 changed text length. See `org-element--cache-submit-request' for more 6088 information. 6089 6090 Throw `org-element--cache-interrupt' if the process stops before 6091 completing the request." 6092 (org-with-base-buffer nil 6093 (org-element--cache-log-message 6094 "org-element-cache: Processing request %s up to %S-%S, next: %S" 6095 (let ((print-length 10) (print-level 3)) (prin1-to-string request)) 6096 future-change 6097 threshold 6098 next-request-key) 6099 (catch 'org-element--cache-quit 6100 (when (= (org-element--request-phase request) 0) 6101 ;; Phase 0. 6102 ;; 6103 ;; Delete all elements starting after beginning of the element 6104 ;; with request key NEXT, but not after buffer position END. 6105 ;; 6106 ;; At each iteration, we start again at tree root since 6107 ;; a deletion modifies structure of the balanced tree. 6108 (org-element--cache-log-message "Phase 0") 6109 (catch 'org-element--cache-end-phase 6110 (let ((deletion-count 0)) 6111 (while t 6112 (when (org-element--cache-interrupt-p time-limit) 6113 (org-element--cache-log-message "Interrupt: time limit") 6114 (throw 'org-element--cache-interrupt nil)) 6115 (let ((request-key (org-element--request-key request)) 6116 (end (org-element--request-end request)) 6117 (node (org-element--cache-root)) 6118 data data-key) 6119 ;; Find first element in cache with key REQUEST-KEY or 6120 ;; after it. 6121 (while node 6122 (let* ((element (avl-tree--node-data node)) 6123 (key (org-element--cache-key element))) 6124 (cond 6125 ((org-element--cache-key-less-p key request-key) 6126 (setq node (avl-tree--node-right node))) 6127 ((org-element--cache-key-less-p request-key key) 6128 (setq data element 6129 data-key key 6130 node (avl-tree--node-left node))) 6131 (t (setq data element 6132 data-key key 6133 node nil))))) 6134 (if data 6135 ;; We found first element in cache starting at or 6136 ;; after REQUEST-KEY. 6137 (let ((pos (org-element-property :begin data))) 6138 ;; FIXME: Maybe simply (< pos end)? 6139 (if (<= pos end) 6140 (progn 6141 (org-element--cache-log-message "removing %S::%S" 6142 (org-element-property :org-element--cache-sync-key data) 6143 (org-element--format-element data)) 6144 (cl-incf deletion-count) 6145 (org-element--cache-remove data) 6146 (when (and (> (log org-element--cache-size 2) 10) 6147 (> deletion-count 6148 (/ org-element--cache-size (log org-element--cache-size 2)))) 6149 (org-element--cache-log-message "Removed %S>N/LogN(=%S/%S) elements. Resetting cache to prevent performance degradation" 6150 deletion-count 6151 org-element--cache-size 6152 (log org-element--cache-size 2)) 6153 (org-element-cache-reset) 6154 (throw 'org-element--cache-quit t))) 6155 ;; Done deleting everything starting before END. 6156 ;; DATA-KEY is the first known element after END. 6157 ;; Move on to phase 1. 6158 (org-element--cache-log-message 6159 "found element after %S: %S::%S" 6160 end 6161 (org-element-property :org-element--cache-sync-key data) 6162 (org-element--format-element data)) 6163 (setf (org-element--request-key request) data-key) 6164 (setf (org-element--request-beg request) pos) 6165 (setf (org-element--request-phase request) 1) 6166 (throw 'org-element--cache-end-phase nil))) 6167 ;; No element starting after modifications left in 6168 ;; cache: further processing is futile. 6169 (org-element--cache-log-message 6170 "Phase 0 deleted all elements in cache after %S!" 6171 request-key) 6172 (throw 'org-element--cache-quit t))))))) 6173 (when (= (org-element--request-phase request) 1) 6174 ;; Phase 1. 6175 ;; 6176 ;; Phase 0 left a hole in the cache. Some elements after it 6177 ;; could have parents within. For example, in the following 6178 ;; buffer: 6179 ;; 6180 ;; - item 6181 ;; 6182 ;; 6183 ;; Paragraph1 6184 ;; 6185 ;; Paragraph2 6186 ;; 6187 ;; if we remove a blank line between "item" and "Paragraph1", 6188 ;; everything down to "Paragraph2" is removed from cache. But 6189 ;; the paragraph now belongs to the list, and its `:parent' 6190 ;; property no longer is accurate. 6191 ;; 6192 ;; Therefore we need to parse again elements in the hole, or at 6193 ;; least in its last section, so that we can re-parent 6194 ;; subsequent elements, during phase 2. 6195 ;; 6196 ;; Note that we only need to get the parent from the first 6197 ;; element in cache after the hole. 6198 ;; 6199 ;; When next key is lesser or equal to the current one, current 6200 ;; request is inside a to-be-shifted part of the cache. It is 6201 ;; fine because the order of elements will not be altered by 6202 ;; shifting. However, we cannot know the real position of the 6203 ;; unshifted NEXT element in the current request. So, we need 6204 ;; to sort the request list according to keys and re-start 6205 ;; processing from the new leftmost request. 6206 (org-element--cache-log-message "Phase 1") 6207 (let ((key (org-element--request-key request))) 6208 (when (and next-request-key (not (org-element--cache-key-less-p key next-request-key))) 6209 ;; In theory, the only case when requests are not 6210 ;; ordered is when key of the next request is either the 6211 ;; same with current key or it is a key for a removed 6212 ;; element. Either way, we can simply merge the two 6213 ;; requests. 6214 (let ((next-request (nth 1 org-element--cache-sync-requests))) 6215 (org-element--cache-log-message "Phase 1: Unorderered requests. Merging: %S\n%S\n" 6216 (let ((print-length 10) (print-level 3)) (prin1-to-string request)) 6217 (let ((print-length 10) (print-level 3)) (prin1-to-string next-request))) 6218 (setf (org-element--request-key next-request) key) 6219 (setf (org-element--request-beg next-request) (org-element--request-beg request)) 6220 (setf (org-element--request-phase next-request) 1) 6221 (throw 'org-element--cache-quit t)))) 6222 ;; Next element will start at its beginning position plus 6223 ;; offset, since it hasn't been shifted yet. Therefore, LIMIT 6224 ;; contains the real beginning position of the first element to 6225 ;; shift and re-parent. 6226 (let ((limit (+ (org-element--request-beg request) (org-element--request-offset request))) 6227 cached-before) 6228 (cond ((and threshold (> limit threshold)) 6229 (org-element--cache-log-message "Interrupt: position %S after threshold %S" limit threshold) 6230 (throw 'org-element--cache-interrupt nil)) 6231 ((and future-change (>= limit future-change)) 6232 ;; Changes happened around this element and they will 6233 ;; trigger another phase 1 request. Skip re-parenting 6234 ;; and simply proceed with shifting (phase 2) to make 6235 ;; sure that followup phase 0 request for the recent 6236 ;; changes can operate on the correctly shifted cache. 6237 (org-element--cache-log-message "position %S after future change %S" limit future-change) 6238 (setf (org-element--request-parent request) nil) 6239 (setf (org-element--request-phase request) 2)) 6240 (t 6241 (when future-change 6242 ;; Changes happened, but not yet registered after 6243 ;; this element. However, we a not yet safe to look 6244 ;; at the buffer and parse elements in the cache gap. 6245 ;; Some of the parents to be added to cache may end 6246 ;; after the changes. Parsing this parents will 6247 ;; assign the :end correct value for cache state 6248 ;; after future-change. Then, when the future change 6249 ;; is going to be processed, such parent boundary 6250 ;; will be altered unnecessarily. To avoid this, 6251 ;; we alter the new parents by -OFFSET. 6252 ;; For now, just save last known cached element and 6253 ;; then check all the parents below. 6254 (setq cached-before (org-element--cache-find (1- limit) nil))) 6255 ;; No relevant changes happened after submitting this 6256 ;; request. We are safe to look at the actual Org 6257 ;; buffer and calculate the new parent. 6258 (let ((parent (org-element--parse-to (1- limit) nil time-limit))) 6259 (when future-change 6260 ;; Check all the newly added parents to not 6261 ;; intersect with future change. 6262 (let ((up parent)) 6263 (while (and up 6264 (or (not cached-before) 6265 (> (org-element-property :begin up) 6266 (org-element-property :begin cached-before)))) 6267 (when (> (org-element-property :end up) future-change) 6268 ;; Offset future cache request. 6269 (org-element--cache-shift-positions 6270 up (- offset) 6271 (if (and (org-element-property :robust-begin up) 6272 (org-element-property :robust-end up)) 6273 '(:contents-end :end :robust-end) 6274 '(:contents-end :end)))) 6275 (setq up (org-element-property :parent up))))) 6276 (org-element--cache-log-message 6277 "New parent at %S: %S::%S" 6278 limit 6279 (org-element-property :org-element--cache-sync-key parent) 6280 (org-element--format-element parent)) 6281 (setf (org-element--request-parent request) parent) 6282 (setf (org-element--request-phase request) 2)))))) 6283 ;; Phase 2. 6284 ;; 6285 ;; Shift all elements starting from key START, but before NEXT, by 6286 ;; OFFSET, and re-parent them when appropriate. 6287 ;; 6288 ;; Elements are modified by side-effect so the tree structure 6289 ;; remains intact. 6290 ;; 6291 ;; Once THRESHOLD, if any, is reached, or once there is an input 6292 ;; pending, exit. Before leaving, the current synchronization 6293 ;; request is updated. 6294 (org-element--cache-log-message "Phase 2") 6295 (let ((start (org-element--request-key request)) 6296 (offset (org-element--request-offset request)) 6297 (parent (org-element--request-parent request)) 6298 (node (org-element--cache-root)) 6299 (stack (list nil)) 6300 (leftp t) 6301 exit-flag continue-flag) 6302 ;; No re-parenting nor shifting planned: request is over. 6303 (when (and (not parent) (zerop offset)) 6304 (org-element--cache-log-message "Empty offset. Request completed.") 6305 (throw 'org-element--cache-quit t)) 6306 (while node 6307 (let* ((data (avl-tree--node-data node)) 6308 (key (org-element--cache-key data))) 6309 ;; Traverse the cache tree. Ignore all the elements before 6310 ;; START. Note that `avl-tree-stack' would not bypass the 6311 ;; elements before START and thus would have been less 6312 ;; efficient. 6313 (if (and leftp (avl-tree--node-left node) 6314 (not (org-element--cache-key-less-p key start))) 6315 (progn (push node stack) 6316 (setq node (avl-tree--node-left node))) 6317 ;; Shift and re-parent when current node starts at or 6318 ;; after START, but before NEXT. 6319 (unless (org-element--cache-key-less-p key start) 6320 ;; We reached NEXT. Request is complete. 6321 (when (and next-request-key 6322 (not (org-element--cache-key-less-p key next-request-key))) 6323 (org-element--cache-log-message "Reached next request.") 6324 (let ((next-request (nth 1 org-element--cache-sync-requests))) 6325 (unless (and (org-element-property :cached (org-element--request-parent next-request)) 6326 (org-element-property :begin (org-element--request-parent next-request)) 6327 parent 6328 (> (org-element-property :begin (org-element--request-parent next-request)) 6329 (org-element-property :begin parent))) 6330 (setf (org-element--request-parent next-request) parent))) 6331 (throw 'org-element--cache-quit t)) 6332 ;; Handle interruption request. Update current request. 6333 (when (or exit-flag (org-element--cache-interrupt-p time-limit)) 6334 (org-element--cache-log-message "Interrupt: %s" (if exit-flag "threshold" "time limit")) 6335 (setf (org-element--request-key request) key) 6336 (setf (org-element--request-parent request) parent) 6337 (throw 'org-element--cache-interrupt nil)) 6338 ;; Shift element. 6339 (unless (zerop offset) 6340 (when (>= org-element--cache-diagnostics-level 3) 6341 (org-element--cache-log-message "Shifting positions (𝝙%S) in %S::%S" 6342 offset 6343 (org-element-property :org-element--cache-sync-key data) 6344 (org-element--format-element data))) 6345 (org-element--cache-shift-positions data offset)) 6346 (let ((begin (org-element-property :begin data))) 6347 ;; Update PARENT and re-parent DATA, only when 6348 ;; necessary. Propagate new structures for lists. 6349 (while (and parent 6350 (<= (org-element-property :end parent) begin)) 6351 (setq parent (org-element-property :parent parent))) 6352 (cond ((and (not parent) (zerop offset)) (throw 'org-element--cache-quit nil)) 6353 ;; Consider scenario when DATA lays within 6354 ;; sensitive lines of PARENT that was found 6355 ;; during phase 2. For example: 6356 ;; 6357 ;; #+ begin_quote 6358 ;; Paragraph 6359 ;; #+end_quote 6360 ;; 6361 ;; In the above source block, remove space in 6362 ;; the first line will trigger re-parenting of 6363 ;; the paragraph and "#+end_quote" that is also 6364 ;; considered paragraph before the modification. 6365 ;; However, the paragraph element stored in 6366 ;; cache must be deleted instead. 6367 ((and parent 6368 (or (not (memq (org-element-type parent) org-element-greater-elements)) 6369 (and (org-element-property :contents-begin parent) 6370 (< (org-element-property :begin data) (org-element-property :contents-begin parent))) 6371 (and (org-element-property :contents-end parent) 6372 (>= (org-element-property :begin data) (org-element-property :contents-end parent))) 6373 (> (org-element-property :end data) (org-element-property :end parent)) 6374 (and (org-element-property :contents-end data) 6375 (> (org-element-property :contents-end data) (org-element-property :contents-end parent))))) 6376 (org-element--cache-log-message "org-element-cache: Removing obsolete element with key %S::%S" 6377 (org-element-property :org-element--cache-sync-key data) 6378 (org-element--format-element data)) 6379 (org-element--cache-remove data) 6380 ;; We altered the tree structure. The tree 6381 ;; traversal needs to be restarted. 6382 (setf (org-element--request-key request) key) 6383 (setf (org-element--request-parent request) parent) 6384 ;; Restart tree traversal. 6385 (setq node (org-element--cache-root) 6386 stack (list nil) 6387 leftp t 6388 begin -1 6389 continue-flag t)) 6390 ((and parent 6391 (not (eq parent data)) 6392 (let ((p (org-element-property :parent data))) 6393 (or (not p) 6394 (< (org-element-property :begin p) 6395 (org-element-property :begin parent)) 6396 (unless (eq p parent) 6397 (not (org-element-property :cached p)) 6398 ;; (not (avl-tree-member-p org-element--cache p)) 6399 )))) 6400 (org-element--cache-log-message 6401 "Updating parent in %S\n Old parent: %S\n New parent: %S" 6402 (org-element--format-element data) 6403 (org-element--format-element (org-element-property :parent data)) 6404 (org-element--format-element parent)) 6405 (when (and (eq 'org-data (org-element-type parent)) 6406 (not (eq 'headline (org-element-type data)))) 6407 ;; FIXME: This check is here to see whether 6408 ;; such error happens within 6409 ;; `org-element--cache-process-request' or somewhere 6410 ;; else. 6411 (org-element--cache-warn 6412 "Added org-data parent to non-headline element: %S 6413 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)." 6414 data) 6415 (org-element-cache-reset) 6416 (throw 'org-element--cache-quit t)) 6417 (org-element-put-property data :parent parent) 6418 (let ((s (org-element-property :structure parent))) 6419 (when (and s (org-element-property :structure data)) 6420 (org-element-put-property data :structure s))))) 6421 ;; Cache is up-to-date past THRESHOLD. Request 6422 ;; interruption. 6423 (when (and threshold (> begin threshold)) 6424 (org-element--cache-log-message "Reached threshold %S: %S" 6425 threshold 6426 (org-element--format-element data)) 6427 (setq exit-flag t)))) 6428 (if continue-flag 6429 (setq continue-flag nil) 6430 (setq node (if (setq leftp (avl-tree--node-right node)) 6431 (avl-tree--node-right node) 6432 (pop stack))))))) 6433 ;; We reached end of tree: synchronization complete. 6434 t)) 6435 (org-element--cache-log-message 6436 "org-element-cache: Finished process. The cache size is %S. The remaining sync requests: %S" 6437 org-element--cache-size 6438 (let ((print-level 2)) (prin1-to-string org-element--cache-sync-requests))))) 6439 6440 (defsubst org-element--open-end-p (element) 6441 "Check if ELEMENT in current buffer contains extra blank lines after 6442 it and does not have closing term. 6443 6444 Examples of such elements are: section, headline, org-data, 6445 and footnote-definition." 6446 (and (org-element-property :contents-end element) 6447 (= (org-element-property :contents-end element) 6448 (save-excursion 6449 (goto-char (org-element-property :end element)) 6450 (skip-chars-backward " \r\n\t") 6451 (line-beginning-position 2))))) 6452 6453 (defun org-element--parse-to (pos &optional syncp time-limit) 6454 "Parse elements in current section, down to POS. 6455 6456 Start parsing from the closest between the last known element in 6457 cache or headline above. Return the smallest element containing 6458 POS. 6459 6460 When optional argument SYNCP is non-nil, return the parent of the 6461 element containing POS instead. In that case, it is also 6462 possible to provide TIME-LIMIT, which is a time value specifying 6463 when the parsing should stop. The function throws 6464 `org-element--cache-interrupt' if the process stopped before finding 6465 the expected result." 6466 (catch 'exit 6467 (save-match-data 6468 (org-with-base-buffer nil 6469 (org-with-wide-buffer 6470 (goto-char pos) 6471 (save-excursion 6472 (end-of-line) 6473 (skip-chars-backward " \r\t\n") 6474 ;; Within blank lines at the beginning of buffer, return nil. 6475 (when (bobp) (throw 'exit nil))) 6476 (let* ((cached (and (org-element--cache-active-p) 6477 (org-element--cache-find pos nil))) 6478 (mode (org-element-property :mode cached)) 6479 element next) 6480 (cond 6481 ;; Nothing in cache before point: start parsing from first 6482 ;; element in buffer down to POS or from the beginning of the 6483 ;; file. 6484 ((and (not cached) (org-element--cache-active-p)) 6485 (setq element (org-element-org-data-parser)) 6486 (unless (org-element-property :begin element) 6487 (org-element--cache-warn "Error parsing org-data. Got %S\nPlease report to Org mode mailing list (M-x org-submit-bug-report)." element)) 6488 (org-element--cache-log-message 6489 "Nothing in cache. Adding org-data: %S" 6490 (org-element--format-element element)) 6491 (org-element--cache-put element) 6492 (goto-char (org-element-property :contents-begin element)) 6493 (setq mode 'org-data)) 6494 ;; Nothing in cache before point because cache is not active. 6495 ;; Parse from previous heading to avoid re-parsing the whole 6496 ;; buffer above. This comes at the cost of not calculating 6497 ;; `:parent' property for headings. 6498 ((not cached) 6499 (if (org-with-limited-levels (outline-previous-heading)) 6500 (progn 6501 (setq element (org-element-headline-parser nil 'fast)) 6502 (setq mode 'planning) 6503 (forward-line)) 6504 (setq element (org-element-org-data-parser)) 6505 (setq mode 'org-data)) 6506 (org-skip-whitespace) 6507 (beginning-of-line)) 6508 ;; Check if CACHED or any of its ancestors contain point. 6509 ;; 6510 ;; If there is such an element, we inspect it in order to know 6511 ;; if we return it or if we need to parse its contents. 6512 ;; Otherwise, we just start parsing from location, which is 6513 ;; right after the top-most element containing CACHED but 6514 ;; still before POS. 6515 ;; 6516 ;; As a special case, if POS is at the end of the buffer, we 6517 ;; want to return the innermost element ending there. 6518 ;; 6519 ;; Also, if we find an ancestor and discover that we need to 6520 ;; parse its contents, make sure we don't start from 6521 ;; `:contents-begin', as we would otherwise go past CACHED 6522 ;; again. Instead, in that situation, we will resume parsing 6523 ;; from NEXT, which is located after CACHED or its higher 6524 ;; ancestor not containing point. 6525 (t 6526 (let ((up cached) 6527 (pos (if (= (point-max) pos) (1- pos) pos))) 6528 (while (and up (<= (org-element-property :end up) pos)) 6529 (goto-char (org-element-property :end up)) 6530 (setq element up 6531 mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil) 6532 up (org-element-property :parent up) 6533 next (point))) 6534 (when up (setq element up))))) 6535 ;; Parse successively each element until we reach POS. 6536 (let ((end (or (org-element-property :end element) (point-max))) 6537 (parent (org-element-property :parent element))) 6538 (while t 6539 (when (org-element--cache-interrupt-p time-limit) 6540 (throw 'org-element--cache-interrupt nil)) 6541 (when (and inhibit-quit org-element--cache-interrupt-C-g quit-flag) 6542 (when quit-flag 6543 (cl-incf org-element--cache-interrupt-C-g-count) 6544 (setq quit-flag nil)) 6545 (when (>= org-element--cache-interrupt-C-g-count 6546 org-element--cache-interrupt-C-g-max-count) 6547 (setq quit-flag t) 6548 (setq org-element--cache-interrupt-C-g-count 0) 6549 (org-element-cache-reset) 6550 (error "org-element: Parsing aborted by user. Cache has been cleared. 6551 If you observe Emacs hangs frequently, please report this to Org mode mailing list (M-x org-submit-bug-report).")) 6552 (message (substitute-command-keys 6553 "`org-element--parse-buffer': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.") 6554 (- org-element--cache-interrupt-C-g-max-count 6555 org-element--cache-interrupt-C-g-count))) 6556 (unless element 6557 ;; Do not try to parse within blank at EOB. 6558 (unless (save-excursion 6559 (org-skip-whitespace) 6560 (eobp)) 6561 (org-element-with-disabled-cache 6562 (setq element (org-element--current-element 6563 end 'element mode 6564 (org-element-property :structure parent))))) 6565 ;; Make sure that we return referenced element in cache 6566 ;; that can be altered directly. 6567 (if element 6568 (setq element (or (org-element--cache-put element) element)) 6569 ;; Nothing to parse (i.e. empty file). 6570 (throw 'exit parent)) 6571 (unless (or (not (org-element--cache-active-p)) parent) 6572 (org-element--cache-warn 6573 "Got empty parent while parsing. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S" 6574 (when (and (fboundp 'backtrace-get-frames) 6575 (fboundp 'backtrace-to-string)) 6576 (backtrace-to-string (backtrace-get-frames 'backtrace)) 6577 (org-element-cache-reset) 6578 (error "org-element--cache: Emergency exit")))) 6579 (org-element-put-property element :parent parent)) 6580 (let ((elem-end (org-element-property :end element)) 6581 (type (org-element-type element))) 6582 (cond 6583 ;; Skip any element ending before point. Also skip 6584 ;; element ending at point (unless it is also the end of 6585 ;; buffer) since we're sure that another element begins 6586 ;; after it. 6587 ((and (<= elem-end pos) (/= (point-max) elem-end)) 6588 ;; Avoid parsing headline siblings above. 6589 (goto-char elem-end) 6590 (when (eq type 'headline) 6591 (save-match-data 6592 (unless (when (and (/= 1 (org-element-property :level element)) 6593 (re-search-forward 6594 (rx-to-string 6595 `(and bol (repeat 1 ,(1- (let ((level (org-element-property :level element))) 6596 (if org-odd-levels-only (1- (* level 2)) level))) 6597 "*") 6598 " ")) 6599 pos t)) 6600 (beginning-of-line) 6601 t) 6602 ;; There are headings with lower level than 6603 ;; ELEMENT between ELEM-END and POS. Siblings 6604 ;; may exist though. Parse starting from the 6605 ;; last sibling or from ELEM-END if there are 6606 ;; no other siblings. 6607 (goto-char pos) 6608 (unless 6609 (re-search-backward 6610 (rx-to-string 6611 `(and bol (repeat ,(let ((level (org-element-property :level element))) 6612 (if org-odd-levels-only (1- (* level 2)) level)) 6613 "*") 6614 " ")) 6615 elem-end t) 6616 ;; Roll-back to normal parsing. 6617 (goto-char elem-end))))) 6618 (setq mode (org-element--next-mode mode type nil))) 6619 ;; A non-greater element contains point: return it. 6620 ((not (memq type org-element-greater-elements)) 6621 (throw 'exit (if syncp parent element))) 6622 ;; Otherwise, we have to decide if ELEMENT really 6623 ;; contains POS. In that case we start parsing from 6624 ;; contents' beginning. 6625 ;; 6626 ;; If POS is at contents' beginning but it is also at 6627 ;; the beginning of the first item in a list or a table. 6628 ;; In that case, we need to create an anchor for that 6629 ;; list or table, so return it. 6630 ;; 6631 ;; Also, if POS is at the end of the buffer, no element 6632 ;; can start after it, but more than one may end there. 6633 ;; Arbitrarily, we choose to return the innermost of 6634 ;; such elements. 6635 ((let ((cbeg (org-element-property :contents-begin element)) 6636 (cend (org-element-property :contents-end element))) 6637 (when (and cbeg cend 6638 (or (< cbeg pos) 6639 (and (= cbeg pos) 6640 (not (memq type '(plain-list table))))) 6641 (or (> cend pos) 6642 ;; When we are at cend or within blank 6643 ;; lines after, it is a special case: 6644 ;; 1. At the end of buffer we return 6645 ;; the innermost element. 6646 ;; 2. At cend of element with return 6647 ;; that element. 6648 ;; 3. At the end of element, we would 6649 ;; return in the earlier cond form. 6650 ;; 4. Within blank lines after cend, 6651 ;; when element does not have a 6652 ;; closing keyword, we return that 6653 ;; outermost element, unless the 6654 ;; outermost element is a non-empty 6655 ;; headline. In the latter case, we 6656 ;; return the outermost element inside 6657 ;; the headline section. 6658 (and (org-element--open-end-p element) 6659 (or (= (org-element-property :end element) (point-max)) 6660 (and (>= pos (org-element-property :contents-end element)) 6661 (memq (org-element-type element) '(org-data section headline))))))) 6662 (goto-char (or next cbeg)) 6663 (setq mode (if next mode (org-element--next-mode mode type t)) 6664 next nil 6665 parent element 6666 end (if (org-element--open-end-p element) 6667 (org-element-property :end element) 6668 (org-element-property :contents-end element)))))) 6669 ;; Otherwise, return ELEMENT as it is the smallest 6670 ;; element containing POS. 6671 (t (throw 'exit (if syncp parent element))))) 6672 (setq element nil))))))))) 6673 6674 ;;;; Staging Buffer Changes 6675 6676 (defconst org-element--cache-sensitive-re 6677 (concat 6678 "^\\*+ " "\\|" 6679 "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|" 6680 "^[ \t]*\\(?:" 6681 "#\\+END\\(?:_\\|:?[ \t]*$\\)" "\\|" 6682 org-list-full-item-re "\\|" 6683 ":\\(?: \\|$\\)" "\\|" 6684 ":\\(?:\\w\\|[-_]\\)+:[ \t]*$" 6685 "\\)") 6686 "Regexp matching a sensitive line, structure wise. 6687 A sensitive line is a headline, inlinetask, block, drawer, or 6688 latex-environment boundary. When such a line is modified, 6689 structure changes in the document may propagate in the whole 6690 section, possibly making cache invalid.") 6691 6692 (defun org-element--cache-before-change (beg end) 6693 "Detect modifications in sensitive parts of Org buffer. 6694 BEG and END are the beginning and end of the range of changed 6695 text. See `before-change-functions' for more information. 6696 6697 The function returns the new value of `org-element--cache-change-warning'." 6698 (org-with-base-buffer nil 6699 (when (org-element--cache-active-p t) 6700 (org-with-wide-buffer 6701 (setq org-element--cache-change-tic (buffer-chars-modified-tick)) 6702 (setq org-element--cache-last-buffer-size (buffer-size)) 6703 (goto-char beg) 6704 (beginning-of-line) 6705 (let ((bottom (save-excursion 6706 (goto-char end) 6707 (if (and (bolp) 6708 ;; When beg == end, still extent to eol. 6709 (> (point) beg)) 6710 ;; FIXME: Potential pitfall. 6711 ;; We are appending to an element end. 6712 ;; Unless the last inserted char is not 6713 ;; newline, the next element is not broken 6714 ;; and does not need to be purged from the 6715 ;; cache. 6716 end 6717 (line-end-position))))) 6718 (prog1 6719 ;; Use the worst change warning to not miss important edits. 6720 ;; This function is called before edit and after edit by 6721 ;; `org-element--cache-after-change'. Before the edit, we still 6722 ;; want to use the old value if it comes from previous 6723 ;; not yet processed edit (they may be merged by 6724 ;; `org-element--cache-submit-request'). After the edit, we want to 6725 ;; look if there was a sensitive removed during edit. 6726 ;; FIXME: This is not the most efficient way and we now 6727 ;; have to delete more elements than needed in some 6728 ;; cases. A better approach may be storing the warning 6729 ;; in the modification request itself. 6730 (let ((org-element--cache-change-warning-before org-element--cache-change-warning) 6731 (org-element--cache-change-warning-after)) 6732 (setq org-element--cache-change-warning-after 6733 (save-match-data 6734 (let ((case-fold-search t)) 6735 (when (re-search-forward 6736 org-element--cache-sensitive-re bottom t) 6737 (goto-char beg) 6738 (beginning-of-line) 6739 (let (min-level) 6740 (cl-loop while (re-search-forward 6741 (rx-to-string 6742 (if (and min-level 6743 (> min-level 1)) 6744 `(and bol (repeat 1 ,(1- min-level) "*") " ") 6745 `(and bol (+ "*") " "))) 6746 bottom t) 6747 do (setq min-level (1- (length (match-string 0)))) 6748 until (= min-level 1)) 6749 (goto-char beg) 6750 (beginning-of-line) 6751 (or (and min-level (org-reduced-level min-level)) 6752 (when (looking-at-p "^[ \t]*#\\+CATEGORY:") 6753 'org-data) 6754 t)))))) 6755 (setq org-element--cache-change-warning 6756 (cond 6757 ((and (numberp org-element--cache-change-warning-before) 6758 (numberp org-element--cache-change-warning-after)) 6759 (min org-element--cache-change-warning-after 6760 org-element--cache-change-warning-before)) 6761 ((numberp org-element--cache-change-warning-before) 6762 org-element--cache-change-warning-before) 6763 ((numberp org-element--cache-change-warning-after) 6764 org-element--cache-change-warning-after) 6765 (t (or org-element--cache-change-warning-after 6766 org-element--cache-change-warning-before))))) 6767 (org-element--cache-log-message 6768 "%S is about to modify text: warning %S" 6769 this-command 6770 org-element--cache-change-warning))))))) 6771 6772 (defun org-element--cache-after-change (beg end pre) 6773 "Update buffer modifications for current buffer. 6774 BEG and END are the beginning and end of the range of changed 6775 text, and the length in bytes of the pre-change text replaced by 6776 that range. See `after-change-functions' for more information." 6777 (org-with-base-buffer nil 6778 (when (org-element--cache-active-p t) 6779 (when (not (eq org-element--cache-change-tic (buffer-chars-modified-tick))) 6780 (org-element--cache-log-message "After change") 6781 (setq org-element--cache-change-warning (org-element--cache-before-change beg end)) 6782 ;; If beg is right after spaces in front of an element, we 6783 ;; risk affecting previous element, so move beg to bol, making 6784 ;; sure that we capture preceding element. 6785 (setq beg (save-excursion 6786 (goto-char beg) 6787 (cl-incf pre (- beg (line-beginning-position))) 6788 (line-beginning-position))) 6789 ;; Store synchronization request. 6790 (let ((offset (- end beg pre))) 6791 (save-match-data 6792 (org-element--cache-submit-request beg (- end offset) offset))) 6793 ;; Activate a timer to process the request during idle time. 6794 (org-element--cache-set-timer (current-buffer)))))) 6795 6796 (defun org-element--cache-setup-change-functions () 6797 "Setup `before-change-functions' and `after-change-functions'." 6798 (when (and (derived-mode-p 'org-mode) org-element-use-cache) 6799 (add-hook 'before-change-functions 6800 #'org-element--cache-before-change nil t) 6801 ;; Run `org-element--cache-after-change' early to handle cases 6802 ;; when other `after-change-functions' require element cache. 6803 (add-hook 'after-change-functions 6804 #'org-element--cache-after-change -1 t))) 6805 6806 (defvar org-element--cache-avoid-synchronous-headline-re-parsing nil 6807 "This variable controls how buffer changes are handled by the cache. 6808 6809 By default (when this variable is nil), cache re-parses modified 6810 headlines immediately after modification preserving all the unaffected 6811 elements inside the headline. 6812 6813 The default behavior works best when users types inside Org buffer of 6814 when buffer modifications are mixed with cache requests. However, 6815 large automated edits inserting/deleting many headlines are somewhat 6816 slower by default (as in `org-archive-subtree'). Let-binding this 6817 variable to non-nil will reduce cache latency after every singular edit 6818 (`after-change-functions') at the cost of slower cache queries.") 6819 (defun org-element--cache-for-removal (beg end offset) 6820 "Return first element to remove from cache. 6821 6822 BEG and END are buffer positions delimiting buffer modifications. 6823 OFFSET is the size of the changes. 6824 6825 Returned element is usually the first element in cache containing 6826 any position between BEG and END. As an exception, greater 6827 elements around the changes that are robust to contents 6828 modifications are preserved and updated according to the 6829 changes. In the latter case, the returned element is the outermost 6830 non-robust element affected by the changes. Note that the returned 6831 element may end before END position in which case some cached element 6832 starting after the returned may still be affected by the changes. 6833 6834 Also, when there are no elements in cache before BEG, return first 6835 known element in cache (it may start after END)." 6836 (let* ((elements (org-element--cache-find (1- beg) 'both)) 6837 (before (car elements)) 6838 (after (cdr elements))) 6839 (if (not before) after 6840 ;; If BEFORE is a keyword, it may need to be removed to become 6841 ;; an affiliated keyword. 6842 (when (eq 'keyword (org-element-type before)) 6843 (let ((prev before)) 6844 (while (eq 'keyword (org-element-type prev)) 6845 (setq before prev 6846 beg (org-element-property :begin prev)) 6847 (setq prev (org-element--cache-find (1- (org-element-property :begin before))))))) 6848 (let ((up before) 6849 (robust-flag t)) 6850 (while up 6851 (if (let ((type (org-element-type up))) 6852 (or (and (memq type '( center-block dynamic-block 6853 quote-block special-block 6854 drawer)) 6855 (or (not (eq type 'drawer)) 6856 (not (string= "PROPERTIES" (org-element-property :drawer-name up)))) 6857 ;; Sensitive change. This is 6858 ;; unconditionally non-robust change. 6859 (not org-element--cache-change-warning) 6860 (let ((cbeg (org-element-property :contents-begin up)) 6861 (cend (org-element-property :contents-end up))) 6862 (and cbeg 6863 (<= cbeg beg) 6864 (or (> cend end) 6865 (and (= cend end) 6866 (= (+ end offset) (point-max))))))) 6867 (and (memq type '(headline section org-data)) 6868 (let ((rbeg (org-element-property :robust-begin up)) 6869 (rend (org-element-property :robust-end up))) 6870 (and rbeg rend 6871 (<= rbeg beg) 6872 (or (> rend end) 6873 (and (= rend end) 6874 (= (+ end offset) (point-max)))))) 6875 (pcase type 6876 ;; Sensitive change in section. Need to 6877 ;; re-parse. 6878 (`section (not org-element--cache-change-warning)) 6879 ;; Headline might be inserted. This is non-robust 6880 ;; change when `up' is a `headline' or `section' 6881 ;; with `>' level compared to the inserted headline. 6882 ;; 6883 ;; Also, planning info/property drawer 6884 ;; could have been inserted. It is not 6885 ;; robust change then. 6886 (`headline 6887 (and 6888 (or (not (numberp org-element--cache-change-warning)) 6889 (> org-element--cache-change-warning 6890 (org-element-property :level up))) 6891 (org-with-point-at (org-element-property :contents-begin up) 6892 (unless 6893 (save-match-data 6894 (when (looking-at-p org-element-planning-line-re) 6895 (forward-line)) 6896 (when (looking-at org-property-drawer-re) 6897 (< beg (match-end 0)))) 6898 'robust)))) 6899 (`org-data (and (not (eq org-element--cache-change-warning 'org-data)) 6900 ;; Property drawer could 6901 ;; have been inserted. It 6902 ;; is not robust change 6903 ;; then. 6904 (org-with-wide-buffer 6905 (goto-char (point-min)) 6906 (while (and (org-at-comment-p) (bolp)) (forward-line)) 6907 ;; Should not see property 6908 ;; drawer within changed 6909 ;; region. 6910 (save-match-data 6911 (or (not (looking-at org-property-drawer-re)) 6912 (> beg (match-end 0))))))) 6913 (_ 'robust))))) 6914 ;; UP is a robust greater element containing changes. 6915 ;; We only need to extend its ending boundaries. 6916 (progn 6917 (org-element--cache-shift-positions 6918 up offset 6919 (if (and (org-element-property :robust-begin up) 6920 (org-element-property :robust-end up)) 6921 '(:contents-end :end :robust-end) 6922 '(:contents-end :end))) 6923 (org-element--cache-log-message 6924 "Shifting end positions of robust parent: %S" 6925 (org-element--format-element up))) 6926 (unless (or 6927 ;; UP is non-robust. Yet, if UP is headline, flagging 6928 ;; everything inside for removal may be to 6929 ;; costly. Instead, we should better re-parse only the 6930 ;; headline itself when possible. If a headline is still 6931 ;; starting from old :begin position, we do not care that 6932 ;; its boundaries could have extended to shrunk - we 6933 ;; will re-parent and shift them anyway. 6934 (and (eq 'headline (org-element-type up)) 6935 (not org-element--cache-avoid-synchronous-headline-re-parsing) 6936 ;; The change is not inside headline. Not 6937 ;; updating here. 6938 (not (<= beg (org-element-property :begin up))) 6939 (not (> end (org-element-property :end up))) 6940 (let ((current (org-with-point-at (org-element-property :begin up) 6941 (org-element-with-disabled-cache 6942 (and (looking-at-p org-element-headline-re) 6943 (org-element-headline-parser)))))) 6944 (when (eq 'headline (org-element-type current)) 6945 (org-element--cache-log-message 6946 "Found non-robust headline that can be updated individually: %S" 6947 (org-element--format-element current)) 6948 (org-element-set-element up current) 6949 t))) 6950 ;; If UP is org-data, the situation is similar to 6951 ;; headline case. We just need to re-parse the 6952 ;; org-data itself, unless the change is made 6953 ;; within blank lines at BOB (that could 6954 ;; potentially alter first-section). 6955 (when (and (eq 'org-data (org-element-type up)) 6956 (>= beg (org-element-property :contents-begin up))) 6957 (org-element-set-element up (org-with-point-at 1 (org-element-org-data-parser))) 6958 (org-element--cache-log-message 6959 "Found non-robust change invalidating org-data. Re-parsing: %S" 6960 (org-element--format-element up)) 6961 t)) 6962 (org-element--cache-log-message 6963 "Found non-robust element: %S" 6964 (org-element--format-element up)) 6965 (setq before up) 6966 (when robust-flag (setq robust-flag nil)))) 6967 (unless (or (org-element-property :parent up) 6968 (eq 'org-data (org-element-type up))) 6969 (org-element--cache-warn "Got element without parent. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" up) 6970 (org-element-cache-reset) 6971 (error "org-element--cache: Emergency exit")) 6972 (setq up (org-element-property :parent up))) 6973 ;; We're at top level element containing ELEMENT: if it's 6974 ;; altered by buffer modifications, it is first element in 6975 ;; cache to be removed. Otherwise, that first element is the 6976 ;; following one. 6977 ;; 6978 ;; As a special case, do not remove BEFORE if it is a robust 6979 ;; container for current changes. 6980 (if (or (< (org-element-property :end before) beg) robust-flag) after 6981 before))))) 6982 6983 (defun org-element--cache-submit-request (beg end offset) 6984 "Submit a new cache synchronization request for current buffer. 6985 BEG and END are buffer positions delimiting the minimal area 6986 where cache data should be removed. OFFSET is the size of the 6987 change, as an integer." 6988 (org-element--cache-log-message 6989 "Submitting new synchronization request for [%S..%S]𝝙%S" 6990 beg end offset) 6991 (org-with-base-buffer nil 6992 (let ((next (car org-element--cache-sync-requests)) 6993 delete-to delete-from) 6994 (if (and next 6995 ;; First existing sync request is in phase 0. 6996 (= 0 (org-element--request-phase next)) 6997 ;; Current changes intersect with the first sync request. 6998 (> (setq delete-to (+ (org-element--request-end next) 6999 (org-element--request-offset next))) 7000 end) 7001 (<= (setq delete-from (org-element--request-beg next)) 7002 end)) 7003 ;; Current changes can be merged with first sync request: we 7004 ;; can save a partial cache synchronization. 7005 (progn 7006 (org-element--cache-log-message "Found another phase 0 request intersecting with current") 7007 ;; Update OFFSET of the existing request. 7008 (cl-incf (org-element--request-offset next) offset) 7009 ;; If last change happened within area to be removed, extend 7010 ;; boundaries of robust parents, if any. Otherwise, find 7011 ;; first element to remove and update request accordingly. 7012 (if (> beg delete-from) 7013 ;; The current modification is completely inside NEXT. 7014 ;; We already added the current OFFSET to the NEXT 7015 ;; request. However, the robust elements around 7016 ;; modifications also need to be shifted. Moreover, the 7017 ;; new modification may also have non-nil 7018 ;; `org-element--cache-change-warning'. In the latter case, we 7019 ;; also need to update the request. 7020 (let ((first (org-element--cache-for-removal delete-from end offset) ; Shift as needed. 7021 )) 7022 (org-element--cache-log-message 7023 "Current request is inside next. Candidate parent: %S" 7024 (org-element--format-element first)) 7025 (when 7026 ;; Non-robust element is now before NEXT. Need to 7027 ;; update. 7028 (and first 7029 (org-element--cache-key-less-p 7030 (org-element--cache-key first) 7031 (org-element--request-key next))) 7032 (org-element--cache-log-message 7033 "Current request is inside next. New parent: %S" 7034 (org-element--format-element first)) 7035 (setf (org-element--request-key next) 7036 (org-element--cache-key first)) 7037 (setf (org-element--request-beg next) 7038 (org-element-property :begin first)) 7039 (setf (org-element--request-end next) 7040 (max (org-element-property :end first) 7041 (org-element--request-end next))) 7042 (setf (org-element--request-parent next) 7043 (org-element-property :parent first)))) 7044 ;; The current and NEXT modifications are intersecting 7045 ;; with current modification starting before NEXT and NEXT 7046 ;; ending after current. We need to update the common 7047 ;; non-robust parent for the new extended modification 7048 ;; region. 7049 (let ((first (org-element--cache-for-removal beg delete-to offset))) 7050 (org-element--cache-log-message 7051 "Current request intersects with next. Candidate parent: %S" 7052 (org-element--format-element first)) 7053 (when (and first 7054 (org-element--cache-key-less-p 7055 (org-element--cache-key first) 7056 (org-element--request-key next))) 7057 (org-element--cache-log-message 7058 "Current request intersects with next. Updating. New parent: %S" 7059 (org-element--format-element first)) 7060 (setf (org-element--request-key next) (org-element--cache-key first)) 7061 (setf (org-element--request-beg next) (org-element-property :begin first)) 7062 (setf (org-element--request-end next) 7063 (max (org-element-property :end first) 7064 (org-element--request-end next))) 7065 (setf (org-element--request-parent next) (org-element-property :parent first)))))) 7066 ;; Ensure cache is correct up to END. Also make sure that NEXT, 7067 ;; if any, is no longer a 0-phase request, thus ensuring that 7068 ;; phases are properly ordered. We need to provide OFFSET as 7069 ;; optional parameter since current modifications are not known 7070 ;; yet to the otherwise correct part of the cache (i.e, before 7071 ;; the first request). 7072 (org-element--cache-log-message "Adding new phase 0 request") 7073 (when next (org-element--cache-sync (current-buffer) end beg offset)) 7074 (let ((first (org-element--cache-for-removal beg end offset))) 7075 (if first 7076 (push (let ((first-beg (org-element-property :begin first)) 7077 (key (org-element--cache-key first))) 7078 (cond 7079 ;; When changes happen before the first known 7080 ;; element, re-parent and shift the rest of the 7081 ;; cache. 7082 ((> first-beg end) 7083 (org-element--cache-log-message "Changes are before first known element. Submitting phase 1 request") 7084 (vector key first-beg nil offset nil 1)) 7085 ;; Otherwise, we find the first non robust 7086 ;; element containing END. All elements between 7087 ;; FIRST and this one are to be removed. 7088 ;; 7089 ;; The current modification is completely inside 7090 ;; FIRST. Clear and update cached elements in 7091 ;; region containing FIRST. 7092 ((let ((first-end (org-element-property :end first))) 7093 (when (> first-end end) 7094 (org-element--cache-log-message "Extending to non-robust element %S" (org-element--format-element first)) 7095 (vector key first-beg first-end offset (org-element-property :parent first) 0)))) 7096 (t 7097 ;; Now, FIRST is the first element after BEG or 7098 ;; non-robust element containing BEG. However, 7099 ;; FIRST ends before END and there might be 7100 ;; another ELEMENT before END that spans beyond 7101 ;; END. If there is such element, we need to 7102 ;; extend the region down to end of the common 7103 ;; parent of FIRST and everything inside 7104 ;; BEG..END. 7105 (let* ((element (org-element--cache-find end)) 7106 (element-end (org-element-property :end element)) 7107 (up element)) 7108 (while (and (not (eq up first)) 7109 (setq up (org-element-property :parent up)) 7110 (>= (org-element-property :begin up) first-beg)) 7111 ;; Note that UP might have been already 7112 ;; shifted if it is a robust element. After 7113 ;; deletion, it can put it's end before yet 7114 ;; unprocessed ELEMENT. 7115 (setq element-end (max (org-element-property :end up) element-end) 7116 element up)) 7117 ;; Extend region to remove elements between 7118 ;; beginning of first and the end of outermost 7119 ;; element starting before END but after 7120 ;; beginning of first. 7121 ;; of the FIRST. 7122 (org-element--cache-log-message 7123 "Extending to all elements between:\n 1: %S\n 2: %S" 7124 (org-element--format-element first) 7125 (org-element--format-element element)) 7126 (vector key first-beg element-end offset up 0))))) 7127 org-element--cache-sync-requests) 7128 ;; No element to remove. No need to re-parent either. 7129 ;; Simply shift additional elements, if any, by OFFSET. 7130 (if org-element--cache-sync-requests 7131 (progn 7132 (org-element--cache-log-message 7133 "Nothing to remove. Updating offset of the next request by 𝝙%S: %S" 7134 offset 7135 (let ((print-level 3)) 7136 (car org-element--cache-sync-requests))) 7137 (cl-incf (org-element--request-offset (car org-element--cache-sync-requests)) 7138 offset)) 7139 (org-element--cache-log-message 7140 "Nothing to remove. No elements in cache after %S. Terminating." 7141 end)))))) 7142 (setq org-element--cache-change-warning nil))) 7143 7144 (defun org-element--cache-verify-element (element) 7145 "Verify correctness of ELEMENT when `org-element--cache-self-verify' is non-nil. 7146 7147 Return non-nil when verification failed." 7148 (let ((org-element--cache-self-verify 7149 (or org-element--cache-self-verify 7150 (and (boundp 'org-batch-test) org-batch-test))) 7151 (org-element--cache-self-verify-frequency 7152 (if (and (boundp 'org-batch-test) org-batch-test) 7153 1 7154 org-element--cache-self-verify-frequency))) 7155 ;; Verify correct parent for the element. 7156 (unless (or (not org-element--cache-self-verify) 7157 (org-element-property :parent element) 7158 (eq 'org-data (org-element-type element))) 7159 (org-element--cache-warn "Got element without parent (cache active?: %S). Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" (org-element--cache-active-p) element) 7160 (org-element-cache-reset)) 7161 (when (and org-element--cache-self-verify 7162 (org-element--cache-active-p) 7163 (eq 'headline (org-element-type element)) 7164 ;; Avoid too much slowdown 7165 (< (random 1000) (* 1000 org-element--cache-self-verify-frequency))) 7166 (org-with-point-at (org-element-property :begin element) 7167 (org-element-with-disabled-cache (org-up-heading-or-point-min)) 7168 (unless (or (= (point) (org-element-property :begin (org-element-property :parent element))) 7169 (eq (point) (point-min))) 7170 (org-element--cache-warn 7171 "Cached element has wrong parent in %s. Resetting. 7172 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report). 7173 The element is: %S\n The parent is: %S\n The real parent is: %S" 7174 (buffer-name (current-buffer)) 7175 (org-element--format-element element) 7176 (org-element--format-element (org-element-property :parent element)) 7177 (org-element--format-element (org-element--current-element (org-element-property :end (org-element-property :parent element))))) 7178 (org-element-cache-reset)) 7179 (org-element--cache-verify-element (org-element-property :parent element)))) 7180 ;; Verify the element itself. 7181 (when (and org-element--cache-self-verify 7182 (org-element--cache-active-p) 7183 element 7184 (not (memq (org-element-type element) '(section org-data))) 7185 ;; Avoid too much slowdown 7186 (< (random 1000) (* 1000 org-element--cache-self-verify-frequency))) 7187 (let ((real-element (let (org-element-use-cache) 7188 (org-element--parse-to 7189 (if (memq (org-element-type element) '(table-row item)) 7190 (1+ (org-element-property :begin element)) 7191 (org-element-property :begin element)))))) 7192 (unless (and (eq (org-element-type real-element) (org-element-type element)) 7193 (eq (org-element-property :begin real-element) (org-element-property :begin element)) 7194 (eq (org-element-property :end real-element) (org-element-property :end element)) 7195 (eq (org-element-property :contents-begin real-element) (org-element-property :contents-begin element)) 7196 (eq (org-element-property :contents-end real-element) (org-element-property :contents-end element)) 7197 (or (not (org-element-property :ID real-element)) 7198 (string= (org-element-property :ID real-element) (org-element-property :ID element)))) 7199 (org-element--cache-warn "(%S) Cached element is incorrect in %s. (Cache tic up to date: %S) Resetting. 7200 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report). 7201 The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S" 7202 this-command 7203 (buffer-name (current-buffer)) 7204 (if (/= org-element--cache-change-tic 7205 (buffer-chars-modified-tick)) 7206 "no" "yes") 7207 (org-element--format-element element) 7208 (org-element--format-element real-element) 7209 (org-element--cache-find (1- (org-element-property :begin real-element))) 7210 (car (org-element--cache-find (org-element-property :begin real-element) 'both)) 7211 (cdr (org-element--cache-find (org-element-property :begin real-element) 'both))) 7212 (org-element-cache-reset)))))) 7213 7214 ;;; Cache persistence 7215 7216 (defun org-element--cache-persist-before-write (container &optional associated) 7217 "Sync cache before saving." 7218 (when (equal container '(elisp org-element--cache)) 7219 (if (and org-element-use-cache 7220 (plist-get associated :file) 7221 (get-file-buffer (plist-get associated :file)) 7222 org-element-cache-persistent) 7223 (with-current-buffer (get-file-buffer (plist-get associated :file)) 7224 (if (and (derived-mode-p 'org-mode) 7225 org-element--cache) 7226 (org-with-wide-buffer 7227 (org-element--cache-sync (current-buffer) (point-max)) 7228 ;; Cleanup cache request keys to avoid collisions during next 7229 ;; Emacs session. 7230 (avl-tree-mapc 7231 (lambda (el) 7232 (org-element-put-property el :org-element--cache-sync-key nil)) 7233 org-element--cache) 7234 nil) 7235 'forbid)) 7236 'forbid))) 7237 7238 (defun org-element--cache-persist-before-read (container &optional associated) 7239 "Avoid reading cache before Org mode is loaded." 7240 (when (equal container '(elisp org-element--cache)) 7241 (if (not (and (plist-get associated :file) 7242 (get-file-buffer (plist-get associated :file)))) 7243 'forbid 7244 (with-current-buffer (get-file-buffer (plist-get associated :file)) 7245 (unless (and org-element-use-cache 7246 org-element-cache-persistent 7247 (derived-mode-p 'org-mode) 7248 (equal (secure-hash 'md5 (current-buffer)) 7249 (plist-get associated :hash))) 7250 'forbid))))) 7251 7252 (defun org-element--cache-persist-after-read (container &optional associated) 7253 "Setup restored cache." 7254 (when (and (plist-get associated :file) 7255 (get-file-buffer (plist-get associated :file))) 7256 (with-current-buffer (get-file-buffer (plist-get associated :file)) 7257 (when (and org-element-use-cache org-element-cache-persistent) 7258 (when (and (equal container '(elisp org-element--cache)) org-element--cache) 7259 (setq-local org-element--cache-size (avl-tree-size org-element--cache))) 7260 (when (and (equal container '(elisp org-element--headline-cache)) org-element--headline-cache) 7261 (setq-local org-element--headline-cache-size (avl-tree-size org-element--headline-cache))))))) 7262 7263 (add-hook 'org-persist-before-write-hook #'org-element--cache-persist-before-write) 7264 (add-hook 'org-persist-before-read-hook #'org-element--cache-persist-before-read) 7265 (add-hook 'org-persist-after-read-hook #'org-element--cache-persist-after-read) 7266 7267 ;;;; Public Functions 7268 7269 (defvar-local org-element--cache-gapless nil 7270 "An alist containing (granularity . `org-element--cache-change-tic') elements. 7271 Each element indicates the latest `org-element--cache-change-tic' when 7272 change did not contain gaps.") 7273 7274 ;;;###autoload 7275 (defun org-element-cache-reset (&optional all no-persistence) 7276 "Reset cache in current buffer. 7277 When optional argument ALL is non-nil, reset cache in all Org 7278 buffers. 7279 When optional argument NO-PERSISTENCE is non-nil, do not try to update 7280 the cache persistence in the buffer." 7281 (interactive "P") 7282 (dolist (buffer (if all (buffer-list) (list (current-buffer)))) 7283 (org-with-base-buffer buffer 7284 (when (and org-element-use-cache (derived-mode-p 'org-mode)) 7285 ;; Only persist cache in file buffers. 7286 (when (and (buffer-file-name) (not no-persistence)) 7287 (when (not org-element-cache-persistent) 7288 (org-persist-unregister 'org-element--headline-cache (current-buffer)) 7289 (org-persist-unregister 'org-element--cache (current-buffer))) 7290 (when (and org-element-cache-persistent 7291 (buffer-file-name (current-buffer))) 7292 (org-persist-register 'org-element--cache (current-buffer)) 7293 (org-persist-register 'org-element--headline-cache 7294 (current-buffer) 7295 :inherit 'org-element--cache))) 7296 (setq-local org-element--cache-change-tic (buffer-chars-modified-tick)) 7297 (setq-local org-element--cache-last-buffer-size (buffer-size)) 7298 (setq-local org-element--cache-gapless nil) 7299 (setq-local org-element--cache 7300 (avl-tree-create #'org-element--cache-compare)) 7301 (setq-local org-element--headline-cache 7302 (avl-tree-create #'org-element--cache-compare)) 7303 (setq-local org-element--cache-hash-left (make-vector org-element--cache-hash-size nil)) 7304 (setq-local org-element--cache-hash-right (make-vector org-element--cache-hash-size nil)) 7305 (setq-local org-element--cache-size 0) 7306 (setq-local org-element--headline-cache-size 0) 7307 (setq-local org-element--cache-sync-keys-value 0) 7308 (setq-local org-element--cache-change-warning nil) 7309 (setq-local org-element--cache-sync-requests nil) 7310 (setq-local org-element--cache-sync-timer nil) 7311 (org-element--cache-setup-change-functions) 7312 ;; Make sure that `org-element--cache-after-change' and 7313 ;; `org-element--cache-before-change' are working inside properly created 7314 ;; indirect buffers. Note that `clone-indirect-buffer-hook' 7315 ;; will not work inside indirect buffers not created by 7316 ;; calling `clone-indirect-buffer'. We consider that the code 7317 ;; not using `clone-indirect-buffer' to be written with 7318 ;; awareness about possible consequences. 7319 (add-hook 'clone-indirect-buffer-hook 7320 #'org-element--cache-setup-change-functions))))) 7321 7322 ;;;###autoload 7323 (defun org-element-cache-refresh (pos) 7324 "Refresh cache at position POS." 7325 (when (org-element--cache-active-p) 7326 (org-element--cache-sync (current-buffer) pos) 7327 (org-element--cache-submit-request pos pos 0) 7328 (org-element--cache-set-timer (current-buffer)))) 7329 7330 (defvar warning-minimum-log-level) ; Defined in warning.el 7331 7332 (defvar org-element-cache-map-continue-from nil 7333 "Position from where mapping should continue. 7334 This variable can be set by called function, especially when the 7335 function modified the buffer.") 7336 ;;;###autoload 7337 (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) restrict-elements 7338 next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count 7339 narrow) 7340 "Map all elements in current buffer with FUNC according to 7341 GRANULARITY. Collect non-nil return values into result list. 7342 7343 FUNC should accept a single argument - the element. 7344 7345 FUNC can modify the buffer, but doing so may reduce performance. If 7346 buffer is modified, the mapping will continue from an element starting 7347 after the last mapped element. If the last mapped element is deleted, 7348 the subsequent element will be skipped as it cannot be distinguished 7349 deterministically from a changed element. If FUNC is expected to 7350 delete the element, it should directly set the value of 7351 `org-element-cache-map-continue-from' to force `org-element-cache-map' 7352 continue from the right point in buffer. 7353 7354 If some elements are not yet in cache, they will be added. 7355 7356 GRANULARITY can be `headline', `headline+inlinetask' 7357 `greater-element', or `element'. The default is 7358 `headline+inlinetask'. `object' granularity is not supported. 7359 7360 RESTRICT-ELEMENTS is a list of element types to be mapped over. 7361 7362 NEXT-RE is a regexp used to search next candidate match when FUNC 7363 returns non-nil and to search the first candidate match. FAIL-RE is a 7364 regexp used to search next candidate match when FUNC returns nil. The 7365 mapping will continue starting from headline at the RE match. 7366 7367 FROM-POS and TO-POS are buffer positions. When non-nil, they bound the 7368 mapped elements to elements starting at of after FROM-POS but before 7369 TO-POS. 7370 7371 AFTER-ELEMENT, when non-nil, bounds the mapping to all the elements 7372 after AFTER-ELEMENT (i.e. if AFTER-ELEMENT is a headline section, we 7373 map all the elements starting from first element inside section, but 7374 not including the section). 7375 7376 LIMIT-COUNT limits mapping to that many first matches where FUNC 7377 returns non-nil. 7378 7379 NARROW controls whether current buffer narrowing should be preserved. 7380 7381 This function does a subset of what `org-element-map' does, but with 7382 much better performance. Cached elements are supplied as the single 7383 argument of FUNC. Changes to elements made in FUNC will also alter 7384 the cache." 7385 (unless (org-element--cache-active-p) 7386 (error "Cache must be active.")) 7387 (unless (memq granularity '( headline headline+inlinetask 7388 greater-element element)) 7389 (error "Unsupported granularity: %S" granularity)) 7390 ;; Make TO-POS marker. Otherwise, buffer edits may garble the the 7391 ;; process. 7392 (unless (markerp to-pos) 7393 (let ((mk (make-marker))) 7394 (set-marker mk to-pos) 7395 (setq to-pos mk))) 7396 (let (;; Bind variables used inside loop to avoid memory 7397 ;; re-allocation on every iteration. 7398 ;; See https://emacsconf.org/2021/talks/faster/ 7399 tmpnext-start tmpparent tmpelement) 7400 (save-excursion 7401 (save-restriction 7402 (unless narrow (widen)) 7403 ;; Synchronize cache up to the end of mapped region. 7404 (org-element-at-point to-pos) 7405 (cl-macrolet ((cache-root 7406 ;; Use the most optimal version of cache available. 7407 () `(if (memq granularity '(headline headline+inlinetask)) 7408 (org-element--headline-cache-root) 7409 (org-element--cache-root))) 7410 (cache-size 7411 ;; Use the most optimal version of cache available. 7412 () `(if (memq granularity '(headline headline+inlinetask)) 7413 org-element--headline-cache-size 7414 org-element--cache-size)) 7415 (cache-walk-restart 7416 ;; Restart tree traversal after AVL tree re-balance. 7417 () `(when node 7418 (org-element-at-point (point-max)) 7419 (setq node (cache-root) 7420 stack (list nil) 7421 leftp t 7422 continue-flag t))) 7423 (cache-walk-abort 7424 ;; Abort tree traversal. 7425 () `(setq continue-flag t 7426 node nil)) 7427 (element-match-at-point 7428 ;; Returning the first element to match around point. 7429 ;; For example, if point is inside headline and 7430 ;; granularity is restricted to headlines only, skip 7431 ;; over all the child elements inside the headline 7432 ;; and return the first parent headline. 7433 ;; When we are inside a cache gap, calling 7434 ;; `org-element-at-point' also fills the cache gap down to 7435 ;; point. 7436 () `(progn 7437 ;; Parsing is one of the performance 7438 ;; bottlenecks. Make sure to optimize it as 7439 ;; much as possible. 7440 ;; 7441 ;; Avoid extra staff like timer cancels et al 7442 ;; and only call `org-element--cache-sync-requests' when 7443 ;; there are pending requests. 7444 (when org-element--cache-sync-requests 7445 (org-element--cache-sync (current-buffer))) 7446 ;; Call `org-element--parse-to' directly avoiding any 7447 ;; kind of `org-element-at-point' overheads. 7448 (if restrict-elements 7449 ;; Search directly instead of calling 7450 ;; `org-element-lineage' to avoid funcall overheads 7451 ;; and making sure that we do not go all 7452 ;; the way to `org-data' as `org-element-lineage' 7453 ;; does. 7454 (progn 7455 (setq tmpelement (org-element--parse-to (point))) 7456 (while (and tmpelement (not (memq (org-element-type tmpelement) restrict-elements))) 7457 (setq tmpelement (org-element-property :parent tmpelement))) 7458 tmpelement) 7459 (org-element--parse-to (point))))) 7460 ;; Starting from (point), search RE and move START to 7461 ;; the next valid element to be matched according to 7462 ;; restriction. Abort cache walk if no next element 7463 ;; can be found. When RE is nil, just find element at 7464 ;; point. 7465 (move-start-to-next-match 7466 (re) `(save-match-data 7467 (if (or (not ,re) 7468 (if org-element--cache-map-statistics 7469 (progn 7470 (setq before-time (float-time)) 7471 (re-search-forward (or (car-safe ,re) ,re) nil 'move) 7472 (cl-incf re-search-time 7473 (- (float-time) 7474 before-time))) 7475 (re-search-forward (or (car-safe ,re) ,re) nil 'move))) 7476 (unless (or (< (point) (or start -1)) 7477 (and data 7478 (< (point) (org-element-property :begin data)))) 7479 (if (cdr-safe ,re) 7480 ;; Avoid parsing when we are 100% 7481 ;; sure that regexp is good enough 7482 ;; to find new START. 7483 (setq start (match-beginning 0)) 7484 (setq start (max (or start -1) 7485 (or (org-element-property :begin data) -1) 7486 (or (org-element-property :begin (element-match-at-point)) -1)))) 7487 (when (>= start to-pos) (cache-walk-abort)) 7488 (when (eq start -1) (setq start nil))) 7489 (cache-walk-abort)))) 7490 ;; Find expected begin position of an element after 7491 ;; DATA. 7492 (next-element-start 7493 () `(progn 7494 (setq tmpnext-start nil) 7495 (if (memq granularity '(headline headline+inlinetask)) 7496 (setq tmpnext-start (or (when (memq (org-element-type data) '(headline org-data)) 7497 (org-element-property :contents-begin data)) 7498 (org-element-property :end data))) 7499 (setq tmpnext-start (or (when (memq (org-element-type data) org-element-greater-elements) 7500 (org-element-property :contents-begin data)) 7501 (org-element-property :end data)))) 7502 ;; DATA end may be the last element inside 7503 ;; i.e. source block. Skip up to the end 7504 ;; of parent in such case. 7505 (setq tmpparent data) 7506 (catch :exit 7507 (when (eq tmpnext-start (org-element-property :contents-end tmpparent)) 7508 (setq tmpnext-start (org-element-property :end tmpparent))) 7509 (while (setq tmpparent (org-element-property :parent tmpparent)) 7510 (if (eq tmpnext-start (org-element-property :contents-end tmpparent)) 7511 (setq tmpnext-start (org-element-property :end tmpparent)) 7512 (throw :exit t)))) 7513 tmpnext-start)) 7514 ;; Check if cache does not have gaps. 7515 (cache-gapless-p 7516 () `(eq org-element--cache-change-tic 7517 (alist-get granularity org-element--cache-gapless)))) 7518 ;; The core algorithm is simple walk along binary tree. However, 7519 ;; instead of checking all the tree elements from first to last 7520 ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping 7521 ;; the elements before FROM-POS efficiently: O(logN) instead of 7522 ;; O(Nbefore). 7523 ;; 7524 ;; Later, we may also not check every single element in the 7525 ;; binary tree after FROM-POS. Instead, we can find position of 7526 ;; next candidate elements by means of regexp search and skip the 7527 ;; binary tree branches that are before the next candidate: 7528 ;; again, O(logN) instead of O(Nbetween). 7529 ;; 7530 ;; Some elements might not yet be in the tree. So, we also parse 7531 ;; the empty gaps in cache as needed making sure that we do not 7532 ;; miss anything. 7533 (let* (;; START is always beginning of an element. When there is 7534 ;; no element in cache at START, we are inside cache gap 7535 ;; and need to fill it. 7536 (start (and from-pos 7537 (progn 7538 (goto-char from-pos) 7539 (org-element-property :begin (element-match-at-point))))) 7540 ;; Some elements may start at the same position, so we 7541 ;; also keep track of the last processed element and make 7542 ;; sure that we do not try to search it again. 7543 (prev after-element) 7544 (node (cache-root)) 7545 data 7546 (stack (list nil)) 7547 (leftp t) 7548 result 7549 ;; Whether previous element matched FUNC (FUNC 7550 ;; returned non-nil). 7551 (last-match t) 7552 continue-flag 7553 ;; Generic regexp to search next potential match. If it 7554 ;; is a cons of (regexp . 'match-beg), we are 100% sure 7555 ;; that the match beginning is the existing element 7556 ;; beginning. 7557 (next-element-re (pcase granularity 7558 ((or `headline 7559 (guard (eq '(headline) 7560 restrict-elements))) 7561 (cons 7562 (org-with-limited-levels 7563 org-element-headline-re) 7564 'match-beg)) 7565 (`headline+inlinetask 7566 (cons 7567 (if (eq '(inlinetask) restrict-elements) 7568 (org-inlinetask-outline-regexp) 7569 org-element-headline-re) 7570 'match-beg)) 7571 ;; TODO: May add other commonly 7572 ;; searched elements as needed. 7573 (_))) 7574 ;; Make sure that we are not checking the same regexp twice. 7575 (next-re (unless (and next-re 7576 (string= next-re 7577 (or (car-safe next-element-re) 7578 next-element-re))) 7579 next-re)) 7580 (fail-re (unless (and fail-re 7581 (string= fail-re 7582 (or (car-safe next-element-re) 7583 next-element-re))) 7584 fail-re)) 7585 (restrict-elements (or restrict-elements 7586 (pcase granularity 7587 (`headline 7588 '(headline)) 7589 (`headline+inlinetask 7590 '(headline inlinetask)) 7591 (`greater-element 7592 org-element-greater-elements) 7593 (_ nil)))) 7594 ;; Statistics 7595 (time (float-time)) 7596 (predicate-time 0) 7597 (pre-process-time 0) 7598 (re-search-time 0) 7599 (count-predicate-calls-match 0) 7600 (count-predicate-calls-fail 0) 7601 ;; Bind variables used inside loop to avoid memory 7602 ;; re-allocation on every iteration. 7603 ;; See https://emacsconf.org/2021/talks/faster/ 7604 cache-size before-time modified-tic) 7605 ;; Skip to first element within region. 7606 (goto-char (or start (point-min))) 7607 (move-start-to-next-match next-element-re) 7608 (unless (and start (>= start to-pos)) 7609 (while node 7610 (setq data (avl-tree--node-data node)) 7611 (if (and leftp (avl-tree--node-left node) ; Left branch. 7612 ;; Do not move to left branch when we are before 7613 ;; PREV. 7614 (or (not prev) 7615 (not (org-element--cache-key-less-p 7616 (org-element--cache-key data) 7617 (org-element--cache-key prev)))) 7618 ;; ... or when we are before START. 7619 (or (not start) 7620 (not (> start (org-element-property :begin data))))) 7621 (progn (push node stack) 7622 (setq node (avl-tree--node-left node))) 7623 ;; The whole tree left to DATA is before START and 7624 ;; PREV. DATA may still be before START (i.e. when 7625 ;; DATA is the root or when START moved), at START, or 7626 ;; after START. 7627 ;; 7628 ;; If DATA is before start, skip it over and move to 7629 ;; subsequent elements. 7630 ;; If DATA is at start, run FUNC if necessary and 7631 ;; update START according and NEXT-RE, FAIL-RE, 7632 ;; NEXT-ELEMENT-RE. 7633 ;; If DATA is after start, we have found a cache gap 7634 ;; and need to fill it. 7635 (unless (or (and start (< (org-element-property :begin data) start)) 7636 (and prev (not (org-element--cache-key-less-p 7637 (org-element--cache-key prev) 7638 (org-element--cache-key data))))) 7639 ;; DATA is at of after START and PREV. 7640 (if (or (not start) (= (org-element-property :begin data) start)) 7641 ;; DATA is at START. Match it. 7642 ;; In the process, we may alter the buffer, 7643 ;; so also keep track of the cache state. 7644 (progn 7645 (setq modified-tic org-element--cache-change-tic) 7646 (setq cache-size (cache-size)) 7647 ;; When NEXT-RE/FAIL-RE is provided, skip to 7648 ;; next regexp match after :begin of the current 7649 ;; element. 7650 (when (if last-match next-re fail-re) 7651 (goto-char (org-element-property :begin data)) 7652 (move-start-to-next-match 7653 (if last-match next-re fail-re))) 7654 (when (and (or (not start) (eq (org-element-property :begin data) start)) 7655 (< (org-element-property :begin data) to-pos)) 7656 ;; Calculate where next possible element 7657 ;; starts and update START if needed. 7658 (setq start (next-element-start)) 7659 (goto-char start) 7660 ;; Move START further if possible. 7661 (when (and next-element-re 7662 ;; Do not move if we know for 7663 ;; sure that cache does not 7664 ;; contain gaps. Regexp 7665 ;; searches are not cheap. 7666 (not (cache-gapless-p))) 7667 (move-start-to-next-match next-element-re) 7668 ;; Make sure that point is at START 7669 ;; before running FUNC. 7670 (goto-char start)) 7671 ;; Try FUNC if DATA matches all the 7672 ;; restrictions. Calculate new START. 7673 (when (or (not restrict-elements) 7674 (memq (org-element-type data) restrict-elements)) 7675 ;; DATA matches restriction. FUNC may 7676 ;; 7677 ;; Call FUNC. FUNC may move point. 7678 (setq org-element-cache-map-continue-from nil) 7679 (if org-element--cache-map-statistics 7680 (progn 7681 (setq before-time (float-time)) 7682 (push (funcall func data) result) 7683 (cl-incf predicate-time 7684 (- (float-time) 7685 before-time)) 7686 (if (car result) 7687 (cl-incf count-predicate-calls-match) 7688 (cl-incf count-predicate-calls-fail))) 7689 (push (funcall func data) result) 7690 (when (car result) (cl-incf count-predicate-calls-match))) 7691 ;; Set `last-match'. 7692 (setq last-match (car result)) 7693 ;; If FUNC moved point forward, update 7694 ;; START. 7695 (when org-element-cache-map-continue-from 7696 (goto-char org-element-cache-map-continue-from)) 7697 (when (> (point) start) 7698 (move-start-to-next-match nil)) 7699 ;; Drop nil. 7700 (unless (car result) (pop result))) 7701 ;; If FUNC did not move the point and we 7702 ;; know for sure that cache does not contain 7703 ;; gaps, do not try to calculate START in 7704 ;; advance but simply loop to the next cache 7705 ;; element. 7706 (when (and (cache-gapless-p) 7707 (eq (next-element-start) 7708 start)) 7709 (setq start nil)) 7710 ;; Check if the buffer has been modified. 7711 (unless (and (eq modified-tic org-element--cache-change-tic) 7712 (eq cache-size (cache-size))) 7713 ;; START may no longer be valid, update 7714 ;; it to beginning of real element. 7715 ;; Upon modification, START may lay 7716 ;; inside an element. We want to move 7717 ;; it to real beginning then despite 7718 ;; START being larger. 7719 (setq start nil) 7720 (move-start-to-next-match nil) 7721 ;; The new element may now start before 7722 ;; or at already processed position. 7723 ;; Make sure that we continue from an 7724 ;; element past already processed 7725 ;; place. 7726 (when (and start 7727 (<= start (org-element-property :begin data)) 7728 (not org-element-cache-map-continue-from)) 7729 (goto-char start) 7730 (setq data (element-match-at-point)) 7731 ;; If DATA is nil, buffer is 7732 ;; empty. Abort. 7733 (when data 7734 (goto-char (next-element-start)) 7735 (move-start-to-next-match next-element-re))) 7736 (org-element-at-point to-pos) 7737 (cache-walk-restart)) 7738 ;; Reached LIMIT-COUNT. Abort. 7739 (when (and limit-count 7740 (>= count-predicate-calls-match 7741 limit-count)) 7742 (cache-walk-abort)) 7743 (if (org-element-property :cached data) 7744 (setq prev data) 7745 (setq prev nil)))) 7746 ;; DATA is after START. Fill the gap. 7747 (if (memq (org-element-type (org-element--parse-to start)) '(plain-list table)) 7748 ;; Tables and lists are special, we need a 7749 ;; trickery to make items/rows be populated 7750 ;; into cache. 7751 (org-element--parse-to (1+ start))) 7752 ;; Restart tree traversal as AVL tree is 7753 ;; re-balanced upon adding elements. We can no 7754 ;; longer trust STACK. 7755 (cache-walk-restart))) 7756 ;; Second, move to the right branch of the tree or skip 7757 ;; it altogether. 7758 (if continue-flag 7759 (setq continue-flag nil) 7760 (setq node (if (and (car stack) 7761 ;; If START advanced beyond stack parent, skip the right branch. 7762 (or (and start (< (org-element-property :begin (avl-tree--node-data (car stack))) start)) 7763 (and prev (org-element--cache-key-less-p 7764 (org-element--cache-key (avl-tree--node-data (car stack))) 7765 (org-element--cache-key prev))))) 7766 (progn 7767 (setq leftp nil) 7768 (pop stack)) 7769 ;; Otherwise, move ahead into the right 7770 ;; branch when it exists. 7771 (if (setq leftp (avl-tree--node-right node)) 7772 (avl-tree--node-right node) 7773 (pop stack)))))))) 7774 (when (and org-element--cache-map-statistics 7775 (or (not org-element--cache-map-statistics-threshold) 7776 (> (- (float-time) time) org-element--cache-map-statistics-threshold))) 7777 (message "Mapped over elements in %S. %d/%d predicate matches. Total time: %f sec. Pre-process time: %f sec. Predicate time: %f sec. Re-search time: %f sec. 7778 Calling parameters: :granularity %S :restrict-elements %S :next-re %S :fail-re %S :from-pos %S :to-pos %S :limit-count %S :after-element %S" 7779 (current-buffer) 7780 count-predicate-calls-match 7781 (+ count-predicate-calls-match 7782 count-predicate-calls-fail) 7783 (- (float-time) time) 7784 pre-process-time 7785 predicate-time 7786 re-search-time 7787 granularity restrict-elements next-re fail-re from-pos to-pos limit-count after-element)) 7788 ;; Return result. 7789 (nreverse result))))))) 7790 7791 7792 7793 7794 ;;; The Toolbox 7795 ;; 7796 ;; The first move is to implement a way to obtain the smallest element 7797 ;; containing point. This is the job of `org-element-at-point'. It 7798 ;; basically jumps back to the beginning of section containing point 7799 ;; and proceed, one element after the other, with 7800 ;; `org-element--current-element' until the container is found. Note: 7801 ;; When using `org-element-at-point', secondary values are never 7802 ;; parsed since the function focuses on elements, not on objects. 7803 ;; 7804 ;; At a deeper level, `org-element-context' lists all elements and 7805 ;; objects containing point. 7806 ;; 7807 ;; `org-element-nested-p' and `org-element-swap-A-B' may be used 7808 ;; internally by navigation and manipulation tools. 7809 7810 7811 ;;;###autoload 7812 (defun org-element-at-point (&optional pom cached-only) 7813 "Determine closest element around point or POM. 7814 7815 Only check cached element when CACHED-ONLY is non-nil and return nil 7816 unconditionally when element at POM is not in cache. 7817 7818 Return value is a list like (TYPE PROPS) where TYPE is the type 7819 of the element and PROPS a plist of properties associated to the 7820 element. 7821 7822 Possible types are defined in `org-element-all-elements'. 7823 Properties depend on element or object type, but always include 7824 `:begin', `:end', and `:post-blank' properties. 7825 7826 As a special case, if point is at the very beginning of the first 7827 item in a list or sub-list, returned element will be that list 7828 instead of the item. Likewise, if point is at the beginning of 7829 the first row of a table, returned element will be the table 7830 instead of the first row. 7831 7832 When point is at the end of the buffer, return the innermost 7833 element ending there." 7834 (setq pom (or pom (point))) 7835 ;; Allow re-parsing when the command can benefit from it. 7836 (when (and cached-only 7837 (memq this-command org-element--cache-non-modifying-commands)) 7838 (setq cached-only nil)) 7839 (let (element) 7840 (when (org-element--cache-active-p) 7841 (if (not org-element--cache) (org-element-cache-reset) 7842 (unless cached-only (org-element--cache-sync (current-buffer) pom)))) 7843 (setq element (if cached-only 7844 (when (and (org-element--cache-active-p) 7845 (or (not org-element--cache-sync-requests) 7846 (< pom 7847 (org-element--request-beg 7848 (car org-element--cache-sync-requests))))) 7849 (org-element--cache-find pom)) 7850 (condition-case err 7851 (org-element--parse-to pom) 7852 (error 7853 (org-element--cache-warn 7854 "Org parser error in %s::%S. Resetting.\n The error was: %S\n Backtrace:\n%S\n Please report this to Org mode mailing list (M-x org-submit-bug-report)." 7855 (buffer-name (current-buffer)) 7856 pom 7857 err 7858 (when (and (fboundp 'backtrace-get-frames) 7859 (fboundp 'backtrace-to-string)) 7860 (backtrace-to-string (backtrace-get-frames 'backtrace)))) 7861 (org-element-cache-reset) 7862 (org-element--parse-to pom))))) 7863 (when (and (org-element--cache-active-p) 7864 element 7865 (org-element--cache-verify-element element)) 7866 (setq element (org-element--parse-to pom))) 7867 (unless (eq 'org-data (org-element-type element)) 7868 (unless (and cached-only 7869 (not (and element 7870 (or (= pom (org-element-property :begin element)) 7871 (and (not (memq (org-element-type element) org-element-greater-elements)) 7872 (>= pom (org-element-property :begin element)) 7873 (< pom (org-element-property :end element))) 7874 (and (org-element-property :contents-begin element) 7875 (>= pom (org-element-property :begin element)) 7876 (< pom (org-element-property :contents-begin element))) 7877 (and (not (org-element-property :contents-end element)) 7878 (>= pom (org-element-property :begin element)) 7879 (< pom (org-element-property :end element))))))) 7880 (if (not (eq (org-element-type element) 'section)) 7881 element 7882 (org-element-at-point (1+ pom) cached-only)))))) 7883 7884 ;;;###autoload 7885 (defsubst org-element-at-point-no-context (&optional pom) 7886 "Quickly find element at point or POM. 7887 7888 It is a faster version of `org-element-at-point' that is not 7889 guaranteed to return correct `:parent' properties even when cache is 7890 enabled." 7891 (or (org-element-at-point pom 'cached-only) 7892 (let (org-element-use-cache) (org-element-at-point pom)))) 7893 7894 ;;;###autoload 7895 (defun org-element-context (&optional element) 7896 "Return smallest element or object around point. 7897 7898 Return value is a list like (TYPE PROPS) where TYPE is the type 7899 of the element or object and PROPS a plist of properties 7900 associated to it. 7901 7902 Possible types are defined in `org-element-all-elements' and 7903 `org-element-all-objects'. Properties depend on element or 7904 object type, but always include `:begin', `:end', `:parent' and 7905 `:post-blank'. 7906 7907 As a special case, if point is right after an object and not at 7908 the beginning of any other object, return that object. 7909 7910 Optional argument ELEMENT, when non-nil, is the closest element 7911 containing point, as returned by `org-element-at-point'. 7912 Providing it allows for quicker computation." 7913 (save-match-data 7914 (catch 'objects-forbidden 7915 (org-with-wide-buffer 7916 (let* ((pos (point)) 7917 (element (or element (org-element-at-point))) 7918 (type (org-element-type element)) 7919 (post (org-element-property :post-affiliated element))) 7920 ;; If point is inside an element containing objects or 7921 ;; a secondary string, narrow buffer to the container and 7922 ;; proceed with parsing. Otherwise, return ELEMENT. 7923 (cond 7924 ;; At a parsed affiliated keyword, check if we're inside main 7925 ;; or dual value. 7926 ((and post (< pos post)) 7927 (beginning-of-line) 7928 (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) 7929 (cond 7930 ((not (member-ignore-case (match-string 1) 7931 org-element-parsed-keywords)) 7932 (throw 'objects-forbidden element)) 7933 ((< (match-end 0) pos) 7934 (narrow-to-region (match-end 0) (line-end-position))) 7935 ((and (match-beginning 2) 7936 (>= pos (match-beginning 2)) 7937 (< pos (match-end 2))) 7938 (narrow-to-region (match-beginning 2) (match-end 2))) 7939 (t (throw 'objects-forbidden element))) 7940 ;; Also change type to retrieve correct restrictions. 7941 (setq type 'keyword)) 7942 ;; At an item, objects can only be located within tag, if any. 7943 ((eq type 'item) 7944 (let ((tag (org-element-property :tag element))) 7945 (if (or (not tag) (/= (line-beginning-position) post)) 7946 (throw 'objects-forbidden element) 7947 (beginning-of-line) 7948 (search-forward tag (line-end-position)) 7949 (goto-char (match-beginning 0)) 7950 (if (and (>= pos (point)) (< pos (match-end 0))) 7951 (narrow-to-region (point) (match-end 0)) 7952 (throw 'objects-forbidden element))))) 7953 ;; At an headline or inlinetask, objects are in title. 7954 ((memq type '(headline inlinetask)) 7955 (let ((case-fold-search nil)) 7956 (goto-char (org-element-property :begin element)) 7957 (looking-at org-complex-heading-regexp) 7958 (let ((end (match-end 4))) 7959 (if (not end) (throw 'objects-forbidden element) 7960 (goto-char (match-beginning 4)) 7961 (when (looking-at org-element-comment-string) 7962 (goto-char (match-end 0))) 7963 (if (>= (point) end) (throw 'objects-forbidden element) 7964 (narrow-to-region (point) end)))))) 7965 ;; At a paragraph, a table-row or a verse block, objects are 7966 ;; located within their contents. 7967 ((memq type '(paragraph table-row verse-block)) 7968 (let ((cbeg (org-element-property :contents-begin element)) 7969 (cend (org-element-property :contents-end element))) 7970 ;; CBEG is nil for table rules. 7971 (if (and cbeg cend (>= pos cbeg) 7972 (or (< pos cend) (and (= pos cend) (eobp)))) 7973 (narrow-to-region cbeg cend) 7974 (throw 'objects-forbidden element)))) 7975 (t (throw 'objects-forbidden element))) 7976 (goto-char (point-min)) 7977 (let ((restriction (org-element-restriction type)) 7978 (parent element) 7979 last) 7980 (catch 'exit 7981 (while t 7982 (let ((next (org-element--object-lex restriction))) 7983 (when next (org-element-put-property next :parent parent)) 7984 ;; Process NEXT, if any, in order to know if we need to 7985 ;; skip it, return it or move into it. 7986 (if (or (not next) (> (org-element-property :begin next) pos)) 7987 (throw 'exit (or last parent)) 7988 (let ((end (org-element-property :end next)) 7989 (cbeg (org-element-property :contents-begin next)) 7990 (cend (org-element-property :contents-end next))) 7991 (cond 7992 ;; Skip objects ending before point. Also skip 7993 ;; objects ending at point unless it is also the 7994 ;; end of buffer, since we want to return the 7995 ;; innermost object. 7996 ((and (<= end pos) (/= (point-max) end)) 7997 (goto-char end) 7998 ;; For convenience, when object ends at POS, 7999 ;; without any space, store it in LAST, as we 8000 ;; will return it if no object starts here. 8001 (when (and (= end pos) 8002 (not (memq (char-before) '(?\s ?\t)))) 8003 (setq last next))) 8004 ;; If POS is within a container object, move into 8005 ;; that object. 8006 ((and cbeg cend 8007 (>= pos cbeg) 8008 (or (< pos cend) 8009 ;; At contents' end, if there is no 8010 ;; space before point, also move into 8011 ;; object, for consistency with 8012 ;; convenience feature above. 8013 (and (= pos cend) 8014 (or (= (point-max) pos) 8015 (not (memq (char-before pos) 8016 '(?\s ?\t))))))) 8017 (goto-char cbeg) 8018 (narrow-to-region (point) cend) 8019 (setq parent next) 8020 (setq restriction (org-element-restriction next))) 8021 ;; Otherwise, return NEXT. 8022 (t (throw 'exit next)))))))))))))) 8023 8024 (defun org-element-lineage (datum &optional types with-self) 8025 "List all ancestors of a given element or object. 8026 8027 DATUM is an object or element. 8028 8029 Return ancestors from the closest to the farthest. When optional 8030 argument TYPES is a list of symbols, return the first element or 8031 object in the lineage whose type belongs to that list instead. 8032 8033 When optional argument WITH-SELF is non-nil, lineage includes 8034 DATUM itself as the first element, and TYPES, if provided, also 8035 apply to it. 8036 8037 When DATUM is obtained through `org-element-context' or 8038 `org-element-at-point', only ancestors from its section can be 8039 found. There is no such limitation when DATUM belongs to a full 8040 parse tree." 8041 (let ((up (if with-self datum (org-element-property :parent datum))) 8042 ancestors) 8043 (while (and up (not (memq (org-element-type up) types))) 8044 (unless types (push up ancestors)) 8045 (setq up (org-element-property :parent up))) 8046 (if types up (nreverse ancestors)))) 8047 8048 (defun org-element-nested-p (elem-A elem-B) 8049 "Non-nil when elements ELEM-A and ELEM-B are nested." 8050 (let ((beg-A (org-element-property :begin elem-A)) 8051 (beg-B (org-element-property :begin elem-B)) 8052 (end-A (org-element-property :end elem-A)) 8053 (end-B (org-element-property :end elem-B))) 8054 (or (and (>= beg-A beg-B) (<= end-A end-B)) 8055 (and (>= beg-B beg-A) (<= end-B end-A))))) 8056 8057 (defun org-element-swap-A-B (elem-A elem-B) 8058 "Swap elements ELEM-A and ELEM-B. 8059 Assume ELEM-B is after ELEM-A in the buffer. Leave point at the 8060 end of ELEM-A." 8061 (goto-char (org-element-property :begin elem-A)) 8062 ;; There are two special cases when an element doesn't start at bol: 8063 ;; the first paragraph in an item or in a footnote definition. 8064 (let ((specialp (not (bolp)))) 8065 ;; Only a paragraph without any affiliated keyword can be moved at 8066 ;; ELEM-A position in such a situation. Note that the case of 8067 ;; a footnote definition is impossible: it cannot contain two 8068 ;; paragraphs in a row because it cannot contain a blank line. 8069 (when (and specialp 8070 (or (not (eq (org-element-type elem-B) 'paragraph)) 8071 (/= (org-element-property :begin elem-B) 8072 (org-element-property :contents-begin elem-B)))) 8073 (error "Cannot swap elements")) 8074 ;; Preserve folding state when `org-fold-core-style' is set to 8075 ;; `text-properties'. 8076 (org-fold-core-ignore-modifications 8077 ;; In a special situation, ELEM-A will have no indentation. We'll 8078 ;; give it ELEM-B's (which will in, in turn, have no indentation). 8079 (let* ((ind-B (when specialp 8080 (goto-char (org-element-property :begin elem-B)) 8081 (current-indentation))) 8082 (beg-A (org-element-property :begin elem-A)) 8083 (end-A (save-excursion 8084 (goto-char (org-element-property :end elem-A)) 8085 (skip-chars-backward " \r\t\n") 8086 (line-end-position))) 8087 (beg-B (org-element-property :begin elem-B)) 8088 (end-B (save-excursion 8089 (goto-char (org-element-property :end elem-B)) 8090 (skip-chars-backward " \r\t\n") 8091 (line-end-position))) 8092 ;; Store inner folds responsible for visibility status. 8093 (folds 8094 (cons 8095 (org-fold-core-get-regions :from beg-A :to end-A :relative t) 8096 (org-fold-core-get-regions :from beg-B :to end-B :relative t))) 8097 ;; Get contents. 8098 (body-A (buffer-substring beg-A end-A)) 8099 (body-B (buffer-substring beg-B end-B))) 8100 ;; Clear up the folds. 8101 (org-fold-region beg-A end-A nil) 8102 (org-fold-region beg-B end-B nil) 8103 (delete-region beg-B end-B) 8104 (goto-char beg-B) 8105 (when specialp 8106 (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) 8107 (indent-to-column ind-B)) 8108 (insert body-A) 8109 ;; Restore ex ELEM-A folds. 8110 (org-fold-core-regions (car folds) :relative beg-B) 8111 (goto-char beg-A) 8112 (delete-region beg-A end-A) 8113 (insert body-B) 8114 ;; Restore ex ELEM-A folds. 8115 (org-fold-core-regions (cdr folds) :relative beg-A) 8116 (goto-char (org-element-property :end elem-B)))))) 8117 8118 (provide 'org-element) 8119 8120 ;; Local variables: 8121 ;; generated-autoload-file: "org-loaddefs.el" 8122 ;; End: 8123 8124 ;;; org-element.el ends here