org-element.el (367561B)
1 ;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2012-2024 Free Software Foundation, Inc. 4 5 ;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> 6 ;; Maintainer: Ihor Radchenko <yantar92 at posteo dot net> 7 ;; Keywords: outlines, hypermedia, calendar, text 8 9 ;; This file is part of GNU Emacs. 10 11 ;; GNU Emacs is free software: you can redistribute it and/or modify 12 ;; it under the terms of the GNU General Public License as published by 13 ;; the Free Software Foundation, either version 3 of the License, or 14 ;; (at your option) any later version. 15 16 ;; GNU Emacs is distributed in the hope that it will be useful, 17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 19 ;; GNU General Public License for more details. 20 21 ;; You should have received a copy of the GNU General Public License 22 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 23 24 ;;; Commentary: 25 ;; 26 ;; See <https://orgmode.org/worg/dev/org-syntax.html> for details about 27 ;; Org syntax. 28 ;; 29 ;; Lisp-wise, a syntax object can be represented as a list. 30 ;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: 31 ;; TYPE is a symbol describing the object. 32 ;; PROPERTIES is the property list attached to it. See docstring of 33 ;; appropriate parsing function to get an exhaustive list. 34 ;; CONTENTS is a list of syntax objects or raw strings contained 35 ;; in the current object, when applicable. 36 ;; 37 ;; For the whole document, TYPE is `org-data' and PROPERTIES is nil. 38 ;; 39 ;; The first part of this file defines constants for the Org syntax, 40 ;; while the second one provide accessors and setters functions. 41 ;; 42 ;; The next part implements a parser and an interpreter for each 43 ;; element and object type in Org syntax. 44 ;; 45 ;; The following part creates a fully recursive buffer parser. It 46 ;; also provides a tool to map a function to elements or objects 47 ;; matching some criteria in the parse tree. Functions of interest 48 ;; are `org-element-parse-buffer', `org-element-map' and, to a lesser 49 ;; extent, `org-element-parse-secondary-string'. 50 ;; 51 ;; The penultimate part is the cradle of an interpreter for the 52 ;; obtained parse tree: `org-element-interpret-data'. 53 ;; 54 ;; The library ends by furnishing `org-element-at-point' function, and 55 ;; a way to give information about document structure around point 56 ;; with `org-element-context'. A cache mechanism is also provided for 57 ;; these functions. 58 59 60 ;;; Code: 61 62 (require 'org-macs) 63 (org-assert-version) 64 65 (require 'avl-tree) 66 (require 'ring) 67 (require 'cl-lib) 68 (require 'ol) 69 (require 'org) 70 (require 'org-persist) 71 (require 'org-compat) 72 (require 'org-entities) 73 (require 'org-footnote) 74 (require 'org-list) 75 (require 'org-macs) 76 (require 'org-table) 77 (require 'org-fold-core) 78 79 (declare-function org-at-heading-p "org" (&optional _)) 80 (declare-function org-escape-code-in-string "org-src" (s)) 81 (declare-function org-src-preserve-indentation-p "org-src" (&optional node)) 82 (declare-function org-macro-escape-arguments "org-macro" (&rest args)) 83 (declare-function org-macro-extract-arguments "org-macro" (s)) 84 (declare-function org-reduced-level "org" (l)) 85 (declare-function org-unescape-code-in-string "org-src" (s)) 86 (declare-function org-inlinetask-outline-regexp "org-inlinetask" ()) 87 (declare-function outline-next-heading "outline" ()) 88 (declare-function outline-previous-heading "outline" ()) 89 90 (defvar org-complex-heading-regexp) 91 (defvar org-done-keywords) 92 (defvar org-edit-src-content-indentation) 93 (defvar org-match-substring-regexp) 94 (defvar org-odd-levels-only) 95 (defvar org-property-drawer-re) 96 (defvar org-property-format) 97 (defvar org-property-re) 98 (defvar org-tags-column) 99 (defvar org-todo-regexp) 100 (defvar org-ts-regexp-both) 101 102 103 ;;; Definitions And Rules 104 ;; 105 ;; Define elements, greater elements and specify recursive objects, 106 ;; along with the affiliated keywords recognized. Also set up 107 ;; restrictions on recursive objects combinations. 108 ;; 109 ;; `org-element-update-syntax' builds proper syntax regexps according 110 ;; to current setup. 111 112 (defconst org-element-archive-tag "ARCHIVE" 113 "Tag marking a subtree as archived.") 114 115 (defconst org-element-citation-key-re 116 (rx "@" (group (one-or-more (any word "-.:?!`'/*@+|(){}<>&_^$#%~")))) 117 "Regexp matching a citation key. 118 Key is located in match group 1.") 119 120 (defconst org-element-citation-prefix-re 121 (rx "[cite" 122 (opt "/" (group (one-or-more (any "/_-" alnum)))) ;style 123 ":" 124 (zero-or-more (any "\t\n "))) 125 "Regexp matching a citation prefix. 126 Style, if any, is located in match group 1.") 127 128 (defconst org-element-clock-line-re 129 (let ((duration ; "=> 212:12" 130 '(seq 131 (1+ (or ?\t ?\s)) "=>" (1+ (or ?\t ?\s)) 132 (1+ digit) ":" digit digit))) 133 (rx-to-string 134 `(seq 135 line-start (0+ (or ?\t ?\s)) 136 "CLOCK:" 137 (or 138 (seq 139 (1+ (or ?\t ?\s)) 140 (regexp ,org-ts-regexp-inactive) 141 (opt "--" 142 (regexp ,org-ts-regexp-inactive) 143 ,duration)) 144 ,duration) 145 (0+ (or ?\t ?\s)) 146 line-end))) 147 "Regexp matching a clock line.") 148 149 (defconst org-element-comment-string "COMMENT" 150 "String marker for commented headlines.") 151 152 (defconst org-element-closed-keyword "CLOSED:" 153 "Keyword used to close TODO entries.") 154 155 (defconst org-element-deadline-keyword "DEADLINE:" 156 "Keyword used to mark deadline entries.") 157 158 (defconst org-element-scheduled-keyword "SCHEDULED:" 159 "Keyword used to mark scheduled entries.") 160 161 (defconst org-element-planning-keywords-re 162 (regexp-opt (list org-element-closed-keyword 163 org-element-deadline-keyword 164 org-element-scheduled-keyword)) 165 "Regexp matching any planning line keyword.") 166 167 (defconst org-element-planning-line-re 168 (rx-to-string 169 `(seq line-start (0+ (any ?\s ?\t)) 170 (group (regexp ,org-element-planning-keywords-re)))) 171 "Regexp matching a planning line.") 172 173 (defconst org-element-drawer-re 174 (rx line-start (0+ (any ?\s ?\t)) 175 ":" (group (1+ (any ?- ?_ word))) ":" 176 (0+ (any ?\s ?\t)) line-end) 177 "Regexp matching opening or closing line of a drawer. 178 Drawer's name is located in match group 1.") 179 180 (defconst org-element-drawer-re-nogroup 181 (rx line-start (0+ (any ?\s ?\t)) 182 ":" (1+ (any ?- ?_ word)) ":" 183 (0+ (any ?\s ?\t)) line-end) 184 "Regexp matching opening or closing line of a drawer.") 185 186 (defconst org-element-dynamic-block-open-re 187 (rx line-start (0+ (any ?\s ?\t)) 188 "#+BEGIN:" (0+ (any ?\s ?\t)) 189 (group (1+ word)) 190 (opt 191 (1+ (any ?\s ?\t)) 192 (group (1+ nonl)))) 193 "Regexp matching the opening line of a dynamic block. 194 Dynamic block's name is located in match group 1. 195 Parameters are in match group 2.") 196 197 (defconst org-element-dynamic-block-open-re-nogroup 198 (rx line-start (0+ (any ?\s ?\t)) 199 "#+BEGIN:" (0+ (any ?\s ?\t)) word) 200 "Regexp matching the opening line of a dynamic block.") 201 202 (defconst org-element-headline-re 203 (rx line-start (1+ "*") " ") 204 "Regexp matching a headline.") 205 206 (defvar org-element-paragraph-separate nil 207 "Regexp to separate paragraphs in an Org buffer. 208 In the case of lines starting with \"#\" and \":\", this regexp 209 is not sufficient to know if point is at a paragraph ending. See 210 `org-element-paragraph-parser' for more information.") 211 212 (defvar org-element--object-regexp nil 213 "Regexp possibly matching the beginning of an object. 214 This regexp allows false positives. Dedicated parser (e.g., 215 `org-element-bold-parser') will take care of further filtering. 216 Radio links are not matched by this regexp, as they are treated 217 specially in `org-element--object-lex'.") 218 219 (defun org-element--set-regexps () 220 "Build variable syntax regexps." 221 (setq org-element-paragraph-separate 222 (concat "^\\(?:" 223 ;; Headlines, inlinetasks. 224 "\\*+ " "\\|" 225 ;; Footnote definitions. 226 "\\[fn:[-_[:word:]]+\\]" "\\|" 227 ;; Diary sexps. 228 "%%(" "\\|" 229 "[ \t]*\\(?:" 230 ;; Empty lines. 231 "$" "\\|" 232 ;; Tables (any type). 233 "|" "\\|" 234 "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|" 235 ;; Comments, keyword-like or block-like constructs. 236 ;; Blocks and keywords with dual values need to be 237 ;; double-checked. 238 "#\\(?: \\|$\\|\\+\\(?:" 239 "BEGIN_\\S-+" "\\|" 240 "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)" 241 "\\|" 242 ;; Drawers (any type) and fixed-width areas. Drawers 243 ;; need to be double-checked. 244 ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|" 245 ;; Horizontal rules. 246 "-\\{5,\\}[ \t]*$" "\\|" 247 ;; LaTeX environments. 248 "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|" 249 ;; Clock lines. 250 org-element-clock-line-re "\\|" 251 ;; Lists. 252 (let ((term (pcase org-plain-list-ordered-item-terminator 253 (?\) ")") (?. "\\.") (_ "[.)]"))) 254 (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) 255 (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" 256 "\\(?:[ \t]\\|$\\)")) 257 "\\)\\)") 258 org-element--object-regexp 259 (mapconcat #'identity 260 (let ((link-types (regexp-opt (org-link-types)))) 261 (list 262 ;; Sub/superscript. 263 "\\(?:[_^][-{(*+.,[:alnum:]]\\)" 264 ;; Bold, code, italic, strike-through, underline 265 ;; and verbatim. 266 (rx (or "*" "~" "=" "+" "_" "/") (not space)) 267 ;; Plain links. 268 (concat "\\<" link-types ":") 269 ;; Objects starting with "[": citations, 270 ;; footnote reference, statistics cookie, 271 ;; timestamp (inactive) and regular link. 272 (format "\\[\\(?:%s\\)" 273 (mapconcat 274 #'identity 275 (list "cite[:/]" 276 "fn:" 277 "\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)" 278 "\\[") 279 "\\|")) 280 ;; Objects starting with "@": export snippets. 281 "@@" 282 ;; Objects starting with "{": macro. 283 "{{{" 284 ;; Objects starting with "<" : timestamp 285 ;; (active, diary), target, radio target and 286 ;; angular links. 287 (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)") 288 ;; Objects starting with "$": latex fragment. 289 "\\$" 290 ;; Objects starting with "\": line break, 291 ;; entity, latex fragment. 292 "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)" 293 ;; Objects starting with raw text: inline Babel 294 ;; source block, inline Babel call. 295 "\\(?:call\\|src\\)_")) 296 "\\|"))) 297 298 (org-element--set-regexps) 299 300 ;;;###autoload 301 (defun org-element-update-syntax () 302 "Update parser internals." 303 (interactive) 304 (org-element--set-regexps) 305 (org-element-cache-reset 'all)) 306 307 (defconst org-element-all-elements 308 '(babel-call center-block clock comment comment-block diary-sexp drawer 309 dynamic-block example-block export-block fixed-width 310 footnote-definition headline horizontal-rule inlinetask item 311 keyword latex-environment node-property paragraph plain-list 312 planning property-drawer quote-block section 313 special-block src-block table table-row verse-block) 314 "Complete list of element types.") 315 316 (defconst org-element-greater-elements 317 '(center-block drawer dynamic-block footnote-definition headline inlinetask 318 item plain-list property-drawer quote-block section 319 special-block table org-data) 320 "List of recursive element types aka Greater Elements.") 321 322 (defconst org-element-all-objects 323 '(bold citation citation-reference code entity export-snippet 324 footnote-reference inline-babel-call inline-src-block italic line-break 325 latex-fragment link macro radio-target statistics-cookie strike-through 326 subscript superscript table-cell target timestamp underline verbatim) 327 "Complete list of object types.") 328 329 (defconst org-element-recursive-objects 330 '(bold citation footnote-reference italic link subscript radio-target 331 strike-through superscript table-cell underline) 332 "List of recursive object types.") 333 334 (defconst org-element-object-containers 335 (append org-element-recursive-objects '(paragraph table-row verse-block)) 336 "List of object or element types that can directly contain objects.") 337 338 (defconst org-element-affiliated-keywords 339 '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" 340 "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") 341 "List of affiliated keywords as strings. 342 By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") 343 are affiliated keywords and need not to be in this list.") 344 345 (defconst org-element-keyword-translation-alist 346 '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME") 347 ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME") 348 ("RESULT" . "RESULTS") ("HEADERS" . "HEADER")) 349 "Alist of usual translations for keywords. 350 The key is the old name and the value the new one. The property 351 holding their value will be named after the translated name.") 352 353 (defconst org-element-multiple-keywords '("CAPTION" "HEADER") 354 "List of affiliated keywords that can occur more than once in an element. 355 356 Their value will be consed into a list of strings, which will be 357 returned as the value of the property. 358 359 This list is checked after translations have been applied. See 360 `org-element-keyword-translation-alist'. 361 362 By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") 363 allow multiple occurrences and need not to be in this list.") 364 365 (defconst org-element-parsed-keywords '("CAPTION") 366 "List of affiliated keywords whose value can be parsed. 367 368 Their value will be stored as a secondary string: a list of 369 strings and objects. 370 371 This list is checked after translations have been applied. See 372 `org-element-keyword-translation-alist'.") 373 374 (defconst org-element--parsed-properties-alist 375 (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k))))) 376 org-element-parsed-keywords) 377 "Alist of parsed keywords and associated properties. 378 This is generated from `org-element-parsed-keywords', which 379 see.") 380 381 (defconst org-element-dual-keywords '("CAPTION" "RESULTS") 382 "List of affiliated keywords which can have a secondary value. 383 384 In Org syntax, they can be written with optional square brackets 385 before the colons. For example, RESULTS keyword can be 386 associated to a hash value with the following: 387 388 #+RESULTS[hash-string]: some-source 389 390 This list is checked after translations have been applied. See 391 `org-element-keyword-translation-alist'.") 392 393 (defconst org-element--affiliated-re 394 (format "[ \t]*#\\+\\(?:%s\\):[ \t]*" 395 (concat 396 ;; Dual affiliated keywords. 397 (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?" 398 (regexp-opt org-element-dual-keywords)) 399 "\\|" 400 ;; Regular affiliated keywords. 401 (format "\\(?1:%s\\)" 402 (regexp-opt 403 (cl-remove-if 404 (lambda (k) (member k org-element-dual-keywords)) 405 org-element-affiliated-keywords))) 406 "\\|" 407 ;; Export attributes. 408 "\\(?1:ATTR_[-_A-Za-z0-9]+\\)")) 409 "Regexp matching any affiliated keyword. 410 411 Keyword name is put in match group 1. Moreover, if keyword 412 belongs to `org-element-dual-keywords', put the dual value in 413 match group 2. 414 415 Don't modify it, set `org-element-affiliated-keywords' instead.") 416 417 (defconst org-element-object-restrictions 418 (let* ((minimal-set '(bold code entity italic latex-fragment strike-through 419 subscript superscript underline verbatim)) 420 (standard-set 421 (remq 'citation-reference (remq 'table-cell org-element-all-objects))) 422 (standard-set-no-line-break (remq 'line-break standard-set)) 423 (standard-set-for-citations (seq-difference 424 standard-set-no-line-break 425 '( citation citation-reference 426 footnote-reference link)))) 427 `((bold ,@standard-set) 428 (citation citation-reference) 429 (citation-reference ,@standard-set-for-citations) 430 (footnote-reference ,@standard-set) 431 (headline ,@standard-set-no-line-break) 432 (inlinetask ,@standard-set-no-line-break) 433 (italic ,@standard-set) 434 (item ,@standard-set-no-line-break) 435 (keyword ,@(remq 'footnote-reference standard-set)) 436 ;; Ignore all links in a link description. Also ignore 437 ;; radio-targets and line breaks. 438 (link export-snippet inline-babel-call inline-src-block macro 439 statistics-cookie ,@minimal-set) 440 (paragraph ,@standard-set) 441 ;; Remove any variable object from radio target as it would 442 ;; prevent it from being properly recognized. 443 (radio-target ,@minimal-set) 444 (strike-through ,@standard-set) 445 (subscript ,@standard-set) 446 (superscript ,@standard-set) 447 ;; Ignore inline babel call and inline source block as formulas 448 ;; are possible. Also ignore line breaks and statistics 449 ;; cookies. 450 (table-cell citation export-snippet footnote-reference link macro 451 radio-target target timestamp ,@minimal-set) 452 (table-row table-cell) 453 (underline ,@standard-set) 454 (verse-block ,@standard-set))) 455 "Alist of objects restrictions. 456 457 key is an element or object type containing objects and value is 458 a list of types that can be contained within an element or object 459 of such type. 460 461 This alist also applies to secondary string. For example, an 462 `headline' type element doesn't directly contain objects, but 463 still has an entry since one of its properties (`:title') does.") 464 465 (defconst org-element-secondary-value-alist 466 '((citation :prefix :suffix) 467 (headline :title) 468 (inlinetask :title) 469 (item :tag) 470 (citation-reference :prefix :suffix)) 471 "Alist between element types and locations of secondary values.") 472 473 (defconst org-element--pair-round-table 474 (let ((table (make-char-table 'syntax-table '(2)))) 475 (modify-syntax-entry ?\( "()" table) 476 (modify-syntax-entry ?\) ")(" table) 477 table) 478 "Table used internally to pair only round brackets.") 479 480 (defconst org-element--pair-square-table 481 (let ((table (make-char-table 'syntax-table '(2)))) 482 (modify-syntax-entry ?\[ "(]" table) 483 (modify-syntax-entry ?\] ")[" table) 484 table) 485 "Table used internally to pair only square brackets.") 486 487 (defconst org-element--pair-curly-table 488 (let ((table (make-char-table 'syntax-table '(2)))) 489 (modify-syntax-entry ?\{ "(}" table) 490 (modify-syntax-entry ?\} "){" table) 491 table) 492 "Table used internally to pair only curly brackets.") 493 494 (defun org-element--parse-paired-brackets (char) 495 "Parse paired brackets at point. 496 CHAR is the opening bracket to consider, as a character. Return 497 contents between brackets, as a string, or nil. Also move point 498 past the brackets." 499 (when (eq char (char-after)) 500 (let ((syntax-table (pcase char 501 (?\{ org-element--pair-curly-table) 502 (?\[ org-element--pair-square-table) 503 (?\( org-element--pair-round-table) 504 (_ nil))) 505 (pos (point))) 506 (when syntax-table 507 (with-syntax-table syntax-table 508 (let ((end (ignore-errors (scan-lists pos 1 0)))) 509 (when end 510 (goto-char end) 511 (buffer-substring-no-properties (1+ pos) (1- end))))))))) 512 513 (defconst org-element--cache-variables 514 '( org-element--cache org-element--cache-size 515 org-element--headline-cache org-element--headline-cache-size 516 org-element--cache-hash-left org-element--cache-hash-right 517 org-element--cache-sync-requests org-element--cache-sync-timer 518 org-element--cache-sync-keys-value org-element--cache-change-tic 519 org-element--cache-last-buffer-size 520 org-element--cache-diagnostics-ring 521 org-element--cache-diagnostics-ring-size 522 org-element--cache-gapless 523 org-element--cache-change-warning) 524 "List of variable symbols holding cache state.") 525 526 (defconst org-element-ignored-local-variables 527 `( org-font-lock-keywords 528 ,@org-element--cache-variables) 529 "List of variables not copied through upon Org buffer duplication. 530 Export process and parsing in `org-element-parse-secondary-string' 531 takes place on a copy of the original buffer. When this copy is 532 created, all Org related local variables not in this list are copied 533 to the new buffer. Variables with an unreadable value are also 534 ignored.") 535 536 (cl-defun org-element--generate-copy-script (buffer 537 &key 538 copy-unreadable 539 drop-visibility 540 drop-narrowing 541 drop-contents 542 drop-locals) 543 "Generate a function duplicating BUFFER. 544 545 The copy will preserve local variables, visibility, contents and 546 narrowing of the original buffer. If a region was active in 547 BUFFER, contents will be narrowed to that region instead. 548 549 When optional key COPY-UNREADABLE is non-nil, do not ensure that all 550 the copied local variables will be readable in another Emacs session. 551 552 When optional keys DROP-VISIBILITY, DROP-NARROWING, DROP-CONTENTS, or 553 DROP-LOCALS are non-nil, do not preserve visibility, narrowing, 554 contents, or local variables correspondingly. 555 556 The resulting function can be evaluated at a later time, from 557 another buffer, effectively cloning the original buffer there. 558 559 The function assumes BUFFER's major mode is `org-mode'." 560 (declare-function org-fold-core--update-buffer-folds "org-fold-core" ()) 561 (require 'org-fold-core) 562 (with-current-buffer buffer 563 (let ((str (unless drop-contents (org-with-wide-buffer (buffer-string)))) 564 (narrowing 565 (unless drop-narrowing 566 (if (org-region-active-p) 567 (list (region-beginning) (region-end)) 568 (list (point-min) (point-max))))) 569 (pos (point)) 570 (varvals 571 (unless drop-locals 572 (let ((varvals nil)) 573 (dolist (entry (buffer-local-variables (buffer-base-buffer))) 574 (when (consp entry) 575 (let ((var (car entry)) 576 (val (cdr entry))) 577 (and (not (memq var org-element-ignored-local-variables)) 578 (or (memq var 579 '(default-directory 580 ;; Required to convert file 581 ;; links in the #+INCLUDEd 582 ;; files. See 583 ;; `org-export--prepare-file-contents'. 584 buffer-file-name 585 buffer-file-coding-system 586 ;; Needed to preserve folding state 587 char-property-alias-alist)) 588 (string-match-p "^\\(org-\\|orgtbl-\\)" 589 (symbol-name var))) 590 ;; Skip unreadable values, as they cannot be 591 ;; sent to external process. 592 (or copy-unreadable (not val) 593 (ignore-errors (read (format "%S" val)))) 594 (push (cons var val) varvals))))) 595 varvals))) 596 (ols 597 (unless drop-visibility 598 (let (ov-set) 599 (dolist (ov (overlays-in (point-min) (point-max))) 600 (let ((invis-prop (overlay-get ov 'invisible))) 601 (when invis-prop 602 (push (list (overlay-start ov) (overlay-end ov) 603 (overlay-properties ov)) 604 ov-set)))) 605 ov-set)))) 606 (lambda () 607 (let ((inhibit-modification-hooks t)) 608 ;; Set major mode. Ignore `org-mode-hook' and other hooks as 609 ;; they have been run already in BUFFER. 610 (unless (eq major-mode 'org-mode) 611 (delay-mode-hooks 612 (let ((org-inhibit-startup t)) (org-mode)))) 613 ;; Copy specific buffer local variables. 614 (pcase-dolist (`(,var . ,val) varvals) 615 (set (make-local-variable var) val)) 616 ;; Whole buffer contents when requested. 617 (when str 618 (let ((inhibit-read-only t)) 619 (erase-buffer) (insert str))) 620 ;; Make org-element-cache not complain about changed buffer 621 ;; state. 622 (org-element-cache-reset nil 'no-persistence) 623 ;; Narrowing. 624 (when narrowing 625 (apply #'narrow-to-region narrowing)) 626 ;; Current position of point. 627 (goto-char pos) 628 ;; Overlays with invisible property. 629 (pcase-dolist (`(,start ,end ,props) ols) 630 (let ((ov (make-overlay start end))) 631 (while props 632 (overlay-put ov (pop props) (pop props))))) 633 ;; Text property folds. 634 (unless drop-visibility (org-fold-core--update-buffer-folds)) 635 ;; Never write the buffer copy to disk, despite 636 ;; `buffer-file-name' not being nil. 637 (setq write-contents-functions (list (lambda (&rest _) t)))))))) 638 639 (cl-defun org-element-copy-buffer (&key to-buffer drop-visibility 640 drop-narrowing drop-contents 641 drop-locals) 642 "Return a copy of the current buffer. 643 The copy preserves Org buffer-local variables, visibility and 644 narrowing. 645 646 IMPORTANT: The buffer copy may also have variable `buffer-file-name' 647 copied. 648 649 To prevent Emacs overwriting the original buffer file, 650 `write-contents-functions' is set to \\='(always). Do not alter this 651 variable and do not do anything that might alter it (like calling a 652 major mode) to prevent data corruption. Also, do note that Emacs may 653 jump into the created buffer if the original file buffer is closed and 654 then re-opened. Making edits in the buffer copy may also trigger 655 Emacs save dialog. Prefer using `org-element-with-buffer-copy' macro 656 when possible. 657 658 When optional key TO-BUFFER is non-nil, copy into BUFFER. 659 660 Optional keys DROP-VISIBILITY, DROP-NARROWING, DROP-CONTENTS, and 661 DROP-LOCALS are passed to `org-element--generate-copy-script'." 662 (let ((copy-buffer-fun (org-element--generate-copy-script 663 (current-buffer) 664 :copy-unreadable 'do-not-check 665 :drop-visibility drop-visibility 666 :drop-narrowing drop-narrowing 667 :drop-contents drop-contents 668 :drop-locals drop-locals)) 669 (new-buf (or to-buffer (generate-new-buffer (buffer-name))))) 670 (with-current-buffer new-buf 671 (funcall copy-buffer-fun) 672 (set-buffer-modified-p nil)) 673 new-buf)) 674 675 (cl-defmacro org-element-with-buffer-copy ( &rest body 676 &key to-buffer drop-visibility 677 drop-narrowing drop-contents 678 drop-locals 679 &allow-other-keys) 680 "Apply BODY in a copy of the current buffer. 681 The copy preserves local variables, visibility and contents of 682 the original buffer. Point is at the beginning of the buffer 683 when BODY is applied. 684 685 Optional keys can modify what is being copied and the generated buffer 686 copy. TO-BUFFER, DROP-VISIBILITY, DROP-NARROWING, DROP-CONTENTS, and 687 DROP-LOCALS are passed as arguments to `org-element-copy-buffer'." 688 (declare (debug t)) 689 ;; Drop keyword arguments from BODY. 690 (while (keywordp (car body)) (pop body) (pop body)) 691 (org-with-gensyms (buf-copy) 692 `(let ((,buf-copy (org-element-copy-buffer 693 :to-buffer ,to-buffer 694 :drop-visibility ,drop-visibility 695 :drop-narrowing ,drop-narrowing 696 :drop-contents ,drop-contents 697 :drop-locals ,drop-locals))) 698 (unwind-protect 699 (with-current-buffer ,buf-copy 700 (goto-char (point-min)) 701 (prog1 702 (progn ,@body) 703 ;; `org-element-copy-buffer' carried the value of 704 ;; `buffer-file-name' from the original buffer. When not 705 ;; killed, the new buffer copy may become a target of 706 ;; `find-file'. Prevent this. 707 (setq buffer-file-name nil))) 708 (and (buffer-live-p ,buf-copy) 709 ;; Kill copy without confirmation. 710 (progn (with-current-buffer ,buf-copy 711 (restore-buffer-modified-p nil)) 712 (unless ,to-buffer 713 (kill-buffer ,buf-copy)))))))) 714 715 716 ;;; Accessors and Setters 717 ;; 718 ;; Provide four accessors: `org-element-type', `org-element-property' 719 ;; `org-element-contents' and `org-element-restriction'. 720 ;; 721 ;; Setter functions allow modification of elements by side effect. 722 ;; There is `org-element-put-property', `org-element-set-contents'. 723 ;; These low-level functions are useful to build a parse tree. 724 ;; 725 ;; `org-element-adopt', `org-element-set', `org-element-extract' and 726 ;; `org-element-insert-before' are high-level functions useful to 727 ;; modify a parse tree. 728 ;; 729 ;; `org-element-secondary-p' is a predicate used to know if a given 730 ;; object belongs to a secondary string. `org-element-class' tells if 731 ;; some parsed data is an element or an object, handling pseudo 732 ;; elements and objects. `org-element-copy' returns an element or 733 ;; object, stripping its parent property and resolving deferred values 734 ;; in the process. 735 736 (require 'org-element-ast) 737 738 (defsubst org-element-restriction (element) 739 "Return restriction associated to ELEMENT. 740 ELEMENT can be an element, an object or a symbol representing an 741 element or object type." 742 (cdr (assq (if (symbolp element) element (org-element-type element)) 743 org-element-object-restrictions))) 744 745 (defsubst org-element-class (datum &optional parent) 746 "Return class for ELEMENT, as a symbol. 747 Class is either `element' or `object'. Optional argument PARENT 748 is the element or object containing DATUM. It defaults to the 749 value of DATUM `:parent' property." 750 (let ((type (org-element-type datum t)) 751 (parent (or parent (org-element-parent datum)))) 752 (cond 753 ;; Trivial cases. 754 ((memq type org-element-all-objects) 'object) 755 ((memq type org-element-all-elements) 'element) 756 ;; Special cases. 757 ((eq type 'org-data) 'element) 758 ((eq type 'plain-text) 'object) 759 ((eq type 'anonymous) 'object) 760 ((not type) nil) 761 ;; Pseudo object or elements. Make a guess about its class. 762 ;; Basically a pseudo object is contained within another object, 763 ;; a secondary string or a container element. 764 ((not parent) 'element) 765 (t 766 (let ((parent-type (org-element-type parent t))) 767 (cond ((eq 'anonymous parent-type) 'object) 768 ((memq parent-type org-element-object-containers) 'object) 769 ((org-element-secondary-p datum) 'object) 770 (t 'element))))))) 771 772 (defsubst org-element-parent-element (object) 773 "Return first element containing OBJECT or nil. 774 OBJECT is the object to consider." 775 (org-element-lineage object org-element-all-elements)) 776 777 (defsubst org-element-begin (node) 778 "Get `:begin' property of NODE." 779 (org-element-property :begin node)) 780 781 (gv-define-setter org-element-begin (value node) 782 `(org-element-put-property ,node :begin ,value)) 783 784 (defsubst org-element-end (node) 785 "Get `:end' property of NODE." 786 (org-element-property :end node)) 787 788 (gv-define-setter org-element-end (value node) 789 `(org-element-put-property ,node :end ,value)) 790 791 (defsubst org-element-contents-begin (node) 792 "Get `:contents-begin' property of NODE." 793 (org-element-property :contents-begin node)) 794 795 (gv-define-setter org-element-contents-begin (value node) 796 `(org-element-put-property ,node :contents-begin ,value)) 797 798 (defsubst org-element-contents-end (node) 799 "Get `:contents-end' property of NODE." 800 (org-element-property :contents-end node)) 801 802 (gv-define-setter org-element-contents-end (value node) 803 `(org-element-put-property ,node :contents-end ,value)) 804 805 (defsubst org-element-post-affiliated (node) 806 "Get `:post-affiliated' property of NODE." 807 (org-element-property :post-affiliated node)) 808 809 (gv-define-setter org-element-post-affiliated (value node) 810 `(org-element-put-property ,node :post-affiliated ,value)) 811 812 (defsubst org-element-post-blank (node) 813 "Get `:post-blank' property of NODE." 814 (org-element-property :post-blank node)) 815 816 (gv-define-setter org-element-post-blank (value node) 817 `(org-element-put-property ,node :post-blank ,value)) 818 819 (defconst org-element--cache-element-properties 820 '(:cached 821 :org-element--cache-sync-key 822 :buffer) 823 "List of element properties used internally by cache.") 824 825 (defvar org-element--string-cache (make-hash-table :test #'equal) 826 "Hash table holding tag strings and todo keyword objects. 827 We use shared string storage to reduce memory footprint of the syntax 828 tree.") 829 830 (defsubst org-element--get-cached-string (string) 831 "Return cached object equal to STRING. 832 Return nil if STRING is nil." 833 (when string 834 (or (gethash string org-element--string-cache) 835 (puthash string string org-element--string-cache)))) 836 837 (defun org-element--substring (element beg-offset end-offset) 838 "Get substring inside ELEMENT according to BEG-OFFSET and END-OFFSET." 839 (with-current-buffer (org-element-property :buffer element) 840 (org-with-wide-buffer 841 (let ((beg (org-element-begin element))) 842 (buffer-substring-no-properties 843 (+ beg beg-offset) (+ beg end-offset)))))) 844 845 (defun org-element--unescape-substring (element beg-offset end-offset) 846 "Call `org-element--substring' and unescape the result. 847 See `org-element--substring' for the meaning of ELEMENT, BEG-OFFSET, 848 and END-OFFSET." 849 (org-unescape-code-in-string 850 (org-element--substring element beg-offset end-offset))) 851 852 853 ;;; Greater elements 854 ;; 855 ;; For each greater element type, we define a parser and an 856 ;; interpreter. 857 ;; 858 ;; A parser returns the element or object as the list described above. 859 ;; Most of them accepts no argument. Though, exceptions exist. Hence 860 ;; every element containing a secondary string (see 861 ;; `org-element-secondary-value-alist') will accept an optional 862 ;; argument to toggle parsing of these secondary strings. Moreover, 863 ;; `item' parser requires current list's structure as its first 864 ;; element. 865 ;; 866 ;; An interpreter accepts two arguments: the list representation of 867 ;; the element or object, and its contents. The latter may be nil, 868 ;; depending on the element or object considered. It returns the 869 ;; appropriate Org syntax, as a string. 870 ;; 871 ;; Parsing functions must follow the naming convention: 872 ;; org-element-TYPE-parser, where TYPE is greater element's type, as 873 ;; defined in `org-element-greater-elements'. 874 ;; 875 ;; Similarly, interpreting functions must follow the naming 876 ;; convention: org-element-TYPE-interpreter. 877 ;; 878 ;; With the exception of `headline' and `item' types, greater elements 879 ;; cannot contain other greater elements of their own type. 880 ;; 881 ;; Beside implementing a parser and an interpreter, adding a new 882 ;; greater element requires tweaking `org-element--current-element'. 883 ;; Moreover, the newly defined type must be added to both 884 ;; `org-element-all-elements' and `org-element-greater-elements'. 885 ;; 886 ;; When adding or modifying the parser, please keep in mind the 887 ;; following rules. They are important to keep parser performance 888 ;; optimal. 889 ;; 890 ;; 1. When you can use `looking-at-p' or `string-match-p' instead of 891 ;; `looking-at' or `string-match' and keep match data unmodified, 892 ;; do it. 893 ;; 2. When regexps can be grouped together, avoiding multiple regexp 894 ;; match calls, they should be grouped. 895 ;; 3. When `save-match-data' can be avoided, avoid it. 896 ;; 4. When simpler regexps can be used for analysis, use the simpler 897 ;; regexps. 898 ;; 5. When regexps can be calculated in advance, not dynamically, they 899 ;; should be calculated in advance. 900 ;; 6 Note that it is not an obligation of a given function to preserve 901 ;; match data - `save-match-data' is costly and must be arranged by 902 ;; the caller if necessary. 903 ;; 904 ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63225 905 906 ;;;; Center Block 907 908 (defun org-element-center-block-parser (limit affiliated) 909 "Parse a center block. 910 911 LIMIT bounds the search. AFFILIATED is a list of which CAR is 912 the buffer position at the beginning of the first affiliated 913 keyword and CDR is a plist of affiliated keywords along with 914 their value. 915 916 Return a new syntax node of `center-block' type containing `:begin', 917 `:end', `:contents-begin', `:contents-end', `:post-blank' and 918 `:post-affiliated' properties. 919 920 Assume point is at the beginning of the block." 921 (let ((case-fold-search t)) 922 (if (not (save-excursion 923 (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t))) 924 ;; Incomplete block: parse it as a paragraph. 925 (org-element-paragraph-parser limit affiliated) 926 (let ((block-end-line (match-beginning 0))) 927 (let* ((begin (car affiliated)) 928 (post-affiliated (point)) 929 ;; Empty blocks have no contents. 930 (contents-begin (progn (forward-line) 931 (and (< (point) block-end-line) 932 (point)))) 933 (contents-end (and contents-begin block-end-line)) 934 (pos-before-blank (progn (goto-char block-end-line) 935 (forward-line) 936 (point))) 937 (end (save-excursion 938 (skip-chars-forward " \r\t\n" limit) 939 (if (eobp) (point) (line-beginning-position))))) 940 (org-element-create 941 'center-block 942 (nconc 943 (list :begin begin 944 :end end 945 :contents-begin contents-begin 946 :contents-end contents-end 947 :post-blank (count-lines pos-before-blank end) 948 :post-affiliated post-affiliated) 949 (cdr affiliated)))))))) 950 951 (defun org-element-center-block-interpreter (_ contents) 952 "Interpret a center-block element as Org syntax. 953 CONTENTS is the contents of the element." 954 (format "#+begin_center\n%s#+end_center" contents)) 955 956 957 ;;;; Drawer 958 959 (defun org-element-drawer-parser (limit affiliated) 960 "Parse a drawer. 961 962 LIMIT bounds the search. AFFILIATED is a list of which CAR is 963 the buffer position at the beginning of the first affiliated 964 keyword and CDR is a plist of affiliated keywords along with 965 their value. 966 967 Return a new syntax node of `drawer' type containing `:drawer-name', 968 `:begin', `:end', `:contents-begin', `:contents-end', `:post-blank' 969 and `:post-affiliated' properties. 970 971 Assume point is at beginning of drawer." 972 (let ((case-fold-search t)) 973 (if (not (save-excursion 974 (goto-char (min limit (line-end-position))) 975 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) 976 ;; Incomplete drawer: parse it as a paragraph. 977 (org-element-paragraph-parser limit affiliated) 978 (save-excursion 979 (let* ((drawer-end-line (match-beginning 0)) 980 (name 981 (progn 982 (looking-at org-element-drawer-re) 983 (org-element--get-cached-string (match-string-no-properties 1)))) 984 (begin (car affiliated)) 985 (post-affiliated (point)) 986 ;; Empty drawers have no contents. 987 (contents-begin (progn (forward-line) 988 (and (< (point) drawer-end-line) 989 (point)))) 990 (contents-end (and contents-begin drawer-end-line)) 991 (pos-before-blank (progn (goto-char drawer-end-line) 992 (forward-line) 993 (point))) 994 (end (progn (skip-chars-forward " \r\t\n" limit) 995 (if (eobp) (point) (line-beginning-position))))) 996 (org-element-create 997 'drawer 998 (nconc 999 (list :begin begin 1000 :end end 1001 :drawer-name name 1002 :contents-begin contents-begin 1003 :contents-end contents-end 1004 :post-blank (count-lines pos-before-blank end) 1005 :post-affiliated post-affiliated) 1006 (cdr affiliated)))))))) 1007 1008 (defun org-element-drawer-interpreter (drawer contents) 1009 "Interpret DRAWER element as Org syntax. 1010 CONTENTS is the contents of the element." 1011 (format ":%s:\n%s:END:" 1012 (org-element-property :drawer-name drawer) 1013 contents)) 1014 1015 1016 ;;;; Dynamic Block 1017 1018 (defun org-element-dynamic-block-parser (limit affiliated) 1019 "Parse a dynamic block. 1020 1021 LIMIT bounds the search. AFFILIATED is a list of which CAR is 1022 the buffer position at the beginning of the first affiliated 1023 keyword and CDR is a plist of affiliated keywords along with 1024 their value. 1025 1026 Return a new syntax node of `dynamic-block' type containing 1027 `:block-name', `:begin', `:end', `:contents-begin', `:contents-end', 1028 `:arguments', `:post-blank' and `:post-affiliated' properties. 1029 1030 Assume point is at beginning of dynamic block." 1031 (let ((case-fold-search t)) 1032 (if (not (save-excursion 1033 (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) 1034 ;; Incomplete block: parse it as a paragraph. 1035 (org-element-paragraph-parser limit affiliated) 1036 (let ((block-end-line (match-beginning 0))) 1037 (save-excursion 1038 (let* ((name (progn 1039 (looking-at org-element-dynamic-block-open-re) 1040 (org-element--get-cached-string (match-string-no-properties 1)))) 1041 (arguments (match-string-no-properties 2)) 1042 (begin (car affiliated)) 1043 (post-affiliated (point)) 1044 ;; Empty blocks have no contents. 1045 (contents-begin (progn (forward-line) 1046 (and (< (point) block-end-line) 1047 (point)))) 1048 (contents-end (and contents-begin block-end-line)) 1049 (pos-before-blank (progn (goto-char block-end-line) 1050 (forward-line) 1051 (point))) 1052 (end (progn (skip-chars-forward " \r\t\n" limit) 1053 (if (eobp) (point) (line-beginning-position))))) 1054 (org-element-create 1055 'dynamic-block 1056 (nconc 1057 (list :begin begin 1058 :end end 1059 :block-name name 1060 :arguments arguments 1061 :contents-begin contents-begin 1062 :contents-end contents-end 1063 :post-blank (count-lines pos-before-blank end) 1064 :post-affiliated post-affiliated) 1065 (cdr affiliated))))))))) 1066 1067 (defun org-element-dynamic-block-interpreter (dynamic-block contents) 1068 "Interpret DYNAMIC-BLOCK element as Org syntax. 1069 CONTENTS is the contents of the element." 1070 (format "#+begin: %s%s\n%s#+end:" 1071 (org-element-property :block-name dynamic-block) 1072 (let ((args (org-element-property :arguments dynamic-block))) 1073 (if args (concat " " args) "")) 1074 contents)) 1075 1076 1077 ;;;; Footnote Definition 1078 1079 (defconst org-element--footnote-separator 1080 (concat org-element-headline-re "\\|" 1081 org-footnote-definition-re "\\|" 1082 "^\\([ \t]*\n\\)\\{2,\\}") 1083 "Regexp used as a footnote definition separator.") 1084 1085 (defun org-element-footnote-definition-parser (limit affiliated) 1086 "Parse a footnote definition. 1087 1088 LIMIT bounds the search. AFFILIATED is a list of which CAR is 1089 the buffer position at the beginning of the first affiliated 1090 keyword and CDR is a plist of affiliated keywords along with 1091 their value. 1092 1093 Return a new syntax node of `footnote-definition' type containing 1094 `:label', `:begin' `:end', `:contents-begin', `:contents-end', 1095 `:pre-blank',`:post-blank' and `:post-affiliated' properties. 1096 1097 Assume point is at the beginning of the footnote definition." 1098 (save-excursion 1099 (let* ((label (progn (looking-at org-footnote-definition-re) 1100 (org-element--get-cached-string 1101 (match-string-no-properties 1)))) 1102 (begin (car affiliated)) 1103 (post-affiliated (point)) 1104 (end 1105 (save-excursion 1106 (end-of-line) 1107 (cond 1108 ((not 1109 (re-search-forward org-element--footnote-separator limit t)) 1110 limit) 1111 ((eq ?\[ (char-after (match-beginning 0))) 1112 ;; At a new footnote definition, make sure we end 1113 ;; before any affiliated keyword above. 1114 (forward-line -1) 1115 (while (and (> (point) post-affiliated) 1116 (looking-at-p org-element--affiliated-re)) 1117 (forward-line -1)) 1118 (line-beginning-position 2)) 1119 ((eq ?* (char-after (match-beginning 0))) (match-beginning 0)) 1120 (t (skip-chars-forward " \r\t\n" limit) 1121 (if (= limit (point)) limit (line-beginning-position)))))) 1122 (pre-blank 0) 1123 (contents-begin 1124 (progn (search-forward "]") 1125 (skip-chars-forward " \r\t\n" end) 1126 (cond ((= (point) end) nil) 1127 ((= (line-beginning-position) post-affiliated) (point)) 1128 (t 1129 (setq pre-blank 1130 (count-lines (line-beginning-position) begin)) 1131 (line-beginning-position))))) 1132 (contents-end 1133 (progn (goto-char end) 1134 (skip-chars-backward " \r\t\n") 1135 (line-beginning-position 2)))) 1136 (org-element-create 1137 'footnote-definition 1138 (nconc 1139 (list :label label 1140 :begin begin 1141 :end end 1142 :contents-begin contents-begin 1143 :contents-end (and contents-begin contents-end) 1144 :pre-blank pre-blank 1145 :post-blank (count-lines contents-end end) 1146 :post-affiliated post-affiliated) 1147 (cdr affiliated)))))) 1148 1149 (defun org-element-footnote-definition-interpreter (footnote-definition contents) 1150 "Interpret FOOTNOTE-DEFINITION element as Org syntax. 1151 CONTENTS is the contents of the footnote-definition." 1152 (let ((pre-blank 1153 (min (or (org-element-property :pre-blank footnote-definition) 1154 ;; 0 is specific to paragraphs at the beginning of 1155 ;; the footnote definition, so we use 1 as 1156 ;; a fall-back value, which is more universal. 1157 1) 1158 ;; Footnote ends after more than two consecutive empty 1159 ;; lines: limit ourselves to 2 newline characters. 1160 2))) 1161 (concat (format "[fn:%s]" (org-element-property :label footnote-definition)) 1162 (if (= pre-blank 0) (concat " " (org-trim contents)) 1163 (concat (make-string pre-blank ?\n) contents))))) 1164 1165 ;;;; Headline 1166 1167 (defun org-element--get-node-properties (&optional at-point-p? parent) 1168 "Return node properties for headline or property drawer at point. 1169 The property values a deferred relative to PARENT element. 1170 Upcase property names. It avoids confusion between properties 1171 obtained through property drawer and default properties from the 1172 parser (e.g. `:end' and :END:). Return value is a plist. 1173 1174 When AT-POINT-P? is nil, assume that point as at a headline. Otherwise 1175 parse properties for property drawer at point." 1176 (save-excursion 1177 (let ((begin (or (org-element-begin parent) (point)))) 1178 (unless at-point-p? 1179 (forward-line) 1180 (when (looking-at-p org-element-planning-line-re) (forward-line))) 1181 (when (looking-at org-property-drawer-re) 1182 (forward-line) 1183 (let ((end (match-end 0)) properties) 1184 (while (< (line-end-position) end) 1185 (looking-at org-property-re) 1186 (let* ((property-name (concat ":" (upcase (match-string 2)))) 1187 (property-name-symbol (intern property-name)) 1188 (property-value 1189 (org-element-deferred-create 1190 t #'org-element--substring 1191 (- (match-beginning 3) begin) 1192 (- (match-end 3) begin)))) 1193 (cond 1194 ((and (plist-member properties property-name-symbol) 1195 (string-match-p "\\+$" property-name)) 1196 (let ((val (plist-get properties property-name-symbol))) 1197 (if (listp val) 1198 (setq properties 1199 (plist-put properties 1200 property-name-symbol 1201 (append (plist-get properties property-name-symbol) 1202 (list property-value)))) 1203 (plist-put properties property-name-symbol (list val property-value))))) 1204 (t (setq properties (plist-put properties property-name-symbol property-value))))) 1205 (forward-line)) 1206 ;; Convert list of deferred properties into a single 1207 ;; deferred property. 1208 (let ((plist properties) val) 1209 (while plist 1210 (setq val (cadr plist)) 1211 (when (and (car-safe val) 1212 (org-element-deferred-p (car val))) 1213 (setcar 1214 (cdr plist) 1215 (org-element-deferred-create-list (cadr plist)))) 1216 (setq plist (cddr plist)))) 1217 properties))))) 1218 1219 (defun org-element--get-time-properties () 1220 "Return time properties associated to headline at point. 1221 Return value is a plist." 1222 (save-excursion 1223 (when (progn (forward-line) (looking-at-p org-element-planning-line-re)) 1224 (let ((end (line-end-position)) 1225 plist) 1226 (while (re-search-forward org-element-planning-keywords-re end t) 1227 (skip-chars-forward " \t") 1228 (let ((keyword (match-string 0)) 1229 (time (org-element-timestamp-parser))) 1230 (cond ((equal keyword org-element-scheduled-keyword) 1231 (setq plist (plist-put plist :scheduled time))) 1232 ((equal keyword org-element-deadline-keyword) 1233 (setq plist (plist-put plist :deadline time))) 1234 (t (setq plist (plist-put plist :closed time)))))) 1235 plist)))) 1236 1237 (defun org-element--headline-deferred (element) 1238 "Parse and set extra properties for ELEMENT headline in BUFFER." 1239 (with-current-buffer (org-element-property :buffer element) 1240 (org-with-wide-buffer 1241 ;; Update robust boundaries to not 1242 ;; include property drawer and planning. 1243 ;; Changes there can now invalidate the 1244 ;; properties. 1245 (org-element-put-property 1246 element :robust-begin 1247 (let ((contents-begin (org-element-contents-begin element)) 1248 (contents-end (org-element-contents-end element))) 1249 (when contents-begin 1250 (progn (goto-char contents-begin) 1251 (when (looking-at-p org-element-planning-line-re) 1252 (forward-line)) 1253 (when (looking-at org-property-drawer-re) 1254 (goto-char (match-end 0))) 1255 ;; If there is :pre-blank, we 1256 ;; need to be careful about 1257 ;; robust beginning. 1258 (max (if (< (+ 2 contents-begin) contents-end) 1259 (+ 2 contents-begin) 1260 0) 1261 (point)))))) 1262 (org-element-put-property 1263 element :robust-end 1264 (let ((contents-end (org-element-contents-end element)) 1265 (robust-begin (org-element-property :robust-begin element))) 1266 (when contents-end 1267 (when (> (- contents-end 2) robust-begin) 1268 (- contents-end 2))))) 1269 (unless (org-element-property :robust-end element) 1270 (org-element-put-property element :robust-begin nil)) 1271 (goto-char (org-element-begin element)) 1272 (setcar (cdr element) 1273 (nconc 1274 (nth 1 element) 1275 (org-element--get-time-properties))) 1276 (goto-char (org-element-begin element)) 1277 (setcar (cdr element) 1278 (nconc 1279 (nth 1 element) 1280 (org-element--get-node-properties nil element))))) 1281 ;; Return nil. 1282 nil) 1283 1284 (defun org-element--headline-raw-value (headline beg-offset end-offset) 1285 "Retrieve :raw-value in HEADLINE according to BEG-OFFSET and END-OFFSET." 1286 (org-trim (org-element--substring headline beg-offset end-offset))) 1287 1288 (defun org-element--headline-archivedp (headline) 1289 "Return t when HEADLINE is archived and nil otherwise." 1290 (if (member org-element-archive-tag 1291 (org-element-property :tags headline)) 1292 t nil)) 1293 1294 (defun org-element--headline-footnote-section-p (headline) 1295 "Return t when HEADLINE is a footnote section and nil otherwise." 1296 (and org-footnote-section 1297 (string= org-footnote-section 1298 (org-element-property :raw-value headline)))) 1299 1300 (defconst org-element--headline-comment-re 1301 (concat org-element-comment-string "\\(?: \\|$\\)") 1302 "Regexp matching comment string in a headline.") 1303 1304 (defconst org-element--headline-archivedp 1305 (org-element-deferred-create 1306 nil #'org-element--headline-archivedp) 1307 "Constant holding deferred value for headline `:archivedp' property.") 1308 1309 (defconst org-element--headline-footnote-section-p 1310 (org-element-deferred-create 1311 nil #'org-element--headline-footnote-section-p) 1312 "Constant holding deferred value for headline `:footnote-section-p' property.") 1313 1314 (defconst org-element--headline-raw-value 1315 (org-element-deferred-create-alias :raw-value) 1316 "Constant holding deferred value for headline `:raw-value' property.") 1317 1318 (defun org-element--headline-parse-title (headline raw-secondary-p) 1319 "Resolve title properties of HEADLINE for side effect. 1320 When RAW-SECONDARY-P is non-nil, headline's title will not be 1321 parsed as a secondary string, but as a plain string instead. 1322 1323 Throw `:org-element-deferred-retry' signal at the end." 1324 (with-current-buffer (org-element-property :buffer headline) 1325 (org-with-point-at (org-element-begin headline) 1326 (let* ((begin (point)) 1327 (true-level (prog1 (skip-chars-forward "*") 1328 (skip-chars-forward " \t"))) 1329 (level (org-reduced-level true-level)) 1330 (todo (and org-todo-regexp 1331 (let (case-fold-search) (looking-at (concat org-todo-regexp "\\(?: \\|$\\)"))) 1332 (progn (goto-char (match-end 0)) 1333 (skip-chars-forward " \t") 1334 (org-element--get-cached-string (match-string-no-properties 1))))) 1335 (todo-type 1336 (and todo (if (member todo org-done-keywords) 'done 'todo))) 1337 (priority (and (looking-at "\\[#.\\][ \t]*") 1338 (progn (goto-char (match-end 0)) 1339 (aref (match-string 0) 2)))) 1340 (commentedp 1341 (and (let ((case-fold-search nil)) 1342 (looking-at org-element--headline-comment-re)) 1343 (prog1 t 1344 (goto-char (match-end 0)) 1345 (skip-chars-forward " \t")))) 1346 (title-start (point)) 1347 (tags (when (re-search-forward 1348 "\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" 1349 (line-end-position) 1350 'move) 1351 (goto-char (match-beginning 0)) 1352 (mapcar #'org-element--get-cached-string 1353 (org-split-string (match-string-no-properties 1) ":")))) 1354 (title-end (point)) 1355 (raw-value 1356 (org-element-deferred-create 1357 t #'org-element--headline-raw-value 1358 (- title-start begin) (- title-end begin)))) 1359 (org-element-put-property headline :raw-value raw-value) 1360 (org-element-put-property headline :level level) 1361 (org-element-put-property headline :priority priority) 1362 (org-element-put-property headline :tags tags) 1363 (org-element-put-property headline :todo-keyword todo) 1364 (org-element-put-property headline :todo-type todo-type) 1365 (org-element-put-property 1366 headline :footnote-section-p org-element--headline-footnote-section-p) 1367 (org-element-put-property headline :archivedp org-element--headline-archivedp) 1368 (org-element-put-property headline :commentedp commentedp) 1369 (org-element-put-property 1370 headline :title 1371 (if raw-secondary-p 1372 org-element--headline-raw-value 1373 (org-element--parse-objects 1374 (progn (goto-char title-start) 1375 (skip-chars-forward " \t") 1376 (point)) 1377 (progn (goto-char title-end) 1378 (skip-chars-backward " \t") 1379 (point)) 1380 nil 1381 (org-element-restriction 1382 (org-element-type headline)) 1383 headline)))))) 1384 (throw :org-element-deferred-retry nil)) 1385 1386 (defconst org-element--headline-parse-title-raw 1387 (org-element-deferred-create 1388 t #'org-element--headline-parse-title t) 1389 "Constant holding deferred value for raw headline `:title' property.") 1390 1391 (defconst org-element--headline-parse-title-parse 1392 (org-element-deferred-create 1393 t #'org-element--headline-parse-title nil) 1394 "Constant holding deferred value for parsed headline `:title' property.") 1395 1396 (defconst org-element--headline-deferred 1397 (org-element-deferred-create 1398 t #'org-element--headline-deferred) 1399 "Constant holding deferred value for headline `:deferred' property.") 1400 1401 (defun org-element-headline-parser (&optional _ raw-secondary-p) 1402 "Parse a headline. 1403 1404 Return a new syntax node of `headline' type containing `:raw-value', 1405 `:title', `:begin', `:end', `:pre-blank', `:contents-begin' and 1406 `:contents-end', `:level', `:priority', `:tags', `:todo-keyword', 1407 `:todo-type', `:scheduled', `:deadline', `:closed', `:archivedp', 1408 `:commentedp' `:footnote-section-p', `:post-blank' and 1409 `:post-affiliated' properties. 1410 1411 The plist also contains any property set in the property drawer, 1412 with its name in upper cases and colons added at the 1413 beginning (e.g., `:CUSTOM_ID'). 1414 1415 When RAW-SECONDARY-P is non-nil, headline's title will not be 1416 parsed as a secondary string, but as a plain string instead. 1417 1418 Assume point is at beginning of the headline." 1419 (save-excursion 1420 (let* ((deferred-title-prop 1421 (if raw-secondary-p 1422 org-element--headline-parse-title-raw 1423 org-element--headline-parse-title-parse)) 1424 (begin (point)) 1425 (true-level (skip-chars-forward "*")) 1426 (end 1427 (save-excursion 1428 (if (re-search-forward (org-headline-re true-level) nil t) 1429 (line-beginning-position) 1430 (point-max)))) 1431 (contents-begin (save-excursion 1432 (forward-line) 1433 (skip-chars-forward " \r\t\n" end) 1434 (and (/= (point) end) (line-beginning-position)))) 1435 (contents-end (and contents-begin end)) 1436 (robust-begin 1437 ;; If there is :pre-blank, we 1438 ;; need to be careful about 1439 ;; robust beginning. 1440 (when contents-begin 1441 (when (< (+ 2 contents-begin) contents-end) 1442 (+ 2 contents-begin)))) 1443 (robust-end (and robust-begin end))) 1444 (org-element-create 1445 'headline 1446 (list 1447 :begin begin 1448 :end end 1449 :pre-blank 1450 (if (not contents-begin) 0 1451 (1- (count-lines begin contents-begin))) 1452 :contents-begin contents-begin 1453 :contents-end contents-end 1454 :robust-begin robust-begin 1455 :robust-end robust-end 1456 :true-level true-level 1457 :buffer (current-buffer) 1458 :raw-value deferred-title-prop 1459 :title deferred-title-prop 1460 :level deferred-title-prop 1461 :priority deferred-title-prop 1462 :tags deferred-title-prop 1463 :todo-keyword deferred-title-prop 1464 :todo-type deferred-title-prop 1465 :post-blank 1466 (if contents-end 1467 ;; Trailing blank lines in org-data, headlines, and 1468 ;; sections belong to the containing elements. 1469 0 1470 (1- (count-lines begin end))) 1471 :footnote-section-p deferred-title-prop 1472 :archivedp deferred-title-prop 1473 :commentedp deferred-title-prop 1474 :post-affiliated begin 1475 :secondary (alist-get 1476 'headline 1477 org-element-secondary-value-alist) 1478 :deferred org-element--headline-deferred))))) 1479 1480 (defun org-element-headline-interpreter (headline contents) 1481 "Interpret HEADLINE element as Org syntax. 1482 CONTENTS is the contents of the element." 1483 (let* ((level (org-element-property :level headline)) 1484 (todo (org-element-property :todo-keyword headline)) 1485 (priority (org-element-property :priority headline)) 1486 (title (org-element-interpret-data 1487 (org-element-property :title headline))) 1488 (tags (let ((tag-list (org-element-property :tags headline))) 1489 (and tag-list 1490 (format ":%s:" (mapconcat #'identity tag-list ":"))))) 1491 (commentedp (org-element-property :commentedp headline)) 1492 (pre-blank (or (org-element-property :pre-blank headline) 0)) 1493 (heading 1494 (concat (make-string (if org-odd-levels-only (1- (* level 2)) level) 1495 ?*) 1496 (and todo (concat " " todo)) 1497 (and commentedp (concat " " org-element-comment-string)) 1498 (and priority (format " [#%c]" priority)) 1499 " " 1500 (if (and org-footnote-section 1501 (org-element-property :footnote-section-p headline)) 1502 org-footnote-section 1503 title)))) 1504 (concat 1505 heading 1506 ;; Align tags. 1507 (when tags 1508 (cond 1509 ((zerop org-tags-column) (format " %s" tags)) 1510 ((< org-tags-column 0) 1511 (concat 1512 (make-string 1513 (max (- (+ org-tags-column (length heading) (length tags))) 1) 1514 ?\s) 1515 tags)) 1516 (t 1517 (concat 1518 (make-string (max (- org-tags-column (length heading)) 1) ?\s) 1519 tags)))) 1520 (make-string (1+ pre-blank) ?\n) 1521 contents))) 1522 1523 ;;;; org-data 1524 1525 (defun org-element--get-category () 1526 "Return category in current buffer." 1527 (let ((default-category 1528 (cond ((null org-category) 1529 (when (org-with-base-buffer nil 1530 buffer-file-name) 1531 (file-name-sans-extension 1532 (file-name-nondirectory 1533 (org-with-base-buffer nil 1534 buffer-file-name))))) 1535 ((symbolp org-category) (symbol-name org-category)) 1536 (t org-category))) 1537 category) 1538 ;; Search for #+CATEGORY keywords. 1539 (org-with-point-at (point-max) 1540 (while (and (not category) 1541 (re-search-backward "^[ \t]*#\\+CATEGORY:" (point-min) t)) 1542 (let ((element (org-element-at-point-no-context))) 1543 (when (org-element-type-p element 'keyword) 1544 (setq category (org-element-property :value element)))))) 1545 ;; Return. 1546 (or category default-category))) 1547 1548 (defun org-element--get-global-node-properties (data) 1549 "Set node properties associated with the whole Org buffer. 1550 Upcase property names. It avoids confusion between properties 1551 obtained through property drawer and default properties from the 1552 parser (e.g. `:end' and :END:). 1553 1554 Alter DATA by side effect." 1555 (with-current-buffer (org-element-property :buffer data) 1556 (org-with-wide-buffer 1557 (goto-char (point-min)) 1558 (org-skip-whitespace) 1559 (forward-line 0) 1560 (while (and (org-at-comment-p) (bolp)) (forward-line)) 1561 (let ((props (org-element--get-node-properties t data)) 1562 (has-category? nil)) 1563 (while props 1564 (org-element-put-property data (car props) (cadr props)) 1565 (when (eq (car props) :CATEGORY) (setq has-category? t)) 1566 (setq props (cddr props))) 1567 ;; CATEGORY not set in top-level property drawer. Go the long way. 1568 (unless has-category? 1569 (org-element-put-property data :CATEGORY (org-element--get-category))))) 1570 ;; Return nil. 1571 nil)) 1572 1573 (defconst org-element--get-global-node-properties 1574 (org-element-deferred-create 1575 t #'org-element--get-global-node-properties) 1576 "Constant holding `:deferred' property for org-data.") 1577 1578 (defvar org-element-org-data-parser--recurse nil) 1579 (defun org-element-org-data-parser (&optional _) 1580 "Parse org-data. 1581 1582 Return a new syntax node of `org-data' type containing `:begin', 1583 `:contents-begin', `:contents-end', `:end', `:post-blank', 1584 `:post-affiliated', and `:path' properties." 1585 (org-with-wide-buffer 1586 (let* ((begin 1) 1587 (contents-begin (progn 1588 (goto-char 1) 1589 (org-skip-whitespace) 1590 (forward-line 0) 1591 (point))) 1592 (end (point-max)) 1593 (contents-end end) 1594 (robust-end contents-end) 1595 (robust-begin (when (and robust-end 1596 (< (+ 2 contents-begin) end)) 1597 (or 1598 (org-with-wide-buffer 1599 (goto-char (point-min)) 1600 (org-skip-whitespace) 1601 (forward-line 0) 1602 (while (and (org-at-comment-p) (bolp)) (forward-line)) 1603 (when (looking-at org-property-drawer-re) 1604 (goto-char (match-end 0)) 1605 (min robust-end (point)))) 1606 (+ 2 contents-begin))))) 1607 (org-element-create 1608 'org-data 1609 (list :begin begin 1610 :contents-begin contents-begin 1611 :contents-end contents-end 1612 :end end 1613 :robust-begin robust-begin 1614 :robust-end robust-end 1615 ;; Trailing blank lines in org-data, headlines, and 1616 ;; sections belong to the containing elements. 1617 :post-blank 0 1618 :post-affiliated begin 1619 :path (buffer-file-name) 1620 :mode 'org-data 1621 :buffer (current-buffer) 1622 :deferred org-element--get-global-node-properties))))) 1623 1624 (defun org-element-org-data-interpreter (_ contents) 1625 "Interpret ORG-DATA element as Org syntax. 1626 CONTENTS is the contents of the element." 1627 contents) 1628 1629 ;;;; Inlinetask 1630 1631 (defun org-element-inlinetask-parser (limit &optional raw-secondary-p) 1632 "Parse an inline task. 1633 1634 Do not search past LIMIT. 1635 1636 Return a new syntax node of `inlinetask' type containing `:title', 1637 `:begin', `:end', `:pre-blank', `:contents-begin' and `:contents-end', 1638 `:level', `:priority', `:raw-value', `:tags', `:todo-keyword', 1639 `:todo-type', `:scheduled', `:deadline', `:closed', `:post-blank' and 1640 `:post-affiliated' properties. 1641 1642 The plist also contains any property set in the property drawer, 1643 with its name in upper cases and colons added at the 1644 beginning (e.g., `:CUSTOM_ID'). 1645 1646 When optional argument RAW-SECONDARY-P is non-nil, inline-task's 1647 title will not be parsed as a secondary string, but as a plain 1648 string instead. 1649 1650 Assume point is at beginning of the inline task." 1651 (save-excursion 1652 (let* ((deferred-title-prop 1653 (if raw-secondary-p 1654 org-element--headline-parse-title-raw 1655 org-element--headline-parse-title-parse)) 1656 (begin (point)) 1657 (task-end (save-excursion 1658 (forward-line 1) 1659 (and (re-search-forward org-element-headline-re limit t) 1660 (looking-at-p "[ \t]*END[ \t]*$") 1661 (line-beginning-position)))) 1662 (contents-begin (and task-end 1663 (< (point) task-end) 1664 (progn 1665 (forward-line) 1666 (skip-chars-forward " \t\n") 1667 (line-beginning-position)))) 1668 (contents-end (and contents-begin task-end)) 1669 (end (progn (when task-end (goto-char task-end)) 1670 (forward-line) 1671 (skip-chars-forward " \r\t\n" limit) 1672 (if (eobp) (point) (line-beginning-position))))) 1673 (org-element-create 1674 'inlinetask 1675 (list 1676 :begin begin 1677 :end end 1678 :pre-blank 1679 (if (not contents-begin) 0 1680 (1- (count-lines begin contents-begin))) 1681 :contents-begin contents-begin 1682 :contents-end contents-end 1683 :buffer (current-buffer) 1684 :raw-value deferred-title-prop 1685 :title deferred-title-prop 1686 :level deferred-title-prop 1687 :priority deferred-title-prop 1688 :tags deferred-title-prop 1689 :todo-keyword deferred-title-prop 1690 :todo-type deferred-title-prop 1691 :archivedp deferred-title-prop 1692 :commentedp deferred-title-prop 1693 :post-blank (1- (count-lines (or task-end begin) end)) 1694 :post-affiliated begin 1695 :secondary (alist-get 1696 'inlinetask 1697 org-element-secondary-value-alist) 1698 :deferred 1699 (and task-end org-element--headline-deferred)))))) 1700 1701 (defun org-element-inlinetask-interpreter (inlinetask contents) 1702 "Interpret INLINETASK element as Org syntax. 1703 CONTENTS is the contents of inlinetask." 1704 (let* ((level (org-element-property :level inlinetask)) 1705 (todo (org-element-property :todo-keyword inlinetask)) 1706 (priority (org-element-property :priority inlinetask)) 1707 (title (org-element-interpret-data 1708 (org-element-property :title inlinetask))) 1709 (tags (let ((tag-list (org-element-property :tags inlinetask))) 1710 (and tag-list 1711 (format ":%s:" (mapconcat 'identity tag-list ":"))))) 1712 (task (concat (make-string level ?*) 1713 (and todo (concat " " todo)) 1714 (and priority (format " [#%c]" priority)) 1715 (and title (concat " " title))))) 1716 (concat task 1717 ;; Align tags. 1718 (when tags 1719 (cond 1720 ((zerop org-tags-column) (format " %s" tags)) 1721 ((< org-tags-column 0) 1722 (concat 1723 (make-string 1724 (max (- (+ org-tags-column (length task) (length tags))) 1) 1725 ?\s) 1726 tags)) 1727 (t 1728 (concat 1729 (make-string (max (- org-tags-column (length task)) 1) ?\s) 1730 tags)))) 1731 ;; Prefer degenerate inlinetasks when there are no 1732 ;; contents. 1733 (when contents 1734 (concat "\n" 1735 contents 1736 (make-string level ?*) " end"))))) 1737 1738 1739 ;;;; Item 1740 1741 (defun org-element-item-parser (limit struct &optional raw-secondary-p) 1742 "Parse an item up to LIMIT. 1743 1744 STRUCT is the structure of the plain list. 1745 1746 Return a new syntax node of `item' type containing `:bullet', 1747 `:begin', `:end', `:contents-begin', `:contents-end', `:checkbox', 1748 `:counter', `:tag', `:structure', `:pre-blank', `:post-blank' and 1749 `:post-affiliated' properties. 1750 1751 When optional argument RAW-SECONDARY-P is non-nil, item's tag, if 1752 any, will not be parsed as a secondary string, but as a plain 1753 string instead. 1754 1755 Assume point is at the beginning of the item." 1756 (save-excursion 1757 (forward-line 0) 1758 (looking-at org-list-full-item-re) 1759 (let* ((begin (point)) 1760 (bullet (org-element--get-cached-string (match-string-no-properties 1))) 1761 (tag-begin (match-beginning 4)) 1762 (tag-end (match-end 4)) 1763 (checkbox (let ((box (match-string 3))) 1764 (cond ((equal "[ ]" box) 'off) 1765 ((equal "[X]" box) 'on) 1766 ((equal "[-]" box) 'trans)))) 1767 (end (progn (goto-char (nth 6 (assq (point) struct))) 1768 (min limit 1769 (if (bolp) (point) (line-beginning-position 2))))) 1770 (pre-blank 0) 1771 (contents-begin 1772 (progn 1773 (goto-char 1774 ;; Ignore tags in un-ordered lists: they are just 1775 ;; a part of item's body. 1776 (if (and (match-beginning 4) 1777 (string-match-p "[.)]" bullet)) 1778 (match-beginning 4) 1779 (match-end 0))) 1780 (skip-chars-forward " \r\t\n" end) 1781 (cond ((= (point) end) nil) 1782 ;; If first line isn't empty, contents really 1783 ;; start at the text after item's meta-data. 1784 ((= (line-beginning-position) begin) (point)) 1785 (t 1786 (setq pre-blank 1787 (count-lines (line-beginning-position) begin)) 1788 (line-beginning-position))))) 1789 (contents-end (and contents-begin 1790 (progn (goto-char end) 1791 (skip-chars-backward " \r\t\n") 1792 (line-beginning-position 2)))) 1793 (counter (let ((c (match-string 2))) 1794 (cond 1795 ((not c) nil) 1796 ((string-match "[A-Za-z]" c) 1797 (- (string-to-char (upcase (match-string-no-properties 0 c))) 1798 64)) 1799 ((string-match "[0-9]+" c) 1800 (string-to-number (match-string-no-properties 0 c)))))) 1801 (item 1802 (org-element-create 1803 'item 1804 (list :bullet bullet 1805 :begin begin 1806 :end end 1807 :contents-begin contents-begin 1808 :contents-end contents-end 1809 :checkbox checkbox 1810 :counter counter 1811 :structure struct 1812 :pre-blank pre-blank 1813 :post-blank (count-lines (or contents-end begin) end) 1814 :post-affiliated begin 1815 :secondary (alist-get 1816 'item 1817 org-element-secondary-value-alist))))) 1818 (org-element-put-property 1819 item :tag 1820 (let ((raw (org-list-get-tag begin struct))) 1821 (when raw 1822 (if raw-secondary-p raw 1823 (org-element--parse-objects 1824 tag-begin tag-end nil 1825 (org-element-restriction 'item) 1826 item)))))))) 1827 1828 (defun org-element-item-interpreter (item contents) 1829 "Interpret ITEM element as Org syntax. 1830 CONTENTS is the contents of the element." 1831 (let ((tag (pcase (org-element-property :tag item) 1832 (`nil nil) 1833 (tag (format "%s :: " (org-element-interpret-data tag))))) 1834 (bullet 1835 (org-list-bullet-string 1836 (cond 1837 ((not (string-match-p "[0-9a-zA-Z]" 1838 (org-element-property :bullet item))) "- ") 1839 ((eq org-plain-list-ordered-item-terminator ?\)) "1)") 1840 (t "1."))))) 1841 (concat 1842 bullet 1843 (pcase (org-element-property :counter item) 1844 (`nil nil) 1845 (counter (format "[@%d] " counter))) 1846 (pcase (org-element-property :checkbox item) 1847 (`on "[X] ") 1848 (`off "[ ] ") 1849 (`trans "[-] ") 1850 (_ nil)) 1851 tag 1852 (when contents 1853 (let* ((ind (make-string (if tag 5 (length bullet)) ?\s)) 1854 (pre-blank 1855 (min (or (org-element-property :pre-blank item) 1856 ;; 0 is specific to paragraphs at the 1857 ;; beginning of the item, so we use 1 as 1858 ;; a fall-back value, which is more universal. 1859 1) 1860 ;; Lists ends after more than two consecutive 1861 ;; empty lines: limit ourselves to 2 newline 1862 ;; characters. 1863 2)) 1864 (contents (replace-regexp-in-string 1865 "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) 1866 (if (= pre-blank 0) (org-trim contents) 1867 (concat (make-string pre-blank ?\n) contents))))))) 1868 1869 1870 ;;;; Plain List 1871 1872 (defun org-element--list-struct (limit) 1873 "Return structure of list at point. 1874 Do not parse past LIMIT. 1875 1876 Internal function. See `org-list-struct' for details." 1877 (let ((case-fold-search t) 1878 (top-ind limit) 1879 (item-re (org-item-re)) 1880 (inlinetask-re (and (featurep 'org-inlinetask) 1881 (boundp 'org-inlinetask-min-level) 1882 (boundp 'org-inlinetask-max-level) 1883 (format "^\\*\\{%d,%d\\}+ " 1884 org-inlinetask-min-level 1885 org-inlinetask-max-level))) 1886 items struct) 1887 (save-excursion 1888 (catch :exit 1889 (while t 1890 (cond 1891 ;; At limit: end all items. 1892 ((>= (point) limit) 1893 (let ((end (progn (skip-chars-backward " \r\t\n") 1894 (line-beginning-position 2)))) 1895 (dolist (item items) (setcar (nthcdr 6 item) end))) 1896 (throw :exit (sort (nconc items struct) #'car-less-than-car))) 1897 ;; At list end: end all items. 1898 ((looking-at-p org-list-end-re) 1899 (dolist (item items) (setcar (nthcdr 6 item) (point))) 1900 (throw :exit (sort (nconc items struct) #'car-less-than-car))) 1901 ;; At a new item: end previous sibling. 1902 ((looking-at-p item-re) 1903 (let ((ind (save-excursion (skip-chars-forward " \t") 1904 (org-current-text-column)))) 1905 (setq top-ind (min top-ind ind)) 1906 (while (and items (<= ind (nth 1 (car items)))) 1907 (let ((item (pop items))) 1908 (setcar (nthcdr 6 item) (point)) 1909 (push item struct))) 1910 (push (progn (looking-at org-list-full-item-re) 1911 (let ((bullet (match-string-no-properties 1))) 1912 (list (point) 1913 ind 1914 bullet 1915 (match-string-no-properties 2) ; counter 1916 (match-string-no-properties 3) ; checkbox 1917 ;; Description tag. 1918 (and 1919 (string-match-p "[-+*]" bullet) 1920 (match-string-no-properties 4)) 1921 ;; Ending position, unknown so far. 1922 nil))) 1923 items)) 1924 (forward-line)) 1925 ;; Skip empty lines. 1926 ((looking-at-p "^[ \t]*$") (forward-line)) 1927 ;; Skip inline tasks and blank lines along the way. 1928 ((and inlinetask-re (looking-at-p inlinetask-re)) 1929 (forward-line) 1930 (let ((origin (point))) 1931 (when (re-search-forward inlinetask-re limit t) 1932 (if (looking-at-p "END[ \t]*$") (forward-line) 1933 (goto-char origin))))) 1934 ;; At some text line. Check if it ends any previous item. 1935 (t 1936 (let ((ind (save-excursion 1937 (skip-chars-forward " \t") 1938 (org-current-text-column))) 1939 (end (save-excursion 1940 (skip-chars-backward " \r\t\n") 1941 (line-beginning-position 2)))) 1942 (while (<= ind (nth 1 (car items))) 1943 (let ((item (pop items))) 1944 (setcar (nthcdr 6 item) end) 1945 (push item struct) 1946 (unless items 1947 (throw :exit (sort struct #'car-less-than-car)))))) 1948 ;; Skip blocks (any type) and drawers contents. 1949 (cond 1950 ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)") 1951 (re-search-forward 1952 (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1)) 1953 limit t))) 1954 ((and (looking-at-p org-element-drawer-re) 1955 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) 1956 (forward-line)))))))) 1957 1958 (defun org-element-plain-list-parser (limit affiliated structure) 1959 "Parse a plain list. 1960 1961 LIMIT bounds the search. AFFILIATED is a list of which CAR is 1962 the buffer position at the beginning of the first affiliated 1963 keyword and CDR is a plist of affiliated keywords along with 1964 their value. STRUCTURE is the structure of the plain list being 1965 parsed. 1966 1967 Return a new syntax node of `plain-list' type containing `:type', 1968 `:begin', `:end', `:contents-begin' and `:contents-end', `:structure', 1969 `:post-blank' and `:post-affiliated' properties. 1970 1971 Assume point is at the beginning of the list." 1972 (save-excursion 1973 (let* ((struct (or structure (org-element--list-struct limit))) 1974 (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) 1975 ((nth 5 (assq (point) struct)) 'descriptive) 1976 (t 'unordered))) 1977 (contents-begin (point)) 1978 (begin (car affiliated)) 1979 (contents-end (let* ((item (assq contents-begin struct)) 1980 (ind (nth 1 item)) 1981 (pos (nth 6 item))) 1982 (while (and (setq item (assq pos struct)) 1983 (= (nth 1 item) ind)) 1984 (setq pos (nth 6 item))) 1985 pos)) 1986 (contents-end (progn (goto-char contents-end) 1987 (skip-chars-backward " \r\t\n") 1988 (if (bolp) (point) (line-beginning-position 2)))) 1989 (end (progn (goto-char contents-end) 1990 (skip-chars-forward " \r\t\n" limit) 1991 (if (= (point) limit) limit (line-beginning-position))))) 1992 ;; Return value. 1993 (org-element-create 1994 'plain-list 1995 (nconc 1996 (list :type type 1997 :begin begin 1998 :end end 1999 :contents-begin contents-begin 2000 :contents-end contents-end 2001 :structure struct 2002 :post-blank (count-lines contents-end end) 2003 :post-affiliated contents-begin) 2004 (cdr affiliated)))))) 2005 2006 (defun org-element-plain-list-interpreter (_ contents) 2007 "Interpret plain-list element as Org syntax. 2008 CONTENTS is the contents of the element." 2009 (org-element-with-buffer-copy 2010 :to-buffer (org-get-buffer-create " *Org parse*" t) 2011 :drop-contents t 2012 :drop-visibility t 2013 :drop-narrowing t 2014 :drop-locals nil 2015 ;; Transferring local variables may put the temporary buffer 2016 ;; into a read-only state. Make sure we can insert CONTENTS. 2017 (let ((inhibit-read-only t)) (erase-buffer) (insert contents)) 2018 (goto-char (point-min)) 2019 (org-list-repair) 2020 ;; Prevent "Buffer *temp* modified; kill anyway?". 2021 (restore-buffer-modified-p nil) 2022 (buffer-string))) 2023 2024 2025 ;;;; Property Drawer 2026 2027 (defun org-element-property-drawer-parser (limit) 2028 "Parse a property drawer. 2029 2030 LIMIT bounds the search. 2031 2032 Return a new syntax node of `property-drawer' type containing 2033 `:begin', `:end', `:contents-begin', `:contents-end', `:post-blank' 2034 and `:post-affiliated' properties. 2035 2036 Assume point is at the beginning of the property drawer." 2037 (save-excursion 2038 (let ((case-fold-search t) 2039 (begin (point)) 2040 (contents-begin (line-beginning-position 2))) 2041 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t) 2042 (let ((contents-end (and (> (match-beginning 0) contents-begin) 2043 (match-beginning 0))) 2044 (before-blank (progn (forward-line) (point))) 2045 (end (progn (skip-chars-forward " \r\t\n" limit) 2046 (if (eobp) (point) (line-beginning-position))))) 2047 (org-element-create 2048 'property-drawer 2049 (list :begin begin 2050 :end end 2051 :contents-begin (and contents-end contents-begin) 2052 :contents-end contents-end 2053 :post-blank (count-lines before-blank end) 2054 :post-affiliated begin)))))) 2055 2056 (defun org-element-property-drawer-interpreter (_ contents) 2057 "Interpret property-drawer element as Org syntax. 2058 CONTENTS is the properties within the drawer." 2059 (format ":PROPERTIES:\n%s:END:" contents)) 2060 2061 2062 ;;;; Quote Block 2063 2064 (defun org-element-quote-block-parser (limit affiliated) 2065 "Parse a quote block. 2066 2067 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2068 the buffer position at the beginning of the first affiliated 2069 keyword and CDR is a plist of affiliated keywords along with 2070 their value. 2071 2072 Return a new syntax node of `quote-block' type containing `:begin', 2073 `:end', `:contents-begin', `:contents-end', `:post-blank' and 2074 `:post-affiliated' properties. 2075 2076 Assume point is at the beginning of the block." 2077 (let ((case-fold-search t)) 2078 (if (not (save-excursion 2079 (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t))) 2080 ;; Incomplete block: parse it as a paragraph. 2081 (org-element-paragraph-parser limit affiliated) 2082 (let ((block-end-line (match-beginning 0))) 2083 (save-excursion 2084 (let* ((begin (car affiliated)) 2085 (post-affiliated (point)) 2086 ;; Empty blocks have no contents. 2087 (contents-begin (progn (forward-line) 2088 (and (< (point) block-end-line) 2089 (point)))) 2090 (contents-end (and contents-begin block-end-line)) 2091 (pos-before-blank (progn (goto-char block-end-line) 2092 (forward-line) 2093 (point))) 2094 (end (progn (skip-chars-forward " \r\t\n" limit) 2095 (if (eobp) (point) (line-beginning-position))))) 2096 (org-element-create 2097 'quote-block 2098 (nconc 2099 (list :begin begin 2100 :end end 2101 :contents-begin contents-begin 2102 :contents-end contents-end 2103 :post-blank (count-lines pos-before-blank end) 2104 :post-affiliated post-affiliated) 2105 (cdr affiliated))))))))) 2106 2107 (defun org-element-quote-block-interpreter (_ contents) 2108 "Interpret quote-block element as Org syntax. 2109 CONTENTS is the contents of the element." 2110 (format "#+begin_quote\n%s#+end_quote" contents)) 2111 2112 2113 ;;;; Section 2114 2115 (defun org-element-section-parser (_) 2116 "Parse a section. 2117 2118 Return a new syntax node of `section' type containing `:begin', 2119 `:end', `:contents-begin', `contents-end', `:post-blank' and 2120 `:post-affiliated' properties." 2121 (save-excursion 2122 ;; Beginning of section is the beginning of the first non-blank 2123 ;; line after previous headline. 2124 (let* ((begin (point)) 2125 (end 2126 (if (re-search-forward (org-get-limited-outline-regexp t) nil 'move) 2127 (goto-char (match-beginning 0)) 2128 (point))) 2129 (contents-end end) 2130 (robust-end end) 2131 (robust-begin begin)) 2132 (org-element-create 2133 'section 2134 (list :begin begin 2135 :end end 2136 :contents-begin begin 2137 :contents-end contents-end 2138 :robust-begin robust-begin 2139 :robust-end robust-end 2140 ;; Trailing blank lines in org-data, headlines, and 2141 ;; sections belong to the containing elements. 2142 :post-blank 0 2143 :post-affiliated begin))))) 2144 2145 (defun org-element-section-interpreter (_ contents) 2146 "Interpret section element as Org syntax. 2147 CONTENTS is the contents of the element." 2148 contents) 2149 2150 2151 ;;;; Special Block 2152 2153 (defun org-element-special-block-parser (limit affiliated) 2154 "Parse a special block. 2155 2156 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2157 the buffer position at the beginning of the first affiliated 2158 keyword and CDR is a plist of affiliated keywords along with 2159 their value. 2160 2161 Return a new syntax node of `special-block' type containing `:type', 2162 `:parameters', `:begin', `:end', `:contents-begin', `:contents-end', 2163 `:post-blank' and `:post-affiliated' properties. 2164 2165 Assume point is at the beginning of the block." 2166 (let* ((case-fold-search t) 2167 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)[ \t]*\\(.*\\)[ \t]*$") 2168 (org-element--get-cached-string 2169 (match-string-no-properties 1)))) 2170 (parameters (match-string-no-properties 2))) 2171 (if (not (save-excursion 2172 (re-search-forward 2173 (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) 2174 limit t))) 2175 ;; Incomplete block: parse it as a paragraph. 2176 (org-element-paragraph-parser limit affiliated) 2177 (let ((block-end-line (match-beginning 0))) 2178 (save-excursion 2179 (let* ((begin (car affiliated)) 2180 (post-affiliated (point)) 2181 ;; Empty blocks have no contents. 2182 (contents-begin (progn (forward-line) 2183 (and (< (point) block-end-line) 2184 (point)))) 2185 (contents-end (and contents-begin block-end-line)) 2186 (pos-before-blank (progn (goto-char block-end-line) 2187 (forward-line) 2188 (point))) 2189 (end (progn (skip-chars-forward " \r\t\n" limit) 2190 (if (eobp) (point) (line-beginning-position))))) 2191 (org-element-create 2192 'special-block 2193 (nconc 2194 (list :type type 2195 :parameters (and (org-string-nw-p parameters) 2196 (org-trim parameters)) 2197 :begin begin 2198 :end end 2199 :contents-begin contents-begin 2200 :contents-end contents-end 2201 :post-blank (count-lines pos-before-blank end) 2202 :post-affiliated post-affiliated) 2203 (cdr affiliated))))))))) 2204 2205 (defun org-element-special-block-interpreter (special-block contents) 2206 "Interpret SPECIAL-BLOCK element as Org syntax. 2207 CONTENTS is the contents of the element." 2208 (let ((block-type (org-element-property :type special-block)) 2209 (parameters (org-element-property :parameters special-block))) 2210 (format "#+begin_%s%s\n%s#+end_%s" block-type 2211 (if parameters (concat " " parameters) "") 2212 (or contents "") block-type))) 2213 2214 2215 2216 ;;; Elements 2217 ;; 2218 ;; For each element, a parser and an interpreter are also defined. 2219 ;; Both follow the same naming convention used for greater elements. 2220 ;; 2221 ;; Also, as for greater elements, adding a new element type is done 2222 ;; through the following steps: implement a parser and an interpreter, 2223 ;; tweak `org-element--current-element' so that it recognizes the new 2224 ;; type and add that new type to `org-element-all-elements'. 2225 2226 2227 ;;;; Babel Call 2228 2229 (defun org-element-babel-call-parser (limit affiliated) 2230 "Parse a babel call. 2231 2232 LIMIT bounds the search. AFFILIATED is a list of which car is 2233 the buffer position at the beginning of the first affiliated 2234 keyword and cdr is a plist of affiliated keywords along with 2235 their value. 2236 2237 Return a new syntax node of `babel-call' type containing `:call', 2238 `:inside-header', `:arguments', `:end-header', `:begin', `:end', 2239 `:value', `:post-blank' and `:post-affiliated' as properties." 2240 (save-excursion 2241 (let* ((begin (car affiliated)) 2242 (post-affiliated (point)) 2243 (before-blank (line-beginning-position 2)) 2244 (value (progn (search-forward ":" before-blank t) 2245 (skip-chars-forward " \t") 2246 (org-trim 2247 (buffer-substring-no-properties 2248 (point) (line-end-position))))) 2249 (call 2250 (or (org-string-nw-p 2251 (buffer-substring-no-properties 2252 (point) (progn (skip-chars-forward "^[]()" before-blank) 2253 (point)))))) 2254 (inside-header (org-element--parse-paired-brackets ?\[)) 2255 (arguments (org-string-nw-p 2256 (org-element--parse-paired-brackets ?\())) 2257 (end-header 2258 (org-string-nw-p 2259 (org-trim 2260 (buffer-substring-no-properties (point) (line-end-position))))) 2261 (end (progn (forward-line) 2262 (skip-chars-forward " \r\t\n" limit) 2263 (if (eobp) (point) (line-beginning-position))))) 2264 (org-element-create 2265 'babel-call 2266 (nconc 2267 (list :call call 2268 :inside-header inside-header 2269 :arguments arguments 2270 :end-header end-header 2271 :begin begin 2272 :end end 2273 :value value 2274 :post-blank (count-lines before-blank end) 2275 :post-affiliated post-affiliated) 2276 (cdr affiliated)))))) 2277 2278 (defun org-element-babel-call-interpreter (babel-call _) 2279 "Interpret BABEL-CALL element as Org syntax." 2280 (concat "#+call: " 2281 (org-element-property :call babel-call) 2282 (let ((h (org-element-property :inside-header babel-call))) 2283 (and h (format "[%s]" h))) 2284 (concat "(" (org-element-property :arguments babel-call) ")") 2285 (let ((h (org-element-property :end-header babel-call))) 2286 (and h (concat " " h))))) 2287 2288 2289 ;;;; Clock 2290 2291 (defun org-element-clock-parser (limit) 2292 "Parse a clock. 2293 2294 LIMIT bounds the search. 2295 2296 Return a new syntax node of `clock' type containing `:status', 2297 `:value', `:time', `:begin', `:end', `:post-blank' and 2298 `:post-affiliated' as properties." 2299 (save-excursion 2300 (let* ((begin (point)) 2301 (value (progn (search-forward "CLOCK:" (line-end-position)) 2302 (skip-chars-forward " \t") 2303 (org-element-timestamp-parser))) 2304 (duration (and (search-forward "=> " (line-end-position) t) 2305 (progn (skip-chars-forward " \t") 2306 (looking-at "\\(\\S-+\\)[ \t]*$")) 2307 (match-string-no-properties 1))) 2308 (status (if duration 'closed 'running)) 2309 (post-blank (let ((before-blank (progn (forward-line) (point)))) 2310 (skip-chars-forward " \r\t\n" limit) 2311 (skip-chars-backward " \t") 2312 (unless (bolp) (skip-chars-forward " \t")) 2313 (count-lines before-blank (point)))) 2314 (end (point))) 2315 (org-element-create 2316 'clock 2317 (list :status status 2318 :value value 2319 :duration duration 2320 :begin begin 2321 :end end 2322 :post-blank post-blank 2323 :post-affiliated begin))))) 2324 2325 (defun org-element-clock-interpreter (clock _) 2326 "Interpret CLOCK element as Org syntax." 2327 (concat "CLOCK: " 2328 (org-element-timestamp-interpreter 2329 (org-element-property :value clock) nil) 2330 (let ((duration (org-element-property :duration clock))) 2331 (and duration 2332 (concat " => " 2333 (apply 'format 2334 "%2s:%02s" 2335 (org-split-string duration ":"))))))) 2336 2337 2338 ;;;; Comment 2339 2340 (defun org-element-comment-parser (limit) 2341 "Parse a comment. 2342 2343 LIMIT bounds the search. 2344 2345 Return a new syntax node of `comment' type containing `:begin', 2346 `:end', `:value', `:post-blank', `:post-affiliated' properties. 2347 2348 Assume point is at comment beginning." 2349 (save-excursion 2350 (let* ((begin (point)) 2351 (value (prog2 (looking-at org-comment-regexp) 2352 (buffer-substring-no-properties 2353 (match-end 0) (line-end-position)) 2354 (forward-line))) 2355 (com-end 2356 ;; Get comments ending. 2357 (progn 2358 (while (and (< (point) limit) (looking-at org-comment-regexp)) 2359 ;; Accumulate lines without leading hash and first 2360 ;; whitespace. 2361 (setq value 2362 (concat value 2363 "\n" 2364 (buffer-substring-no-properties 2365 (match-end 0) (line-end-position)))) 2366 (forward-line)) 2367 (point))) 2368 (end (progn (goto-char com-end) 2369 (skip-chars-forward " \r\t\n" limit) 2370 (if (eobp) (point) (line-beginning-position))))) 2371 (org-element-create 2372 'comment 2373 (list :begin begin 2374 :end end 2375 :value value 2376 :post-blank (count-lines com-end end) 2377 :post-affiliated begin))))) 2378 2379 (defun org-element-comment-interpreter (comment _) 2380 "Interpret COMMENT element as Org syntax. 2381 CONTENTS is nil." 2382 (replace-regexp-in-string "^" "# " (org-element-property :value comment))) 2383 2384 2385 ;;;; Comment Block 2386 2387 (defun org-element-comment-block-parser (limit affiliated) 2388 "Parse an export block. 2389 2390 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2391 the buffer position at the beginning of the first affiliated 2392 keyword and CDR is a plist of affiliated keywords along with 2393 their value. 2394 2395 Return a new syntax node of `comment-block' type containing `:begin', 2396 `:end', `:value', `:post-blank' and `:post-affiliated' properties. 2397 2398 Assume point is at comment block beginning." 2399 (let ((case-fold-search t)) 2400 (if (not (save-excursion 2401 (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t))) 2402 ;; Incomplete block: parse it as a paragraph. 2403 (org-element-paragraph-parser limit affiliated) 2404 (let ((contents-end (match-beginning 0))) 2405 (save-excursion 2406 (let* ((begin (car affiliated)) 2407 (post-affiliated (point)) 2408 (contents-begin (progn (forward-line) (point))) 2409 (pos-before-blank (progn (goto-char contents-end) 2410 (forward-line) 2411 (point))) 2412 (end (progn (skip-chars-forward " \r\t\n" limit) 2413 (if (eobp) (point) (line-beginning-position)))) 2414 (value 2415 (org-element-deferred-create 2416 t #'org-element--substring 2417 (- contents-begin begin) 2418 (- contents-end begin)))) 2419 (org-element-create 2420 'comment-block 2421 (nconc 2422 (list :begin begin 2423 :end end 2424 :value value 2425 :post-blank (count-lines pos-before-blank end) 2426 :post-affiliated post-affiliated) 2427 (cdr affiliated))))))))) 2428 2429 (defun org-element-comment-block-interpreter (comment-block _) 2430 "Interpret COMMENT-BLOCK element as Org syntax." 2431 (format "#+begin_comment\n%s#+end_comment" 2432 (org-element-normalize-string 2433 (org-remove-indentation 2434 (org-element-property :value comment-block))))) 2435 2436 2437 ;;;; Diary Sexp 2438 2439 (defun org-element-diary-sexp-parser (limit affiliated) 2440 "Parse a diary sexp. 2441 2442 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2443 the buffer position at the beginning of the first affiliated 2444 keyword and CDR is a plist of affiliated keywords along with 2445 their value. 2446 2447 Return a new syntax node of `diary-sexp' type containing `:begin', 2448 `:end', `:value', `:post-blank' and `:post-affiliated' properties." 2449 (save-excursion 2450 (let ((begin (car affiliated)) 2451 (post-affiliated (point)) 2452 (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") 2453 (match-string-no-properties 1))) 2454 (pos-before-blank (progn (forward-line) (point))) 2455 (end (progn (skip-chars-forward " \r\t\n" limit) 2456 (if (eobp) (point) (line-beginning-position))))) 2457 (org-element-create 2458 'diary-sexp 2459 (nconc 2460 (list :value value 2461 :begin begin 2462 :end end 2463 :post-blank (count-lines pos-before-blank end) 2464 :post-affiliated post-affiliated) 2465 (cdr affiliated)))))) 2466 2467 (defun org-element-diary-sexp-interpreter (diary-sexp _) 2468 "Interpret DIARY-SEXP as Org syntax." 2469 (org-element-property :value diary-sexp)) 2470 2471 2472 ;;;; Example Block 2473 2474 (defun org-element-example-block-parser (limit affiliated) 2475 "Parse an example block. 2476 2477 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2478 the buffer position at the beginning of the first affiliated 2479 keyword and CDR is a plist of affiliated keywords along with 2480 their value. 2481 2482 Return a new syntax node of `example-block' type containing `:begin', 2483 `:end', `:number-lines', `:preserve-indent', `:retain-labels', 2484 `:use-labels', `:label-fmt', `:switches', `:value', `:post-blank' and 2485 `:post-affiliated' properties." 2486 (let ((case-fold-search t)) 2487 (if (not (save-excursion 2488 (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) 2489 ;; Incomplete block: parse it as a paragraph. 2490 (org-element-paragraph-parser limit affiliated) 2491 (let ((contents-end (match-beginning 0))) 2492 (save-excursion 2493 (let* ((switches 2494 (progn 2495 (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") 2496 (match-string-no-properties 1))) 2497 ;; Switches analysis. 2498 (number-lines 2499 (and switches 2500 (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" 2501 switches) 2502 (cons 2503 (if (equal (match-string 1 switches) "-") 2504 'new 2505 'continued) 2506 (if (not (match-end 2)) 0 2507 ;; Subtract 1 to give number of lines before 2508 ;; first line. 2509 (1- (string-to-number (match-string 2 switches))))))) 2510 (preserve-indent 2511 (and switches (string-match-p "-i\\>" switches))) 2512 ;; Should labels be retained in (or stripped from) example 2513 ;; blocks? 2514 (retain-labels 2515 (or (not switches) 2516 (not (string-match-p "-r\\>" switches)) 2517 (and number-lines (string-match-p "-k\\>" switches)))) 2518 ;; What should code-references use - labels or 2519 ;; line-numbers? 2520 (use-labels 2521 (or (not switches) 2522 (and retain-labels 2523 (not (string-match-p "-k\\>" switches))))) 2524 (label-fmt 2525 (and switches 2526 (string-match "-l +\"\\([^\"\n]+\\)\"" switches) 2527 (match-string-no-properties 1 switches))) 2528 ;; Standard block parsing. 2529 (begin (car affiliated)) 2530 (post-affiliated (point)) 2531 (contents-begin (line-beginning-position 2)) 2532 (value 2533 (org-element-deferred-create 2534 t #'org-element--unescape-substring 2535 (- contents-begin begin) 2536 (- contents-end begin))) 2537 (pos-before-blank (progn (goto-char contents-end) 2538 (forward-line) 2539 (point))) 2540 (end (progn (skip-chars-forward " \r\t\n" limit) 2541 (if (eobp) (point) (line-beginning-position))))) 2542 (org-element-create 2543 'example-block 2544 (nconc 2545 (list :begin begin 2546 :end end 2547 :value value 2548 :switches switches 2549 :number-lines number-lines 2550 :preserve-indent preserve-indent 2551 :retain-labels retain-labels 2552 :use-labels use-labels 2553 :label-fmt label-fmt 2554 :post-blank (count-lines pos-before-blank end) 2555 :post-affiliated post-affiliated) 2556 (cdr affiliated))))))))) 2557 2558 (defun org-element-example-block-interpreter (example-block _) 2559 "Interpret EXAMPLE-BLOCK element as Org syntax." 2560 (let ((switches (org-element-property :switches example-block)) 2561 (value 2562 (let ((val (org-element-property :value example-block))) 2563 (cond 2564 ((org-src-preserve-indentation-p example-block) val) 2565 ((= 0 org-edit-src-content-indentation) 2566 (org-remove-indentation val)) 2567 (t 2568 (let ((ind (make-string org-edit-src-content-indentation ?\s))) 2569 (replace-regexp-in-string "^[ \t]*\\S-" 2570 (concat ind "\\&") 2571 (org-remove-indentation val)))))))) 2572 (concat "#+begin_example" (and switches (concat " " switches)) "\n" 2573 (org-element-normalize-string (org-escape-code-in-string value)) 2574 "#+end_example"))) 2575 2576 2577 ;;;; Export Block 2578 2579 (defun org-element-export-block-parser (limit affiliated) 2580 "Parse an export block. 2581 2582 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2583 the buffer position at the beginning of the first affiliated 2584 keyword and CDR is a plist of affiliated keywords along with 2585 their value. 2586 2587 Return a new syntax node of `export-block' type containing `:begin', 2588 `:end', `:type', `:value', `:post-blank' and `:post-affiliated' 2589 properties. 2590 2591 Assume point is at export-block beginning." 2592 (let* ((case-fold-search t)) 2593 (if (not (save-excursion 2594 (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t))) 2595 ;; Incomplete block: parse it as a paragraph. 2596 (org-element-paragraph-parser limit affiliated) 2597 (save-excursion 2598 (let* ((contents-end (match-beginning 0)) 2599 (backend 2600 (progn 2601 (looking-at 2602 "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$") 2603 (match-string-no-properties 1))) 2604 (begin (car affiliated)) 2605 (post-affiliated (point)) 2606 (contents-begin (progn (forward-line) (point))) 2607 (pos-before-blank (progn (goto-char contents-end) 2608 (forward-line) 2609 (point))) 2610 (end (progn (skip-chars-forward " \r\t\n" limit) 2611 (if (eobp) (point) (line-beginning-position)))) 2612 (value 2613 (org-element-deferred-create 2614 t #'org-element--unescape-substring 2615 (- contents-begin begin) 2616 (- contents-end begin)))) 2617 (org-element-create 2618 'export-block 2619 (nconc 2620 (list :type (and backend (upcase backend)) 2621 :begin begin 2622 :end end 2623 :value value 2624 :post-blank (count-lines pos-before-blank end) 2625 :post-affiliated post-affiliated) 2626 (cdr affiliated)))))))) 2627 2628 (defun org-element-export-block-interpreter (export-block _) 2629 "Interpret EXPORT-BLOCK element as Org syntax." 2630 (format "#+begin_export %s\n%s#+end_export" 2631 (org-element-property :type export-block) 2632 (org-element-property :value export-block))) 2633 2634 2635 ;;;; Fixed-width 2636 2637 (defun org-element-fixed-width-parser (limit affiliated) 2638 "Parse a fixed-width section. 2639 2640 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2641 the buffer position at the beginning of the first affiliated 2642 keyword and CDR is a plist of affiliated keywords along with 2643 their value. 2644 2645 Return a new syntax node of `fixed-width' type containing `:begin', 2646 `:end', `:value', `:post-blank' and `:post-affiliated' properties. 2647 2648 Assume point is at the beginning of the fixed-width area." 2649 (save-excursion 2650 (let* ((begin (car affiliated)) 2651 (post-affiliated (point)) 2652 (end-area 2653 (progn 2654 (while (and (< (point) limit) 2655 (looking-at-p "[ \t]*:\\( \\|$\\)")) 2656 (forward-line)) 2657 (if (bolp) (line-end-position 0) (point)))) 2658 (end (progn (skip-chars-forward " \r\t\n" limit) 2659 (if (eobp) (point) (line-beginning-position))))) 2660 (org-element-create 2661 'fixed-width 2662 (nconc 2663 (list :begin begin 2664 :end end 2665 :value (replace-regexp-in-string 2666 "^[ \t]*: ?" "" 2667 (buffer-substring-no-properties post-affiliated 2668 end-area)) 2669 :post-blank (count-lines end-area end) 2670 :post-affiliated post-affiliated) 2671 (cdr affiliated)))))) 2672 2673 (defun org-element-fixed-width-interpreter (fixed-width _) 2674 "Interpret FIXED-WIDTH element as Org syntax." 2675 (let ((value (org-element-property :value fixed-width))) 2676 (and value 2677 (if (string-empty-p value) ":\n" 2678 (replace-regexp-in-string "^" ": " value))))) 2679 2680 2681 ;;;; Horizontal Rule 2682 2683 (defun org-element-horizontal-rule-parser (limit affiliated) 2684 "Parse an horizontal rule. 2685 2686 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2687 the buffer position at the beginning of the first affiliated 2688 keyword and CDR is a plist of affiliated keywords along with 2689 their value. 2690 2691 Return a new syntax node of `horizontal-rule' type containing 2692 `:begin', `:end', `:post-blank' and `:post-affiliated' properties." 2693 (save-excursion 2694 (let ((begin (car affiliated)) 2695 (post-affiliated (point)) 2696 (post-hr (progn (forward-line) (point))) 2697 (end (progn (skip-chars-forward " \r\t\n" limit) 2698 (if (eobp) (point) (line-beginning-position))))) 2699 (org-element-create 2700 'horizontal-rule 2701 (nconc 2702 (list :begin begin 2703 :end end 2704 :post-blank (count-lines post-hr end) 2705 :post-affiliated post-affiliated) 2706 (cdr affiliated)))))) 2707 2708 (defun org-element-horizontal-rule-interpreter (&rest _) 2709 "Interpret HORIZONTAL-RULE element as Org syntax." 2710 "-----") 2711 2712 2713 ;;;; Keyword 2714 2715 (defun org-element-keyword-parser (limit affiliated) 2716 "Parse a keyword at point. 2717 2718 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2719 the buffer position at the beginning of the first affiliated 2720 keyword and CDR is a plist of affiliated keywords along with 2721 their value. 2722 2723 Return a new syntax node of `keyword' type containing `:key', 2724 `:value', `:begin', `:end', `:post-blank' and `:post-affiliated' 2725 properties." 2726 (save-excursion 2727 ;; An orphaned affiliated keyword is considered as a regular 2728 ;; keyword. In this case AFFILIATED is nil, so we take care of 2729 ;; this corner case. 2730 (let ((begin (or (car affiliated) (point))) 2731 (post-affiliated (point)) 2732 (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):") 2733 (org-element--get-cached-string 2734 (upcase (match-string-no-properties 1))))) 2735 (value (org-trim (buffer-substring-no-properties 2736 (match-end 0) (line-end-position)))) 2737 (pos-before-blank (progn (forward-line) (point))) 2738 (end (progn (skip-chars-forward " \r\t\n" limit) 2739 (if (eobp) (point) (line-beginning-position))))) 2740 (org-element-create 2741 'keyword 2742 (nconc 2743 (list :key key 2744 :value value 2745 :begin begin 2746 :end end 2747 :post-blank (count-lines pos-before-blank end) 2748 :post-affiliated post-affiliated) 2749 (cdr affiliated)))))) 2750 2751 (defun org-element-keyword-interpreter (keyword _) 2752 "Interpret KEYWORD element as Org syntax." 2753 (format "#+%s: %s" 2754 (downcase (org-element-property :key keyword)) 2755 (org-element-property :value keyword))) 2756 2757 2758 ;;;; LaTeX Environment 2759 2760 (defconst org-element--latex-begin-environment 2761 "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}" 2762 "Regexp matching the beginning of a LaTeX environment. 2763 The environment is captured by the first group. 2764 2765 See also `org-element--latex-end-environment'.") 2766 2767 (defconst org-element--latex-begin-environment-nogroup 2768 "^[ \t]*\\\\begin{[A-Za-z0-9*]+}" 2769 "Regexp matching the beginning of a LaTeX environment.") 2770 2771 (defconst org-element--latex-end-environment 2772 "\\\\end{%s}[ \t]*$" 2773 "Format string matching the ending of a LaTeX environment. 2774 See also `org-element--latex-begin-environment'.") 2775 2776 (defun org-element-latex-environment-parser (limit affiliated) 2777 "Parse a LaTeX environment. 2778 2779 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2780 the buffer position at the beginning of the first affiliated 2781 keyword and CDR is a plist of affiliated keywords along with 2782 their value. 2783 2784 Return a new syntax node of `latex-environment' type containing 2785 `:begin', `:end', `:value', `:post-blank' and `:post-affiliated' 2786 properties. 2787 2788 Assume point is at the beginning of the latex environment." 2789 (save-excursion 2790 (let ((case-fold-search t) 2791 (code-begin (point))) 2792 (looking-at org-element--latex-begin-environment) 2793 (if (not (re-search-forward (format org-element--latex-end-environment 2794 (regexp-quote (match-string 1))) 2795 limit t)) 2796 ;; Incomplete latex environment: parse it as a paragraph. 2797 (org-element-paragraph-parser limit affiliated) 2798 (let* ((code-end (progn (forward-line) (point))) 2799 (begin (car affiliated)) 2800 (value 2801 (org-element-deferred-create 2802 t #'org-element--substring 2803 (- code-begin begin) 2804 (- code-end begin))) 2805 (end (progn (skip-chars-forward " \r\t\n" limit) 2806 (if (eobp) (point) (line-beginning-position))))) 2807 (org-element-create 2808 'latex-environment 2809 (nconc 2810 (list :begin begin 2811 :end end 2812 :value value 2813 :post-blank (count-lines code-end end) 2814 :post-affiliated code-begin) 2815 (cdr affiliated)))))))) 2816 2817 (defun org-element-latex-environment-interpreter (latex-environment _) 2818 "Interpret LATEX-ENVIRONMENT element as Org syntax." 2819 (org-element-property :value latex-environment)) 2820 2821 2822 ;;;; Node Property 2823 2824 (defun org-element-node-property-parser (_) 2825 "Parse a node-property at point. 2826 2827 Return a new syntax node of `node-property' type containing `:key', 2828 `:value', `:begin', `:end', `:post-blank' and `:post-affiliated' 2829 properties." 2830 (looking-at org-property-re) 2831 (let ((begin (point)) 2832 (key (org-element--get-cached-string 2833 (match-string-no-properties 2))) 2834 (value (match-string-no-properties 3)) 2835 (end (min (point-max) (1+ (match-end 0))))) 2836 (org-element-create 2837 'node-property 2838 (list :key key 2839 :value value 2840 :begin begin 2841 :end end 2842 :post-blank 0 2843 :post-affiliated begin)))) 2844 2845 (defun org-element-node-property-interpreter (node-property _) 2846 "Interpret NODE-PROPERTY element as Org syntax." 2847 (format org-property-format 2848 (format ":%s:" (org-element-property :key node-property)) 2849 (or (org-element-property :value node-property) ""))) 2850 2851 2852 ;;;; Paragraph 2853 2854 (defun org-element-paragraph-parser (limit affiliated) 2855 "Parse a paragraph. 2856 2857 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2858 the buffer position at the beginning of the first affiliated 2859 keyword and CDR is a plist of affiliated keywords along with 2860 their value. 2861 2862 Return a new syntax node of `paragraph' type containing `:begin', 2863 `:end', `:contents-begin' and `:contents-end', `:post-blank' and 2864 `:post-affiliated' properties. 2865 2866 Assume point is at the beginning of the paragraph." 2867 (save-excursion 2868 (let* ((begin (car affiliated)) 2869 (contents-begin (point)) 2870 (before-blank 2871 (let ((case-fold-search t)) 2872 (end-of-line) 2873 ;; A matching `org-element-paragraph-separate' is not 2874 ;; necessarily the end of the paragraph. In particular, 2875 ;; drawers, blocks or LaTeX environments opening lines 2876 ;; must be closed. Moreover keywords with a secondary 2877 ;; value must belong to "dual keywords". 2878 (while (not 2879 (cond 2880 ((not (and (re-search-forward 2881 org-element-paragraph-separate limit 'move) 2882 (progn (forward-line 0) t)))) 2883 ((looking-at-p org-element-drawer-re) 2884 (save-excursion 2885 (forward-line 1) 2886 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) 2887 ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") 2888 (save-excursion 2889 (re-search-forward 2890 (format "^[ \t]*#\\+END_%s[ \t]*$" 2891 (regexp-quote (match-string 1))) 2892 limit t))) 2893 ((looking-at org-element--latex-begin-environment) 2894 (save-excursion 2895 (re-search-forward 2896 (format org-element--latex-end-environment 2897 (regexp-quote (match-string 1))) 2898 limit t))) 2899 ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:") 2900 (member-ignore-case (match-string 1) 2901 org-element-dual-keywords)) 2902 ;; Everything else is unambiguous. 2903 (t))) 2904 (end-of-line)) 2905 (if (= (point) limit) limit 2906 (goto-char (line-beginning-position))))) 2907 (contents-end (save-excursion 2908 (skip-chars-backward " \r\t\n" contents-begin) 2909 (line-beginning-position 2))) 2910 (end (progn (skip-chars-forward " \r\t\n" limit) 2911 (if (eobp) (point) (line-beginning-position))))) 2912 (org-element-create 2913 'paragraph 2914 (nconc 2915 (list :begin begin 2916 :end end 2917 :contents-begin contents-begin 2918 :contents-end contents-end 2919 :post-blank (count-lines before-blank end) 2920 :post-affiliated contents-begin) 2921 (cdr affiliated)))))) 2922 2923 (defun org-element-paragraph-interpreter (_ contents) 2924 "Interpret paragraph element as Org syntax. 2925 CONTENTS is the contents of the element." 2926 contents) 2927 2928 2929 ;;;; Planning 2930 2931 (defun org-element-planning-parser (limit) 2932 "Parse a planning. 2933 2934 LIMIT bounds the search. 2935 2936 Return a new syntax node of `planning' type containing `:closed', 2937 `:deadline', `:scheduled', `:begin', `:end', `:post-blank' and 2938 `:post-affiliated' properties." 2939 (save-excursion 2940 (let* ((case-fold-search nil) 2941 (begin (point)) 2942 (post-blank (let ((before-blank (progn (forward-line) (point)))) 2943 (skip-chars-forward " \r\t\n" limit) 2944 (skip-chars-backward " \t") 2945 (unless (bolp) (skip-chars-forward " \t")) 2946 (count-lines before-blank (point)))) 2947 (end (point)) 2948 closed deadline scheduled) 2949 (goto-char begin) 2950 (while (re-search-forward org-element-planning-keywords-re end t) 2951 (skip-chars-forward " \t" end) 2952 (let ((keyword (match-string 0)) 2953 (time (org-element-timestamp-parser))) 2954 (cond 2955 ((equal keyword org-element-closed-keyword) (setq closed time)) 2956 ((equal keyword org-element-deadline-keyword) (setq deadline time)) 2957 (t (setq scheduled time))))) 2958 (org-element-create 2959 'planning 2960 (list :closed closed 2961 :deadline deadline 2962 :scheduled scheduled 2963 :begin begin 2964 :end end 2965 :post-blank post-blank 2966 :post-affiliated begin))))) 2967 2968 (defun org-element-planning-interpreter (planning _) 2969 "Interpret PLANNING element as Org syntax." 2970 (mapconcat 2971 #'identity 2972 (delq nil 2973 (list (let ((deadline (org-element-property :deadline planning))) 2974 (when deadline 2975 (concat org-element-deadline-keyword " " 2976 (org-element-timestamp-interpreter deadline nil)))) 2977 (let ((scheduled (org-element-property :scheduled planning))) 2978 (when scheduled 2979 (concat org-element-scheduled-keyword " " 2980 (org-element-timestamp-interpreter scheduled nil)))) 2981 (let ((closed (org-element-property :closed planning))) 2982 (when closed 2983 (concat org-element-closed-keyword " " 2984 (org-element-timestamp-interpreter closed nil)))))) 2985 " ")) 2986 2987 2988 ;;;; Src Block 2989 2990 (defun org-element-src-block-parser (limit affiliated) 2991 "Parse a source block. 2992 2993 LIMIT bounds the search. AFFILIATED is a list of which CAR is 2994 the buffer position at the beginning of the first affiliated 2995 keyword and CDR is a plist of affiliated keywords along with 2996 their value. 2997 2998 Return a new syntax node of `src-block' type containing `:language', 2999 `:switches', `:parameters', `:begin', `:end', `:number-lines', 3000 `:retain-labels', `:use-labels', `:label-fmt', `:preserve-indent', 3001 `:value', `:post-blank' and `:post-affiliated' properties. 3002 3003 Assume point is at the beginning of the block." 3004 (let ((case-fold-search t)) 3005 (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$" 3006 limit t))) 3007 ;; Incomplete block: parse it as a paragraph. 3008 (org-element-paragraph-parser limit affiliated) 3009 (let ((contents-end (match-beginning 0))) 3010 (save-excursion 3011 (let* ((begin (car affiliated)) 3012 (post-affiliated (point)) 3013 ;; Get language as a string. 3014 (language 3015 (progn 3016 (looking-at 3017 "^[ \t]*#\\+BEGIN_SRC\ 3018 \\(?: +\\(\\S-+\\)\\)?\ 3019 \\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\ 3020 \\(.*\\)[ \t]*$") 3021 (org-element--get-cached-string 3022 (match-string-no-properties 1)))) 3023 ;; Get switches. 3024 (switches (match-string-no-properties 2)) 3025 ;; Get parameters. 3026 (parameters (match-string-no-properties 3)) 3027 ;; Switches analysis. 3028 (number-lines 3029 (and switches 3030 (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" 3031 switches) 3032 (cons 3033 (if (equal (match-string 1 switches) "-") 3034 'new 3035 'continued) 3036 (if (not (match-end 2)) 0 3037 ;; Subtract 1 to give number of lines before 3038 ;; first line. 3039 (1- (string-to-number (match-string 2 switches))))))) 3040 (preserve-indent (and switches 3041 (string-match-p "-i\\>" switches))) 3042 (label-fmt 3043 (and switches 3044 (string-match "-l +\"\\([^\"\n]+\\)\"" switches) 3045 (match-string-no-properties 1 switches))) 3046 ;; Should labels be retained in (or stripped from) 3047 ;; source blocks? 3048 (retain-labels 3049 (or (not switches) 3050 (not (string-match-p "-r\\>" switches)) 3051 (and number-lines (string-match-p "-k\\>" switches)))) 3052 ;; What should code-references use - labels or 3053 ;; line-numbers? 3054 (use-labels 3055 (or (not switches) 3056 (and retain-labels 3057 (not (string-match-p "-k\\>" switches))))) 3058 ;; Retrieve code. 3059 (value 3060 (org-element-deferred-create 3061 t #'org-element--unescape-substring 3062 (- (line-beginning-position 2) begin) 3063 (- contents-end begin))) 3064 (pos-before-blank (progn (goto-char contents-end) 3065 (forward-line) 3066 (point))) 3067 ;; Get position after ending blank lines. 3068 (end (progn (skip-chars-forward " \r\t\n" limit) 3069 (if (eobp) (point) (line-beginning-position))))) 3070 (org-element-create 3071 'src-block 3072 (nconc 3073 (list :language language 3074 :switches (and (org-string-nw-p switches) 3075 (org-trim switches)) 3076 :parameters (and (org-string-nw-p parameters) 3077 (org-trim parameters)) 3078 :begin begin 3079 :end end 3080 :number-lines number-lines 3081 :preserve-indent preserve-indent 3082 :retain-labels retain-labels 3083 :use-labels use-labels 3084 :label-fmt label-fmt 3085 :value value 3086 :post-blank (count-lines pos-before-blank end) 3087 :post-affiliated post-affiliated) 3088 (cdr affiliated))))))))) 3089 3090 (defun org-element-src-block-interpreter (src-block _) 3091 "Interpret SRC-BLOCK element as Org syntax." 3092 (let ((lang (org-element-property :language src-block)) 3093 (switches (org-element-property :switches src-block)) 3094 (params (org-element-property :parameters src-block)) 3095 (value 3096 (let ((val (org-element-property :value src-block))) 3097 (cond 3098 ((org-src-preserve-indentation-p src-block) val) 3099 ((zerop org-edit-src-content-indentation) 3100 (org-remove-indentation val)) 3101 (t 3102 (let ((ind (make-string org-edit-src-content-indentation ?\s))) 3103 (replace-regexp-in-string "^[ \t]*\\S-" 3104 (concat ind "\\&") 3105 (org-remove-indentation val)))))))) 3106 (format "#+begin_src%s\n%s#+end_src" 3107 (concat (and lang (concat " " lang)) 3108 (and switches (concat " " switches)) 3109 (and params (concat " " params))) 3110 (org-element-normalize-string (org-escape-code-in-string value))))) 3111 3112 3113 ;;;; Table 3114 3115 (defun org-element-table-parser (limit affiliated) 3116 "Parse a table at point. 3117 3118 LIMIT bounds the search. AFFILIATED is a list of which CAR is 3119 the buffer position at the beginning of the first affiliated 3120 keyword and CDR is a plist of affiliated keywords along with 3121 their value. 3122 3123 Return a new syntax node of `table' type containing `:begin', `:end', 3124 `:tblfm', `:type', `:contents-begin', `:contents-end', `:value', 3125 `:post-blank' and `:post-affiliated' properties. 3126 3127 Assume point is at the beginning of the table." 3128 (save-excursion 3129 (let* ((case-fold-search t) 3130 (table-begin (point)) 3131 (type (if (looking-at-p "[ \t]*|") 'org 'table.el)) 3132 (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)" 3133 (if (eq type 'org) "" "+"))) 3134 (begin (car affiliated)) 3135 (table-end 3136 (if (re-search-forward end-re limit 'move) 3137 (goto-char (match-beginning 0)) 3138 (point))) 3139 (tblfm (let (acc) 3140 (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") 3141 (push (match-string-no-properties 1) acc) 3142 (forward-line)) 3143 acc)) 3144 (pos-before-blank (point)) 3145 (end (progn (skip-chars-forward " \r\t\n" limit) 3146 (if (eobp) (point) (line-beginning-position))))) 3147 (org-element-create 3148 'table 3149 (nconc 3150 (list :begin begin 3151 :end end 3152 :type type 3153 :tblfm tblfm 3154 ;; Only `org' tables have contents. `table.el' tables 3155 ;; use a `:value' property to store raw table as 3156 ;; a string. 3157 :contents-begin (and (eq type 'org) table-begin) 3158 :contents-end (and (eq type 'org) table-end) 3159 :value (and (eq type 'table.el) 3160 (org-element-deferred-create 3161 t #'org-element--substring 3162 (- table-begin begin) 3163 (- table-end begin))) 3164 :post-blank (count-lines pos-before-blank end) 3165 :post-affiliated table-begin) 3166 (cdr affiliated)))))) 3167 3168 (defun org-element-table-interpreter (table contents) 3169 "Interpret TABLE element as Org syntax. 3170 CONTENTS is a string, if table's type is `org', or nil." 3171 (if (eq (org-element-property :type table) 'table.el) 3172 (org-remove-indentation (org-element-property :value table)) 3173 (concat (with-temp-buffer (insert contents) 3174 (org-table-align) 3175 (buffer-string)) 3176 (mapconcat (lambda (fm) (concat "#+TBLFM: " fm)) 3177 (reverse (org-element-property :tblfm table)) 3178 "\n")))) 3179 3180 3181 ;;;; Table Row 3182 3183 (defun org-element-table-row-parser (_) 3184 "Parse table row at point. 3185 3186 Return a new syntax node of `table-row' type containing `:begin', 3187 `:end', `:contents-begin', `:contents-end', `:type', `:post-blank' and 3188 `:post-affiliated' properties." 3189 (save-excursion 3190 (let* ((type (if (looking-at-p "^[ \t]*|-") 'rule 'standard)) 3191 (begin (point)) 3192 ;; A table rule has no contents. In that case, ensure 3193 ;; CONTENTS-BEGIN matches CONTENTS-END. 3194 (contents-begin (and (eq type 'standard) (search-forward "|"))) 3195 (contents-end (and (eq type 'standard) 3196 (progn 3197 (end-of-line) 3198 (skip-chars-backward " \t") 3199 (point)))) 3200 (end (line-beginning-position 2))) 3201 (org-element-create 3202 'table-row 3203 (list :type type 3204 :begin begin 3205 :end end 3206 :contents-begin contents-begin 3207 :contents-end contents-end 3208 :post-blank 0 3209 :post-affiliated begin))))) 3210 3211 (defun org-element-table-row-interpreter (table-row contents) 3212 "Interpret TABLE-ROW element as Org syntax. 3213 CONTENTS is the contents of the table row." 3214 (if (eq (org-element-property :type table-row) 'rule) "|-" 3215 (concat "|" contents))) 3216 3217 3218 ;;;; Verse Block 3219 3220 (defun org-element-verse-block-parser (limit affiliated) 3221 "Parse a verse block. 3222 3223 LIMIT bounds the search. AFFILIATED is a list of which CAR is 3224 the buffer position at the beginning of the first affiliated 3225 keyword and CDR is a plist of affiliated keywords along with 3226 their value. 3227 3228 Return a new syntax node of `verse-block' type containing `:begin', 3229 `:end', `:contents-begin', `:contents-end', `:post-blank' and 3230 `:post-affiliated' properties. 3231 3232 Assume point is at beginning of the block." 3233 (let ((case-fold-search t)) 3234 (if (not (save-excursion 3235 (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t))) 3236 ;; Incomplete block: parse it as a paragraph. 3237 (org-element-paragraph-parser limit affiliated) 3238 (let ((contents-end (match-beginning 0))) 3239 (save-excursion 3240 (let* ((begin (car affiliated)) 3241 (post-affiliated (point)) 3242 (contents-begin (progn (forward-line) (point))) 3243 (pos-before-blank (progn (goto-char contents-end) 3244 (forward-line) 3245 (point))) 3246 (end (progn (skip-chars-forward " \r\t\n" limit) 3247 (if (eobp) (point) (line-beginning-position))))) 3248 (org-element-create 3249 'verse-block 3250 (nconc 3251 (list :begin begin 3252 :end end 3253 :contents-begin contents-begin 3254 :contents-end contents-end 3255 :post-blank (count-lines pos-before-blank end) 3256 :post-affiliated post-affiliated) 3257 (cdr affiliated))))))))) 3258 3259 (defun org-element-verse-block-interpreter (_ contents) 3260 "Interpret verse-block element as Org syntax. 3261 CONTENTS is verse block contents." 3262 (format "#+begin_verse\n%s#+end_verse" contents)) 3263 3264 3265 3266 ;;; Objects 3267 ;; 3268 ;; Unlike to elements, raw text can be found between objects. Hence, 3269 ;; `org-element--object-lex' is provided to find the next object in 3270 ;; buffer. 3271 ;; 3272 ;; Some object types (e.g., `italic') are recursive. Restrictions on 3273 ;; object types they can contain will be specified in 3274 ;; `org-element-object-restrictions'. 3275 ;; 3276 ;; Creating a new type of object requires altering 3277 ;; `org-element--object-regexp' and `org-element--object-lex', add the 3278 ;; new type in `org-element-all-objects', and possibly add 3279 ;; restrictions in `org-element-object-restrictions'. 3280 3281 ;;;; Bold 3282 3283 (defun org-element--parse-generic-emphasis (mark type) 3284 "Parse emphasis object at point, if any. 3285 3286 MARK is the delimiter string used. TYPE is a symbol among 3287 `bold', `code', `italic', `strike-through', `underline', and 3288 `verbatim'. 3289 3290 Assume point is at first MARK." 3291 (save-excursion 3292 (let ((origin (point))) 3293 (unless (bolp) (forward-char -1)) 3294 (let ((opening-re 3295 (rx-to-string 3296 `(seq (or line-start (any space ?- ?\( ?' ?\" ?\{)) 3297 ,mark 3298 (not space))))) 3299 (when (looking-at-p opening-re) 3300 (goto-char (1+ origin)) 3301 (let ((closing-re 3302 (rx-to-string 3303 `(seq 3304 (not space) 3305 (group ,mark) 3306 (or (any space ?- ?. ?, ?\; ?: ?! ?? ?' ?\" ?\) ?\} ?\\ ?\[) 3307 line-end))))) 3308 (when (re-search-forward closing-re nil t) 3309 (let ((closing (match-end 1))) 3310 (goto-char closing) 3311 (let* ((post-blank (skip-chars-forward " \t")) 3312 (contents-begin (1+ origin)) 3313 (contents-end (1- closing))) 3314 (org-element-create 3315 type 3316 (append 3317 (list :begin origin 3318 :end (point) 3319 :post-blank post-blank) 3320 (if (memq type '(code verbatim)) 3321 (list :value 3322 (and (memq type '(code verbatim)) 3323 (org-element-deferred-create 3324 t #'org-element--substring 3325 (- contents-begin origin) 3326 (- contents-end origin)))) 3327 (list :contents-begin contents-begin 3328 :contents-end contents-end))))))))))))) 3329 3330 (defun org-element-bold-parser () 3331 "Parse bold object at point, if any. 3332 3333 When at a bold object, return a new syntax node `bold' type containing 3334 `:begin', `:end', `:contents-begin', `:contents-end', and 3335 `:post-blank' properties. Otherwise, return nil. 3336 3337 Assume point is at the first star marker." 3338 (org-element--parse-generic-emphasis "*" 'bold)) 3339 3340 (defun org-element-bold-interpreter (_ contents) 3341 "Interpret bold object as Org syntax. 3342 CONTENTS is the contents of the object." 3343 (format "*%s*" contents)) 3344 3345 3346 ;;;; Citation 3347 3348 (defun org-element-citation-parser () 3349 "Parse citation object at point, if any. 3350 3351 When at a citation object, return a new syntax node of `citation' type 3352 containing `:style', `:prefix', `:suffix', `:begin', `:end', 3353 `:contents-begin', `:contents-end', and `:post-blank' properties. 3354 Otherwise, return nil. 3355 3356 Assume point is at the beginning of the citation." 3357 (when (looking-at org-element-citation-prefix-re) 3358 (let* ((begin (point)) 3359 (style (and (match-end 1) 3360 (org-element--get-cached-string 3361 (match-string-no-properties 1)))) 3362 ;; Ignore blanks between cite type and prefix or key. 3363 (start (match-end 0)) 3364 (closing (with-syntax-table org-element--pair-square-table 3365 (ignore-errors (scan-lists begin 1 0))))) 3366 (save-excursion 3367 (when (and closing 3368 (re-search-forward org-element-citation-key-re closing t)) 3369 ;; Find prefix, if any. 3370 (let ((first-key-end (match-end 0)) 3371 (types (org-element-restriction 'citation-reference)) 3372 (cite 3373 (org-element-create 3374 'citation 3375 (list :style style 3376 :begin begin 3377 :post-blank (progn 3378 (goto-char closing) 3379 (skip-chars-forward " \t")) 3380 :end (point) 3381 :secondary (alist-get 3382 'citation 3383 org-element-secondary-value-alist))))) 3384 ;; `:contents-begin' depends on the presence of 3385 ;; a non-empty common prefix. 3386 (goto-char first-key-end) 3387 (if (not (search-backward ";" start t)) 3388 (org-element-put-property cite :contents-begin start) 3389 (when (< start (point)) 3390 (org-element-put-property 3391 cite :prefix 3392 (org-element--parse-objects start (point) nil types cite))) 3393 (forward-char) 3394 (org-element-put-property cite :contents-begin (point))) 3395 ;; `:contents-end' depends on the presence of a non-empty 3396 ;; common suffix. 3397 (goto-char (1- closing)) 3398 (skip-chars-backward " \r\t\n") 3399 (let ((end (point))) 3400 (if (or (not (search-backward ";" first-key-end t)) 3401 (re-search-forward org-element-citation-key-re end t)) 3402 (org-element-put-property cite :contents-end end) 3403 (forward-char) 3404 (when (< (point) end) 3405 (org-element-put-property 3406 cite :suffix 3407 (org-element--parse-objects (point) end nil types cite))) 3408 (org-element-put-property cite :contents-end (point)))) 3409 cite)))))) 3410 3411 (defun org-element-citation-interpreter (citation contents) 3412 "Interpret CITATION object as Org syntax. 3413 CONTENTS is the contents of the object, as a string." 3414 (let ((prefix (org-element-property :prefix citation)) 3415 (suffix (org-element-property :suffix citation)) 3416 (style (org-element-property :style citation))) 3417 (concat "[cite" 3418 (and style (concat "/" style)) 3419 ":" 3420 (and prefix (concat (org-element-interpret-data prefix) ";")) 3421 (if suffix 3422 (concat contents (org-element-interpret-data suffix)) 3423 ;; Remove spurious semicolon. 3424 (substring contents nil -1)) 3425 "]"))) 3426 3427 3428 ;;;; Citation Reference 3429 3430 (defun org-element-citation-reference-parser () 3431 "Parse citation reference object at point, if any. 3432 3433 When at a reference, return a new syntax node of `citation-reference' 3434 type containing `:key', `:prefix', `:suffix', `:begin', `:end', and 3435 `:post-blank' properties. 3436 3437 Assume point is at the beginning of the reference." 3438 (save-excursion 3439 (let ((begin (point))) 3440 (when (re-search-forward org-element-citation-key-re nil t) 3441 (let* ((key (org-element--get-cached-string 3442 (match-string-no-properties 1))) 3443 (key-start (match-beginning 0)) 3444 (key-end (match-end 0)) 3445 (separator (search-forward ";" nil t)) 3446 (end (or separator (point-max))) 3447 (suffix-end (if separator (1- end) end)) 3448 (types (org-element-restriction 'citation-reference)) 3449 (reference 3450 (org-element-create 3451 'citation-reference 3452 (list :key key 3453 :begin begin 3454 :end end 3455 :post-blank 0 3456 :secondary (alist-get 3457 'citation-reference 3458 org-element-secondary-value-alist))))) 3459 (when (< begin key-start) 3460 (org-element-put-property 3461 reference :prefix 3462 (org-element--parse-objects begin key-start nil types reference))) 3463 (when (< key-end suffix-end) 3464 (org-element-put-property 3465 reference :suffix 3466 (org-element--parse-objects key-end suffix-end nil types reference))) 3467 reference))))) 3468 3469 (defun org-element-citation-reference-interpreter (citation-reference _) 3470 "Interpret CITATION-REFERENCE object as Org syntax." 3471 (concat (org-element-interpret-data 3472 (org-element-property :prefix citation-reference)) 3473 "@" (org-element-property :key citation-reference) 3474 (org-element-interpret-data 3475 (org-element-property :suffix citation-reference)) 3476 ";")) 3477 3478 3479 ;;;; Code 3480 3481 (defun org-element-code-parser () 3482 "Parse code object at point, if any. 3483 3484 When at a code object, return a new syntax node of `code' type 3485 containing `:value', `:begin', `:end' and `:post-blank' properties. 3486 Otherwise, return nil. 3487 3488 Assume point is at the first tilde marker." 3489 (org-element--parse-generic-emphasis "~" 'code)) 3490 3491 (defun org-element-code-interpreter (code _) 3492 "Interpret CODE object as Org syntax." 3493 (format "~%s~" (org-element-property :value code))) 3494 3495 3496 ;;;; Entity 3497 3498 (defun org-element-entity-parser () 3499 "Parse entity at point, if any. 3500 3501 When at an entity, return a new syntax node of `entity' type 3502 containing `:begin', `:end', `:latex', `:latex-math-p', `:html', 3503 `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and `:post-blank' as 3504 properties. Otherwise, return nil. 3505 3506 Assume point is at the beginning of the entity." 3507 (catch 'no-object 3508 (when (looking-at 3509 (rx "\\" 3510 (or 3511 ;; Special case: whitespace entities are matched by 3512 ;; name only. 3513 (group-n 1 (seq "_" (1+ " "))) 3514 (seq 3515 (group-n 1 3516 (or "there4" 3517 (seq "sup" (in "123")) 3518 (seq "frac" (in "13") (in "24")) 3519 (1+ (in "a-zA-Z")))) 3520 (group-n 2 (or eol "{}" (not letter))))))) 3521 (save-excursion 3522 (let* ((value (or (org-entity-get (match-string 1)) 3523 (throw 'no-object nil))) 3524 (begin (match-beginning 0)) 3525 (bracketsp (string= (match-string 2) "{}")) 3526 (post-blank (progn (goto-char (match-end 1)) 3527 (when bracketsp (forward-char 2)) 3528 (skip-chars-forward " \t"))) 3529 (end (point))) 3530 (org-element-create 3531 'entity 3532 (list :name (car value) 3533 :latex (nth 1 value) 3534 :latex-math-p (nth 2 value) 3535 :html (nth 3 value) 3536 :ascii (nth 4 value) 3537 :latin1 (nth 5 value) 3538 :utf-8 (nth 6 value) 3539 :begin begin 3540 :end end 3541 :use-brackets-p bracketsp 3542 :post-blank post-blank))))))) 3543 3544 (defun org-element-entity-interpreter (entity _) 3545 "Interpret ENTITY object as Org syntax." 3546 (concat "\\" 3547 (org-element-property :name entity) 3548 (when (org-element-property :use-brackets-p entity) "{}"))) 3549 3550 3551 ;;;; Export Snippet 3552 3553 (defun org-element-export-snippet-parser () 3554 "Parse export snippet at point. 3555 3556 When at an export snippet, return a new syntax node of 3557 `export-snippet' type containing `:begin', `:end', `:back-end', 3558 `:value' and `:post-blank' as properties. Otherwise, return nil. 3559 3560 Assume point is at the beginning of the snippet." 3561 (save-excursion 3562 (when (looking-at "@@\\([-A-Za-z0-9]+\\):") 3563 (goto-char (match-end 0)) 3564 (let* ((begin (match-beginning 0)) 3565 (contents-begin (match-end 0)) 3566 (backend (org-element--get-cached-string 3567 (match-string-no-properties 1))) 3568 (contents-end 3569 (when (re-search-forward "@@" nil t) 3570 (match-beginning 0))) 3571 (value 3572 (when contents-end 3573 (org-element-deferred-create 3574 t #'org-element--substring 3575 (- contents-begin begin) 3576 (- contents-end begin)))) 3577 (post-blank (skip-chars-forward " \t")) 3578 (end (point))) 3579 (when contents-end ; No match when no trailing "@@". 3580 (org-element-create 3581 'export-snippet 3582 (list :back-end backend 3583 :value value 3584 :begin begin 3585 :end end 3586 :post-blank post-blank))))))) 3587 3588 (defun org-element-export-snippet-interpreter (export-snippet _) 3589 "Interpret EXPORT-SNIPPET object as Org syntax." 3590 (format "@@%s:%s@@" 3591 (org-element-property :back-end export-snippet) 3592 (org-element-property :value export-snippet))) 3593 3594 3595 ;;;; Footnote Reference 3596 3597 (defun org-element-footnote-reference-parser () 3598 "Parse footnote reference at point, if any. 3599 3600 When at a footnote reference, return a new syntax node of 3601 `footnote-reference' type containing `:label', `:type', `:begin', 3602 `:end', `:contents-begin', `:contents-end' and `:post-blank' as 3603 properties. Otherwise, return nil." 3604 (when (looking-at org-footnote-re) 3605 (let ((closing (with-syntax-table org-element--pair-square-table 3606 (ignore-errors (scan-lists (point) 1 0))))) 3607 (when closing 3608 (save-excursion 3609 (let* ((begin (point)) 3610 (label (org-element--get-cached-string 3611 (match-string-no-properties 1))) 3612 (inner-begin (match-end 0)) 3613 (inner-end (1- closing)) 3614 (type (if (match-end 2) 'inline 'standard)) 3615 (post-blank (progn (goto-char closing) 3616 (skip-chars-forward " \t"))) 3617 (end (point))) 3618 (org-element-create 3619 'footnote-reference 3620 (list :label label 3621 :type type 3622 :begin begin 3623 :end end 3624 :contents-begin (and (eq type 'inline) inner-begin) 3625 :contents-end (and (eq type 'inline) inner-end) 3626 :post-blank post-blank)))))))) 3627 3628 (defun org-element-footnote-reference-interpreter (footnote-reference contents) 3629 "Interpret FOOTNOTE-REFERENCE object as Org syntax. 3630 CONTENTS is its definition, when inline, or nil." 3631 (format "[fn:%s%s]" 3632 (or (org-element-property :label footnote-reference) "") 3633 (if contents (concat ":" contents) ""))) 3634 3635 3636 ;;;; Inline Babel Call 3637 3638 (defun org-element-inline-babel-call-parser () 3639 "Parse inline babel call at point, if any. 3640 3641 When at an inline babel call, return a new syntax node of 3642 `inline-babel-call' type containing `:call', `:inside-header', 3643 `:arguments', `:end-header', `:begin', `:end', `:value' and 3644 `:post-blank' as properties. Otherwise, return nil. 3645 3646 Assume point is at the beginning of the babel call." 3647 (save-excursion 3648 (catch :no-object 3649 (when (let ((case-fold-search nil)) 3650 (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]")) 3651 (goto-char (match-end 1)) 3652 (let* ((begin (match-beginning 0)) 3653 (call (org-element--get-cached-string 3654 (match-string-no-properties 1))) 3655 (inside-header 3656 (let ((p (org-element--parse-paired-brackets ?\[))) 3657 (and (org-string-nw-p p) 3658 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3659 (arguments (org-string-nw-p 3660 (or (org-element--parse-paired-brackets ?\() 3661 ;; Parenthesis are mandatory. 3662 (throw :no-object nil)))) 3663 (end-header 3664 (let ((p (org-element--parse-paired-brackets ?\[))) 3665 (and (org-string-nw-p p) 3666 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3667 (value 3668 (org-element-deferred-create 3669 t #'org-element--substring 3670 0 (- (point) begin))) 3671 (post-blank (skip-chars-forward " \t")) 3672 (end (point))) 3673 (org-element-create 3674 'inline-babel-call 3675 (list :call call 3676 :inside-header inside-header 3677 :arguments arguments 3678 :end-header end-header 3679 :begin begin 3680 :end end 3681 :value value 3682 :post-blank post-blank))))))) 3683 3684 (defun org-element-inline-babel-call-interpreter (inline-babel-call _) 3685 "Interpret INLINE-BABEL-CALL object as Org syntax." 3686 (concat "call_" 3687 (org-element-property :call inline-babel-call) 3688 (let ((h (org-element-property :inside-header inline-babel-call))) 3689 (and h (format "[%s]" h))) 3690 "(" (org-element-property :arguments inline-babel-call) ")" 3691 (let ((h (org-element-property :end-header inline-babel-call))) 3692 (and h (format "[%s]" h))))) 3693 3694 3695 ;;;; Inline Src Block 3696 3697 (defun org-element-inline-src-block-parser () 3698 "Parse inline source block at point, if any. 3699 3700 When at an inline source block, return a new syntax node of 3701 `inline-src-block' type containing `:begin', `:end', `:language', 3702 `:value', `:parameters' and `:post-blank' as properties. Otherwise, 3703 return nil. 3704 3705 Assume point is at the beginning of the inline source block." 3706 (save-excursion 3707 (catch :no-object 3708 (when (let ((case-fold-search nil)) 3709 (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]")) 3710 (goto-char (match-end 1)) 3711 (let ((begin (match-beginning 0)) 3712 (language (org-element--get-cached-string 3713 (match-string-no-properties 1))) 3714 (parameters 3715 (let ((p (org-element--parse-paired-brackets ?\[))) 3716 (and (org-string-nw-p p) 3717 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3718 (value (or (org-element--parse-paired-brackets ?\{) 3719 (throw :no-object nil))) 3720 (post-blank (skip-chars-forward " \t"))) 3721 (org-element-create 3722 'inline-src-block 3723 (list :language language 3724 :value value 3725 :parameters parameters 3726 :begin begin 3727 :end (point) 3728 :post-blank post-blank))))))) 3729 3730 (defun org-element-inline-src-block-interpreter (inline-src-block _) 3731 "Interpret INLINE-SRC-BLOCK object as Org syntax." 3732 (let ((language (org-element-property :language inline-src-block)) 3733 (arguments (org-element-property :parameters inline-src-block)) 3734 (body (org-element-property :value inline-src-block))) 3735 (format "src_%s%s{%s}" 3736 language 3737 (if arguments (format "[%s]" arguments) "") 3738 body))) 3739 3740 ;;;; Italic 3741 3742 (defun org-element-italic-parser () 3743 "Parse italic object at point, if any. 3744 3745 When at an italic object, return a new syntax node of `italic' type 3746 containing `:begin', `:end', `:contents-begin' and `:contents-end' and 3747 `:post-blank' properties. Otherwise, return nil. 3748 3749 Assume point is at the first slash marker." 3750 (org-element--parse-generic-emphasis "/" 'italic)) 3751 3752 (defun org-element-italic-interpreter (_ contents) 3753 "Interpret italic object as Org syntax. 3754 CONTENTS is the contents of the object." 3755 (format "/%s/" contents)) 3756 3757 3758 ;;;; LaTeX Fragment 3759 3760 (defun org-element-latex-fragment-parser () 3761 "Parse LaTeX fragment at point, if any. 3762 3763 When at a LaTeX fragment, return a new syntax node of `latex-fragment' 3764 type containing `:value', `:begin', `:end', and `:post-blank' as 3765 properties. Otherwise, return nil. 3766 3767 Assume point is at the beginning of the LaTeX fragment." 3768 (catch 'no-object 3769 (save-excursion 3770 (let* ((begin (point)) 3771 (after-fragment 3772 (cond 3773 ((not (eq ?$ (char-after))) 3774 (pcase (char-after (1+ (point))) 3775 (?\( (search-forward "\\)" nil t)) 3776 (?\[ (search-forward "\\]" nil t)) 3777 (_ 3778 ;; Macro. 3779 (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\ 3780 \\|\\({[^{}\n]*}\\)\\)*") 3781 (match-end 0))))) 3782 ((eq ?$ (char-after (1+ (point)))) 3783 (search-forward "$$" nil t 2)) 3784 (t 3785 (and (not (eq ?$ (char-before))) 3786 (not (memq (char-after (1+ (point))) 3787 '(?\s ?\t ?\n ?, ?. ?\;))) 3788 (search-forward "$" nil t 2) 3789 (not (memq (char-before (match-beginning 0)) 3790 '(?\s ?\t ?\n ?, ?.))) 3791 (looking-at-p 3792 "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)") 3793 (point))))) 3794 (post-blank 3795 (if (not after-fragment) (throw 'no-object nil) 3796 (goto-char after-fragment) 3797 (skip-chars-forward " \t"))) 3798 (end (point))) 3799 (org-element-create 3800 'latex-fragment 3801 (list :value 3802 (org-element-deferred-create 3803 t #'org-element--substring 3804 0 (- after-fragment begin)) 3805 :begin begin 3806 :end end 3807 :post-blank post-blank)))))) 3808 3809 (defun org-element-latex-fragment-interpreter (latex-fragment _) 3810 "Interpret LATEX-FRAGMENT object as Org syntax." 3811 (org-element-property :value latex-fragment)) 3812 3813 ;;;; Line Break 3814 3815 (defun org-element-line-break-parser () 3816 "Parse line break at point, if any. 3817 3818 When at a line break, return a new syntax node of `line-break' type 3819 containing `:begin', `:end' and `:post-blank' properties. Otherwise, 3820 return nil. 3821 3822 Assume point is at the beginning of the line break." 3823 (when (and (looking-at-p "\\\\\\\\[ \t]*$") 3824 (not (eq (char-before) ?\\))) 3825 (org-element-create 3826 'line-break 3827 (list :begin (point) 3828 :end (line-beginning-position 2) 3829 :post-blank 0)))) 3830 3831 (defun org-element-line-break-interpreter (&rest _) 3832 "Interpret LINE-BREAK object as Org syntax." 3833 "\\\\\n") 3834 3835 3836 ;;;; Link 3837 3838 (defun org-element-link-parser () 3839 "Parse link at point, if any. 3840 3841 When at a link, return a new syntax node of `link' type containing 3842 `:type', `:type-explicit-p', `:path', `:format', `:raw-link', 3843 `:application', `:search-option', `:begin', `:end', `:contents-begin', 3844 `:contents-end' and `:post-blank' as properties. Otherwise, return nil. 3845 3846 Assume point is at the beginning of the link." 3847 (catch 'no-object 3848 (let ((begin (point)) 3849 end contents-begin contents-end link-end post-blank path type format 3850 raw-link search-option application 3851 (explicit-type-p nil)) 3852 (cond 3853 ;; Type 1: Text targeted from a radio target. 3854 ((and org-target-link-regexp 3855 (save-excursion (or (bolp) (backward-char)) 3856 (if org-target-link-regexps 3857 (org--re-list-looking-at org-target-link-regexps) 3858 (looking-at org-target-link-regexp)))) 3859 (setq type "radio") 3860 (setq format 'plain) 3861 (setq link-end (match-end 1)) 3862 (setq path (match-string-no-properties 1)) 3863 (setq contents-begin (match-beginning 1)) 3864 (setq contents-end (match-end 1))) 3865 ;; Type 2: Standard link, i.e. [[https://orgmode.org][website]] 3866 ((looking-at org-link-bracket-re) 3867 (setq format 'bracket) 3868 (setq contents-begin (match-beginning 2)) 3869 (setq contents-end (match-end 2)) 3870 (setq link-end (match-end 0)) 3871 ;; RAW-LINK is the original link. Decode any encoding. 3872 ;; Expand any abbreviation in it. 3873 ;; 3874 ;; Also treat any newline character and associated 3875 ;; indentation as a single space character. This is not 3876 ;; compatible with RFC 3986, which requires ignoring 3877 ;; them altogether. However, doing so would require 3878 ;; users to encode spaces on the fly when writing links 3879 ;; (e.g., insert [[shell:ls%20*.org]] instead of 3880 ;; [[shell:ls *.org]], which defeats Org's focus on 3881 ;; simplicity. 3882 (setq raw-link (org-link-expand-abbrev 3883 (org-link-unescape 3884 (replace-regexp-in-string 3885 "[ \t]*\n[ \t]*" " " 3886 (match-string-no-properties 1))))) 3887 ;; Determine TYPE of link and set PATH accordingly. According 3888 ;; to RFC 3986, remove whitespaces from URI in external links. 3889 ;; In internal ones, treat indentation as a single space. 3890 (cond 3891 ;; File type. 3892 ((or (file-name-absolute-p raw-link) 3893 (string-match-p "\\`\\.\\.?/" raw-link)) 3894 (setq type "file") 3895 (setq path raw-link)) 3896 ;; Explicit type (http, irc, bbdb...). 3897 ((string-match org-link-types-re raw-link) 3898 (setq type (match-string-no-properties 1 raw-link)) 3899 (setq explicit-type-p t) 3900 (setq path (substring raw-link (match-end 0)))) 3901 ;; Code-ref type: PATH is the name of the reference. 3902 ((and (string-match-p "\\`(" raw-link) 3903 (string-match-p ")\\'" raw-link)) 3904 (setq type "coderef") 3905 (setq path (substring raw-link 1 -1))) 3906 ;; Custom-id type: PATH is the name of the custom id. 3907 ((= (string-to-char raw-link) ?#) 3908 (setq type "custom-id") 3909 (setq path (substring raw-link 1))) 3910 ;; Fuzzy type: Internal link either matches a target, an 3911 ;; headline name or nothing. PATH is the target or 3912 ;; headline's name. 3913 (t 3914 (setq type "fuzzy") 3915 (setq path raw-link)))) 3916 ;; Type 3: Plain link, e.g., https://orgmode.org 3917 ((looking-at org-link-plain-re) 3918 (setq format 'plain) 3919 (setq raw-link (match-string-no-properties 0)) 3920 (setq type (match-string-no-properties 1)) 3921 (setq explicit-type-p t) 3922 (setq link-end (match-end 0)) 3923 (setq path (match-string-no-properties 2))) 3924 ;; Type 4: Angular link, e.g., <https://orgmode.org>. Unlike to 3925 ;; bracket links, follow RFC 3986 and remove any extra 3926 ;; whitespace in URI. 3927 ((looking-at org-link-angle-re) 3928 (setq format 'angle) 3929 (setq type (match-string-no-properties 1)) 3930 (setq explicit-type-p t) 3931 (setq link-end (match-end 0)) 3932 (setq raw-link 3933 (buffer-substring-no-properties 3934 (match-beginning 1) (match-end 2))) 3935 (setq path (replace-regexp-in-string 3936 "[ \t]*\n[ \t]*" "" (match-string-no-properties 2)))) 3937 (t (throw 'no-object nil))) 3938 ;; In any case, deduce end point after trailing white space from 3939 ;; LINK-END variable. 3940 (save-excursion 3941 (setq post-blank 3942 (progn (goto-char link-end) (skip-chars-forward " \t"))) 3943 (setq end (point))) 3944 ;; Special "file"-type link processing. Extract opening 3945 ;; application and search option, if any. Also normalize URI. 3946 (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) 3947 (setq application (match-string-no-properties 1 type)) 3948 (setq type "file") 3949 (when (string-match "::\\(.*\\)\\'" path) 3950 (setq search-option (match-string-no-properties 1 path)) 3951 (setq path (replace-match "" nil nil path))) 3952 (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) 3953 ;; Translate link, if `org-link-translation-function' is set. 3954 (let ((trans (and (functionp org-link-translation-function) 3955 (funcall org-link-translation-function type path)))) 3956 (when trans 3957 (setq type (car trans)) 3958 (setq explicit-type-p t) 3959 (setq path (cdr trans)))) 3960 (org-element-create 3961 'link 3962 (list :type (org-element--get-cached-string type) 3963 :type-explicit-p explicit-type-p 3964 :path path 3965 :format format 3966 :raw-link (or raw-link path) 3967 :application application 3968 :search-option search-option 3969 :begin begin 3970 :end end 3971 :contents-begin contents-begin 3972 :contents-end contents-end 3973 :post-blank post-blank))))) 3974 3975 (defun org-element-link-interpreter (link contents) 3976 "Interpret LINK object as Org syntax. 3977 CONTENTS is the contents of the object, or nil." 3978 (let ((type (org-element-property :type link)) 3979 (path (org-element-property :path link))) 3980 (if (string= type "radio") path 3981 (let ((fmt (pcase (org-element-property :format link) 3982 ;; Links with contents and internal links have to 3983 ;; use bracket syntax. Ignore `:format' in these 3984 ;; cases. This is also the default syntax when the 3985 ;; property is not defined, e.g., when the object 3986 ;; was crafted by the user. 3987 ((guard contents) 3988 (format "[[%%s][%s]]" 3989 ;; Since this is going to be used as 3990 ;; a format string, escape percent signs 3991 ;; in description. 3992 (replace-regexp-in-string "%" "%%" contents))) 3993 ((or `bracket 3994 `nil 3995 (guard (member type '("coderef" "custom-id" "fuzzy")))) 3996 "[[%s]]") 3997 ;; Otherwise, just obey to `:format'. 3998 (`angle "<%s>") 3999 (`plain "%s") 4000 (f (error "Wrong `:format' value: %s" f))))) 4001 (format fmt 4002 (pcase type 4003 ("coderef" (format "(%s)" path)) 4004 ("custom-id" (concat "#" path)) 4005 ("file" 4006 (let ((app (org-element-property :application link)) 4007 (opt (org-element-property :search-option link)) 4008 (type-explicit-p (org-element-property :type-explicit-p link))) 4009 (concat (and type-explicit-p type) 4010 (and type-explicit-p app (concat "+" app)) 4011 (and type-explicit-p ":") 4012 path 4013 (and opt (concat "::" opt))))) 4014 ("fuzzy" path) 4015 (_ (concat type ":" path)))))))) 4016 4017 4018 ;;;; Macro 4019 4020 (defun org-element-macro-parser () 4021 "Parse macro at point, if any. 4022 4023 When at a macro, return a new syntax node of `macro' type containing 4024 `:key', `:args', `:begin', `:end', `:value' and `:post-blank' as 4025 properties. Otherwise, return nil. 4026 4027 Assume point is at the macro." 4028 (save-excursion 4029 (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\(\\(?:.\\|\n\\)*?\\))\\)?}}}") 4030 (let ((begin (point)) 4031 (key (org-element--get-cached-string 4032 (downcase (match-string-no-properties 1)))) 4033 (value (match-string-no-properties 0)) 4034 (post-blank (progn (goto-char (match-end 0)) 4035 (skip-chars-forward " \t"))) 4036 (end (point)) 4037 (args (pcase (match-string-no-properties 3) 4038 (`nil nil) 4039 (a (org-macro-extract-arguments 4040 (replace-regexp-in-string 4041 "[ \t\r\n]+" " " (org-trim a))))))) 4042 (org-element-create 4043 'macro 4044 (list :key key 4045 :value value 4046 :args args 4047 :begin begin 4048 :end end 4049 :post-blank post-blank)))))) 4050 4051 (defun org-element-macro-interpreter (macro _) 4052 "Interpret MACRO object as Org syntax." 4053 (format "{{{%s%s}}}" 4054 (org-element-property :key macro) 4055 (pcase (org-element-property :args macro) 4056 (`nil "") 4057 (args (format "(%s)" (apply #'org-macro-escape-arguments args)))))) 4058 4059 4060 ;;;; Radio-target 4061 4062 (defun org-element-radio-target-parser () 4063 "Parse radio target at point, if any. 4064 4065 When at a radio target, return a new syntax node of `radio-target' 4066 type containing `:begin', `:end', `:contents-begin', `:contents-end', 4067 `:value' and `:post-blank' as properties. Otherwise, return nil. 4068 4069 Assume point is at the radio target." 4070 (save-excursion 4071 (when (looking-at org-radio-target-regexp) 4072 (let ((begin (point)) 4073 (contents-begin (match-beginning 1)) 4074 (contents-end (match-end 1)) 4075 (value (match-string-no-properties 1)) 4076 (post-blank (progn (goto-char (match-end 0)) 4077 (skip-chars-forward " \t"))) 4078 (end (point))) 4079 (org-element-create 4080 'radio-target 4081 (list :begin begin 4082 :end end 4083 :contents-begin contents-begin 4084 :contents-end contents-end 4085 :post-blank post-blank 4086 :value value)))))) 4087 4088 (defun org-element-radio-target-interpreter (_ contents) 4089 "Interpret target object as Org syntax. 4090 CONTENTS is the contents of the object." 4091 (concat "<<<" contents ">>>")) 4092 4093 4094 ;;;; Statistics Cookie 4095 4096 (defun org-element-statistics-cookie-parser () 4097 "Parse statistics cookie at point, if any. 4098 4099 When at a statistics cookie, return a new syntax node of 4100 `statistics-cookie' type containing `:begin', `:end', `:value' and 4101 `:post-blank' properties. Otherwise, return nil. 4102 4103 Assume point is at the beginning of the statistics-cookie." 4104 (save-excursion 4105 (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") 4106 (let* ((begin (point)) 4107 (value (buffer-substring-no-properties 4108 (match-beginning 0) (match-end 0))) 4109 (post-blank (progn (goto-char (match-end 0)) 4110 (skip-chars-forward " \t"))) 4111 (end (point))) 4112 (org-element-create 4113 'statistics-cookie 4114 (list :begin begin 4115 :end end 4116 :value value 4117 :post-blank post-blank)))))) 4118 4119 (defun org-element-statistics-cookie-interpreter (statistics-cookie _) 4120 "Interpret STATISTICS-COOKIE object as Org syntax." 4121 (org-element-property :value statistics-cookie)) 4122 4123 4124 ;;;; Strike-Through 4125 4126 (defun org-element-strike-through-parser () 4127 "Parse strike-through object at point, if any. 4128 4129 When at a strike-through object, return a new syntax node of 4130 `strike-through' type containing `:begin', `:end', `:contents-begin' 4131 and `:contents-end' and `:post-blank' properties. Otherwise, return 4132 nil. 4133 4134 Assume point is at the first plus sign marker." 4135 (org-element--parse-generic-emphasis "+" 'strike-through)) 4136 4137 (defun org-element-strike-through-interpreter (_ contents) 4138 "Interpret strike-through object as Org syntax. 4139 CONTENTS is the contents of the object." 4140 (format "+%s+" contents)) 4141 4142 4143 ;;;; Subscript 4144 4145 (defun org-element-subscript-parser () 4146 "Parse subscript at point, if any. 4147 4148 When at a subscript object, return a new syntax node of `subscript' 4149 type containing `:begin', `:end', `:contents-begin', `:contents-end', 4150 `:use-brackets-p' and `:post-blank' as properties. Otherwise, return 4151 nil. 4152 4153 Assume point is at the underscore." 4154 (save-excursion 4155 (unless (bolp) 4156 (backward-char) 4157 (when (looking-at org-match-substring-regexp) 4158 (let ((bracketsp (if (match-beginning 4) t nil)) 4159 (begin (match-beginning 2)) 4160 (contents-begin (or (match-beginning 4) 4161 (match-beginning 3))) 4162 (contents-end (or (match-end 4) (match-end 3))) 4163 (post-blank (progn (goto-char (match-end 0)) 4164 (skip-chars-forward " \t"))) 4165 (end (point))) 4166 (org-element-create 4167 'subscript 4168 (list :begin begin 4169 :end end 4170 :use-brackets-p bracketsp 4171 :contents-begin contents-begin 4172 :contents-end contents-end 4173 :post-blank post-blank))))))) 4174 4175 (defun org-element-subscript-interpreter (subscript contents) 4176 "Interpret SUBSCRIPT object as Org syntax. 4177 CONTENTS is the contents of the object." 4178 (format 4179 (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") 4180 contents)) 4181 4182 4183 ;;;; Superscript 4184 4185 (defun org-element-superscript-parser () 4186 "Parse superscript at point, if any. 4187 4188 When at a superscript object, return a new syntax node of 4189 `superscript' type containing `:begin', `:end', `:contents-begin', 4190 `:contents-end', `:use-brackets-p' and `:post-blank' as properties. 4191 Otherwise, return nil. 4192 4193 Assume point is at the caret." 4194 (save-excursion 4195 (unless (bolp) (backward-char)) 4196 (when (looking-at org-match-substring-regexp) 4197 (let ((bracketsp (if (match-beginning 4) t nil)) 4198 (begin (match-beginning 2)) 4199 (contents-begin (or (match-beginning 4) 4200 (match-beginning 3))) 4201 (contents-end (or (match-end 4) (match-end 3))) 4202 (post-blank (progn (goto-char (match-end 0)) 4203 (skip-chars-forward " \t"))) 4204 (end (point))) 4205 (org-element-create 4206 'superscript 4207 (list :begin begin 4208 :end end 4209 :use-brackets-p bracketsp 4210 :contents-begin contents-begin 4211 :contents-end contents-end 4212 :post-blank post-blank)))))) 4213 4214 (defun org-element-superscript-interpreter (superscript contents) 4215 "Interpret SUPERSCRIPT object as Org syntax. 4216 CONTENTS is the contents of the object." 4217 (format 4218 (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") 4219 contents)) 4220 4221 4222 ;;;; Table Cell 4223 4224 (defun org-element-table-cell-parser () 4225 "Parse table cell at point. 4226 Return a new syntax node of `table-cell' type containing `:begin', 4227 `:end', `:contents-begin', `:contents-end' and `:post-blank' 4228 properties." 4229 (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)") 4230 (let* ((begin (match-beginning 0)) 4231 (end (match-end 0)) 4232 (contents-begin (match-beginning 1)) 4233 (contents-end (match-end 1))) 4234 (org-element-create 4235 'table-cell 4236 (list :begin begin 4237 :end end 4238 :contents-begin contents-begin 4239 :contents-end contents-end 4240 :post-blank 0)))) 4241 4242 (defun org-element-table-cell-interpreter (_ contents) 4243 "Interpret table-cell element as Org syntax. 4244 CONTENTS is the contents of the cell, or nil." 4245 (concat " " contents " |")) 4246 4247 4248 ;;;; Target 4249 4250 (defun org-element-target-parser () 4251 "Parse target at point, if any. 4252 4253 When at a target, return a new syntax node of `target' type containing 4254 `:begin', `:end', `:value' and `:post-blank' as properties. 4255 Otherwise, return nil. 4256 4257 Assume point is at the target." 4258 (save-excursion 4259 (when (looking-at org-target-regexp) 4260 (let ((begin (point)) 4261 (value (match-string-no-properties 1)) 4262 (post-blank (progn (goto-char (match-end 0)) 4263 (skip-chars-forward " \t"))) 4264 (end (point))) 4265 (org-element-create 4266 'target 4267 (list :begin begin 4268 :end end 4269 :value value 4270 :post-blank post-blank)))))) 4271 4272 (defun org-element-target-interpreter (target _) 4273 "Interpret TARGET object as Org syntax." 4274 (format "<<%s>>" (org-element-property :value target))) 4275 4276 4277 ;;;; Timestamp 4278 4279 (defconst org-element--timestamp-regexp 4280 (concat org-ts-regexp-both 4281 "\\|" 4282 "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" 4283 "\\|" 4284 "\\(?:<%%\\(?:([^>\n]+)\\)\\([^\n>]*\\)>\\)") 4285 "Regexp matching any timestamp type object.") 4286 4287 (defconst org-element--timestamp-raw-value-regexp 4288 (concat "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\(" 4289 org-ts-regexp-both 4290 "\\)\\)?") 4291 "Regexp for matching raw value of a timestamp.") 4292 4293 (defun org-element-timestamp-parser () 4294 "Parse time stamp at point, if any. 4295 4296 When at a time stamp, return a new syntax node of `timestamp' type 4297 containing `:type', `:range-type', `:raw-value', `:year-start', 4298 `:month-start', `:day-start', `:hour-start', `:minute-start', 4299 `:year-end', `:month-end', `:day-end', `:hour-end', `:minute-end', 4300 `:repeater-type', `:repeater-value', `:repeater-unit', 4301 `:repeater-deadline-value', `:repeater-deadline-unit', `:warning-type', 4302 `:warning-value', `:warning-unit', `:diary-sexp', `:begin', `:end' and 4303 `:post-blank' properties. Otherwise, return nil. 4304 4305 Assume point is at the beginning of the timestamp." 4306 (when (looking-at-p org-element--timestamp-regexp) 4307 (save-excursion 4308 (let* ((begin (point)) 4309 (activep (eq (char-after) ?<)) 4310 (raw-value 4311 (progn 4312 (looking-at org-element--timestamp-raw-value-regexp) 4313 (match-string-no-properties 0))) 4314 (diaryp (match-beginning 2)) 4315 diary-sexp 4316 (date-start (if diaryp 4317 ;; Only consider part after sexp for 4318 ;; diary timestamps. 4319 (save-match-data 4320 (looking-at org-element--timestamp-regexp) 4321 (setq diary-sexp 4322 (buffer-substring-no-properties 4323 (+ 3 (match-beginning 0)) 4324 (match-beginning 2))) 4325 (match-string 2)) 4326 (match-string-no-properties 1))) 4327 (date-end (match-string-no-properties 3)) 4328 (post-blank (progn (goto-char (match-end 0)) 4329 (skip-chars-forward " \t"))) 4330 (end (point)) 4331 (time-range 4332 (when (string-match 4333 "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" 4334 date-start) 4335 (cons (string-to-number (match-string 2 date-start)) 4336 (string-to-number (match-string 3 date-start))))) 4337 (type (cond (diaryp 'diary) 4338 ((and activep (or date-end time-range)) 'active-range) 4339 (activep 'active) 4340 ((or date-end time-range) 'inactive-range) 4341 (t 'inactive))) 4342 (range-type (cond 4343 (date-end 'daterange) 4344 (time-range 'timerange) 4345 (t nil))) 4346 (repeater-props 4347 (and (not diaryp) 4348 (string-match 4349 (rx 4350 (group-n 1 (or "+" "++" ".+")) 4351 (group-n 2 (+ digit)) 4352 (group-n 3 (any "hdwmy")) 4353 (optional 4354 "/" 4355 (group-n 4 (+ digit)) 4356 (group-n 5 (any "hdwmy")))) 4357 raw-value) 4358 (nconc 4359 (list 4360 :repeater-type 4361 (let ((type (match-string 1 raw-value))) 4362 (cond ((equal "++" type) 'catch-up) 4363 ((equal ".+" type) 'restart) 4364 (t 'cumulate))) 4365 :repeater-value (string-to-number (match-string 2 raw-value)) 4366 :repeater-unit 4367 (pcase (string-to-char (match-string 3 raw-value)) 4368 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))) 4369 4370 (let ((repeater-deadline-value (match-string 4 raw-value)) 4371 (repeater-deadline-unit (match-string 5 raw-value))) 4372 (when (and repeater-deadline-value repeater-deadline-unit) 4373 (list 4374 :repeater-deadline-value (string-to-number repeater-deadline-value) 4375 :repeater-deadline-unit 4376 (pcase (string-to-char repeater-deadline-unit) 4377 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))))) 4378 (warning-props 4379 (and (not diaryp) 4380 (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) 4381 (list 4382 :warning-type (if (match-string 1 raw-value) 'first 'all) 4383 :warning-value (string-to-number (match-string 2 raw-value)) 4384 :warning-unit 4385 (pcase (string-to-char (match-string 3 raw-value)) 4386 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) 4387 year-start month-start day-start hour-start minute-start year-end 4388 month-end day-end hour-end minute-end) 4389 ;; Parse date-start. 4390 (unless diaryp 4391 (let ((date (org-parse-time-string date-start t))) 4392 (setq year-start (nth 5 date) 4393 month-start (nth 4 date) 4394 day-start (nth 3 date) 4395 hour-start (nth 2 date) 4396 minute-start (nth 1 date)))) 4397 ;; Compute date-end. It can be provided directly in timestamp, 4398 ;; or extracted from time range. Otherwise, it defaults to the 4399 ;; same values as date-start. 4400 (unless diaryp 4401 (let ((date (and date-end (org-parse-time-string date-end t)))) 4402 (setq year-end (or (nth 5 date) year-start) 4403 month-end (or (nth 4 date) month-start) 4404 day-end (or (nth 3 date) day-start) 4405 hour-end (or (nth 2 date) (car time-range) hour-start) 4406 minute-end (or (nth 1 date) (cdr time-range) minute-start)))) 4407 ;; Diary timestamp with time. 4408 (when (and diaryp 4409 (string-match "\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)?" date-start)) 4410 (setq hour-start (match-string 1 date-start) 4411 minute-start (match-string 2 date-start) 4412 hour-end (match-string 4 date-start) 4413 minute-end (match-string 5 date-start)) 4414 (when hour-start (setq hour-start (string-to-number hour-start))) 4415 (when minute-start (setq minute-start (string-to-number minute-start))) 4416 (when hour-end (setq hour-end (string-to-number hour-end))) 4417 (when minute-end (setq minute-end (string-to-number minute-end)))) 4418 (org-element-create 4419 'timestamp 4420 (nconc (list :type type 4421 :range-type range-type 4422 :raw-value raw-value 4423 :year-start year-start 4424 :month-start month-start 4425 :day-start day-start 4426 :hour-start hour-start 4427 :minute-start minute-start 4428 :year-end year-end 4429 :month-end month-end 4430 :day-end day-end 4431 :hour-end hour-end 4432 :minute-end minute-end 4433 :begin begin 4434 :end end 4435 :post-blank post-blank) 4436 (and diary-sexp (list :diary-sexp diary-sexp)) 4437 repeater-props 4438 warning-props)))))) 4439 4440 (defun org-element-timestamp-interpreter (timestamp _) 4441 "Interpret TIMESTAMP object as Org syntax." 4442 (let((type (org-element-property :type timestamp))) 4443 (let ((day-start (org-element-property :day-start timestamp)) 4444 (month-start (org-element-property :month-start timestamp)) 4445 (year-start (org-element-property :year-start timestamp))) 4446 ;; Return nil when start date is not available. Could also 4447 ;; throw an error, but the current behavior is historical. 4448 (when (or (and day-start month-start year-start) 4449 (eq type 'diary)) 4450 (let* ((repeat-string 4451 (concat 4452 (pcase (org-element-property :repeater-type timestamp) 4453 (`cumulate "+") (`catch-up "++") (`restart ".+")) 4454 (let ((val (org-element-property :repeater-value timestamp))) 4455 (and val (number-to-string val))) 4456 (pcase (org-element-property :repeater-unit timestamp) 4457 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")) 4458 (when-let* ((repeater-deadline-value 4459 (org-element-property :repeater-deadline-value timestamp)) 4460 (repeater-deadline-unit 4461 (org-element-property :repeater-deadline-unit timestamp))) 4462 (concat 4463 "/" 4464 (number-to-string repeater-deadline-value) 4465 (pcase repeater-deadline-unit 4466 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))))) 4467 (range-type (org-element-property :range-type timestamp)) 4468 (warning-string 4469 (concat 4470 (pcase (org-element-property :warning-type timestamp) 4471 (`first "--") (`all "-")) 4472 (let ((val (org-element-property :warning-value timestamp))) 4473 (and val (number-to-string val))) 4474 (pcase (org-element-property :warning-unit timestamp) 4475 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) 4476 (hour-start (org-element-property :hour-start timestamp)) 4477 (minute-start (org-element-property :minute-start timestamp)) 4478 (brackets 4479 (if (member 4480 type 4481 '(inactive inactive-range)) 4482 (cons "[" "]") 4483 ;; diary as well 4484 (cons "<" ">"))) 4485 (timestamp-end 4486 (concat 4487 (and (org-string-nw-p repeat-string) (concat " " repeat-string)) 4488 (and (org-string-nw-p warning-string) (concat " " warning-string)) 4489 (cdr brackets)))) 4490 (concat 4491 ;; Opening bracket: [ or < 4492 (car brackets) 4493 ;; Starting date/time: YYYY-MM-DD DAY[ HH:MM] 4494 (if (eq type 'diary) 4495 (concat 4496 "%%" 4497 (org-element-property :diary-sexp timestamp) 4498 (when (and minute-start hour-start) 4499 (format " %02d:%02d" hour-start minute-start))) 4500 (format-time-string 4501 ;; `org-time-stamp-formats'. 4502 (org-time-stamp-format 4503 ;; Ignore time unless both HH:MM are available. 4504 ;; Ignore means (car org-timestamp-formats). 4505 (and minute-start hour-start) 4506 'no-brackets) 4507 (org-encode-time 4508 0 (or minute-start 0) (or hour-start 0) 4509 day-start month-start year-start))) 4510 ;; Range: -HH:MM or TIMESTAMP-END--[YYYY-MM-DD DAY HH:MM] 4511 (let ((hour-end (org-element-property :hour-end timestamp)) 4512 (minute-end (org-element-property :minute-end timestamp))) 4513 (pcase type 4514 ((or `active `inactive) 4515 ;; `org-element-timestamp-parser' uses this type 4516 ;; when no time/date range is provided. So, 4517 ;; should normally return nil in this clause. 4518 (pcase range-type 4519 (`nil 4520 ;; `org-element-timestamp-parser' assigns end 4521 ;; times for `active'/`inactive' TYPE if start 4522 ;; time is not nil. But manually built 4523 ;; timestamps may not contain end times, so 4524 ;; check for end times anyway. 4525 (when (and hour-start hour-end minute-start minute-end 4526 (or (/= hour-start hour-end) 4527 (/= minute-start minute-end))) 4528 ;; Could also throw an error. Return range 4529 ;; timestamp nevertheless to preserve 4530 ;; historical behavior. 4531 (format "-%02d:%02d" hour-end minute-end))) 4532 ((or `timerange `daterange) 4533 (error "`:range-type' must be `nil' for `active'/`inactive' type")))) 4534 ;; Range must be present. 4535 ((or `active-range `inactive-range 4536 (and `diary (guard (eq 'timerange range-type)))) 4537 (pcase range-type 4538 ;; End time: -HH:MM. 4539 ;; Fall back to start time if end time is not defined (arbitrary historical choice). 4540 ;; Error will be thrown if both end and begin time is not defined. 4541 (`timerange (format "-%02d:%02d" (or hour-end hour-start) (or minute-end minute-start))) 4542 ;; End date: TIMESTAMP-END--[YYYY-MM-DD DAY HH:MM 4543 ((or `daterange 4544 ;; Should never happen in the output of `org-element-timestamp-parser'. 4545 ;; Treat as an equivalent of `daterange' arbitrarily. 4546 `nil) 4547 (concat 4548 ;; repeater + warning + closing > or ] 4549 ;; This info is duplicated in date ranges. 4550 timestamp-end 4551 "--" (car brackets) 4552 (format-time-string 4553 ;; `org-time-stamp-formats'. 4554 (org-time-stamp-format 4555 ;; Ignore time unless both HH:MM are available. 4556 ;; Ignore means (car org-timestamp-formats). 4557 (and minute-end hour-end) 4558 'no-brackets) 4559 (org-encode-time 4560 ;; Closing HH:MM missing is a valid scenario. 4561 0 (or minute-end 0) (or hour-end 0) 4562 ;; YEAR/MONTH/DAY-END will always be present 4563 ;; for `daterange' range-type, as parsed by 4564 ;; `org-element-timestamp-parser'. 4565 ;; For manually constructed timestamp 4566 ;; object, arbitrarily fall back to starting 4567 ;; date. 4568 (or (org-element-property :day-end timestamp) day-start) 4569 (or (org-element-property :month-end timestamp) month-start) 4570 (or (org-element-property :year-end timestamp) year-start))))))))) 4571 ;; repeater + warning + closing > or ] 4572 ;; This info is duplicated in date ranges. 4573 timestamp-end)))))) 4574 ;;;; Underline 4575 4576 (defun org-element-underline-parser () 4577 "Parse underline object at point, if any. 4578 4579 When at an underline object, return a new syntax node of `underline' 4580 type containing `:begin', `:end', `:contents-begin' and 4581 `:contents-end' and `:post-blank' properties. Otherwise, return nil. 4582 4583 Assume point is at the first underscore marker." 4584 (org-element--parse-generic-emphasis "_" 'underline)) 4585 4586 (defun org-element-underline-interpreter (_ contents) 4587 "Interpret underline object as Org syntax. 4588 CONTENTS is the contents of the object." 4589 (format "_%s_" contents)) 4590 4591 4592 ;;;; Verbatim 4593 4594 (defun org-element-verbatim-parser () 4595 "Parse verbatim object at point, if any. 4596 4597 When at a verbatim object, return a new syntax node of `verbatim' type 4598 containing `:value', `:begin', `:end' and `:post-blank' properties. 4599 Otherwise, return nil. 4600 4601 Assume point is at the first equal sign marker." 4602 (org-element--parse-generic-emphasis "=" 'verbatim)) 4603 4604 (defun org-element-verbatim-interpreter (verbatim _) 4605 "Interpret VERBATIM object as Org syntax." 4606 (format "=%s=" (org-element-property :value verbatim))) 4607 4608 4609 4610 ;;; Parsing Element Starting At Point 4611 ;; 4612 ;; `org-element--current-element' is the core function of this section. 4613 ;; It returns the Lisp representation of the element starting at 4614 ;; point. 4615 4616 (defconst org-element--current-element-re 4617 (rx-to-string 4618 `(or 4619 (group-n 1 (regexp ,org-element--latex-begin-environment-nogroup)) 4620 (group-n 2 (regexp ,org-element-drawer-re-nogroup)) 4621 (group-n 3 (regexp "[ \t]*:\\( \\|$\\)")) 4622 (group-n 7 (regexp ,org-element-dynamic-block-open-re-nogroup)) 4623 (seq (group-n 4 (regexp "[ \t]*#\\+")) 4624 (or 4625 (seq "BEGIN_" (group-n 5 (1+ (not space)))) 4626 (group-n 6 "CALL:") 4627 (group-n 8 (1+ (not space)) ":"))) 4628 (group-n 9 (regexp ,org-footnote-definition-re)) 4629 (group-n 10 (regexp "[ \t]*-----+[ \t]*$")) 4630 (group-n 11 "%%("))) 4631 "Bulk regexp matching multiple elements in a single regexp. 4632 This is a bit more efficient compared to invoking regexp search 4633 multiple times.") 4634 4635 (defvar org-inlinetask-min-level); Declared in org-inlinetask.el 4636 (defvar org-element--cache-sync-requests); Declared later 4637 (defsubst org-element--current-element (limit &optional granularity mode structure) 4638 "Parse the element starting at point. 4639 4640 Return value is a list like (TYPE PROPS) where TYPE is the type 4641 of the element and PROPS a plist of properties associated to the 4642 element. 4643 4644 Possible types are defined in `org-element-all-elements'. 4645 4646 LIMIT bounds the search. 4647 4648 Optional argument GRANULARITY determines the depth of the 4649 recursion. Allowed values are `headline', `greater-element', 4650 `element', `object' or nil. When it is broader than `object' (or 4651 nil), secondary values will not be parsed, since they only 4652 contain objects. 4653 4654 Optional argument MODE, when non-nil, can be either 4655 `first-section', `item', `node-property', `planning', 4656 `property-drawer', `section', `table-row', or `top-comment'. 4657 4658 4659 If STRUCTURE isn't provided but MODE is set to `item', it will be 4660 computed. 4661 4662 This function assumes point is always at the beginning of the 4663 element it has to parse." 4664 (save-excursion 4665 (let ((case-fold-search t) 4666 ;; Determine if parsing depth allows for secondary strings 4667 ;; parsing. It only applies to elements referenced in 4668 ;; `org-element-secondary-value-alist'. 4669 (raw-secondary-p (and granularity (not (eq granularity 'object)))) 4670 result at-task?) 4671 (setq 4672 result 4673 ;; Regexp matches below should avoid modifying match data, 4674 ;; if possible. Doing it unnecessarily degrades regexp 4675 ;; matching performance an order of magnitude, which 4676 ;; becomes important when parsing large buffers with huge 4677 ;; amount of elements to be parsed. 4678 ;; 4679 ;; In general, the checks below should be as efficient as 4680 ;; possible, especially early in the `cond' form. (The 4681 ;; early checks will contribute to all subsequent parsers as 4682 ;; well). 4683 (cond 4684 ;; Item. 4685 ((eq mode 'item) (org-element-item-parser limit structure raw-secondary-p)) 4686 ;; Table Row. 4687 ((eq mode 'table-row) (org-element-table-row-parser limit)) 4688 ;; Node Property. 4689 ((eq mode 'node-property) (org-element-node-property-parser limit)) 4690 ;; Headline. 4691 ((and (looking-at-p "^\\*+ ") 4692 (setq at-task? t) 4693 (or (not (featurep 'org-inlinetask)) 4694 (save-excursion 4695 (< (skip-chars-forward "*") 4696 (if org-odd-levels-only 4697 (1- (* org-inlinetask-min-level 2)) 4698 org-inlinetask-min-level))))) 4699 (org-element-headline-parser limit raw-secondary-p)) 4700 ;; Sections (must be checked after headline). 4701 ((memq mode '(section first-section)) (org-element-section-parser nil)) 4702 ;; Comments. 4703 ((looking-at-p org-comment-regexp) (org-element-comment-parser limit)) 4704 ;; Planning. 4705 ((and (eq mode 'planning) 4706 (eq ?* (char-after (line-beginning-position 0))) 4707 (looking-at-p org-element-planning-line-re)) 4708 (org-element-planning-parser limit)) 4709 ;; Property drawer. 4710 ((and (pcase mode 4711 (`planning (eq ?* (char-after (line-beginning-position 0)))) 4712 ((or `property-drawer `top-comment) 4713 ;; See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=63225#80 4714 (save-excursion 4715 (forward-line -1) ; faster than beginning-of-line 4716 (skip-chars-forward "[:blank:]") ; faster than looking-at-p 4717 (or (not (eolp)) ; very cheap 4718 ;; Document-wide property drawer may be preceded by blank lines. 4719 (progn (skip-chars-backward " \t\n\r") (bobp))))) 4720 (_ nil)) 4721 (looking-at-p org-property-drawer-re)) 4722 (org-element-property-drawer-parser limit)) 4723 ;; When not at bol, point is at the beginning of an item or 4724 ;; a footnote definition: next item is always a paragraph. 4725 ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) 4726 ;; Clock. 4727 ((looking-at-p org-element-clock-line-re) (org-element-clock-parser limit)) 4728 ;; Inlinetask. 4729 (at-task? (org-element-inlinetask-parser limit raw-secondary-p)) 4730 ;; From there, elements can have affiliated keywords. 4731 ;; Note an edge case with a keyword followed by element that 4732 ;; cannot have affiliated keywords attached (the above). 4733 ;; `org-element--collect-affiliated-keywords' must have a 4734 ;; special check to fall back to parsing proper keyword. 4735 (t (let ((affiliated (org-element--collect-affiliated-keywords 4736 limit (memq granularity '(nil object))))) 4737 (cond 4738 ;; Jumping over affiliated keywords put point off-limits. 4739 ;; Parse them as regular keywords. 4740 ((and (cdr affiliated) (>= (point) limit)) 4741 (goto-char (car affiliated)) 4742 (org-element-keyword-parser limit nil)) 4743 ;; Do a single regexp match do reduce overheads for 4744 ;; multiple regexp search invocations. 4745 ((looking-at org-element--current-element-re) 4746 (cond 4747 ;; LaTeX Environment. 4748 ((match-beginning 1) 4749 (org-element-latex-environment-parser limit affiliated)) 4750 ;; Drawer. 4751 ((match-beginning 2) 4752 (org-element-drawer-parser limit affiliated)) 4753 ;; Fixed Width 4754 ((match-beginning 3) 4755 (org-element-fixed-width-parser limit affiliated)) 4756 ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and 4757 ;; Keywords. 4758 ((match-beginning 5) 4759 (funcall (pcase (upcase (match-string 5)) 4760 ("CENTER" #'org-element-center-block-parser) 4761 ("COMMENT" #'org-element-comment-block-parser) 4762 ("EXAMPLE" #'org-element-example-block-parser) 4763 ("EXPORT" #'org-element-export-block-parser) 4764 ("QUOTE" #'org-element-quote-block-parser) 4765 ("SRC" #'org-element-src-block-parser) 4766 ("VERSE" #'org-element-verse-block-parser) 4767 (_ #'org-element-special-block-parser)) 4768 limit 4769 affiliated)) 4770 ((match-beginning 6) 4771 (org-element-babel-call-parser limit affiliated)) 4772 ((match-beginning 7) 4773 (forward-line 0) 4774 (org-element-dynamic-block-parser limit affiliated)) 4775 ((match-beginning 8) 4776 (org-element-keyword-parser limit affiliated)) 4777 ((match-beginning 4) ;; #+, not matching a specific element. 4778 (org-element-paragraph-parser limit affiliated)) 4779 ;; Footnote Definition. 4780 ((match-beginning 9) 4781 (org-element-footnote-definition-parser limit affiliated)) 4782 ;; Horizontal Rule. 4783 ((match-beginning 10) 4784 (org-element-horizontal-rule-parser limit affiliated)) 4785 ;; Diary Sexp. 4786 ((match-beginning 11) 4787 (org-element-diary-sexp-parser limit affiliated)))) 4788 ;; Table. 4789 ((or (looking-at-p "[ \t]*|") 4790 ;; There is no strict definition of a table.el 4791 ;; table. Try to prevent false positive while being 4792 ;; quick. 4793 (let ((rule-regexp 4794 (rx (zero-or-more (any " \t")) 4795 "+" 4796 (one-or-more (one-or-more "-") "+") 4797 (zero-or-more (any " \t")) 4798 eol)) 4799 (non-table.el-line 4800 (rx bol 4801 (zero-or-more (any " \t")) 4802 (or eol (not (any "+| \t"))))) 4803 (next (line-beginning-position 2))) 4804 ;; Start with a full rule. 4805 (and 4806 (looking-at-p rule-regexp) 4807 (< next limit) ;no room for a table.el table 4808 (save-excursion 4809 (end-of-line) 4810 (cond 4811 ;; Must end with a full rule. 4812 ((not (re-search-forward non-table.el-line limit 'move)) 4813 (if (bolp) (forward-line -1) (forward-line 0)) 4814 (looking-at-p rule-regexp)) 4815 ;; Ignore pseudo-tables with a single 4816 ;; rule. 4817 ((= next (line-beginning-position)) 4818 nil) 4819 ;; Must end with a full rule. 4820 (t 4821 (forward-line -1) 4822 (looking-at-p rule-regexp))))))) 4823 (org-element-table-parser limit affiliated)) 4824 ;; List. 4825 ((looking-at-p (org-item-re)) 4826 (org-element-plain-list-parser 4827 limit affiliated 4828 (or structure (org-element--list-struct limit)))) 4829 ;; Default element: Paragraph. 4830 (t (org-element-paragraph-parser limit affiliated))))))) 4831 (when result 4832 (org-element-put-property result :buffer (current-buffer)) 4833 (org-element-put-property result :mode mode) 4834 (org-element-put-property result :granularity granularity)) 4835 result))) 4836 4837 4838 ;; Most elements can have affiliated keywords. When looking for an 4839 ;; element beginning, we want to move before them, as they belong to 4840 ;; that element, and, in the meantime, collect information they give 4841 ;; into appropriate properties. Hence the following function. 4842 4843 (defun org-element--collect-affiliated-keywords (limit parse) 4844 "Collect affiliated keywords from point down to LIMIT. 4845 4846 Return a list whose CAR is the position at the first of them and 4847 CDR a plist of keywords and values and move point to the 4848 beginning of the first line after them. 4849 4850 As a special case, if element doesn't start at the beginning of 4851 the line (e.g., a paragraph starting an item), CAR is current 4852 position of point and CDR is nil. 4853 4854 When PARSE is non-nil, values from keywords belonging to 4855 `org-element-parsed-keywords' are parsed as secondary strings." 4856 (if (not (bolp)) (list (point)) 4857 (let ((case-fold-search t) 4858 (origin (point)) 4859 ;; RESTRICT is the list of objects allowed in parsed 4860 ;; keywords value. If PARSE is nil, no object is allowed. 4861 (restrict (and parse (org-element-restriction 'keyword))) 4862 output) 4863 (while (and (< (point) limit) (looking-at org-element--affiliated-re)) 4864 (let* ((raw-kwd (upcase (match-string 1))) 4865 ;; Apply translation to RAW-KWD. From there, KWD is 4866 ;; the official keyword. 4867 (kwd (or (cdr (assoc raw-kwd 4868 org-element-keyword-translation-alist)) 4869 raw-kwd)) 4870 ;; PARSED? is non-nil when keyword should have its 4871 ;; value parsed. 4872 (parsed? (member kwd org-element-parsed-keywords)) 4873 ;; Find main value for any keyword. 4874 (value-begin (match-end 0)) 4875 (value-end 4876 (save-excursion 4877 (end-of-line) 4878 (skip-chars-backward " \t") 4879 (point))) 4880 value 4881 ;; If KWD is a dual keyword, find its secondary value. 4882 ;; Maybe parse it. 4883 (dual? (member kwd org-element-dual-keywords)) 4884 (dual-value 4885 (and dual? 4886 (let ((sec (match-string-no-properties 2))) 4887 (cond 4888 ((and sec parsed?) 4889 (org-element--parse-objects 4890 (match-beginning 2) (match-end 2) nil restrict)) 4891 (sec sec))))) 4892 ;; Attribute a property name to KWD. 4893 (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) 4894 (setq value 4895 (if parsed? 4896 (org-element--parse-objects 4897 value-begin value-end nil restrict) 4898 (org-trim (buffer-substring-no-properties 4899 value-begin value-end)))) 4900 ;; Now set final shape for VALUE. 4901 (when dual? 4902 (setq value (and (or value dual-value) (cons value dual-value)))) 4903 (when (or (member kwd org-element-multiple-keywords) 4904 ;; Attributes can always appear on multiple lines. 4905 (string-match-p "^ATTR_" kwd)) 4906 (setq value (nconc (plist-get output kwd-sym) (list value)))) 4907 ;; Eventually store the new value in OUTPUT. 4908 (setq output (plist-put output kwd-sym value)) 4909 ;; Move to next keyword. 4910 (forward-line))) 4911 ;; If affiliated keywords are orphaned: move back to first one. 4912 ;; They will be parsed as a paragraph. 4913 (when (or (looking-at-p "[ \t]*$") 4914 ;; Affiliated keywords are not allowed before comments. 4915 (looking-at-p org-comment-regexp) 4916 ;; Clock lines are also not allowed. 4917 (looking-at-p org-clock-line-re) 4918 ;; Inlinetasks not allowed. 4919 (looking-at-p "^\\*+ ")) 4920 (goto-char origin) (setq output nil)) 4921 ;; Return value. 4922 (cons origin output)))) 4923 4924 4925 4926 ;;; The Org Parser 4927 ;; 4928 ;; The two major functions here are `org-element-parse-buffer', which 4929 ;; parses Org syntax inside the current buffer, taking into account 4930 ;; region, narrowing, or even visibility if specified, and 4931 ;; `org-element-parse-secondary-string', which parses objects within 4932 ;; a given string. 4933 ;; 4934 ;; The (almost) almighty `org-element-map' allows applying a function 4935 ;; on elements or objects matching some type, and accumulating the 4936 ;; resulting values. In an export situation, it also skips unneeded 4937 ;; parts of the parse tree. 4938 4939 (defun org-element-parse-buffer (&optional granularity visible-only keep-deferred) 4940 "Recursively parse the current Org mode buffer and return structure. 4941 If narrowing is in effect, only parse the visible part of the 4942 buffer. 4943 4944 This function assumes that current major mode is `org-mode'. When the 4945 major mode is different, the behaviour is undefined. 4946 4947 Optional argument GRANULARITY determines the depth of the 4948 recursion. It can be set to the following symbols: 4949 4950 `headline' Only parse headlines. 4951 `greater-element' Don't recurse into greater elements except 4952 headlines and sections. Thus, elements 4953 parsed are the top-level ones. 4954 `element' Parse everything but objects and plain text. 4955 `object' Parse the complete buffer (default). 4956 4957 When VISIBLE-ONLY is non-nil, don't parse contents of hidden 4958 elements. 4959 4960 When KEEP-DEFERRED is non-nil, do not resolve deferred properties. 4961 4962 An element or object is represented as a list with the 4963 pattern (TYPE PROPERTIES CONTENTS), where : 4964 4965 TYPE is a symbol describing the element or object. See 4966 `org-element-all-elements' and `org-element-all-objects' for an 4967 exhaustive list of such symbols. One can retrieve it with 4968 `org-element-type' function. 4969 4970 PROPERTIES is the list of properties attached to the element or 4971 object, as a plist. Although most of them are specific to the 4972 element or object type, all types share `:begin', `:end', 4973 `:post-blank' and `:parent' properties, which respectively 4974 refer to buffer position where the element or object starts, 4975 ends, the number of white spaces or blank lines after it, and 4976 the element or object containing it. Properties values can be 4977 obtained by using `org-element-property' function. 4978 4979 CONTENTS is a list of elements, objects or raw strings 4980 contained in the current element or object, when applicable. 4981 One can access them with `org-element-contents' function. 4982 4983 The Org buffer has `org-data' as type and nil as properties. 4984 `org-element-map' function can be used to find specific elements 4985 or objects within the parse tree." 4986 (save-excursion 4987 (goto-char (point-min)) 4988 (let ((org-data (org-element-org-data-parser)) 4989 (gc-cons-threshold #x40000000)) 4990 (org-skip-whitespace) 4991 (setq org-data 4992 (org-element--parse-elements 4993 (line-beginning-position) (point-max) 4994 ;; Start in `first-section' mode so text before the first 4995 ;; headline belongs to a section. 4996 'first-section nil granularity visible-only org-data)) 4997 (unless keep-deferred 4998 (org-element-map ; undefer 4999 org-data t 5000 (lambda (el) (org-element-properties-resolve el t)) 5001 nil nil nil t)) 5002 org-data))) 5003 5004 (defun org-element-parse-secondary-string (string restriction &optional parent) 5005 "Recursively parse objects in STRING and return structure. 5006 5007 RESTRICTION is a symbol limiting the object types that will be 5008 looked after. 5009 5010 Optional argument PARENT, when non-nil, is the element or object 5011 containing the secondary string. It is used to set correctly 5012 `:parent' property within the string. 5013 5014 If STRING is the empty string or nil, return nil." 5015 (cond 5016 ((not string) nil) 5017 ((equal string "") nil) 5018 (t (let (rtn) 5019 (org-element-with-buffer-copy 5020 :to-buffer (org-get-buffer-create " *Org parse*" t) 5021 :drop-contents t 5022 :drop-visibility t 5023 :drop-narrowing t 5024 :drop-locals nil 5025 ;; Transferring local variables may put the temporary buffer 5026 ;; into a read-only state. Make sure we can insert STRING. 5027 (let ((inhibit-read-only t)) (erase-buffer) (insert string)) 5028 ;; Prevent "Buffer *temp* modified; kill anyway?". 5029 (restore-buffer-modified-p nil) 5030 (setq rtn 5031 (org-element--parse-objects 5032 (point-min) (point-max) nil restriction parent)) 5033 ;; Resolve deferred. 5034 (org-element-map rtn t 5035 (lambda (el) (org-element-properties-resolve el t))) 5036 rtn))))) 5037 5038 (defun org-element-map 5039 ( data types fun 5040 &optional 5041 info first-match no-recursion 5042 with-affiliated no-undefer) 5043 "Map a function on selected elements or objects. 5044 5045 DATA is a parse tree (for example, returned by 5046 `org-element-parse-buffer'), an element, an object, a string, or a 5047 list of such constructs. TYPES is a symbol or list of symbols of 5048 elements or object types (see `org-element-all-elements' and 5049 `org-element-all-objects' for a complete list of types). FUN is the 5050 function called on the matching element or object. It has to accept 5051 one argument: the element or object itself. 5052 5053 When TYPES is t, call FUN for all the elements and objects. 5054 5055 FUN can also be a Lisp form. The form will be evaluated as function 5056 with symbol `node' bound to the current node. 5057 5058 When optional argument INFO is non-nil, it should be a plist 5059 holding export options. In that case, elements of the parse tree 5060 \\(compared with `eq') not exportable according to `:ignore-list' 5061 property in that property list will be skipped. 5062 5063 When optional argument FIRST-MATCH is non-nil, stop at the first 5064 match for which FUN doesn't return nil, and return that value. 5065 5066 Optional argument NO-RECURSION is a symbol or a list of symbols 5067 representing elements or objects types. `org-element-map' won't 5068 enter any recursive element or object whose type belongs to that 5069 list. Though, FUN can still be applied on them. 5070 5071 When optional argument WITH-AFFILIATED is non-nil, FUN will also 5072 apply to matching objects within parsed affiliated keywords (see 5073 `org-element-parsed-keywords'). 5074 5075 When optional argument NO-UNDEFER is non-nil, do not resolve deferred 5076 values. 5077 5078 FUN may throw `:org-element-skip' signal. Then, `org-element-map' 5079 will not recurse into the current element. 5080 5081 Nil values returned from FUN do not appear in the results. 5082 5083 When buffer parse tree is used, elements and objects are generally 5084 traversed in the same order they appear in text with a single 5085 exception of dual keywords where secondary value is traversed after 5086 the mail value. 5087 5088 Examples: 5089 --------- 5090 5091 Assuming TREE is a variable containing an Org buffer parse tree, 5092 the following example will return a flat list of all `src-block' 5093 and `example-block' elements in it: 5094 5095 (setq tree (org-element-parse-buffer)) 5096 (org-element-map tree \\='(example-block src-block) #\\='identity) 5097 5098 The following snippet will find the first headline with a level 5099 of 1 and a \"phone\" tag, and will return its beginning position: 5100 5101 (org-element-map tree \\='headline 5102 (lambda (hl) 5103 (and (= (org-element-property :level hl) 1) 5104 (member \"phone\" (org-element-property :tags hl)) 5105 (org-element-begin hl))) 5106 nil t) 5107 5108 The next example will return a flat list of all `plain-list' type 5109 elements in TREE that are not a sub-list themselves: 5110 5111 (org-element-map tree \\='plain-list #\\='identity nil nil \\='plain-list) 5112 5113 Eventually, this example will return a flat list of all `bold' 5114 type objects containing a `latex-snippet' type object, even 5115 looking into captions: 5116 5117 (org-element-map tree \\='bold 5118 (lambda (b) 5119 (and (org-element-map b \\='latex-snippet #\\='identity nil t) b)) 5120 nil nil nil t)" 5121 (declare (indent 2)) 5122 ;; Ensure TYPES and NO-RECURSION are a list, even of one element. 5123 (when (and types data) 5124 (let* ((ignore-list (plist-get info :ignore-list)) 5125 (objects? 5126 (or (eq types t) 5127 (cl-intersection 5128 (cons 'plain-text org-element-all-objects) 5129 (if (listp types) types (list types))))) 5130 (no-recursion 5131 (append 5132 (if (listp no-recursion) no-recursion 5133 (list no-recursion)) 5134 (unless objects? 5135 org-element-all-objects) 5136 (unless objects? 5137 ;; Do not recurse into elements that can only contain 5138 ;; objects. 5139 (cl-set-difference 5140 org-element-all-elements 5141 org-element-greater-elements))))) 5142 (org-element-ast-map 5143 data types fun 5144 ignore-list first-match 5145 no-recursion 5146 ;; Affiliated keywords may only contain objects. 5147 (when (and with-affiliated objects?) 5148 (mapcar #'cdr org-element--parsed-properties-alist)) 5149 ;; Secondary strings may only contain objects. 5150 (not objects?) 5151 no-undefer)))) 5152 5153 ;; The following functions are internal parts of the parser. 5154 ;; 5155 ;; The first one, `org-element--parse-elements' acts at the element's 5156 ;; level. 5157 ;; 5158 ;; The second one, `org-element--parse-objects' applies on all objects 5159 ;; of a paragraph or a secondary string. It calls 5160 ;; `org-element--object-lex' to find the next object in the current 5161 ;; container. 5162 5163 (defsubst org-element--next-mode (mode type parent?) 5164 "Return next mode according to current one. 5165 5166 MODE is a symbol representing the expectation about the next 5167 element or object. Meaningful values are `first-section', 5168 `item', `node-property', `planning', `property-drawer', 5169 `section', `table-row', `top-comment', and nil. 5170 5171 TYPE is the type of the current element or object. 5172 5173 If PARENT? is non-nil, assume the next element or object will be 5174 located inside the current one." 5175 (if parent? 5176 (pcase type 5177 (`headline 'section) 5178 ((and (guard (eq mode 'first-section)) `section) 'top-comment) 5179 ((and (guard (eq mode 'org-data)) `org-data) 'first-section) 5180 ((and (guard (not mode)) `org-data) 'first-section) 5181 (`inlinetask 'planning) 5182 (`plain-list 'item) 5183 (`property-drawer 'node-property) 5184 (`section 'planning) 5185 (`table 'table-row)) 5186 (pcase mode 5187 (`item 'item) 5188 (`node-property 'node-property) 5189 ((and `planning (guard (eq type 'planning))) 'property-drawer) 5190 (`table-row 'table-row) 5191 ((and `top-comment (guard (eq type 'comment))) 'property-drawer)))) 5192 5193 (defun org-element--parse-elements 5194 (beg end mode structure granularity visible-only acc) 5195 "Parse elements between BEG and END positions. 5196 5197 MODE prioritizes some elements over the others. It can be set to 5198 `first-section', `item', `node-property', `planning', 5199 `property-drawer', `section', `table-row', `top-comment', or nil. 5200 5201 When value is `item', STRUCTURE will be used as the current list 5202 structure. 5203 5204 GRANULARITY determines the depth of the recursion. See 5205 `org-element-parse-buffer' for more information. 5206 5207 When VISIBLE-ONLY is non-nil, don't parse contents of hidden 5208 elements. 5209 5210 Elements are accumulated into ACC." 5211 (save-excursion 5212 (goto-char beg) 5213 ;; When parsing only headlines, skip any text before first one. 5214 (when (and (eq granularity 'headline) (not (org-at-heading-p))) 5215 (org-with-limited-levels (outline-next-heading))) 5216 (let (elements) 5217 (while (< (point) end) 5218 ;; Visible only: skip invisible parts due to folding. 5219 (if (and visible-only (org-invisible-p nil t)) 5220 (progn 5221 (goto-char (org-find-visible)) 5222 (when (and (eolp) (not (eobp))) (forward-char))) 5223 ;; Find current element's type and parse it accordingly to 5224 ;; its category. 5225 (let* ((element (org-element--current-element end granularity mode structure)) 5226 (type (org-element-type element)) 5227 (cbeg (org-element-contents-begin element))) 5228 (goto-char (org-element-end element)) 5229 ;; Fill ELEMENT contents by side-effect. 5230 (cond 5231 ;; If element has no contents, don't modify it. 5232 ((not cbeg)) 5233 ;; Greater element: parse it between `contents-begin' and 5234 ;; `contents-end'. Ensure GRANULARITY allows recursion, 5235 ;; or ELEMENT is a headline, in which case going inside 5236 ;; is mandatory, in order to get sub-level headings. 5237 ((and (memq type org-element-greater-elements) 5238 (or (memq granularity '(element object nil)) 5239 (and (eq granularity 'greater-element) 5240 (eq type 'section)) 5241 (eq type 'headline))) 5242 (org-element--parse-elements 5243 cbeg (org-element-contents-end element) 5244 ;; Possibly switch to a special mode. 5245 (org-element--next-mode mode type t) 5246 (and (memq type '(item plain-list)) 5247 (org-element-property :structure element)) 5248 granularity visible-only element)) 5249 ;; ELEMENT has contents. Parse objects inside, if 5250 ;; GRANULARITY allows it. 5251 ((memq granularity '(object nil)) 5252 (org-element--parse-objects 5253 cbeg (org-element-contents-end element) element 5254 (org-element-restriction type)))) 5255 (push (org-element-put-property element :parent acc) elements) 5256 ;; Update mode. 5257 (setq mode (org-element--next-mode mode type nil))))) 5258 ;; Return result. 5259 (org-element-put-property acc :granularity granularity) 5260 (apply #'org-element-set-contents acc (nreverse elements))))) 5261 5262 (defun org-element--object-lex (restriction) 5263 "Return next object in current buffer or nil. 5264 RESTRICTION is a list of object types, as symbols, that should be 5265 looked after. This function assumes that the buffer is narrowed 5266 to an appropriate container (e.g., a paragraph)." 5267 (let (result) 5268 (setq 5269 result 5270 (cond 5271 ((memq 'table-cell restriction) (org-element-table-cell-parser)) 5272 ((memq 'citation-reference restriction) 5273 (org-element-citation-reference-parser)) 5274 (t 5275 (let* ((start (point)) 5276 (limit 5277 ;; Object regexp sometimes needs to have a peek at 5278 ;; a character ahead. Therefore, when there is a hard 5279 ;; limit, make it one more than the true beginning of the 5280 ;; radio target. 5281 (save-excursion 5282 (cond ((not org-target-link-regexp) nil) 5283 ((not (memq 'link restriction)) nil) 5284 ((progn 5285 (unless (bolp) (forward-char -1)) 5286 (not 5287 (if org-target-link-regexps 5288 (org--re-list-search-forward org-target-link-regexps nil t) 5289 (re-search-forward org-target-link-regexp nil t)))) 5290 nil) 5291 ;; Since we moved backward, we do not want to 5292 ;; match again an hypothetical 1-character long 5293 ;; radio link before us. Realizing that this can 5294 ;; only happen if such a radio link starts at 5295 ;; beginning of line, we prevent this here. 5296 ((and (= start (1+ (line-beginning-position))) 5297 (= start (match-end 1))) 5298 (and 5299 (if org-target-link-regexps 5300 (org--re-list-search-forward org-target-link-regexps nil t) 5301 (re-search-forward org-target-link-regexp nil t)) 5302 (1+ (match-beginning 1)))) 5303 (t (1+ (match-beginning 1)))))) 5304 found) 5305 (save-excursion 5306 (while (and (not found) 5307 (re-search-forward org-element--object-regexp limit 'move)) 5308 (goto-char (match-beginning 0)) 5309 (let ((result (match-string 0))) 5310 (setq found 5311 (cond 5312 ((string-prefix-p "call_" result t) 5313 (and (memq 'inline-babel-call restriction) 5314 (org-element-inline-babel-call-parser))) 5315 ((string-prefix-p "src_" result t) 5316 (and (memq 'inline-src-block restriction) 5317 (org-element-inline-src-block-parser))) 5318 (t 5319 (pcase (char-after) 5320 (?^ (and (memq 'superscript restriction) 5321 (org-element-superscript-parser))) 5322 (?_ (or (and (memq 'underline restriction) 5323 (org-element-underline-parser)) 5324 (and (memq 'subscript restriction) 5325 (org-element-subscript-parser)))) 5326 (?* (and (memq 'bold restriction) 5327 (org-element-bold-parser))) 5328 (?/ (and (memq 'italic restriction) 5329 (org-element-italic-parser))) 5330 (?~ (and (memq 'code restriction) 5331 (org-element-code-parser))) 5332 (?= (and (memq 'verbatim restriction) 5333 (org-element-verbatim-parser))) 5334 (?+ (and (memq 'strike-through restriction) 5335 (org-element-strike-through-parser))) 5336 (?@ (and (memq 'export-snippet restriction) 5337 (org-element-export-snippet-parser))) 5338 (?{ (and (memq 'macro restriction) 5339 (org-element-macro-parser))) 5340 (?$ (and (memq 'latex-fragment restriction) 5341 (org-element-latex-fragment-parser))) 5342 (?< 5343 (if (eq (aref result 1) ?<) 5344 (or (and (memq 'radio-target restriction) 5345 (org-element-radio-target-parser)) 5346 (and (memq 'target restriction) 5347 (org-element-target-parser))) 5348 (or (and (memq 'timestamp restriction) 5349 (org-element-timestamp-parser)) 5350 (and (memq 'link restriction) 5351 (org-element-link-parser))))) 5352 (?\\ 5353 (if (eq (aref result 1) ?\\) 5354 (and (memq 'line-break restriction) 5355 (org-element-line-break-parser)) 5356 (or (and (memq 'entity restriction) 5357 (org-element-entity-parser)) 5358 (and (memq 'latex-fragment restriction) 5359 (org-element-latex-fragment-parser))))) 5360 (?\[ 5361 (pcase (aref result 1) 5362 ((and ?\[ 5363 (guard (memq 'link restriction))) 5364 (org-element-link-parser)) 5365 ((and ?f 5366 (guard (memq 'footnote-reference restriction))) 5367 (org-element-footnote-reference-parser)) 5368 ((and ?c 5369 (guard (memq 'citation restriction))) 5370 (org-element-citation-parser)) 5371 ((and (or ?% ?/) 5372 (guard (memq 'statistics-cookie restriction))) 5373 (org-element-statistics-cookie-parser)) 5374 (_ 5375 (or (and (memq 'timestamp restriction) 5376 (org-element-timestamp-parser)) 5377 (and (memq 'statistics-cookie restriction) 5378 (org-element-statistics-cookie-parser)))))) 5379 ;; This is probably a plain link. 5380 (_ (and (memq 'link restriction) 5381 (org-element-link-parser))))))) 5382 (or (eobp) (forward-char)))) 5383 (cond (found) 5384 (limit (forward-char -1) 5385 (org-element-link-parser)) ;radio link 5386 (t nil))))))) 5387 (org-element-put-property result :buffer (current-buffer)))) 5388 5389 (defun org-element--parse-objects (beg end acc restriction &optional parent) 5390 "Parse objects between BEG and END and return recursive structure. 5391 5392 Objects are accumulated in ACC. RESTRICTION is a list of object 5393 successors which are allowed in the current object. 5394 5395 ACC becomes the parent for all parsed objects. However, if ACC 5396 is nil (i.e., a secondary string is being parsed) and optional 5397 argument PARENT is non-nil, use it as the parent for all objects. 5398 Eventually, if both ACC and PARENT are nil, the common parent is 5399 the list of objects itself." 5400 (save-excursion 5401 (save-restriction 5402 (narrow-to-region beg end) 5403 (goto-char (point-min)) 5404 (let (next-object contents) 5405 (while (and (not (eobp)) 5406 (setq next-object (org-element--object-lex restriction))) 5407 ;; Text before any object. 5408 (let ((obj-beg (org-element-begin next-object))) 5409 (unless (= (point) obj-beg) 5410 (let ((text (buffer-substring-no-properties (point) obj-beg))) 5411 (push (if acc (org-element-put-property text :parent acc) text) 5412 contents)))) 5413 ;; Object... 5414 (let ((obj-end (org-element-end next-object)) 5415 (cont-beg (org-element-contents-begin next-object))) 5416 (when acc (org-element-put-property next-object :parent acc)) 5417 (push (if cont-beg 5418 ;; Fill contents of NEXT-OBJECT if possible. 5419 (org-element--parse-objects 5420 cont-beg 5421 (org-element-contents-end next-object) 5422 next-object 5423 (org-element-restriction next-object)) 5424 next-object) 5425 contents) 5426 (goto-char obj-end))) 5427 ;; Text after last object. 5428 (unless (eobp) 5429 (let ((text (buffer-substring-no-properties (point) end))) 5430 (push (if acc (org-element-put-property text :parent acc) text) 5431 contents))) 5432 ;; Result. Set appropriate parent. 5433 (if acc (apply #'org-element-set-contents acc (nreverse contents)) 5434 (let* ((contents (nreverse contents)) 5435 (parent (or parent contents))) 5436 (dolist (datum contents contents) 5437 (org-element-put-property datum :parent parent)))))))) 5438 5439 5440 5441 ;;; Towards A Bijective Process 5442 ;; 5443 ;; The parse tree obtained with `org-element-parse-buffer' is really 5444 ;; a snapshot of the corresponding Org buffer. Therefore, it can be 5445 ;; interpreted and expanded into a string with canonical Org syntax. 5446 ;; Hence `org-element-interpret-data'. 5447 ;; 5448 ;; The function relies internally on 5449 ;; `org-element--interpret-affiliated-keywords'. 5450 5451 ;;;###autoload 5452 (defun org-element-interpret-data (data) 5453 "Interpret DATA as Org syntax. 5454 DATA is a parse tree, an element, an object or a secondary string 5455 to interpret. Return Org syntax as a string." 5456 (letrec ((fun 5457 (lambda (data parent) 5458 (let* ((type (org-element-type data)) 5459 ;; Find interpreter for current object or 5460 ;; element. If it doesn't exist (e.g. this is 5461 ;; a pseudo object or element), return contents, 5462 ;; if any. 5463 (interpret 5464 (let ((fun (intern 5465 (format "org-element-%s-interpreter" type)))) 5466 (if (fboundp fun) fun (lambda (_ contents) contents)))) 5467 (results 5468 (cond 5469 ;; Secondary string. 5470 ((eq type 'anonymous) 5471 (mapconcat (lambda (obj) (funcall fun obj parent)) 5472 data 5473 "")) 5474 ;; Full Org document. 5475 ((eq type 'org-data) 5476 (mapconcat (lambda (obj) (funcall fun obj parent)) 5477 (org-element-contents data) 5478 "")) 5479 ;; Plain text: return it. 5480 ((stringp data) data) 5481 ;; Element or object without contents. 5482 ((not (org-element-contents data)) 5483 (funcall interpret data nil)) 5484 ;; Element or object with contents. 5485 (t 5486 (funcall 5487 interpret 5488 data 5489 ;; Recursively interpret contents. 5490 (mapconcat 5491 (lambda (datum) (funcall fun datum data)) 5492 (org-element-contents 5493 (if (not (memq type '(paragraph verse-block))) 5494 data 5495 ;; Fix indentation of elements containing 5496 ;; objects. We ignore `table-row' 5497 ;; elements as they are one line long 5498 ;; anyway. 5499 (org-element-normalize-contents 5500 data 5501 ;; When normalizing first paragraph of 5502 ;; an item or a footnote-definition, 5503 ;; ignore first line's indentation. 5504 (and (eq type 'paragraph) 5505 (org-element-type-p 5506 parent '(footnote-definition item)) 5507 (eq data (car (org-element-contents parent))) 5508 (eq (org-element-property :pre-blank parent) 5509 0))))) 5510 "")))))) 5511 (if (memq type '(org-data anonymous)) results 5512 ;; Build white spaces. If no `:post-blank' property 5513 ;; is specified, assume its value is 0. 5514 (let ((blank (or (org-element-post-blank data) 0))) 5515 (if (eq (org-element-class data parent) 'object) 5516 (concat results (make-string blank ?\s)) 5517 (concat (org-element--interpret-affiliated-keywords data) 5518 (org-element-normalize-string results) 5519 (make-string blank ?\n))))))))) 5520 (funcall fun data nil))) 5521 5522 (defun org-element--interpret-affiliated-keywords (element) 5523 "Return ELEMENT's affiliated keywords as Org syntax. 5524 If there is no affiliated keyword, return the empty string." 5525 (let ((keyword-to-org 5526 (lambda (key value) 5527 (let (dual) 5528 (when (member key org-element-dual-keywords) 5529 (setq dual (cdr value) value (car value))) 5530 (concat "#+" (downcase key) 5531 (and dual 5532 (format "[%s]" (org-element-interpret-data dual))) 5533 ": " 5534 (if (member key org-element-parsed-keywords) 5535 (org-element-interpret-data value) 5536 value) 5537 "\n"))))) 5538 (mapconcat 5539 (lambda (prop) 5540 (let ((value (org-element-property prop element)) 5541 (keyword (upcase (substring (symbol-name prop) 1)))) 5542 (when value 5543 (if (or (member keyword org-element-multiple-keywords) 5544 ;; All attribute keywords can have multiple lines. 5545 (string-match-p "^ATTR_" keyword)) 5546 (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) 5547 value "") 5548 (funcall keyword-to-org keyword value))))) 5549 ;; List all ELEMENT's properties matching an attribute line or an 5550 ;; affiliated keyword, but ignore translated keywords since they 5551 ;; cannot belong to the property list. 5552 (let (acc) 5553 (org-element-properties-mapc 5554 (lambda (prop _ __) 5555 (let ((keyword (upcase (substring (symbol-name prop) 1)))) 5556 (when (or (string-match-p "^ATTR_" keyword) 5557 (and 5558 (member keyword org-element-affiliated-keywords) 5559 (not (assoc keyword 5560 org-element-keyword-translation-alist)))) 5561 (push prop acc)))) 5562 element t) 5563 (nreverse acc)) 5564 ""))) 5565 5566 ;; Because interpretation of the parse tree must return the same 5567 ;; number of blank lines between elements and the same number of white 5568 ;; space after objects, some special care must be given to white 5569 ;; spaces. 5570 ;; 5571 ;; The first function, `org-element-normalize-string', ensures any 5572 ;; string different from the empty string will end with a single 5573 ;; newline character. 5574 ;; 5575 ;; The second function, `org-element-normalize-contents', removes 5576 ;; global indentation from the contents of the current element. 5577 5578 (defun org-element-normalize-string (s) 5579 "Ensure string S ends with a single newline character. 5580 5581 If S isn't a string return it unchanged. If S is the empty 5582 string, return it. Otherwise, return a new string with a single 5583 newline character at its end." 5584 (cond 5585 ((not (stringp s)) s) 5586 ((string= "" s) "") 5587 (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) 5588 (replace-match "\n" nil nil s))))) 5589 5590 (defun org-element-normalize-contents (element &optional ignore-first) 5591 "Normalize plain text in ELEMENT's contents. 5592 5593 ELEMENT must only contain plain text and objects. 5594 5595 If optional argument IGNORE-FIRST is non-nil, ignore first line's 5596 indentation to compute maximal common indentation. 5597 5598 Return the normalized element that is element with global 5599 indentation removed from its contents." 5600 (letrec ((find-min-ind 5601 ;; Return minimal common indentation within BLOB. This is 5602 ;; done by walking recursively BLOB and updating MIN-IND 5603 ;; along the way. FIRST-FLAG is non-nil when the next 5604 ;; object is expected to be a string that doesn't start 5605 ;; with a newline character. It happens for strings at 5606 ;; the beginnings of the contents or right after a line 5607 ;; break. 5608 (lambda (blob first-flag min-ind) 5609 (dolist (datum (org-element-contents blob) min-ind) 5610 (when first-flag 5611 (setq first-flag nil) 5612 (cond 5613 ;; Objects cannot start with spaces: in this 5614 ;; case, indentation is 0. 5615 ((not (stringp datum)) (throw :zero 0)) 5616 ((not (string-match 5617 "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum)) 5618 (throw :zero 0)) 5619 ((equal (match-string 2 datum) "\n") 5620 (put-text-property 5621 (match-beginning 1) (match-end 1) 'org-ind 'empty datum)) 5622 (t 5623 (let ((i (string-width (match-string 1 datum)))) 5624 (put-text-property 5625 (match-beginning 1) (match-end 1) 'org-ind i datum) 5626 (setq min-ind (min i min-ind)))))) 5627 (cond 5628 ((stringp datum) 5629 (let ((s 0)) 5630 (while (string-match 5631 "\n\\([ \t]*\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s) 5632 (setq s (match-end 1)) 5633 (cond 5634 ((equal (match-string 1 datum) "") 5635 (unless (member (match-string 2 datum) '("" "\n")) 5636 (throw :zero 0))) 5637 ((equal (match-string 2 datum) "\n") 5638 (put-text-property (match-beginning 1) (match-end 1) 5639 'org-ind 'empty datum)) 5640 (t 5641 (let ((i (string-width (match-string 1 datum)))) 5642 (put-text-property (match-beginning 1) (match-end 1) 5643 'org-ind i datum) 5644 (setq min-ind (min i min-ind)))))))) 5645 ((org-element-type-p datum 'line-break) 5646 (setq first-flag t)) 5647 ((org-element-type-p datum org-element-recursive-objects) 5648 (setq min-ind 5649 (funcall find-min-ind datum first-flag min-ind))))))) 5650 (min-ind 5651 (catch :zero 5652 (funcall find-min-ind 5653 element (not ignore-first) most-positive-fixnum)))) 5654 (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element 5655 ;; Build ELEMENT back, replacing each string with the same 5656 ;; string minus common indentation. 5657 (letrec ((build 5658 (lambda (datum) 5659 ;; Return DATUM with all its strings indentation 5660 ;; shortened from MIN-IND white spaces. 5661 (apply 5662 #'org-element-set-contents 5663 datum 5664 (mapcar 5665 (lambda (object) 5666 (cond 5667 ((stringp object) 5668 (with-temp-buffer 5669 (insert object) 5670 (let ((s (point-min))) 5671 (while (setq s (text-property-not-all 5672 s (point-max) 'org-ind nil)) 5673 (goto-char s) 5674 (let ((i (get-text-property s 'org-ind))) 5675 (delete-region s (progn 5676 (skip-chars-forward " \t") 5677 (point))) 5678 (when (integerp i) (indent-to (- i min-ind)))))) 5679 (buffer-string))) 5680 ((org-element-type-p object org-element-recursive-objects) 5681 (funcall build object)) 5682 (t object))) 5683 (org-element-contents datum))) 5684 datum))) 5685 (funcall build element))))) 5686 5687 5688 5689 ;;; Cache 5690 ;; 5691 ;; Implement a caching mechanism for `org-element-at-point', `org-element-context', and for 5692 ;; fast mapping across Org elements in `org-element-cache-map', which see. 5693 ;; 5694 ;; When cache is enabled, the elements returned by `org-element-at-point' and 5695 ;; `org-element-context' are returned by reference. Altering these elements will 5696 ;; also alter their cache representation. The same is true for 5697 ;; elements passed to mapping function in `org-element-cache-map'. 5698 ;; 5699 ;; Public functions are: `org-element-cache-reset', `org-element-cache-refresh', and 5700 ;; `org-element-cache-map'. 5701 ;; 5702 ;; Cache can be controlled using `org-element-use-cache' and `org-element-cache-persistent'. 5703 ;; `org-element-cache-sync-idle-time', `org-element-cache-sync-duration' and 5704 ;; `org-element-cache-sync-break' can be tweaked to control caching behavior. 5705 ;; 5706 ;; Internally, parsed elements are stored in an AVL tree, 5707 ;; `org-element--cache'. This tree is updated lazily: whenever 5708 ;; a change happens to the buffer, a synchronization request is 5709 ;; registered in `org-element--cache-sync-requests' (see 5710 ;; `org-element--cache-submit-request'). During idle time, requests 5711 ;; are processed by `org-element--cache-sync'. Synchronization also 5712 ;; happens when an element is required from the cache. In this case, 5713 ;; the process stops as soon as the needed element is up-to-date. 5714 ;; 5715 ;; A synchronization request can only apply on a synchronized part of 5716 ;; the cache. Therefore, the cache is updated at least to the 5717 ;; location where the new request applies. Thus, requests are ordered 5718 ;; from left to right and all elements starting before the first 5719 ;; request are correct. This property is used by functions like 5720 ;; `org-element--cache-find' to retrieve elements in the part of the 5721 ;; cache that can be trusted. 5722 ;; 5723 ;; A request applies to every element, starting from its original 5724 ;; location (or key, see below). When a request is processed, it 5725 ;; moves forward and may collide the next one. In this case, both 5726 ;; requests are merged into a new one that starts from that element. 5727 ;; As a consequence, the whole synchronization complexity does not 5728 ;; depend on the number of pending requests, but on the number of 5729 ;; elements the very first request will be applied on. 5730 ;; 5731 ;; Elements cannot be accessed through their beginning position, which 5732 ;; may or may not be up-to-date. Instead, each element in the tree is 5733 ;; associated to a key, obtained with `org-element--cache-key'. This 5734 ;; mechanism is robust enough to preserve total order among elements 5735 ;; even when the tree is only partially synchronized. 5736 ;; 5737 ;; The cache code debugging is fairly complex because cache request 5738 ;; state is often hard to reproduce. An extensive diagnostics 5739 ;; functionality is built into the cache code to assist hunting bugs. 5740 ;; See `org-element--cache-self-verify', `org-element--cache-self-verify-frequency', 5741 ;; `org-element--cache-diagnostics', `org-element--cache-diagnostics-level', 5742 ;; `org-element--cache-diagnostics-ring-size', `org-element--cache-map-statistics', 5743 ;; `org-element--cache-map-statistics-threshold'. 5744 5745 ;;;###autoload 5746 (defvar org-element-use-cache t 5747 "Non-nil when Org parser should cache its results.") 5748 5749 (defvar org-element-cache-persistent t 5750 "Non-nil when cache should persist between Emacs sessions.") 5751 5752 (defconst org-element-cache-version "2.3" 5753 "Version number for Org AST structure. 5754 Used to avoid loading obsolete AST representation when using 5755 `org-element-cache-persistent'.") 5756 5757 (defvar org-element-cache-sync-idle-time 0.6 5758 "Length, in seconds, of idle time before syncing cache.") 5759 5760 (defvar org-element-cache-sync-duration 0.04 5761 "Maximum duration, as a time value, for a cache synchronization. 5762 If the synchronization is not over after this delay, the process 5763 pauses and resumes after `org-element-cache-sync-break' 5764 seconds.") 5765 5766 (defvar org-element-cache-sync-break 0.3 5767 "Duration, as a time value, of the pause between synchronizations. 5768 See `org-element-cache-sync-duration' for more information.") 5769 5770 (defvar org-element--cache-self-verify nil 5771 "Activate extra consistency checks for the cache. 5772 5773 This may cause serious performance degradation depending on the value 5774 of `org-element--cache-self-verify-frequency'. 5775 5776 When set to symbol `backtrace', record and display backtrace log if 5777 any inconsistency is detected.") 5778 5779 (defvar org-element--cache-self-verify-before-persisting nil 5780 "Perform consistency checks for the cache before writing to disk. 5781 5782 When non-nil, signal an error an show backtrace if cache contains 5783 incorrect elements. `org-element--cache-self-verify' must be set to 5784 symbol `backtrace' to have non-empty backtrace displayed.") 5785 5786 (defvar org-element--cache-self-verify-frequency 0.03 5787 "Frequency of cache element verification. 5788 5789 This number is a probability to check an element requested from cache 5790 to be correct. Setting this to a value less than 0.0001 is useless.") 5791 5792 (defvar org-element--cache-diagnostics nil 5793 "Print detailed diagnostics of cache processing.") 5794 5795 (defvar org-element--cache-map-statistics nil 5796 "Print statistics for `org-element-cache-map'.") 5797 5798 (defvar org-element--cache-map-statistics-threshold 0.1 5799 "Time threshold in seconds to log statistics for `org-element-cache-map'.") 5800 5801 (defvar org-element--cache-diagnostics-level 2 5802 "Detail level of the diagnostics.") 5803 5804 (defvar-local org-element--cache-diagnostics-ring nil 5805 "Ring containing cache process log entries. 5806 The ring size is `org-element--cache-diagnostics-ring-size'.") 5807 5808 (defvar org-element--cache-diagnostics-ring-size 5000 5809 "Size of `org-element--cache-diagnostics-ring'.") 5810 5811 ;;;; Data Structure 5812 5813 (defvar-local org-element--cache nil 5814 "AVL tree used to cache elements. 5815 Each node of the tree contains an element. Comparison is done 5816 with `org-element--cache-compare'. This cache is used in 5817 `org-element-at-point'.") 5818 5819 (defvar-local org-element--headline-cache nil 5820 "AVL tree used to cache headline and inlinetask elements. 5821 Each node of the tree contains an element. Comparison is done 5822 with `org-element--cache-compare'. This cache is used in 5823 `org-element-cache-map'.") 5824 5825 (defconst org-element--cache-hash-size 16 5826 "Cache size for recent cached calls to `org-element--cache-find'. 5827 5828 This extra caching is based on the following paper: 5829 Pugh [Information Processing Letters] (1990) Slow optimally balanced 5830 search strategies vs. cached fast uniformly balanced search 5831 strategies. http://dx.doi.org/10.1016/0020-0190(90)90130-P 5832 5833 Also, see `org-element--cache-hash-left' and `org-element--cache-hash-right'.") 5834 (defvar-local org-element--cache-hash-left nil 5835 "Cached elements from `org-element--cache' for fast O(1) lookup. 5836 When non-nil, it should be a vector representing POS arguments of 5837 `org-element--cache-find' called with nil SIDE argument. 5838 Also, see `org-element--cache-hash-size'.") 5839 (defvar-local org-element--cache-hash-right nil 5840 "Cached elements from `org-element--cache' for fast O(1) lookup. 5841 When non-nil, it should be a vector representing POS arguments of 5842 `org-element--cache-find' called with non-nil, non-`both' SIDE argument. 5843 Also, see `org-element--cache-hash-size'.") 5844 5845 (defvar-local org-element--cache-size 0 5846 "Size of the `org-element--cache'. 5847 5848 Storing value is variable is faster because `avl-tree-size' is O(N).") 5849 5850 (defvar-local org-element--headline-cache-size 0 5851 "Size of the `org-element--headline-cache'. 5852 5853 Storing value is variable is faster because `avl-tree-size' is O(N).") 5854 5855 (defvar-local org-element--cache-sync-requests nil 5856 "List of pending synchronization requests. 5857 5858 A request is a vector with the following pattern: 5859 5860 [NEXT BEG END OFFSET PARENT PHASE] 5861 5862 Processing a synchronization request consists of three phases: 5863 5864 0. Delete modified elements, 5865 1. Fill missing area in cache, 5866 2. Shift positions and re-parent elements after the changes. 5867 5868 During phase 0, NEXT is the key of the first element to be 5869 removed, BEG and END is buffer position delimiting the 5870 modifications. Elements starting between them (inclusive) are 5871 removed. So are elements whose parent is removed. PARENT, when 5872 non-nil, is the common parent of all the elements between BEG and END. 5873 5874 It is guaranteed that only a single phase 0 request exists at any 5875 moment of time. If it does, it must be the first request in the list. 5876 5877 During phase 1, NEXT is the key of the next known element in 5878 cache and BEG its beginning position. Parse buffer between that 5879 element and the one before it in order to determine the parent of 5880 the next element. Set PARENT to the element containing NEXT. 5881 5882 During phase 2, NEXT is the key of the next element to shift in 5883 the parse tree. All elements starting from this one have their 5884 properties relative to buffer positions shifted by integer 5885 OFFSET and, if they belong to element PARENT, are adopted by it. 5886 5887 PHASE specifies the phase number, as an integer. 5888 5889 For any synchronization request, all the later requests in the cache 5890 must not start at or before END. See `org-element--cache-submit-request'.") 5891 5892 (defvar-local org-element--cache-sync-timer nil 5893 "Timer used for cache synchronization.") 5894 5895 (defvar-local org-element--cache-sync-keys-value nil 5896 "Id value used to identify keys during synchronization. 5897 See `org-element--cache-key' for more information.") 5898 5899 (defvar-local org-element--cache-change-tic nil 5900 "Last `buffer-chars-modified-tick' for registered changes.") 5901 5902 (defvar-local org-element--cache-last-buffer-size nil 5903 "Last value of `buffer-size' for registered changes.") 5904 5905 (defvar org-element--cache-non-modifying-commands 5906 '(org-agenda 5907 org-agenda-redo 5908 org-sparse-tree 5909 org-occur 5910 org-columns 5911 org-columns-redo 5912 org-columns-new 5913 org-columns-delete 5914 org-columns-compute 5915 org-columns-insert-dblock 5916 org-agenda-columns 5917 org-ctrl-c-ctrl-c) 5918 "List of commands that are not expected to change the cache state. 5919 5920 This variable is used to determine when re-parsing buffer is not going 5921 to slow down the command. 5922 5923 If the commands end up modifying the cache, the worst case scenario is 5924 performance drop. So, advising these commands is safe. Yet, it is 5925 better to remove the commands advised in such a way from this list.") 5926 5927 (defmacro org-element--request-key (request) 5928 "Get NEXT part of a `org-element--cache-sync-requests' REQUEST." 5929 `(aref ,request 0)) 5930 5931 (defmacro org-element--request-beg (request) 5932 "Get BEG part of a `org-element--cache-sync-requests' REQUEST." 5933 `(aref ,request 1)) 5934 5935 (defmacro org-element--request-end (request) 5936 "Get END part of a `org-element--cache-sync-requests' REQUEST." 5937 `(aref ,request 2)) 5938 5939 (defmacro org-element--request-offset (request) 5940 "Get OFFSET part of a `org-element--cache-sync-requests' REQUEST." 5941 `(aref ,request 3)) 5942 5943 (defmacro org-element--request-parent (request) 5944 "Get PARENT part of a `org-element--cache-sync-requests' REQUEST." 5945 `(aref ,request 4)) 5946 5947 (defmacro org-element--request-phase (request) 5948 "Get PHASE part of a `org-element--cache-sync-requests' REQUEST." 5949 `(aref ,request 5)) 5950 5951 (defmacro org-element--format-element (element) 5952 "Format ELEMENT for printing in diagnostics." 5953 `(let ((print-length 50) 5954 (print-level 5)) 5955 (prin1-to-string ,element))) 5956 5957 (defmacro org-element--cache-log-message (format-string &rest args) 5958 "Add a new log message for org-element-cache. 5959 FORMAT-STRING and ARGS are the same arguments as in `format'." 5960 `(when (or org-element--cache-diagnostics 5961 (eq org-element--cache-self-verify 'backtrace)) 5962 (let* ((format-string (concat (format "org-element-cache diagnostics(%s): " 5963 (buffer-name (current-buffer))) 5964 ,format-string)) 5965 (format-string (funcall #'format format-string ,@args))) 5966 (if org-element--cache-diagnostics 5967 (display-warning '(org-element org-element-cache) format-string) 5968 (unless org-element--cache-diagnostics-ring 5969 (setq org-element--cache-diagnostics-ring 5970 (make-ring org-element--cache-diagnostics-ring-size))) 5971 (ring-insert org-element--cache-diagnostics-ring format-string))))) 5972 5973 (defmacro org-element--cache-warn (format-string &rest args) 5974 "Raise warning for org-element-cache. 5975 FORMAT-STRING and ARGS are the same arguments as in `format'." 5976 `(let* ((format-string (funcall #'format ,format-string ,@args)) 5977 (format-string 5978 (if (or (not org-element--cache-diagnostics-ring) 5979 (not (eq 'backtrace org-element--cache-self-verify))) 5980 format-string 5981 (prog1 5982 (concat (format "Warning(%s): " 5983 (buffer-name (current-buffer))) 5984 format-string 5985 "\nBacktrace:\n " 5986 (mapconcat #'identity 5987 (ring-elements org-element--cache-diagnostics-ring) 5988 "\n ")) 5989 (setq org-element--cache-diagnostics-ring nil))))) 5990 (if (and (boundp 'org-batch-test) org-batch-test) 5991 (error "%s" (concat "org-element--cache: " format-string)) 5992 (push (concat "org-element--cache: " format-string) org--warnings) 5993 (display-warning '(org-element org-element-cache) 5994 (concat "org-element--cache: " format-string))))) 5995 5996 (defsubst org-element--cache-key (element) 5997 "Return a unique key for ELEMENT in cache tree. 5998 5999 Keys are used to keep a total order among elements in the cache. 6000 Comparison is done with `org-element--cache-key-less-p'. 6001 6002 When no synchronization is taking place, a key is simply the 6003 beginning position of the element, or that position plus one in 6004 the case of an first item (respectively row) in 6005 a list (respectively a table). They key of a section is its beginning 6006 position minus one. 6007 6008 During a synchronization, the key is the one the element had when 6009 the cache was synchronized for the last time. Elements added to 6010 cache during the synchronization get a new key generated with 6011 `org-element--cache-generate-key'. 6012 6013 Such keys are stored inside the element property 6014 `:org-element--cache-sync-key'. The property is a cons containing 6015 current `org-element--cache-sync-keys-value' and the element key." 6016 (or (when-let* ((key-cons (org-element-property :org-element--cache-sync-key element))) 6017 (when (eq org-element--cache-sync-keys-value (car key-cons)) 6018 (cdr key-cons))) 6019 (let* ((begin (org-element-begin element)) 6020 (type (org-element-type element)) 6021 ;; Increase beginning position of items (respectively 6022 ;; table rows) by one, so the first item can get 6023 ;; a different key from its parent list (respectively 6024 ;; table). 6025 (key 6026 (cond 6027 ((memq type '(item table-row)) (1+ begin)) 6028 ;; Decrease beginning position of sections by one, 6029 ;; so that the first element of the section get 6030 ;; different key from the parent section. 6031 ((eq type 'section) (1- begin)) 6032 ((eq type 'org-data) (- begin 2)) 6033 (t begin)))) 6034 (when org-element--cache-sync-requests 6035 (org-element-put-property 6036 element 6037 :org-element--cache-sync-key 6038 (cons org-element--cache-sync-keys-value key))) 6039 key))) 6040 6041 (defun org-element--cache-generate-key (lower upper) 6042 "Generate a key between LOWER and UPPER. 6043 6044 LOWER and UPPER are fixnums or lists of same, possibly empty. 6045 6046 If LOWER and UPPER are equals, return LOWER. Otherwise, return 6047 a unique key, as an integer or a list of integers, according to 6048 the following rules: 6049 6050 - LOWER and UPPER are compared level-wise until values differ. 6051 6052 - If, at a given level, LOWER and UPPER differ from more than 6053 2, the new key shares all the levels above with LOWER and 6054 gets a new level. Its value is the mean between LOWER and 6055 UPPER: 6056 6057 (1 2) + (1 4) --> (1 3) 6058 6059 - If LOWER has no value to compare with, it is assumed that its 6060 value is `most-negative-fixnum'. E.g., 6061 6062 (1 1) + (1 1 2) 6063 6064 is equivalent to 6065 6066 (1 1 m) + (1 1 2) 6067 6068 where m is `most-negative-fixnum'. Likewise, if UPPER is 6069 short of levels, the current value is `most-positive-fixnum'. 6070 6071 - If they differ from only one, the new key inherits from 6072 current LOWER level and fork it at the next level. E.g., 6073 6074 (2 1) + (3 3) 6075 6076 is equivalent to 6077 6078 (2 1) + (2 M) 6079 6080 where M is `most-positive-fixnum'. 6081 6082 - If the key is only one level long, it is returned as an 6083 integer: 6084 6085 (1 2) + (3 2) --> 2 6086 6087 When they are not equals, the function assumes that LOWER is 6088 lesser than UPPER, per `org-element--cache-key-less-p'." 6089 (if (equal lower upper) lower 6090 (let ((lower (if (integerp lower) (list lower) lower)) 6091 (upper (if (integerp upper) (list upper) upper)) 6092 skip-upper key) 6093 (catch 'exit 6094 (while t 6095 (let ((min (or (car lower) most-negative-fixnum)) 6096 (max (cond (skip-upper most-positive-fixnum) 6097 ((car upper)) 6098 (t most-positive-fixnum)))) 6099 (if (< (1+ min) max) 6100 (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1)))) 6101 (throw 'exit (if key (nreverse (cons mean key)) mean))) 6102 (when (and (< min max) (not skip-upper)) 6103 ;; When at a given level, LOWER and UPPER differ from 6104 ;; 1, ignore UPPER altogether. Instead create a key 6105 ;; between LOWER and the greatest key with the same 6106 ;; prefix as LOWER so far. 6107 (setq skip-upper t)) 6108 (push min key) 6109 (setq lower (cdr lower) upper (cdr upper))))))))) 6110 6111 (defsubst org-element--cache-key-less-p (a b) 6112 "Non-nil if key A is less than key B. 6113 A and B are either integers or lists of integers, as returned by 6114 `org-element--cache-key'. 6115 6116 Note that it is not reliable to compare buffer position with the cache 6117 keys. They keys may be larger compared to actual element :begin 6118 position." 6119 (if (integerp a) (if (integerp b) (< a b) (<= a (car b))) 6120 (if (integerp b) (< (car a) b) 6121 (catch 'exit 6122 (while (and a b) 6123 (cond ((car-less-than-car a b) (throw 'exit t)) 6124 ((car-less-than-car b a) (throw 'exit nil)) 6125 (t (setq a (cdr a) b (cdr b))))) 6126 ;; If A is empty, either keys are equal (B is also empty) and 6127 ;; we return nil, or A is lesser than B (B is longer) and we 6128 ;; return a non-nil value. 6129 ;; 6130 ;; If A is not empty, B is necessarily empty and A is greater 6131 ;; than B (A is longer). Therefore, return nil. 6132 (and (null a) b))))) 6133 6134 (defsubst org-element--cache-compare (a b) 6135 "Non-nil when element A is located before element B." 6136 (org-element--cache-key-less-p (org-element--cache-key a) (org-element--cache-key b))) 6137 6138 (defsubst org-element--cache-root () 6139 "Return root value in `org-element--cache' . 6140 This function assumes `org-element--cache' is a valid AVL tree." 6141 (avl-tree--node-left (avl-tree--dummyroot org-element--cache))) 6142 6143 (defsubst org-element--headline-cache-root () 6144 "Return root value in `org-element--headline-cache' . 6145 This function assumes `org-element--headline-cache' is a valid AVL tree." 6146 (avl-tree--node-left (avl-tree--dummyroot org-element--headline-cache))) 6147 6148 ;;;; Tools 6149 6150 ;; FIXME: `org-fold-core-cycle-over-indirect-buffers' should better be 6151 ;; taken out of org-fold-core to track indirect buffers in general. 6152 (defun org-element--cache-active-p (&optional called-from-cache-change-func-p) 6153 "Non-nil when cache is active in current buffer. 6154 When CALLED-FROM-CACHE-CHANGE-FUNC-P is non-nil, do not assert cache 6155 consistency with buffer modifications." 6156 (org-with-base-buffer nil 6157 (and org-element-use-cache 6158 (or org-element--cache 6159 (when (derived-mode-p 'org-mode) 6160 (org-element-cache-reset) 6161 t)) 6162 (or called-from-cache-change-func-p 6163 (eq org-element--cache-change-tic (buffer-chars-modified-tick)) 6164 (and 6165 ;; org-num-mode calls some Org structure analysis functions 6166 ;; that can trigger cache update in the middle of changes. See 6167 ;; `org-num--verify' calling `org-num--skip-value' calling 6168 ;; `org-entry-get' that uses cache. 6169 ;; Forcefully disable cache when called from inside a 6170 ;; modification hook, where `inhibit-modification-hooks' is set 6171 ;; to t. 6172 (not inhibit-modification-hooks) 6173 ;; `combine-change-calls' sets `after-change-functions' to 6174 ;; nil. We need not to use cache inside 6175 ;; `combine-change-calls' because the buffer is potentially 6176 ;; changed without notice (the change will be registered 6177 ;; after exiting the `combine-change-calls' body though). 6178 (catch :inhibited 6179 (org-fold-core-cycle-over-indirect-buffers 6180 (unless (memq #'org-element--cache-after-change after-change-functions) 6181 (throw :inhibited nil))) 6182 t)))))) 6183 6184 (defun org-element--cache-find (pos &optional side) 6185 "Find element in cache starting at POS or before. 6186 6187 POS refers to a buffer position. 6188 6189 When optional argument SIDE is non-nil, the function checks for 6190 elements starting at or past POS instead. If SIDE is `both', the 6191 function returns a cons cell where car is the first element 6192 starting at or before POS and cdr the first element starting 6193 after POS. 6194 6195 The function can only find elements in the synchronized part of 6196 the cache." 6197 (org-with-base-buffer nil 6198 (let* ((limit (and org-element--cache-sync-requests 6199 (org-element--request-key (car org-element--cache-sync-requests)))) 6200 (node (org-element--cache-root)) 6201 (hash-pos (unless (eq side 'both) 6202 (mod (org-knuth-hash pos) 6203 org-element--cache-hash-size))) 6204 (hashed (if (not side) 6205 (aref org-element--cache-hash-left hash-pos) 6206 (unless (eq side 'both) 6207 (aref org-element--cache-hash-right hash-pos)))) 6208 lower upper) 6209 ;; `org-element--cache-key-less-p' does not accept markers. 6210 (when (markerp pos) (setq pos (marker-position pos))) 6211 (if (and hashed (not (eq side 'both)) 6212 ;; Ensure that HASHED is not within synchronized part 6213 ;; of the cache. 6214 (org-element-property :cached hashed) 6215 (or (not limit) 6216 ;; Limit can be a list key. 6217 (org-element--cache-key-less-p 6218 (org-element--cache-key hashed) 6219 limit)) 6220 ;; It is only safe to assume that element at POS is 6221 ;; exact. Extra elements starting before/after could 6222 ;; have been added to cache and HASHED may no longer be 6223 ;; valid. 6224 (= pos (org-element-begin hashed)) 6225 ;; We cannot rely on element :begin for elements with 6226 ;; children starting at the same pos. 6227 (not (org-element-type-p hashed '(section org-data table)))) 6228 hashed 6229 ;; No appropriate HASHED. Search the cache. 6230 (while node 6231 (let* ((element (avl-tree--node-data node)) 6232 (begin (org-element-begin element))) 6233 (cond 6234 ((and limit 6235 (not (org-element--cache-key-less-p 6236 (org-element--cache-key element) limit))) 6237 (setq node (avl-tree--node-left node))) 6238 ((> begin pos) 6239 (setq upper element 6240 node (avl-tree--node-left node))) 6241 ((or (< begin pos) 6242 ;; If the element is section or org-data, we also need 6243 ;; to check the following element. 6244 (org-element-type-p element '(section org-data))) 6245 (setq lower element 6246 node (avl-tree--node-right node))) 6247 ;; We found an element in cache starting at POS. If `side' 6248 ;; is `both' we also want the next one in order to generate 6249 ;; a key in-between. 6250 ;; 6251 ;; If the element is the first row or item in a table or 6252 ;; a plain list, we always return the table or the plain 6253 ;; list. 6254 ;; 6255 ;; In any other case, we return the element found. 6256 ((eq side 'both) 6257 (setq lower element) 6258 (setq node (avl-tree--node-right node))) 6259 ((and (org-element-type-p element '(item table-row)) 6260 ;; Cached elements cannot have deferred `:parent'. 6261 (let ((parent (org-element-property-raw :parent element))) 6262 (and (= (org-element-begin element) 6263 (org-element-contents-begin parent)) 6264 (setq node nil 6265 lower parent 6266 upper parent))))) 6267 (t 6268 (setq node nil 6269 lower element 6270 upper element))))) 6271 (pcase side 6272 (`both (cons lower upper)) 6273 (`nil 6274 (aset org-element--cache-hash-left hash-pos lower)) 6275 (_ 6276 (aset org-element--cache-hash-right hash-pos upper))))))) 6277 6278 (defun org-element--cache-put (element) 6279 "Store ELEMENT in current buffer's cache, if allowed." 6280 (org-with-base-buffer nil 6281 (when (org-element--cache-active-p) 6282 (when org-element--cache-sync-requests 6283 ;; During synchronization, first build an appropriate key for 6284 ;; the new element so `avl-tree-enter' can insert it at the 6285 ;; right spot in the cache. 6286 (let* ((keys (org-element--cache-find 6287 (org-element-begin element) 'both)) 6288 (new-key (org-element--cache-generate-key 6289 (and (car keys) (org-element--cache-key (car keys))) 6290 (cond ((cdr keys) (org-element--cache-key (cdr keys))) 6291 (org-element--cache-sync-requests 6292 (org-element--request-key (car org-element--cache-sync-requests))))))) 6293 (org-element-put-property 6294 element 6295 :org-element--cache-sync-key 6296 (cons org-element--cache-sync-keys-value new-key)))) 6297 (when (>= org-element--cache-diagnostics-level 2) 6298 (org-element--cache-log-message 6299 "Added new element with %S key: %S" 6300 (org-element-property :org-element--cache-sync-key element) 6301 (org-element--format-element element))) 6302 (org-element-put-property element :cached t) 6303 (when (org-element-type-p element '(headline inlinetask)) 6304 (cl-incf org-element--headline-cache-size) 6305 (avl-tree-enter org-element--headline-cache element)) 6306 (cl-incf org-element--cache-size) 6307 (avl-tree-enter org-element--cache element)))) 6308 6309 (defsubst org-element--cache-remove (element) 6310 "Remove ELEMENT from cache. 6311 Assume ELEMENT belongs to cache and that a cache is active." 6312 (org-with-base-buffer nil 6313 (org-element-put-property element :cached nil) 6314 (cl-decf org-element--cache-size) 6315 ;; Invalidate contents of parent. 6316 (when (org-element-contents 6317 ;; Cached elements cannot have deferred `:parent'. 6318 (org-element-property-raw :parent element)) 6319 (org-element-set-contents 6320 (org-element-property-raw :parent element) nil)) 6321 (when (org-element-type-p element '(headline inlinetask)) 6322 (cl-decf org-element--headline-cache-size) 6323 (avl-tree-delete org-element--headline-cache element)) 6324 (org-element--cache-log-message 6325 "Decreasing cache size to %S" 6326 org-element--cache-size) 6327 (when (< org-element--cache-size 0) 6328 (org-element--cache-warn 6329 "Cache grew to negative size in %S when deleting %S at %S. Cache key: %S. 6330 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)." 6331 (org-element-type element) 6332 (current-buffer) 6333 (org-element-begin element) 6334 (org-element-property :org-element--cache-sync-key element)) 6335 (org-element-cache-reset) 6336 (throw 'org-element--cache-quit nil)) 6337 (or (avl-tree-delete org-element--cache element) 6338 (progn 6339 ;; This should not happen, but if it is, would be better to know 6340 ;; where it happens. 6341 (org-element--cache-warn 6342 "Failed to delete %S element in %S at %S. The element cache key was %S. 6343 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)." 6344 (org-element-type element) 6345 (current-buffer) 6346 (org-element-begin element) 6347 (org-element-property :org-element--cache-sync-key element)) 6348 (org-element-cache-reset) 6349 (throw 'org-element--cache-quit nil))))) 6350 6351 ;;;; Synchronization 6352 6353 (defsubst org-element--cache-set-timer (buffer) 6354 "Set idle timer for cache synchronization in BUFFER." 6355 (when org-element--cache-sync-timer 6356 (cancel-timer org-element--cache-sync-timer)) 6357 (setq org-element--cache-sync-timer 6358 (run-with-idle-timer 6359 (let ((idle (current-idle-time))) 6360 (if idle (time-add idle org-element-cache-sync-break) 6361 org-element-cache-sync-idle-time)) 6362 nil 6363 #'org-element--cache-sync 6364 buffer))) 6365 6366 (defsubst org-element--cache-interrupt-p (time-limit) 6367 "Non-nil when synchronization process should be interrupted. 6368 TIME-LIMIT is a time value or nil." 6369 (and time-limit 6370 (or (input-pending-p) 6371 (time-less-p time-limit nil)))) 6372 6373 (defsubst org-element--cache-shift-positions (element offset &optional props) 6374 "Shift ELEMENT properties relative to buffer positions by OFFSET. 6375 6376 Properties containing buffer positions are `:begin', `:end', 6377 `:contents-begin', `:contents-end' and `:structure'. When 6378 optional argument PROPS is a list of keywords, only shift 6379 properties provided in that list. 6380 6381 Properties are modified by side-effect." 6382 ;; Shift `:structure' property for the first plain list only: it 6383 ;; is the only one that really matters and it prevents from 6384 ;; shifting it more than once. 6385 (when (and (not (zerop offset)) 6386 (or (not props) (memq :structure props)) 6387 (org-element-type-p element 'plain-list) 6388 (not (org-element-type-p 6389 ;; Cached elements cannot have deferred `:parent'. 6390 (org-element-property-raw :parent element) 6391 'item))) 6392 (let ((structure (org-element-property :structure element))) 6393 (dolist (item structure) 6394 (cl-incf (car item) offset) 6395 (cl-incf (nth 6 item) offset)))) 6396 ;; Clear :fragile cache when contents is changed. 6397 (when props (org-element-put-property element :fragile-cache nil)) 6398 ;; Do not use loop for inline expansion to work during compile time. 6399 (unless (zerop offset) 6400 (when (or (not props) (memq :begin props)) 6401 (cl-incf (org-element-begin element) offset)) 6402 (when (or (not props) (memq :end props)) 6403 (cl-incf (org-element-end element) offset)) 6404 (when (or (not props) (memq :post-affiliated props)) 6405 (cl-incf (org-element-post-affiliated element) offset)) 6406 (when (and (or (not props) (memq :contents-begin props)) 6407 (org-element-contents-begin element)) 6408 (cl-incf (org-element-contents-begin element) offset)) 6409 (when (and (or (not props) (memq :contents-end props)) 6410 (org-element-contents-end element)) 6411 (cl-incf (org-element-contents-end element) offset)) 6412 (when (and (or (not props) (memq :robust-begin props)) 6413 (org-element-property :robust-begin element)) 6414 (cl-incf (org-element-property :robust-begin element) offset)) 6415 (when (and (or (not props) (memq :robust-end props)) 6416 (org-element-property :robust-end element)) 6417 (cl-incf (org-element-property :robust-end element) offset)))) 6418 6419 (defvar org-element--cache-interrupt-C-g t 6420 "When non-nil, allow the user to abort `org-element--cache-sync'. 6421 The execution is aborted upon pressing `\\[keyboard-quit]' 6422 `org-element--cache-interrupt-C-g-max-count' times.") 6423 (defvar org-element--cache-interrupt-C-g-max-count 5 6424 "`\\[keyboard-quit]' count to interrupt `org-element--cache-sync'. 6425 See `org-element--cache-interrupt-C-g'.") 6426 (defvar org-element--cache-interrupt-C-g-count 0 6427 "Current number of `org-element--cache-sync' calls. 6428 See `org-element--cache-interrupt-C-g'.") 6429 6430 (defvar org-element--cache-change-warning nil 6431 "Non-nil when a sensitive line is about to be changed. 6432 It is a symbol among nil, t, or a number representing smallest level of 6433 modified headline. The level considers headline levels both before 6434 and after the modification.") 6435 6436 (defun org-element--cache-sync (buffer &optional threshold future-change offset force) 6437 "Synchronize cache with recent modification in BUFFER. 6438 6439 When optional argument THRESHOLD is non-nil, do the 6440 synchronization for all elements starting before or at threshold, 6441 then exit. Otherwise, synchronize cache for as long as 6442 `org-element-cache-sync-duration' or until Emacs leaves idle 6443 state. 6444 6445 FUTURE-CHANGE, when non-nil, is a buffer position where changes 6446 not registered yet in the cache are going to happen. OFFSET is the 6447 change offset. It is used in `org-element--cache-submit-request', 6448 where cache is partially updated before current modification are 6449 actually submitted. 6450 6451 FORCE, when non-nil will force the synchronization even when 6452 `org-element--cache-active-p' returns nil." 6453 (when (buffer-live-p buffer) 6454 (org-with-base-buffer buffer 6455 ;; Do not sync when, for example, in the middle of 6456 ;; `combine-change-calls'. See the commentary inside 6457 ;; `org-element--cache-active-p'. Such situation may occur when 6458 ;; sync timer triggers in the middle of `combine-change-calls'. 6459 (when (and org-element--cache-sync-requests 6460 (or force (org-element--cache-active-p))) 6461 ;; Check if the buffer have been changed outside visibility of 6462 ;; `org-element--cache-before-change' and `org-element--cache-after-change'. 6463 (if (/= org-element--cache-last-buffer-size (buffer-size)) 6464 (progn 6465 (org-element--cache-warn 6466 "Unregistered buffer modifications detected (%S != %S). Resetting. 6467 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report). 6468 The buffer is: %s\n Current command: %S\n Backtrace:\n%S" 6469 org-element--cache-last-buffer-size 6470 (buffer-size) 6471 (buffer-name (current-buffer)) 6472 this-command 6473 (when (and (fboundp 'backtrace-get-frames) 6474 (fboundp 'backtrace-to-string)) 6475 (backtrace-to-string (backtrace-get-frames 'backtrace)))) 6476 (org-element-cache-reset)) 6477 (let ((inhibit-quit t) request next) 6478 (setq org-element--cache-interrupt-C-g-count 0) 6479 (when org-element--cache-sync-timer 6480 (cancel-timer org-element--cache-sync-timer)) 6481 (let ((time-limit (time-add nil org-element-cache-sync-duration))) 6482 (catch 'org-element--cache-interrupt 6483 (when org-element--cache-sync-requests 6484 (org-element--cache-log-message "Syncing down to %S-%S" (or future-change threshold) threshold)) 6485 (while org-element--cache-sync-requests 6486 (setq request (car org-element--cache-sync-requests) 6487 next (nth 1 org-element--cache-sync-requests)) 6488 (org-element--cache-process-request 6489 request 6490 (when next (org-element--request-key next)) 6491 threshold 6492 (unless threshold time-limit) 6493 future-change 6494 offset) 6495 ;; Re-assign current and next requests. It could have 6496 ;; been altered during phase 1. 6497 (setq request (car org-element--cache-sync-requests) 6498 next (nth 1 org-element--cache-sync-requests)) 6499 ;; Request processed. Merge current and next offsets and 6500 ;; transfer ending position. 6501 (when next 6502 ;; The following requests can only be either phase 1 6503 ;; or phase 2 requests. We need to let them know 6504 ;; that additional shifting happened ahead of them. 6505 (cl-incf (org-element--request-offset next) (org-element--request-offset request)) 6506 (org-element--cache-log-message 6507 "Updating next request offset to %S: %s" 6508 (org-element--request-offset next) 6509 (let ((print-length 10) (print-level 3)) (prin1-to-string next))) 6510 ;; FIXME: END part of the request only matters for 6511 ;; phase 0 requests. However, the only possible 6512 ;; phase 0 request must be the first request in the 6513 ;; list all the time. END position should be 6514 ;; unused. 6515 (setf (org-element--request-end next) (org-element--request-end request))) 6516 (setq org-element--cache-sync-requests 6517 (cdr org-element--cache-sync-requests))))) 6518 ;; If more requests are awaiting, set idle timer accordingly. 6519 ;; Otherwise, reset keys. 6520 (if org-element--cache-sync-requests 6521 (org-element--cache-set-timer buffer) 6522 ;; NOTE: We cannot reset 6523 ;; `org-element--cache-change-warning' here as it might 6524 ;; still be needed when synchronization is called by 6525 ;; `org-element--cache-submit-request' before 6526 ;; `org-element--cache-for-removal'. 6527 (setq org-element--cache-sync-keys-value (1+ org-element--cache-sync-keys-value))))))))) 6528 6529 (defun org-element--cache-process-request 6530 (request next-request-key threshold time-limit future-change offset) 6531 "Process synchronization REQUEST for all entries before NEXT. 6532 6533 REQUEST is a vector, built by `org-element--cache-submit-request'. 6534 6535 NEXT-REQUEST-KEY is a cache key of the next request, as returned by 6536 `org-element--cache-key'. 6537 6538 When non-nil, THRESHOLD is a buffer position. Synchronization 6539 stops as soon as a shifted element begins after it. 6540 6541 When non-nil, TIME-LIMIT is a time value. Synchronization stops 6542 after this time or when Emacs exits idle state. 6543 6544 When non-nil, FUTURE-CHANGE is a buffer position where changes not 6545 registered yet in the cache are going to happen. OFFSET is the 6546 changed text length. See `org-element--cache-submit-request' for more 6547 information. 6548 6549 Throw `org-element--cache-interrupt' if the process stops before 6550 completing the request." 6551 (org-with-base-buffer nil 6552 (org-element--cache-log-message 6553 "org-element-cache: Processing request %s up to %S-%S, next: %S" 6554 (let ((print-length 10) (print-level 3)) (prin1-to-string request)) 6555 future-change 6556 threshold 6557 next-request-key) 6558 (catch 'org-element--cache-quit 6559 (when (= (org-element--request-phase request) 0) 6560 ;; Phase 0. 6561 ;; 6562 ;; Delete all elements starting after beginning of the element 6563 ;; with request key NEXT, but not after buffer position END. 6564 ;; 6565 ;; At each iteration, we start again at tree root since 6566 ;; a deletion modifies structure of the balanced tree. 6567 (org-element--cache-log-message "Phase 0") 6568 (catch 'org-element--cache-end-phase 6569 (let ((deletion-count 0)) 6570 (while t 6571 (when (org-element--cache-interrupt-p time-limit) 6572 (org-element--cache-log-message "Interrupt: time limit") 6573 (throw 'org-element--cache-interrupt nil)) 6574 (let ((request-key (org-element--request-key request)) 6575 (end (org-element--request-end request)) 6576 (node (org-element--cache-root)) 6577 data data-key) 6578 ;; Find first element in cache with key REQUEST-KEY or 6579 ;; after it. 6580 (while node 6581 (let* ((element (avl-tree--node-data node)) 6582 (key (org-element--cache-key element))) 6583 (cond 6584 ((org-element--cache-key-less-p key request-key) 6585 (setq node (avl-tree--node-right node))) 6586 ((org-element--cache-key-less-p request-key key) 6587 (setq data element 6588 data-key key 6589 node (avl-tree--node-left node))) 6590 (t (setq data element 6591 data-key key 6592 node nil))))) 6593 (if data 6594 ;; We found first element in cache starting at or 6595 ;; after REQUEST-KEY. 6596 (let ((pos (org-element-begin data))) 6597 ;; FIXME: Maybe simply (< pos end)? 6598 (if (<= pos end) 6599 (progn 6600 (org-element--cache-log-message "removing %S::%S" 6601 (org-element-property :org-element--cache-sync-key data) 6602 (org-element--format-element data)) 6603 (cl-incf deletion-count) 6604 (org-element--cache-remove data) 6605 (when (and (> (log org-element--cache-size 2) 10) 6606 (> deletion-count 6607 (/ org-element--cache-size (log org-element--cache-size 2)))) 6608 (org-element--cache-log-message "Removed %S>N/LogN(=%S/%S) elements. Resetting cache to prevent performance degradation" 6609 deletion-count 6610 org-element--cache-size 6611 (log org-element--cache-size 2)) 6612 (org-element-cache-reset) 6613 (throw 'org-element--cache-quit t))) 6614 ;; Done deleting everything starting before END. 6615 ;; DATA-KEY is the first known element after END. 6616 ;; Move on to phase 1. 6617 (org-element--cache-log-message 6618 "found element after %S: %S::%S" 6619 end 6620 (org-element-property :org-element--cache-sync-key data) 6621 (org-element--format-element data)) 6622 (setf (org-element--request-key request) data-key) 6623 (setf (org-element--request-beg request) pos) 6624 (setf (org-element--request-phase request) 1) 6625 (throw 'org-element--cache-end-phase nil))) 6626 ;; No element starting after modifications left in 6627 ;; cache: further processing is futile. 6628 (org-element--cache-log-message 6629 "Phase 0 deleted all elements in cache after %S!" 6630 request-key) 6631 (throw 'org-element--cache-quit t))))))) 6632 (when (= (org-element--request-phase request) 1) 6633 ;; Phase 1. 6634 ;; 6635 ;; Phase 0 left a hole in the cache. Some elements after it 6636 ;; could have parents within. For example, in the following 6637 ;; buffer: 6638 ;; 6639 ;; - item 6640 ;; 6641 ;; 6642 ;; Paragraph1 6643 ;; 6644 ;; Paragraph2 6645 ;; 6646 ;; if we remove a blank line between "item" and "Paragraph1", 6647 ;; everything down to "Paragraph2" is removed from cache. But 6648 ;; the paragraph now belongs to the list, and its `:parent' 6649 ;; property no longer is accurate. 6650 ;; 6651 ;; Therefore we need to parse again elements in the hole, or at 6652 ;; least in its last section, so that we can re-parent 6653 ;; subsequent elements, during phase 2. 6654 ;; 6655 ;; Note that we only need to get the parent from the first 6656 ;; element in cache after the hole. 6657 ;; 6658 ;; When next key is lesser or equal to the current one, current 6659 ;; request is inside a to-be-shifted part of the cache. It is 6660 ;; fine because the order of elements will not be altered by 6661 ;; shifting. However, we cannot know the real position of the 6662 ;; unshifted NEXT element in the current request. So, we need 6663 ;; to sort the request list according to keys and re-start 6664 ;; processing from the new leftmost request. 6665 (org-element--cache-log-message "Phase 1") 6666 (let ((key (org-element--request-key request))) 6667 (when (and next-request-key (not (org-element--cache-key-less-p key next-request-key))) 6668 ;; In theory, the only case when requests are not 6669 ;; ordered is when key of the next request is either the 6670 ;; same with current key or it is a key for a removed 6671 ;; element. Either way, we can simply merge the two 6672 ;; requests. 6673 (let ((next-request (nth 1 org-element--cache-sync-requests))) 6674 (org-element--cache-log-message "Phase 1: Unorderered requests. Merging: %S\n%S\n" 6675 (let ((print-length 10) (print-level 3)) (prin1-to-string request)) 6676 (let ((print-length 10) (print-level 3)) (prin1-to-string next-request))) 6677 (setf (org-element--request-key next-request) key) 6678 (setf (org-element--request-beg next-request) (org-element--request-beg request)) 6679 (setf (org-element--request-phase next-request) 1) 6680 (throw 'org-element--cache-quit t)))) 6681 ;; Next element will start at its beginning position plus 6682 ;; offset, since it hasn't been shifted yet. Therefore, LIMIT 6683 ;; contains the real beginning position of the first element to 6684 ;; shift and re-parent. 6685 (let ((limit (+ (org-element--request-beg request) (org-element--request-offset request))) 6686 cached-before) 6687 (cond ((and threshold (> limit threshold)) 6688 (org-element--cache-log-message "Interrupt: position %S after threshold %S" limit threshold) 6689 (throw 'org-element--cache-interrupt nil)) 6690 ((and future-change (>= limit future-change)) 6691 ;; Changes happened around this element and they will 6692 ;; trigger another phase 1 request. Skip re-parenting 6693 ;; and simply proceed with shifting (phase 2) to make 6694 ;; sure that followup phase 0 request for the recent 6695 ;; changes can operate on the correctly shifted cache. 6696 (org-element--cache-log-message "position %S after future change %S" limit future-change) 6697 (setf (org-element--request-parent request) nil) 6698 (setf (org-element--request-phase request) 2)) 6699 (t 6700 (when future-change 6701 ;; Changes happened, but not yet registered after 6702 ;; this element. However, we a not yet safe to look 6703 ;; at the buffer and parse elements in the cache gap. 6704 ;; Some of the parents to be added to cache may end 6705 ;; after the changes. Parsing this parents will 6706 ;; assign the :end correct value for cache state 6707 ;; after future-change. Then, when the future change 6708 ;; is going to be processed, such parent boundary 6709 ;; will be altered unnecessarily. To avoid this, 6710 ;; we alter the new parents by -OFFSET. 6711 ;; For now, just save last known cached element and 6712 ;; then check all the parents below. 6713 (setq cached-before (org-element--cache-find (1- limit) nil))) 6714 ;; No relevant changes happened after submitting this 6715 ;; request. We are safe to look at the actual Org 6716 ;; buffer and calculate the new parent. 6717 (let ((parent (org-element--parse-to (1- limit) nil time-limit))) 6718 (when future-change 6719 ;; Check all the newly added parents to not 6720 ;; intersect with future change. 6721 (let ((up parent)) 6722 (while (and up 6723 (or (not cached-before) 6724 (> (org-element-begin up) 6725 (org-element-begin cached-before)))) 6726 (when (> (org-element-end up) future-change) 6727 ;; Offset future cache request. 6728 (org-element--cache-shift-positions 6729 up (- offset) 6730 (if (and (org-element-property :robust-begin up) 6731 (org-element-property :robust-end up)) 6732 '(:contents-end :end :robust-end) 6733 '(:contents-end :end)))) 6734 ;; Cached elements cannot have deferred `:parent'. 6735 (setq up (org-element-property-raw :parent up))))) 6736 (org-element--cache-log-message 6737 "New parent at %S: %S::%S" 6738 limit 6739 (org-element-property :org-element--cache-sync-key parent) 6740 (org-element--format-element parent)) 6741 (setf (org-element--request-parent request) parent) 6742 (setf (org-element--request-phase request) 2)))))) 6743 ;; Phase 2. 6744 ;; 6745 ;; Shift all elements starting from key START, but before NEXT, by 6746 ;; OFFSET, and re-parent them when appropriate. 6747 ;; 6748 ;; Elements are modified by side-effect so the tree structure 6749 ;; remains intact. 6750 ;; 6751 ;; Once THRESHOLD, if any, is reached, or once there is an input 6752 ;; pending, exit. Before leaving, the current synchronization 6753 ;; request is updated. 6754 (org-element--cache-log-message "Phase 2") 6755 (let ((start (org-element--request-key request)) 6756 (offset (org-element--request-offset request)) 6757 (parent (org-element--request-parent request)) 6758 (node (org-element--cache-root)) 6759 (stack (list nil)) 6760 (leftp t) 6761 exit-flag continue-flag) 6762 ;; No re-parenting nor shifting planned: request is over. 6763 (when (and (not parent) (zerop offset)) 6764 (org-element--cache-log-message "Empty offset. Request completed.") 6765 (throw 'org-element--cache-quit t)) 6766 (while node 6767 (let* ((data (avl-tree--node-data node)) 6768 (key (org-element--cache-key data))) 6769 ;; Traverse the cache tree. Ignore all the elements before 6770 ;; START. Note that `avl-tree-stack' would not bypass the 6771 ;; elements before START and thus would have been less 6772 ;; efficient. 6773 (if (and leftp (avl-tree--node-left node) 6774 (not (org-element--cache-key-less-p key start))) 6775 (progn (push node stack) 6776 (setq node (avl-tree--node-left node))) 6777 ;; Shift and re-parent when current node starts at or 6778 ;; after START, but before NEXT. 6779 (unless (org-element--cache-key-less-p key start) 6780 ;; We reached NEXT. Request is complete. 6781 (when (and next-request-key 6782 (not (org-element--cache-key-less-p key next-request-key))) 6783 (org-element--cache-log-message "Reached next request.") 6784 (let ((next-request (nth 1 org-element--cache-sync-requests))) 6785 (unless (and (org-element-property :cached (org-element--request-parent next-request)) 6786 (org-element-begin (org-element--request-parent next-request)) 6787 parent 6788 (> (org-element-begin (org-element--request-parent next-request)) 6789 (org-element-begin parent))) 6790 (setf (org-element--request-parent next-request) parent))) 6791 (throw 'org-element--cache-quit t)) 6792 ;; Handle interruption request. Update current request. 6793 (when (or exit-flag (org-element--cache-interrupt-p time-limit)) 6794 (org-element--cache-log-message "Interrupt: %s" (if exit-flag "threshold" "time limit")) 6795 (setf (org-element--request-key request) key) 6796 (setf (org-element--request-parent request) parent) 6797 (throw 'org-element--cache-interrupt nil)) 6798 ;; Shift element. 6799 (when (>= org-element--cache-diagnostics-level 3) 6800 (org-element--cache-log-message "Shifting positions (𝝙%S) in %S::%S" 6801 offset 6802 (org-element-property :org-element--cache-sync-key data) 6803 (org-element--format-element data))) 6804 (org-element--cache-shift-positions data offset) 6805 (let ((begin (org-element-begin data))) 6806 ;; Update PARENT and re-parent DATA, only when 6807 ;; necessary. Propagate new structures for lists. 6808 (while (and parent (<= (org-element-end parent) begin)) 6809 (setq parent 6810 ;; Cached elements cannot have deferred `:parent'. 6811 (org-element-property-raw :parent parent))) 6812 (cond ((and (not parent) (zerop offset)) (throw 'org-element--cache-quit nil)) 6813 ;; Consider scenario when DATA lays within 6814 ;; sensitive lines of PARENT that was found 6815 ;; during phase 2. For example: 6816 ;; 6817 ;; #+ begin_quote 6818 ;; Paragraph 6819 ;; #+end_quote 6820 ;; 6821 ;; In the above source block, remove space in 6822 ;; the first line will trigger re-parenting of 6823 ;; the paragraph and "#+end_quote" that is also 6824 ;; considered paragraph before the modification. 6825 ;; However, the paragraph element stored in 6826 ;; cache must be deleted instead. 6827 ((and parent 6828 (or (not (org-element-type-p parent org-element-greater-elements)) 6829 (and (org-element-contents-begin parent) 6830 (< (org-element-begin data) (org-element-contents-begin parent))) 6831 (and (org-element-contents-end parent) 6832 (>= (org-element-begin data) (org-element-contents-end parent))) 6833 (> (org-element-end data) (org-element-end parent)) 6834 (and (org-element-contents-end data) 6835 (> (org-element-contents-end data) (org-element-contents-end parent))))) 6836 (org-element--cache-log-message "org-element-cache: Removing obsolete element with key %S::%S" 6837 (org-element-property :org-element--cache-sync-key data) 6838 (org-element--format-element data)) 6839 (org-element--cache-remove data) 6840 ;; We altered the tree structure. The tree 6841 ;; traversal needs to be restarted. 6842 (setf (org-element--request-key request) key) 6843 ;; Make sure that we restart tree traversal 6844 ;; past already shifted elements (before the 6845 ;; removed DATA). 6846 (setq start key) 6847 (setf (org-element--request-parent request) parent) 6848 ;; Restart tree traversal. 6849 (setq node (org-element--cache-root) 6850 stack (list nil) 6851 leftp t 6852 begin -1 6853 continue-flag t)) 6854 ((and parent 6855 (not (eq parent data)) 6856 ;; Cached elements cannot have deferred `:parent'. 6857 (let ((p (org-element-property-raw :parent data))) 6858 (or (not p) 6859 (< (org-element-begin p) 6860 (org-element-begin parent)) 6861 (unless (eq p parent) 6862 (not (org-element-property :cached p)) 6863 ;; (not (avl-tree-member-p org-element--cache p)) 6864 )))) 6865 (org-element--cache-log-message 6866 "Updating parent in %S\n Old parent: %S\n New parent: %S" 6867 (org-element--format-element data) 6868 (org-element--format-element 6869 (org-element-property-raw :parent data)) 6870 (org-element--format-element parent)) 6871 (when (and (org-element-type-p parent 'org-data) 6872 (not (org-element-type-p data 'headline))) 6873 ;; FIXME: This check is here to see whether 6874 ;; such error happens within 6875 ;; `org-element--cache-process-request' or somewhere 6876 ;; else. 6877 (org-element--cache-warn 6878 "Added org-data parent to non-headline element: %S 6879 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report)." 6880 data) 6881 (org-element-cache-reset) 6882 (throw 'org-element--cache-quit t)) 6883 (org-element-put-property data :parent parent) 6884 (let ((s (org-element-property :structure parent))) 6885 (when (and s (org-element-property :structure data)) 6886 (org-element-put-property data :structure s))))) 6887 ;; Cache is up-to-date past THRESHOLD. Request 6888 ;; interruption. 6889 (when (and threshold (> begin threshold)) 6890 (org-element--cache-log-message "Reached threshold %S: %S" 6891 threshold 6892 (org-element--format-element data)) 6893 (setq exit-flag t)))) 6894 (if continue-flag 6895 (setq continue-flag nil) 6896 (setq node (if (setq leftp (avl-tree--node-right node)) 6897 (avl-tree--node-right node) 6898 (pop stack))))))) 6899 ;; We reached end of tree: synchronization complete. 6900 t)) 6901 (org-element--cache-log-message 6902 "org-element-cache: Finished process. The cache size is %S. The remaining sync requests: %S" 6903 org-element--cache-size 6904 (let ((print-level 2)) (prin1-to-string org-element--cache-sync-requests))))) 6905 6906 (defun org-element--headline-parent-deferred (headline) 6907 "Parse parent for HEADLINE." 6908 (with-current-buffer (org-element-property :buffer headline) 6909 (org-with-point-at (org-element-begin headline) 6910 (if (or (bobp) (= 1 (org-element-property :true-level headline))) 6911 ;; Top-level heading. Parent is `org-data'. 6912 (org-element-org-data-parser) 6913 (re-search-backward 6914 (org-headline-re 6915 (1- (org-element-property :true-level headline))) 6916 nil 'move) 6917 (let ((parent (org-element-at-point))) 6918 (if (org-element-type-p parent 'headline) parent 6919 ;; Before first headline. Assign `org-data'. 6920 (org-element-lineage parent 'org-data t))))))) 6921 6922 (defconst org-element--headline-parent-deferred 6923 (org-element-deferred-create 6924 t #'org-element--headline-parent-deferred) 6925 "Constant holding deferred value for headline `:parent' property.") 6926 6927 (defun org-element--parse-to (pos &optional syncp time-limit) 6928 "Parse elements in current section, down to POS. 6929 6930 Start parsing from the closest between the last known element in 6931 cache or headline above. Return the smallest element containing 6932 POS. 6933 6934 When optional argument SYNCP is non-nil, return the parent of the 6935 element containing POS instead. In that case, it is also 6936 possible to provide TIME-LIMIT, which is a time value specifying 6937 when the parsing should stop. The function throws 6938 `org-element--cache-interrupt' if the process stopped before finding 6939 the expected result." 6940 (catch 'exit 6941 (org-with-base-buffer nil 6942 (org-with-wide-buffer 6943 (goto-char pos) 6944 (save-excursion 6945 (forward-line 1) 6946 (skip-chars-backward " \r\t\n") 6947 ;; Within blank lines at the beginning of buffer, return nil. 6948 (when (bobp) (throw 'exit nil))) 6949 (let* ((cached (and (org-element--cache-active-p) 6950 (org-element--cache-find pos nil))) 6951 (mode (org-element-property :mode cached)) 6952 element next) 6953 (cond 6954 ;; Nothing in cache before point: start parsing from first 6955 ;; element in buffer down to POS or from the beginning of the 6956 ;; file. 6957 ((and (not cached) (org-element--cache-active-p)) 6958 (setq element (org-element-org-data-parser)) 6959 (unless (org-element-begin element) 6960 (org-element--cache-warn "Error parsing org-data. Got %S\nPlease report to Org mode mailing list (M-x org-submit-bug-report)." element)) 6961 (org-element--cache-log-message 6962 "Nothing in cache. Adding org-data: %S" 6963 (org-element--format-element element)) 6964 (org-element--cache-put element) 6965 (goto-char (org-element-contents-begin element)) 6966 (setq mode 'org-data)) 6967 ;; Nothing in cache before point because cache is not active. 6968 ;; Parse from previous heading to avoid re-parsing the whole 6969 ;; buffer above. Arrange `:parent' to be calculated on demand. 6970 ((not cached) 6971 (forward-line 1) ; ensure the end of current heading. 6972 (if (re-search-backward 6973 (org-get-limited-outline-regexp t) 6974 nil 'move) 6975 (progn 6976 (setq element (org-element-headline-parser nil 'fast)) 6977 (org-element-put-property 6978 element :parent 6979 org-element--headline-parent-deferred) 6980 (setq mode 'planning) 6981 (forward-line)) 6982 (setq element (org-element-org-data-parser)) 6983 (setq mode 'org-data)) 6984 (org-skip-whitespace) 6985 (forward-line 0)) 6986 ;; Check if CACHED or any of its ancestors contain point. 6987 ;; 6988 ;; If there is such an element, we inspect it in order to know 6989 ;; if we return it or if we need to parse its contents. 6990 ;; Otherwise, we just start parsing from location, which is 6991 ;; right after the top-most element containing CACHED but 6992 ;; still before POS. 6993 ;; 6994 ;; As a special case, if POS is at the end of the buffer, we 6995 ;; want to return the innermost element ending there. 6996 ;; 6997 ;; Also, if we find an ancestor and discover that we need to 6998 ;; parse its contents, make sure we don't start from 6999 ;; `:contents-begin', as we would otherwise go past CACHED 7000 ;; again. Instead, in that situation, we will resume parsing 7001 ;; from NEXT, which is located after CACHED or its higher 7002 ;; ancestor not containing point. 7003 (t 7004 (let ((up cached) 7005 (pos (if (= (point-max) pos) (1- pos) pos))) 7006 (while (and up (<= (org-element-end up) pos)) 7007 (setq next (org-element-end up) 7008 element up 7009 mode (org-element--next-mode (org-element-property :mode element) (org-element-type element) nil) 7010 ;; Cached elements cannot have deferred `:parent'. 7011 up (org-element-property-raw :parent up))) 7012 (when next (goto-char next)) 7013 (when up (setq element up))))) 7014 ;; Parse successively each element until we reach POS. 7015 (let ((end (or (org-element-end element) (point-max))) 7016 (parent (org-element-property-raw :parent element))) 7017 (while t 7018 (when (org-element--cache-interrupt-p time-limit) 7019 (throw 'org-element--cache-interrupt nil)) 7020 (when (and inhibit-quit org-element--cache-interrupt-C-g quit-flag) 7021 (when quit-flag 7022 (cl-incf org-element--cache-interrupt-C-g-count) 7023 (setq quit-flag nil)) 7024 (when (>= org-element--cache-interrupt-C-g-count 7025 org-element--cache-interrupt-C-g-max-count) 7026 (setq quit-flag t) 7027 (setq org-element--cache-interrupt-C-g-count 0) 7028 (org-element-cache-reset) 7029 (error "org-element: Parsing aborted by user. Cache has been cleared. 7030 If you observe Emacs hangs frequently, please report this to Org mode mailing list (M-x org-submit-bug-report)")) 7031 (message (substitute-command-keys 7032 "`org-element--parse-to': Suppressed `\\[keyboard-quit]'. Press `\\[keyboard-quit]' %d more times to force interruption.") 7033 (- org-element--cache-interrupt-C-g-max-count 7034 org-element--cache-interrupt-C-g-count))) 7035 (unless element 7036 ;; Do not try to parse within blank at EOB. 7037 (unless (save-excursion 7038 (org-skip-whitespace) 7039 (eobp)) 7040 (setq element (org-element--current-element 7041 end 'element mode 7042 (org-element-property :structure parent)))) 7043 ;; Make sure that we return referenced element in cache 7044 ;; that can be altered directly. 7045 (if element 7046 (setq element (or (org-element--cache-put element) element)) 7047 ;; Nothing to parse (i.e. empty file). 7048 (throw 'exit parent)) 7049 (unless (or parent (not (org-element--cache-active-p))) 7050 (org-element--cache-warn 7051 "Got empty parent while parsing. Please report it to Org mode mailing list (M-x org-submit-bug-report).\n Backtrace:\n%S" 7052 (when (and (fboundp 'backtrace-get-frames) 7053 (fboundp 'backtrace-to-string)) 7054 (backtrace-to-string (backtrace-get-frames 'backtrace)) 7055 (org-element-cache-reset) 7056 (error "org-element--cache: Emergency exit")))) 7057 (org-element-put-property element :parent parent)) 7058 (let ((elem-end (org-element-end element)) 7059 (type (org-element-type element))) 7060 (cond 7061 ;; Skip any element ending before point. Also skip 7062 ;; element ending at point (unless it is also the end of 7063 ;; buffer) since we're sure that another element begins 7064 ;; after it. 7065 ((and (<= elem-end pos) (/= (point-max) elem-end)) 7066 ;; Avoid parsing headline siblings above. 7067 (goto-char elem-end) 7068 (when (eq type 'headline) 7069 (unless (when (and (/= 1 (org-element-property :true-level element)) 7070 (re-search-forward 7071 (org-headline-re (1- (org-element-property :true-level element))) 7072 pos t)) 7073 (forward-line 0) 7074 t) 7075 ;; There are headings with lower level than 7076 ;; ELEMENT between ELEM-END and POS. Siblings 7077 ;; may exist though. Parse starting from the 7078 ;; last sibling or from ELEM-END if there are 7079 ;; no other siblings. 7080 (goto-char pos) 7081 (unless 7082 (re-search-backward 7083 (org-headline-re (org-element-property :true-level element)) 7084 elem-end t) 7085 ;; Roll-back to normal parsing. 7086 (goto-char elem-end)))) 7087 (setq mode (org-element--next-mode mode type nil))) 7088 ;; A non-greater element contains point: return it. 7089 ((not (memq type org-element-greater-elements)) 7090 (throw 'exit (if syncp parent element))) 7091 ;; Otherwise, we have to decide if ELEMENT really 7092 ;; contains POS. In that case we start parsing from 7093 ;; contents' beginning. 7094 ;; 7095 ;; If POS is at contents' beginning but it is also at 7096 ;; the beginning of the first item in a list or a table. 7097 ;; In that case, we need to create an anchor for that 7098 ;; list or table, so return it. 7099 ;; 7100 ;; Also, if POS is at the end of the buffer, no element 7101 ;; can start after it, but more than one may end there. 7102 ;; Arbitrarily, we choose to return the innermost of 7103 ;; such elements. 7104 ((let ((cbeg (org-element-contents-begin element)) 7105 (cend (org-element-contents-end element))) 7106 (when (and cbeg cend 7107 (or (< cbeg pos) 7108 (and (= cbeg pos) 7109 (not (memq type '(plain-list table))))) 7110 (or (> cend pos) 7111 ;; When we are at cend or within blank 7112 ;; lines after, it is a special case: 7113 ;; 1. At the end of buffer we return 7114 ;; the innermost element. 7115 (= pos cend (point-max)) 7116 ;; 2. At cend of element with return 7117 ;; that element (thus, no need to 7118 ;; parse inside). 7119 nil)) 7120 (goto-char (or next cbeg)) 7121 (setq mode (if next mode (org-element--next-mode mode type t)) 7122 next nil 7123 parent element 7124 end (org-element-contents-end element))))) 7125 ;; Otherwise, return ELEMENT as it is the smallest 7126 ;; element containing POS. 7127 (t (throw 'exit (if syncp parent element))))) 7128 (setq element nil)))))))) 7129 7130 ;;;; Staging Buffer Changes 7131 7132 (defconst org-element--cache-sensitive-re 7133 (concat 7134 "^\\*+ " "\\|" 7135 "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|" 7136 "^[ \t]*\\(?:" 7137 "#\\+END\\(?:_\\|:?[ \t]*$\\)" "\\|" 7138 org-list-full-item-re "\\|" 7139 ":\\(?: \\|$\\)" "\\|" 7140 ":\\(?:\\w\\|[-_]\\)+:[ \t]*$" 7141 "\\)") 7142 "Regexp matching a sensitive line, structure wise. 7143 A sensitive line is a headline, inlinetask, block, drawer, or 7144 latex-environment boundary. When such a line is modified, 7145 structure changes in the document may propagate in the whole 7146 section, possibly making cache invalid.") 7147 7148 (defun org-element--cache-before-change (beg end) 7149 "Detect modifications in sensitive parts of Org buffer. 7150 BEG and END are the beginning and end of the range of changed 7151 text. See `before-change-functions' for more information. 7152 7153 The function returns the new value of `org-element--cache-change-warning'." 7154 (org-with-base-buffer nil 7155 (when (org-element--cache-active-p t) 7156 (org-with-wide-buffer 7157 (setq org-element--cache-change-tic (buffer-chars-modified-tick)) 7158 (setq org-element--cache-last-buffer-size (buffer-size)) 7159 (goto-char beg) 7160 (forward-line 0) 7161 (let ((bottom (save-excursion (goto-char end) (line-end-position)))) 7162 (prog1 7163 ;; Use the worst change warning to not miss important edits. 7164 ;; This function is called before edit and after edit by 7165 ;; `org-element--cache-after-change'. Before the edit, we still 7166 ;; want to use the old value if it comes from previous 7167 ;; not yet processed edit (they may be merged by 7168 ;; `org-element--cache-submit-request'). After the edit, we want to 7169 ;; look if there was a sensitive removed during edit. 7170 ;; FIXME: This is not the most efficient way and we now 7171 ;; have to delete more elements than needed in some 7172 ;; cases. A better approach may be storing the warning 7173 ;; in the modification request itself. 7174 (let ((org-element--cache-change-warning-before org-element--cache-change-warning) 7175 (org-element--cache-change-warning-after)) 7176 (setq org-element--cache-change-warning-after 7177 ;; We must preserve match data when called as `before-change-functions'. 7178 (save-match-data 7179 (let ((case-fold-search t)) 7180 (when (re-search-forward 7181 org-element--cache-sensitive-re bottom t) 7182 (goto-char beg) 7183 (forward-line 0) 7184 (let (min-level) 7185 (cl-loop while (re-search-forward 7186 (rx-to-string 7187 (if (and min-level 7188 (> min-level 1)) 7189 `(and bol (repeat 1 ,(1- min-level) "*") " ") 7190 `(and bol (+ "*") " "))) 7191 bottom t) 7192 do (setq min-level (1- (length (match-string 0)))) 7193 until (= min-level 1)) 7194 (goto-char beg) 7195 (forward-line 0) 7196 (or (and min-level (org-reduced-level min-level)) 7197 (when (looking-at-p "^[ \t]*#\\+CATEGORY:") 7198 'org-data) 7199 t)))))) 7200 (setq org-element--cache-change-warning 7201 (cond 7202 ((and (numberp org-element--cache-change-warning-before) 7203 (numberp org-element--cache-change-warning-after)) 7204 (min org-element--cache-change-warning-after 7205 org-element--cache-change-warning-before)) 7206 ((numberp org-element--cache-change-warning-before) 7207 org-element--cache-change-warning-before) 7208 ((numberp org-element--cache-change-warning-after) 7209 org-element--cache-change-warning-after) 7210 (t (or org-element--cache-change-warning-after 7211 org-element--cache-change-warning-before))))) 7212 (org-element--cache-log-message 7213 "%S is about to modify text: warning %S" 7214 this-command 7215 org-element--cache-change-warning))))))) 7216 7217 (defun org-element--cache-after-change (beg end pre) 7218 "Update buffer modifications for current buffer. 7219 BEG, END, and PRE are the beginning and end of the range of changed 7220 text, and the length in bytes of the pre-change text replaced by 7221 that range. See `after-change-functions' for more information." 7222 (org-with-base-buffer nil 7223 (when (org-element--cache-active-p t) 7224 (when (not (eq org-element--cache-change-tic (buffer-chars-modified-tick))) 7225 (org-element--cache-log-message "After change") 7226 (org-element--cache-before-change beg end) 7227 ;; If beg is right after spaces in front of an element, we 7228 ;; risk affecting previous element, so move beg to bol, making 7229 ;; sure that we capture preceding element. 7230 (setq beg (save-excursion 7231 (goto-char beg) 7232 (cl-incf pre (- beg (line-beginning-position))) 7233 (line-beginning-position))) 7234 ;; Store synchronization request. 7235 (let ((offset (- end beg pre))) 7236 ;; We must preserve match data when called as `after-change-functions'. 7237 (save-match-data 7238 (org-element--cache-submit-request beg (- end offset) offset))) 7239 ;; Activate a timer to process the request during idle time. 7240 (org-element--cache-set-timer (current-buffer)))))) 7241 7242 (defun org-element--cache-setup-change-functions () 7243 "Setup `before-change-functions' and `after-change-functions'." 7244 (when (and (derived-mode-p 'org-mode) org-element-use-cache) 7245 ;; Clear copied local cache to avoid extra memory usage. 7246 ;; We only use cache stored in the base buffer. 7247 (when (buffer-base-buffer) 7248 (setq-local org-element--cache nil) 7249 (setq-local org-element--headline-cache nil)) 7250 ;; Register current buffer in `org-fold-core--indirect-buffers' to 7251 ;; be used within `org-fold-core-cycle-over-indirect-buffers'. 7252 ;; FIXME: We should eventually factor out indirect buffer tracking 7253 ;; from org-fold-core. 7254 (org-fold-core-decouple-indirect-buffer-folds) 7255 (add-hook 'before-change-functions 7256 #'org-element--cache-before-change nil t) 7257 ;; Run `org-element--cache-after-change' early to handle cases 7258 ;; when other `after-change-functions' require element cache. 7259 (add-hook 'after-change-functions 7260 #'org-element--cache-after-change -1 t))) 7261 7262 (defvar org-element--cache-avoid-synchronous-headline-re-parsing nil 7263 "This variable controls how buffer changes are handled by the cache. 7264 7265 By default (when this variable is nil), cache re-parses modified 7266 headlines immediately after modification preserving all the unaffected 7267 elements inside the headline. 7268 7269 The default behavior works best when users types inside Org buffer of 7270 when buffer modifications are mixed with cache requests. However, 7271 large automated edits inserting/deleting many headlines are somewhat 7272 slower by default (as in `org-archive-subtree'). Let-binding this 7273 variable to non-nil will reduce cache latency after every singular edit 7274 \(`after-change-functions') at the cost of slower cache queries.") 7275 (defun org-element--cache-for-removal (beg end offset) 7276 "Return first element to remove from cache. 7277 7278 BEG and END are buffer positions delimiting buffer modifications. 7279 OFFSET is the size of the changes. 7280 7281 Returned element is usually the first element in cache containing 7282 any position between BEG and END. As an exception, greater 7283 elements around the changes that are robust to contents 7284 modifications are preserved and updated according to the 7285 changes. In the latter case, the returned element is the outermost 7286 non-robust element affected by the changes. Note that the returned 7287 element may end before END position in which case some cached element 7288 starting after the returned may still be affected by the changes. 7289 7290 Also, when there are no elements in cache before BEG, return first 7291 known element in cache (it may start after END)." 7292 (let* ((elements (org-element--cache-find (1- beg) 'both)) 7293 (before (car elements)) 7294 (after (cdr elements))) 7295 (if (not before) after 7296 ;; If BEFORE is a keyword, it may need to be removed to become 7297 ;; an affiliated keyword. 7298 (when (org-element-type-p before 'keyword) 7299 (let ((prev before)) 7300 (while (org-element-type-p prev 'keyword) 7301 (setq before prev 7302 beg (org-element-begin prev)) 7303 (setq prev (org-element--cache-find (1- (org-element-begin before))))))) 7304 (let ((up before) 7305 (robust-flag t)) 7306 (while up 7307 (if (let ((type (org-element-type up))) 7308 (or (and (memq type '( center-block dynamic-block 7309 quote-block special-block 7310 drawer)) 7311 (or (not (eq type 'drawer)) 7312 (not (string= "PROPERTIES" (org-element-property :drawer-name up)))) 7313 ;; Sensitive change. This is 7314 ;; unconditionally non-robust change. 7315 (not org-element--cache-change-warning) 7316 (let ((cbeg (org-element-contents-begin up)) 7317 (cend (org-element-contents-end up))) 7318 (and cbeg 7319 (<= cbeg beg) 7320 (or (> cend end) 7321 (and (= cend end) 7322 (= (+ end offset) (point-max))))))) 7323 (and (memq type '(headline section org-data)) 7324 (let ((rbeg (org-element-property :robust-begin up)) 7325 (rend (org-element-property :robust-end up))) 7326 (and rbeg rend 7327 (<= rbeg beg) 7328 (or (> rend end) 7329 (and (= rend end) 7330 (= (+ end offset) (point-max)))))) 7331 (pcase type 7332 ;; Sensitive change in section. Need to 7333 ;; re-parse. 7334 (`section (not org-element--cache-change-warning)) 7335 ;; Headline might be inserted. This is non-robust 7336 ;; change when `up' is a `headline' or `section' 7337 ;; with `>' level compared to the inserted headline. 7338 ;; 7339 ;; Also, planning info/property drawer 7340 ;; could have been inserted. It is not 7341 ;; robust change then. 7342 (`headline 7343 (and 7344 (or (not (numberp org-element--cache-change-warning)) 7345 (> org-element--cache-change-warning 7346 (org-element-property :level up))) 7347 (org-with-point-at (org-element-contents-begin up) 7348 (unless 7349 (progn 7350 (when (looking-at-p org-element-planning-line-re) 7351 (forward-line)) 7352 (when (looking-at org-property-drawer-re) 7353 (< beg (match-end 0)))) 7354 'robust)))) 7355 (`org-data (and (not (eq org-element--cache-change-warning 'org-data)) 7356 ;; Property drawer could 7357 ;; have been inserted. It 7358 ;; is not robust change 7359 ;; then. 7360 (org-with-wide-buffer 7361 (goto-char (point-min)) 7362 (while (and (org-at-comment-p) (bolp)) (forward-line)) 7363 ;; Should not see property 7364 ;; drawer within changed 7365 ;; region. 7366 (or (not (looking-at org-property-drawer-re)) 7367 (> beg (match-end 0)))))) 7368 (_ 'robust))))) 7369 ;; UP is a robust greater element containing changes. 7370 ;; We only need to extend its ending boundaries. 7371 (progn 7372 (org-element--cache-shift-positions 7373 up offset 7374 (if (and (org-element-property :robust-begin up) 7375 (org-element-property :robust-end up)) 7376 '(:contents-end :end :robust-end) 7377 '(:contents-end :end))) 7378 (org-element--cache-log-message 7379 "Shifting end positions of robust parent (warning %S): %S" 7380 org-element--cache-change-warning 7381 (org-element--format-element up))) 7382 (unless (or 7383 ;; UP is non-robust. Yet, if UP is headline, flagging 7384 ;; everything inside for removal may be to 7385 ;; costly. Instead, we should better re-parse only the 7386 ;; headline itself when possible. If a headline is still 7387 ;; starting from old :begin position, we do not care that 7388 ;; its boundaries could have extended to shrunk - we 7389 ;; will re-parent and shift them anyway. 7390 (and (org-element-type-p up 'headline) 7391 (not org-element--cache-avoid-synchronous-headline-re-parsing) 7392 ;; The change is not inside headline. Not 7393 ;; updating here. 7394 (not (<= beg (org-element-begin up))) 7395 (not (> end (org-element-end up))) 7396 (let ((current (org-with-point-at (org-element-begin up) 7397 (org-element-with-disabled-cache 7398 (and (looking-at-p org-element-headline-re) 7399 (org-element-headline-parser nil 'fast)))))) 7400 (when (org-element-type-p current 'headline) 7401 (org-element--cache-log-message 7402 "Found non-robust headline that can be updated individually (warning %S): %S" 7403 org-element--cache-change-warning 7404 (org-element--format-element current)) 7405 (org-element-set up current org-element--cache-element-properties) 7406 t))) 7407 ;; If UP is org-data, the situation is similar to 7408 ;; headline case. We just need to re-parse the 7409 ;; org-data itself, unless the change is made 7410 ;; within blank lines at BOB (that could 7411 ;; potentially alter first-section). 7412 (when (and (org-element-type-p up 'org-data) 7413 (>= beg (org-element-contents-begin up))) 7414 (org-element-set up (org-with-point-at 1 (org-element-org-data-parser)) org-element--cache-element-properties) 7415 (org-element--cache-log-message 7416 "Found non-robust change invalidating org-data. Re-parsing: %S" 7417 (org-element--format-element up)) 7418 t)) 7419 (org-element--cache-log-message 7420 "Found non-robust element: %S" 7421 (org-element--format-element up)) 7422 (setq before up) 7423 (when robust-flag (setq robust-flag nil)))) 7424 (unless (or (org-element-property-raw :parent up) 7425 (org-element-type-p up 'org-data)) 7426 (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) 7427 (org-element-cache-reset) 7428 (error "org-element--cache: Emergency exit")) 7429 (setq up (org-element-property-raw :parent up))) 7430 ;; We're at top level element containing ELEMENT: if it's 7431 ;; altered by buffer modifications, it is first element in 7432 ;; cache to be removed. Otherwise, that first element is the 7433 ;; following one. 7434 ;; 7435 ;; As a special case, do not remove BEFORE if it is a robust 7436 ;; container for current changes. 7437 (if (or (< (org-element-end before) beg) robust-flag) after 7438 before))))) 7439 7440 (defun org-element--cache-submit-request (beg end offset) 7441 "Submit a new cache synchronization request for current buffer. 7442 BEG and END are buffer positions delimiting the minimal area 7443 where cache data should be removed. OFFSET is the size of the 7444 change, as an integer." 7445 (org-element--cache-log-message 7446 "Submitting new synchronization request for [%S..%S]𝝙%S" 7447 beg end offset) 7448 (org-with-base-buffer nil 7449 (let ((next (car org-element--cache-sync-requests)) 7450 delete-to delete-from) 7451 (if (and next 7452 ;; First existing sync request is in phase 0. 7453 (= 0 (org-element--request-phase next)) 7454 ;; Current changes intersect with the first sync request. 7455 (> (setq delete-to (+ (org-element--request-end next) 7456 (org-element--request-offset next))) 7457 end) 7458 (<= (setq delete-from (org-element--request-beg next)) 7459 end)) 7460 ;; Current changes can be merged with first sync request: we 7461 ;; can save a partial cache synchronization. 7462 (progn 7463 (org-element--cache-log-message "Found another phase 0 request intersecting with current") 7464 ;; Update OFFSET of the existing request. 7465 (cl-incf (org-element--request-offset next) offset) 7466 ;; If last change happened within area to be removed, extend 7467 ;; boundaries of robust parents, if any. Otherwise, find 7468 ;; first element to remove and update request accordingly. 7469 (if (> beg delete-from) 7470 ;; The current modification is completely inside NEXT. 7471 ;; We already added the current OFFSET to the NEXT 7472 ;; request. However, the robust elements around 7473 ;; modifications also need to be shifted. Moreover, the 7474 ;; new modification may also have non-nil 7475 ;; `org-element--cache-change-warning'. In the latter case, we 7476 ;; also need to update the request. 7477 (let ((first (org-element--cache-for-removal delete-from end offset) ; Shift as needed. 7478 )) 7479 (org-element--cache-log-message 7480 "Current request is inside next. Candidate parent: %S" 7481 (org-element--format-element first)) 7482 (when 7483 ;; Non-robust element is now before NEXT. Need to 7484 ;; update. 7485 (and first 7486 (org-element--cache-key-less-p 7487 (org-element--cache-key first) 7488 (org-element--request-key next))) 7489 (org-element--cache-log-message 7490 "Current request is inside next. New parent: %S" 7491 (org-element--format-element first)) 7492 (setf (org-element--request-key next) 7493 (org-element--cache-key first)) 7494 (setf (org-element--request-beg next) 7495 (org-element-begin first)) 7496 (setf (org-element--request-end next) 7497 (max (org-element-end first) 7498 (org-element--request-end next))) 7499 (setf (org-element--request-parent next) 7500 ;; Cached elements cannot have deferred `:parent'. 7501 (org-element-property-raw :parent first)))) 7502 ;; The current and NEXT modifications are intersecting 7503 ;; with current modification starting before NEXT and NEXT 7504 ;; ending after current. We need to update the common 7505 ;; non-robust parent for the new extended modification 7506 ;; region. 7507 (let ((first (org-element--cache-for-removal beg delete-to offset))) 7508 (org-element--cache-log-message 7509 "Current request intersects with next. Candidate parent: %S" 7510 (org-element--format-element first)) 7511 (when (and first 7512 (org-element--cache-key-less-p 7513 (org-element--cache-key first) 7514 (org-element--request-key next))) 7515 (org-element--cache-log-message 7516 "Current request intersects with next. Updating. New parent: %S" 7517 (org-element--format-element first)) 7518 (setf (org-element--request-key next) (org-element--cache-key first)) 7519 (setf (org-element--request-beg next) (org-element-begin first)) 7520 (setf (org-element--request-end next) 7521 (max (org-element-end first) 7522 (org-element--request-end next))) 7523 (setf (org-element--request-parent next) 7524 ;; Cached elements cannot have deferred `:parent'. 7525 (org-element-property-raw :parent first)))))) 7526 ;; Ensure cache is correct up to END. Also make sure that NEXT, 7527 ;; if any, is no longer a 0-phase request, thus ensuring that 7528 ;; phases are properly ordered. We need to provide OFFSET as 7529 ;; optional parameter since current modifications are not known 7530 ;; yet to the otherwise correct part of the cache (i.e, before 7531 ;; the first request). 7532 (org-element--cache-log-message "Adding new phase 0 request") 7533 (when next (org-element--cache-sync (current-buffer) end beg offset 'force)) 7534 (let ((first (org-element--cache-for-removal beg end offset))) 7535 (if first 7536 (push (let ((first-beg (org-element-begin first)) 7537 (key (org-element--cache-key first))) 7538 (cond 7539 ;; When changes happen before the first known 7540 ;; element, re-parent and shift the rest of the 7541 ;; cache. 7542 ((> first-beg end) 7543 (org-element--cache-log-message "Changes are before first known element. Submitting phase 1 request") 7544 (vector key first-beg nil offset nil 1)) 7545 ;; Otherwise, we find the first non robust 7546 ;; element containing END. All elements between 7547 ;; FIRST and this one are to be removed. 7548 ;; 7549 ;; The current modification is completely inside 7550 ;; FIRST. Clear and update cached elements in 7551 ;; region containing FIRST. 7552 ((let ((first-end (org-element-end first))) 7553 (when (> first-end end) 7554 (org-element--cache-log-message "Extending to non-robust element %S" (org-element--format-element first)) 7555 (vector key first-beg first-end offset 7556 (org-element-property-raw :parent first) 0)))) 7557 (t 7558 ;; Now, FIRST is the first element after BEG or 7559 ;; non-robust element containing BEG. However, 7560 ;; FIRST ends before END and there might be 7561 ;; another ELEMENT before END that spans beyond 7562 ;; END. If there is such element, we need to 7563 ;; extend the region down to end of the common 7564 ;; parent of FIRST and everything inside 7565 ;; BEG..END. 7566 (let* ((element (org-element--cache-find end)) 7567 (element-end (org-element-end element)) 7568 (up element)) 7569 (while (and (not (eq up first)) 7570 ;; Cached elements cannot have deferred `:parent'. 7571 (setq up (org-element-property-raw :parent up)) 7572 (>= (org-element-begin up) first-beg)) 7573 ;; Note that UP might have been already 7574 ;; shifted if it is a robust element. After 7575 ;; deletion, it can put it's end before yet 7576 ;; unprocessed ELEMENT. 7577 (setq element-end (max (org-element-end up) element-end) 7578 element up)) 7579 ;; Extend region to remove elements between 7580 ;; beginning of first and the end of outermost 7581 ;; element starting before END but after 7582 ;; beginning of first. 7583 ;; of the FIRST. 7584 (org-element--cache-log-message 7585 "Extending to all elements between:\n 1: %S\n 2: %S" 7586 (org-element--format-element first) 7587 (org-element--format-element element)) 7588 (vector key first-beg element-end offset up 0))))) 7589 org-element--cache-sync-requests) 7590 ;; No element to remove. No need to re-parent either. 7591 ;; Simply shift additional elements, if any, by OFFSET. 7592 (if org-element--cache-sync-requests 7593 (progn 7594 (org-element--cache-log-message 7595 "Nothing to remove. Updating offset of the next request by 𝝙%S: %S" 7596 offset 7597 (let ((print-level 3)) 7598 (car org-element--cache-sync-requests))) 7599 (cl-incf (org-element--request-offset (car org-element--cache-sync-requests)) 7600 offset)) 7601 (org-element--cache-log-message 7602 "Nothing to remove. No elements in cache after %S. Terminating." 7603 end)))))) 7604 (setq org-element--cache-change-warning nil))) 7605 7606 (defun org-element--cache-verify-element (element) 7607 "Verify correctness of ELEMENT when `org-element--cache-self-verify' is non-nil. 7608 7609 Return non-nil when verification failed." 7610 (let ((org-element--cache-self-verify 7611 (or org-element--cache-self-verify 7612 (and (boundp 'org-batch-test) org-batch-test))) 7613 (org-element--cache-self-verify-frequency 7614 (if (and (boundp 'org-batch-test) org-batch-test) 7615 1 7616 org-element--cache-self-verify-frequency))) 7617 ;; Verify correct parent for the element. 7618 (unless (or (not org-element--cache-self-verify) 7619 (org-element-property :parent element) 7620 (org-element-type-p element 'org-data)) 7621 (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) 7622 (org-element-cache-reset)) 7623 (when (and org-element--cache-self-verify 7624 (org-element--cache-active-p) 7625 (org-element-type-p element 'headline) 7626 ;; Avoid too much slowdown 7627 (< (random 1000) (* 1000 org-element--cache-self-verify-frequency))) 7628 (org-with-point-at (org-element-begin element) 7629 (org-element-with-disabled-cache (org-up-heading-or-point-min)) 7630 (unless (or (= (point) 7631 (org-element-begin 7632 (org-element-property :parent element))) 7633 (eq (point) (point-min))) 7634 (org-element--cache-warn 7635 "Cached element has wrong parent in %s. Resetting. 7636 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report). 7637 The element is: %S\n The parent is: %S\n The real parent is: %S" 7638 (buffer-name (current-buffer)) 7639 (org-element--format-element element) 7640 (org-element--format-element (org-element-property :parent element)) 7641 (org-element--format-element 7642 (org-element--current-element 7643 (org-element-end (org-element-property :parent element))))) 7644 (org-element-cache-reset)) 7645 (org-element--cache-verify-element 7646 (org-element-property :parent element)))) 7647 ;; Verify the element itself. 7648 (when (and org-element--cache-self-verify 7649 (org-element--cache-active-p) 7650 element 7651 (not (org-element-type-p element '(section org-data))) 7652 ;; Avoid too much slowdown 7653 (< (random 1000) (* 1000 org-element--cache-self-verify-frequency))) 7654 (let ((real-element (org-element-with-disabled-cache 7655 (org-element--parse-to 7656 (if (org-element-type-p element '(table-row item)) 7657 (1+ (org-element-begin element)) 7658 (org-element-begin element)))))) 7659 (unless (and (eq (org-element-type real-element) (org-element-type element)) 7660 (eq (org-element-begin real-element) (org-element-begin element)) 7661 (eq (org-element-end real-element) (org-element-end element)) 7662 (eq (org-element-contents-begin real-element) (org-element-contents-begin element)) 7663 (eq (org-element-contents-end real-element) (org-element-contents-end element)) 7664 (or (not (org-element-property :ID real-element)) 7665 (string= (org-element-property :ID real-element) (org-element-property :ID element)))) 7666 (org-element--cache-warn "(%S) Cached element is incorrect in %s. (Cache tic up to date: %S) Resetting. 7667 If this warning appears regularly, please report the warning text to Org mode mailing list (M-x org-submit-bug-report). 7668 The element is: %S\n The real element is: %S\n Cache around :begin:\n%S\n%S\n%S" 7669 this-command 7670 (buffer-name (current-buffer)) 7671 (if (/= org-element--cache-change-tic 7672 (buffer-chars-modified-tick)) 7673 "no" "yes") 7674 (org-element--format-element element) 7675 (org-element--format-element real-element) 7676 (org-element--format-element (org-element--cache-find (1- (org-element-begin real-element)))) 7677 (org-element--format-element (car (org-element--cache-find (org-element-begin real-element) 'both))) 7678 (org-element--format-element (cdr (org-element--cache-find (org-element-begin real-element) 'both)))) 7679 (org-element-cache-reset)))))) 7680 7681 ;;; Cache persistence 7682 7683 (defun org-element--cache-persist-before-write (container &optional associated) 7684 "Sync element cache for CONTAINER and ASSOCIATED item before saving. 7685 This function is intended to be used in `org-persist-before-write-hook'. 7686 7687 Prevent writing to disk cache when cache is disabled in the CONTAINER 7688 buffer. Otherwise, cleanup cache sync keys, unreadable :buffer 7689 properties, and verify cache consistency." 7690 (when (equal container '(elisp org-element--cache)) 7691 (if (and org-element-use-cache 7692 (plist-get associated :file) 7693 (get-file-buffer (plist-get associated :file)) 7694 org-element-cache-persistent) 7695 (with-current-buffer (get-file-buffer (plist-get associated :file)) 7696 (if (and (derived-mode-p 'org-mode) 7697 org-element--cache) 7698 (org-with-wide-buffer 7699 (org-element--cache-sync (current-buffer) (point-max)) 7700 ;; Cleanup cache request keys to avoid collisions during next 7701 ;; Emacs session. Cleanup known non-printable objects. 7702 (avl-tree-mapc 7703 (lambda (el) 7704 (org-element-put-property el :org-element--cache-sync-key nil) 7705 (org-element-map el t 7706 (lambda (el2) 7707 (unless (org-element-type-p el2 'plain-text) 7708 (org-element-put-property el2 :buffer nil))) 7709 nil nil nil 'with-affiliated 'no-undefer) 7710 (let ((org-element--cache-self-verify-frequency 1.0)) 7711 (when (and org-element--cache-self-verify-before-persisting 7712 (org-element--cache-verify-element el)) 7713 (error "Cache verification failed: aborting")))) 7714 org-element--cache) 7715 nil) 7716 'forbid)) 7717 'forbid))) 7718 7719 (defun org-element--cache-persist-before-read (container &optional associated) 7720 "Avoid reading cache for CONTAINER and ASSOCIATED before Org mode is loaded. 7721 This function is intended to be used in `org-persist-before-read-hook'. 7722 7723 Also, prevent reading cache when the buffer CONTAINER hash is not 7724 consistent with the cache." 7725 (when (equal container '(elisp org-element--cache)) 7726 (org-element--cache-log-message "Loading persistent cache for %s" (plist-get associated :file)) 7727 (if (not (and (plist-get associated :file) 7728 (get-file-buffer (plist-get associated :file)))) 7729 (progn 7730 (org-element--cache-log-message "%s does not have a buffer: not loading cache" (plist-get associated :file)) 7731 'forbid) 7732 (with-current-buffer (get-file-buffer (plist-get associated :file)) 7733 (unless (and org-element-use-cache 7734 org-element-cache-persistent 7735 (derived-mode-p 'org-mode) 7736 (equal (secure-hash 'md5 (current-buffer)) 7737 (plist-get associated :hash))) 7738 (org-element--cache-log-message "Cache is not current (or persistence is disabled) in %s" (plist-get associated :file)) 7739 'forbid))))) 7740 7741 (defun org-element--cache-persist-after-read (container &optional associated) 7742 "Setup restored cache for CONTAINER and ASSOCIATED. 7743 Re-fill :buffer properties for cache elements (buffer objects cannot 7744 be written onto disk). Also, perform some consistency checks to 7745 prevent loading corrupted cache." 7746 (when (and (plist-get associated :file) 7747 (get-file-buffer (plist-get associated :file))) 7748 (with-current-buffer (get-file-buffer (plist-get associated :file)) 7749 (when (and org-element-use-cache org-element-cache-persistent) 7750 (catch 'abort 7751 (when (and (equal container '(elisp org-element--cache)) org-element--cache) 7752 ;; Restore `:buffer' property. 7753 (avl-tree-mapc 7754 (lambda (el) 7755 (org-element-map el t 7756 (lambda (el2) 7757 (unless (org-element-type-p el2 'plain-text) 7758 (org-element-put-property el2 :buffer (current-buffer)))) 7759 nil nil nil 'with-affiliated 'no-undefer) 7760 (org-element--cache-log-message 7761 "Recovering persistent cached element: %S" 7762 (org-element--format-element el)) 7763 (when (and (not (org-element-parent el)) (not (org-element-type-p el 'org-data))) 7764 (org-element--cache-warn 7765 "Got element without parent when loading cache from disk. Not using this persistent cache. 7766 Please report it to Org mode mailing list (M-x org-submit-bug-report).\n%S" el) 7767 (org-element-cache-reset) 7768 (throw 'abort t))) 7769 org-element--cache) 7770 (setq-local org-element--cache-size (avl-tree-size org-element--cache))) 7771 (when (and (equal container '(elisp org-element--headline-cache)) org-element--headline-cache) 7772 (setq-local org-element--headline-cache-size (avl-tree-size org-element--headline-cache)))))))) 7773 7774 (add-hook 'org-persist-before-write-hook #'org-element--cache-persist-before-write) 7775 (add-hook 'org-persist-before-read-hook #'org-element--cache-persist-before-read) 7776 (add-hook 'org-persist-after-read-hook #'org-element--cache-persist-after-read) 7777 7778 ;;;; Public Functions 7779 7780 (defvar-local org-element--cache-gapless nil 7781 "An alist containing (granularity . `org-element--cache-change-tic') elements. 7782 Each element indicates the latest `org-element--cache-change-tic' when 7783 change did not contain gaps.") 7784 7785 ;;;###autoload 7786 (defun org-element-cache-reset (&optional all no-persistence) 7787 "Reset cache in current buffer. 7788 When optional argument ALL is non-nil, reset cache in all Org 7789 buffers. 7790 When optional argument NO-PERSISTENCE is non-nil, do not try to update 7791 the cache persistence in the buffer." 7792 (interactive "P") 7793 (dolist (buffer (if all (buffer-list) (list (current-buffer)))) 7794 (org-with-base-buffer buffer 7795 (when (and org-element-use-cache (derived-mode-p 'org-mode)) 7796 ;; Only persist cache in file buffers. 7797 (when (and (buffer-file-name) (not no-persistence)) 7798 (when (not org-element-cache-persistent) 7799 (org-persist-unregister 7800 'org-element--headline-cache 7801 (current-buffer) 7802 :remove-related t) 7803 (org-persist-unregister 7804 'org-element--cache 7805 (current-buffer) 7806 :remove-related t)) 7807 (when (and org-element-cache-persistent 7808 (buffer-file-name (current-buffer))) 7809 (org-persist-register 7810 `((elisp org-element--cache) (version ,org-element-cache-version)) 7811 (current-buffer)) 7812 (org-persist-register 7813 'org-element--headline-cache 7814 (current-buffer) 7815 :inherit `((elisp org-element--cache) (version ,org-element-cache-version))))) 7816 (setq-local org-element--cache-change-tic (buffer-chars-modified-tick)) 7817 (setq-local org-element--cache-last-buffer-size (buffer-size)) 7818 (setq-local org-element--cache-gapless nil) 7819 (setq-local org-element--cache 7820 (avl-tree-create #'org-element--cache-compare)) 7821 (setq-local org-element--headline-cache 7822 (avl-tree-create #'org-element--cache-compare)) 7823 (setq-local org-element--cache-hash-left (make-vector org-element--cache-hash-size nil)) 7824 (setq-local org-element--cache-hash-right (make-vector org-element--cache-hash-size nil)) 7825 (setq-local org-element--cache-size 0) 7826 (setq-local org-element--headline-cache-size 0) 7827 (setq-local org-element--cache-sync-keys-value 0) 7828 (setq-local org-element--cache-change-warning nil) 7829 (setq-local org-element--cache-sync-requests nil) 7830 (setq-local org-element--cache-sync-timer nil) 7831 (org-element--cache-setup-change-functions) 7832 ;; Install in the existing indirect buffers. 7833 (dolist (buf (seq-filter 7834 (lambda (buf) 7835 (eq (current-buffer) 7836 (buffer-base-buffer buf))) 7837 (buffer-list))) 7838 (with-current-buffer buf 7839 (org-element--cache-setup-change-functions))) 7840 ;; Make sure that `org-element--cache-after-change' and 7841 ;; `org-element--cache-before-change' are working inside properly created 7842 ;; indirect buffers. Note that `clone-indirect-buffer-hook' 7843 ;; will not work inside indirect buffers not created by 7844 ;; calling `clone-indirect-buffer'. We consider that the code 7845 ;; not using `clone-indirect-buffer' to be written with 7846 ;; awareness about possible consequences. 7847 (add-hook 'clone-indirect-buffer-hook 7848 #'org-element--cache-setup-change-functions))))) 7849 7850 ;;;###autoload 7851 (defun org-element-cache-store-key (epom key value &optional robust) 7852 "Store KEY with VALUE associated with EPOM - point, marker, or element. 7853 The key can be retrieved as long as the element (provided or at point) 7854 contents is not modified. 7855 If optional argument ROBUST is non-nil, the key will be retained even 7856 when the contents (children) of current element are modified. Only 7857 non-robust element modifications (affecting the element properties 7858 other then begin/end boundaries) will invalidate the key then." 7859 (let ((element (org-element-at-point epom)) 7860 (property (if robust :robust-cache :fragile-cache))) 7861 (let ((key-store (org-element-property property element))) 7862 (unless (hash-table-p key-store) 7863 (setq key-store (make-hash-table :test #'equal)) 7864 (org-element-put-property element property key-store)) 7865 (puthash key value key-store)))) 7866 7867 ;;;###autoload 7868 (defun org-element-cache-get-key (epom key &optional default) 7869 "Get KEY associated with EPOM - point, marker, or element. 7870 Return DEFAULT when KEY is not associated with EPOM. 7871 The key can be retrieved as long as the element (provided or at point) 7872 contents is not modified." 7873 (let ((element (org-element-at-point epom))) 7874 (let ((key-store1 (org-element-property :fragile-cache element)) 7875 (key-store2 (org-element-property :robust-cache element))) 7876 (let ((val1 (if (hash-table-p key-store1) 7877 (gethash key key-store1 'not-found) 7878 'not-found)) 7879 (val2 (if (hash-table-p key-store2) 7880 (gethash key key-store2 'not-found) 7881 'not-found))) 7882 (cond 7883 ((and (eq 'not-found val1) 7884 (eq 'not-found val2)) 7885 default) 7886 ((eq 'not-found val1) val2) 7887 ((eq 'not-found val2) val1)))))) 7888 7889 ;;;###autoload 7890 (defun org-element-cache-refresh (pos) 7891 "Refresh cache at position POS." 7892 (when (org-element--cache-active-p) 7893 (org-element--cache-sync (current-buffer) pos) 7894 (org-element--cache-submit-request pos pos 0) 7895 (org-element--cache-set-timer (current-buffer)))) 7896 7897 (defmacro org-element-with-enabled-cache (&rest body) 7898 "Run BODY with org-element cache enabled (maybe temporarily). 7899 When cache is enabled, just run body. 7900 When cache is disabled, initialize a new cache, run BODY, and cleanup 7901 at the end." 7902 (declare (debug (form body)) (indent 0)) 7903 (org-with-gensyms (old-state buffer) 7904 `(if (org-element--cache-active-p) 7905 ;; Cache is active, just run BODY. 7906 (progn ,@body) 7907 ;; Cache is disabled. 7908 ;; Save existing cache. 7909 (let ((,buffer (current-buffer)) 7910 (,old-state 7911 (org-with-base-buffer nil 7912 (mapcar #'symbol-value org-element--cache-variables))) 7913 (org-element-use-cache t)) 7914 (unwind-protect 7915 (progn 7916 (org-element-cache-reset) 7917 ,@body) 7918 (cl-mapc 7919 (lambda (var values) 7920 (org-with-base-buffer ,buffer 7921 (set var values))) 7922 org-element--cache-variables 7923 ,old-state)))))) 7924 7925 (defvar warning-minimum-log-level) ; Defined in warning.el 7926 (defvar org-element-cache-map-continue-from nil 7927 "Position from where mapping should continue. 7928 This variable can be set by called function, especially when the 7929 function modified the buffer.") 7930 ;;;###autoload 7931 (cl-defun org-element-cache-map (func &key (granularity 'headline+inlinetask) restrict-elements 7932 next-re fail-re from-pos (to-pos (point-max-marker)) after-element limit-count 7933 narrow) 7934 "Map all elements in current buffer with FUNC according to GRANULARITY. 7935 Collect non-nil return values into result list. 7936 7937 FUNC should accept a single argument - the element. 7938 7939 FUNC can modify the buffer, but doing so may reduce performance. If 7940 buffer is modified, the mapping will continue from an element starting 7941 after the last mapped element. If the last mapped element is deleted, 7942 the subsequent element will be skipped as it cannot be distinguished 7943 deterministically from a changed element. If FUNC is expected to 7944 delete the element, it should directly set the value of 7945 `org-element-cache-map-continue-from' to force `org-element-cache-map' 7946 continue from the right point in buffer. 7947 7948 If some elements are not yet in cache, they will be added. 7949 7950 GRANULARITY can be `headline', `headline+inlinetask' 7951 `greater-element', or `element'. The default is 7952 `headline+inlinetask'. `object' granularity is not supported. 7953 7954 RESTRICT-ELEMENTS is a list of element types to be mapped over. 7955 7956 NEXT-RE is a regexp used to search next candidate match when FUNC 7957 returns non-nil and to search the first candidate match. FAIL-RE is a 7958 regexp used to search next candidate match when FUNC returns nil. The 7959 mapping will continue starting from headline at the RE match. 7960 7961 FROM-POS and TO-POS are buffer positions. When non-nil, they bound the 7962 mapped elements to elements starting at of after FROM-POS but before 7963 TO-POS. 7964 7965 AFTER-ELEMENT, when non-nil, bounds the mapping to all the elements 7966 after AFTER-ELEMENT (i.e. if AFTER-ELEMENT is a headline section, we 7967 map all the elements starting from first element inside section, but 7968 not including the section). 7969 7970 LIMIT-COUNT limits mapping to that many first matches where FUNC 7971 returns non-nil. 7972 7973 NARROW controls whether current buffer narrowing should be preserved. 7974 7975 This function does a subset of what `org-element-map' does, but with 7976 much better performance. Cached elements are supplied as the single 7977 argument of FUNC. Changes to elements made in FUNC will also alter 7978 the cache." 7979 (org-element-with-enabled-cache 7980 (unless (org-element--cache-active-p) 7981 (error "Cache must be active")) 7982 (unless (memq granularity '( headline headline+inlinetask 7983 greater-element element)) 7984 (error "Unsupported granularity: %S" granularity)) 7985 ;; Make TO-POS marker. Otherwise, buffer edits may garble the 7986 ;; process. 7987 (unless (markerp to-pos) 7988 (let ((mk (make-marker))) 7989 (set-marker mk to-pos) 7990 (setq to-pos mk))) 7991 (let ((gc-cons-threshold #x40000000) 7992 ;; Bind variables used inside loop to avoid memory 7993 ;; re-allocation on every iteration. 7994 ;; See https://emacsconf.org/2021/talks/faster/ 7995 tmpnext-start tmpparent tmpelement) 7996 (save-excursion 7997 (save-restriction 7998 (unless narrow (widen)) 7999 ;; Synchronize cache up to the end of mapped region. 8000 (org-element-at-point to-pos) 8001 (cl-macrolet ((cache-root 8002 ;; Use the most optimal version of cache available. 8003 () `(org-with-base-buffer nil 8004 (if (memq granularity '(headline headline+inlinetask)) 8005 (org-element--headline-cache-root) 8006 (org-element--cache-root)))) 8007 (cache-size 8008 ;; Use the most optimal version of cache available. 8009 () `(org-with-base-buffer nil 8010 (if (memq granularity '(headline headline+inlinetask)) 8011 org-element--headline-cache-size 8012 org-element--cache-size))) 8013 (cache-walk-restart 8014 ;; Restart tree traversal after AVL tree re-balance. 8015 () `(when node 8016 (org-element-at-point (point-max)) 8017 (setq node (cache-root) 8018 stack (list nil) 8019 leftp t 8020 continue-flag t))) 8021 (cache-walk-abort 8022 ;; Abort tree traversal. 8023 () `(setq continue-flag t 8024 node nil)) 8025 (element-match-at-point 8026 ;; Returning the first element to match around point. 8027 ;; For example, if point is inside headline and 8028 ;; granularity is restricted to headlines only, skip 8029 ;; over all the child elements inside the headline 8030 ;; and return the first parent headline. 8031 ;; When we are inside a cache gap, calling 8032 ;; `org-element-at-point' also fills the cache gap down to 8033 ;; point. 8034 () `(progn 8035 ;; Parsing is one of the performance 8036 ;; bottlenecks. Make sure to optimize it as 8037 ;; much as possible. 8038 ;; 8039 ;; Avoid extra staff like timer cancels et al 8040 ;; and only call `org-element--cache-sync-requests' when 8041 ;; there are pending requests. 8042 (org-with-base-buffer nil 8043 (when org-element--cache-sync-requests 8044 (org-element--cache-sync (current-buffer)))) 8045 ;; Call `org-element--parse-to' directly avoiding any 8046 ;; kind of `org-element-at-point' overheads. 8047 (if restrict-elements 8048 ;; Search directly instead of calling 8049 ;; `org-element-lineage' to avoid funcall overheads 8050 ;; and making sure that we do not go all 8051 ;; the way to `org-data' as `org-element-lineage' 8052 ;; does. 8053 (progn 8054 (setq tmpelement (org-element--parse-to (point))) 8055 (while (and tmpelement (not (org-element-type-p tmpelement restrict-elements))) 8056 (setq tmpelement (org-element-parent tmpelement))) 8057 tmpelement) 8058 (org-element--parse-to (point))))) 8059 ;; Starting from (point), search RE and move START to 8060 ;; the next valid element to be matched according to 8061 ;; restriction. Abort cache walk if no next element 8062 ;; can be found. When RE is nil, just find element at 8063 ;; point. 8064 (move-start-to-next-match 8065 ;; Preserve match data that might be set by FUNC. 8066 (re) `(save-match-data 8067 (if (or (not ,re) 8068 (if org-element--cache-map-statistics 8069 (progn 8070 (setq before-time (float-time)) 8071 (prog1 (re-search-forward (or (car-safe ,re) ,re) nil 'move) 8072 (cl-incf re-search-time 8073 (- (float-time) 8074 before-time)))) 8075 (re-search-forward (or (car-safe ,re) ,re) nil 'move))) 8076 (unless (or (< (point) (or start -1)) 8077 (and data 8078 (< (point) (org-element-begin data)))) 8079 (if (cdr-safe ,re) 8080 ;; Avoid parsing when we are 100% 8081 ;; sure that regexp is good enough 8082 ;; to find new START. 8083 (setq start (match-beginning 0)) 8084 (setq start (max (or start -1) 8085 (or (org-element-begin data) -1) 8086 (or (org-element-begin (element-match-at-point)) -1)))) 8087 (when (>= start to-pos) (cache-walk-abort)) 8088 (when (eq start -1) (setq start nil))) 8089 (cache-walk-abort)))) 8090 ;; Find expected begin position of an element after 8091 ;; DATA. 8092 (next-element-start 8093 () `(progn 8094 (setq tmpnext-start nil) 8095 (if (memq granularity '(headline headline+inlinetask)) 8096 (setq tmpnext-start (or (when (org-element-type-p data '(headline org-data)) 8097 (org-element-contents-begin data)) 8098 (org-element-end data))) 8099 (setq tmpnext-start (or (when (org-element-type-p data org-element-greater-elements) 8100 (org-element-contents-begin data)) 8101 (org-element-end data)))) 8102 ;; DATA end may be the last element inside 8103 ;; i.e. source block. Skip up to the end 8104 ;; of parent in such case. 8105 (setq tmpparent data) 8106 (catch :exit 8107 (when (eq tmpnext-start (org-element-contents-end tmpparent)) 8108 (setq tmpnext-start (org-element-end tmpparent))) 8109 (while (setq tmpparent (org-element-parent tmpparent)) 8110 (if (eq tmpnext-start (org-element-contents-end tmpparent)) 8111 (setq tmpnext-start (org-element-end tmpparent)) 8112 (throw :exit t)))) 8113 tmpnext-start)) 8114 ;; Check if cache does not have gaps. 8115 (cache-gapless-p 8116 () `(org-with-base-buffer nil 8117 (eq org-element--cache-change-tic 8118 (alist-get granularity org-element--cache-gapless))))) 8119 ;; The core algorithm is simple walk along binary tree. However, 8120 ;; instead of checking all the tree elements from first to last 8121 ;; (like in `avl-tree-mapcar'), we begin from FROM-POS skipping 8122 ;; the elements before FROM-POS efficiently: O(logN) instead of 8123 ;; O(Nbefore). 8124 ;; 8125 ;; Later, we may also not check every single element in the 8126 ;; binary tree after FROM-POS. Instead, we can find position of 8127 ;; next candidate elements by means of regexp search and skip the 8128 ;; binary tree branches that are before the next candidate: 8129 ;; again, O(logN) instead of O(Nbetween). 8130 ;; 8131 ;; Some elements might not yet be in the tree. So, we also parse 8132 ;; the empty gaps in cache as needed making sure that we do not 8133 ;; miss anything. 8134 (let* (;; START is always beginning of an element. When there is 8135 ;; no element in cache at START, we are inside cache gap 8136 ;; and need to fill it. 8137 (start (and from-pos 8138 (progn 8139 (goto-char from-pos) 8140 (org-element-begin (element-match-at-point))))) 8141 ;; Some elements may start at the same position, so we 8142 ;; also keep track of the last processed element and make 8143 ;; sure that we do not try to search it again. 8144 (prev after-element) 8145 (node (cache-root)) 8146 data 8147 (stack (list nil)) 8148 (leftp t) 8149 result 8150 ;; Whether previous element matched FUNC (FUNC 8151 ;; returned non-nil). 8152 (last-match t) 8153 continue-flag 8154 ;; Generic regexp to search next potential match. If it 8155 ;; is a cons of (regexp . 'match-beg), we are 100% sure 8156 ;; that the match beginning is the existing element 8157 ;; beginning. 8158 (next-element-re (pcase granularity 8159 ((or `headline 8160 (guard (equal '(headline) 8161 restrict-elements))) 8162 (cons 8163 (org-with-limited-levels 8164 org-element-headline-re) 8165 'match-beg)) 8166 (`headline+inlinetask 8167 (cons 8168 (if (equal '(inlinetask) restrict-elements) 8169 (org-inlinetask-outline-regexp) 8170 org-element-headline-re) 8171 'match-beg)) 8172 ;; TODO: May add other commonly 8173 ;; searched elements as needed. 8174 (_))) 8175 ;; Make sure that we are not checking the same regexp twice. 8176 (next-re (unless (and next-re 8177 (string= next-re 8178 (or (car-safe next-element-re) 8179 next-element-re))) 8180 next-re)) 8181 (fail-re (unless (and fail-re 8182 (string= fail-re 8183 (or (car-safe next-element-re) 8184 next-element-re))) 8185 fail-re)) 8186 (restrict-elements (or restrict-elements 8187 (pcase granularity 8188 (`headline 8189 '(headline)) 8190 (`headline+inlinetask 8191 '(headline inlinetask)) 8192 (`greater-element 8193 org-element-greater-elements) 8194 (_ nil)))) 8195 ;; Statistics 8196 (time (float-time)) 8197 (predicate-time 0) 8198 (pre-process-time 0) 8199 (re-search-time 0) 8200 (count-predicate-calls-match 0) 8201 (count-predicate-calls-fail 0) 8202 ;; Bind variables used inside loop to avoid memory 8203 ;; re-allocation on every iteration. 8204 ;; See https://emacsconf.org/2021/talks/faster/ 8205 cache-size before-time modified-tic) 8206 ;; Skip to first element within region. 8207 (goto-char (or start (point-min))) 8208 (move-start-to-next-match next-element-re) 8209 (unless (and start (>= start to-pos)) 8210 (while node 8211 (setq data (avl-tree--node-data node)) 8212 (if (and leftp (avl-tree--node-left node) ; Left branch. 8213 ;; Do not move to left branch when we are before 8214 ;; PREV. 8215 (or (not prev) 8216 (not (org-element--cache-key-less-p 8217 (org-element--cache-key data) 8218 (org-element--cache-key prev)))) 8219 ;; ... or when we are before START. 8220 (or (not start) 8221 (not (> start (org-element-begin data))))) 8222 (progn (push node stack) 8223 (setq node (avl-tree--node-left node))) 8224 ;; The whole tree left to DATA is before START and 8225 ;; PREV. DATA may still be before START (i.e. when 8226 ;; DATA is the root or when START moved), at START, or 8227 ;; after START. 8228 ;; 8229 ;; If DATA is before start, skip it over and move to 8230 ;; subsequent elements. 8231 ;; If DATA is at start, run FUNC if necessary and 8232 ;; update START according and NEXT-RE, FAIL-RE, 8233 ;; NEXT-ELEMENT-RE. 8234 ;; If DATA is after start, we have found a cache gap 8235 ;; and need to fill it. 8236 (unless (or (and start (< (org-element-begin data) start)) 8237 (and prev (not (org-element--cache-key-less-p 8238 (org-element--cache-key prev) 8239 (org-element--cache-key data))))) 8240 ;; DATA is at of after START and PREV. 8241 (if (or (not start) (= (org-element-begin data) start)) 8242 ;; DATA is at START. Match it. 8243 ;; In the process, we may alter the buffer, 8244 ;; so also keep track of the cache state. 8245 (progn 8246 (setq modified-tic 8247 (org-with-base-buffer nil 8248 org-element--cache-change-tic)) 8249 (setq cache-size (cache-size)) 8250 ;; When NEXT-RE/FAIL-RE is provided, skip to 8251 ;; next regexp match after :begin of the current 8252 ;; element. 8253 (when (if last-match next-re fail-re) 8254 (goto-char (org-element-begin data)) 8255 (move-start-to-next-match 8256 (if last-match next-re fail-re))) 8257 (when (and (or (not start) (eq (org-element-begin data) start)) 8258 (< (org-element-begin data) to-pos) 8259 (not continue-flag)) 8260 ;; Calculate where next possible element 8261 ;; starts and update START if needed. 8262 (setq start (next-element-start)) 8263 (goto-char start) 8264 ;; Move START further if possible. 8265 (save-excursion 8266 (when (and next-element-re 8267 ;; Do not move if we know for 8268 ;; sure that cache does not 8269 ;; contain gaps. Regexp 8270 ;; searches are not cheap. 8271 (not (cache-gapless-p))) 8272 (move-start-to-next-match next-element-re))) 8273 ;; Try FUNC if DATA matches all the 8274 ;; restrictions. Calculate new START. 8275 (when (or (not restrict-elements) 8276 (org-element-type-p data restrict-elements)) 8277 ;; DATA matches restriction. FUNC may 8278 ;; 8279 ;; Call FUNC. FUNC may move point. 8280 (setq org-element-cache-map-continue-from nil) 8281 (if (org-with-base-buffer nil org-element--cache-map-statistics) 8282 (progn 8283 (setq before-time (float-time)) 8284 (push (funcall func data) result) 8285 (cl-incf predicate-time 8286 (- (float-time) 8287 before-time)) 8288 (if (car result) 8289 (cl-incf count-predicate-calls-match) 8290 (cl-incf count-predicate-calls-fail))) 8291 (push (funcall func data) result) 8292 (when (car result) (cl-incf count-predicate-calls-match))) 8293 ;; Set `last-match'. 8294 (setq last-match (car result)) 8295 ;; If FUNC moved point forward, update 8296 ;; START. 8297 (when org-element-cache-map-continue-from 8298 (goto-char org-element-cache-map-continue-from)) 8299 (when (> (point) start) 8300 (move-start-to-next-match nil) 8301 ;; (point) inside matching element. 8302 ;; Go further. 8303 (when (> (point) start) 8304 (setq data (element-match-at-point)) 8305 (if (not data) 8306 (cache-walk-abort) 8307 (goto-char (next-element-start)) 8308 (move-start-to-next-match next-element-re)))) 8309 ;; Drop nil. 8310 (unless (car result) (pop result))) 8311 ;; If FUNC did not move the point and we 8312 ;; know for sure that cache does not contain 8313 ;; gaps, do not try to calculate START in 8314 ;; advance but simply loop to the next cache 8315 ;; element. 8316 (when (and (cache-gapless-p) 8317 (eq (next-element-start) 8318 start)) 8319 (setq start nil)) 8320 ;; Reached LIMIT-COUNT. Abort. 8321 (when (and limit-count 8322 (>= count-predicate-calls-match 8323 limit-count)) 8324 (cache-walk-abort)) 8325 ;; Make sure that we have a cached 8326 ;; element at the new START. 8327 (when start (element-match-at-point))) 8328 ;; Check if the buffer or cache has been modified. 8329 (unless (org-with-base-buffer nil 8330 (and (eq modified-tic org-element--cache-change-tic) 8331 (eq cache-size (cache-size)))) 8332 ;; START may no longer be valid, update 8333 ;; it to beginning of real element. 8334 ;; Upon modification, START may lay 8335 ;; inside an element. We want to move 8336 ;; it to real beginning then despite 8337 ;; START being larger. 8338 (setq start nil) 8339 (let ((data nil)) ; data may not be valid. ignore it. 8340 (move-start-to-next-match nil)) 8341 ;; The new element may now start before 8342 ;; or at already processed position. 8343 ;; Make sure that we continue from an 8344 ;; element past already processed 8345 ;; place. 8346 (when (and start 8347 (<= start (org-element-begin data)) 8348 (not org-element-cache-map-continue-from)) 8349 (goto-char start) 8350 (setq data (element-match-at-point)) 8351 ;; If DATA is nil, buffer is 8352 ;; empty. Abort. 8353 (when data 8354 (goto-char (next-element-start)) 8355 (move-start-to-next-match next-element-re))) 8356 (org-element-at-point to-pos) 8357 (cache-walk-restart)) 8358 (if (org-element-property :cached data) 8359 (setq prev data) 8360 (setq prev nil))) 8361 ;; DATA is after START. Fill the gap. 8362 (if (org-element-type-p 8363 (org-element--parse-to start) 8364 '(plain-list table)) 8365 ;; Tables and lists are special, we need a 8366 ;; trickery to make items/rows be populated 8367 ;; into cache. 8368 (org-element--parse-to (1+ start))) 8369 ;; Restart tree traversal as AVL tree is 8370 ;; re-balanced upon adding elements. We can no 8371 ;; longer trust STACK. 8372 (cache-walk-restart))) 8373 ;; Second, move to the right branch of the tree or skip 8374 ;; it altogether. 8375 (if continue-flag 8376 (setq continue-flag nil) 8377 (setq node (if (and (car stack) 8378 ;; If START advanced beyond stack parent, skip the right branch. 8379 (or (and start (< (org-element-begin (avl-tree--node-data (car stack))) start)) 8380 (and prev (org-element--cache-key-less-p 8381 (org-element--cache-key (avl-tree--node-data (car stack))) 8382 (org-element--cache-key prev))))) 8383 (progn 8384 (setq leftp nil) 8385 (pop stack)) 8386 ;; Otherwise, move ahead into the right 8387 ;; branch when it exists. 8388 (if (setq leftp (avl-tree--node-right node)) 8389 (avl-tree--node-right node) 8390 (pop stack)))))))) 8391 (when (and org-element--cache-map-statistics 8392 (or (not org-element--cache-map-statistics-threshold) 8393 (> (- (float-time) time) org-element--cache-map-statistics-threshold))) 8394 (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. 8395 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" 8396 (current-buffer) 8397 count-predicate-calls-match 8398 (+ count-predicate-calls-match 8399 count-predicate-calls-fail) 8400 (- (float-time) time) 8401 pre-process-time 8402 predicate-time 8403 re-search-time 8404 granularity restrict-elements next-re fail-re from-pos to-pos limit-count after-element)) 8405 ;; Return result. 8406 (nreverse result)))))))) 8407 8408 8409 8410 8411 ;;; The Toolbox 8412 ;; 8413 ;; The first move is to implement a way to obtain the smallest element 8414 ;; containing point. This is the job of `org-element-at-point'. It 8415 ;; basically jumps back to the beginning of section containing point 8416 ;; and proceed, one element after the other, with 8417 ;; `org-element--current-element' until the container is found. Note: 8418 ;; When using `org-element-at-point', secondary values are never 8419 ;; parsed since the function focuses on elements, not on objects. 8420 ;; 8421 ;; At a deeper level, `org-element-context' lists all elements and 8422 ;; objects containing point. 8423 ;; 8424 ;; `org-element-nested-p' and `org-element-swap-A-B' may be used 8425 ;; internally by navigation and manipulation tools. 8426 8427 8428 ;;;###autoload 8429 (defun org-element-at-point (&optional epom cached-only) 8430 "Determine closest element around point or EPOM. 8431 8432 When EPOM is an element, return it immediately. 8433 Otherwise, determine element at EPOM marker or position. 8434 8435 Only check cached element when CACHED-ONLY is non-nil and return nil 8436 unconditionally when element at EPOM is not in cache. 8437 8438 Return value is a list like (TYPE PROPS) where TYPE is the type 8439 of the element and PROPS a plist of properties associated to the 8440 element. 8441 8442 Possible types are defined in `org-element-all-elements'. 8443 Properties depend on element or object type, but always include 8444 `:begin', `:end', and `:post-blank' properties. 8445 8446 As a special case, if point is at the very beginning of the first 8447 item in a list or sub-list, returned element will be that list 8448 instead of the item. Likewise, if point is at the beginning of 8449 the first row of a table, returned element will be the table 8450 instead of the first row. 8451 8452 When point is at the end of the buffer, return the innermost 8453 element ending there. 8454 8455 This function may modify the match data." 8456 (if (org-element-type epom t) epom 8457 (setq epom (or epom (point))) 8458 (org-with-point-at epom 8459 (unless (derived-mode-p 'org-mode) 8460 (display-warning 8461 '(org-element org-element-parser) 8462 (format-message 8463 "`org-element-at-point' cannot be used in non-Org buffer %S (%s)" 8464 (current-buffer) major-mode))) 8465 ;; Allow re-parsing when the command can benefit from it. 8466 (when (and cached-only 8467 (memq this-command org-element--cache-non-modifying-commands)) 8468 (setq cached-only nil)) 8469 (let (element) 8470 (when (org-element--cache-active-p) 8471 (if (not (org-with-base-buffer nil org-element--cache)) (org-element-cache-reset) 8472 (unless cached-only (org-element--cache-sync (current-buffer) epom)))) 8473 (setq element (if cached-only 8474 (when (and (org-element--cache-active-p) 8475 (or (not org-element--cache-sync-requests) 8476 (< epom 8477 (org-element--request-beg 8478 (car org-element--cache-sync-requests))))) 8479 (org-element--cache-find epom)) 8480 (condition-case-unless-debug err 8481 (org-element--parse-to epom) 8482 (error 8483 (org-element--cache-warn 8484 "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)." 8485 (buffer-name (current-buffer)) 8486 epom 8487 err 8488 (when (and (fboundp 'backtrace-get-frames) 8489 (fboundp 'backtrace-to-string)) 8490 (backtrace-to-string (backtrace-get-frames 'backtrace)))) 8491 (org-element-cache-reset) 8492 (org-element--parse-to epom))))) 8493 (when (and (org-element--cache-active-p) 8494 element 8495 (org-element--cache-verify-element element)) 8496 (setq element (org-element--parse-to epom))) 8497 (unless (org-element-type-p element 'org-data) 8498 (unless (and cached-only 8499 (not (and element 8500 (or (= epom (org-element-begin element)) 8501 (and (not (org-element-type-p element org-element-greater-elements)) 8502 (>= epom (org-element-begin element)) 8503 (< epom (org-element-end element))) 8504 (and (org-element-contents-begin element) 8505 (>= epom (org-element-begin element)) 8506 (< epom (org-element-contents-begin element))) 8507 (and (not (org-element-contents-end element)) 8508 (>= epom (org-element-begin element)) 8509 (< epom (org-element-end element))))))) 8510 (if (not (org-element-type-p element 'section)) 8511 element 8512 (org-element-at-point (1+ epom) cached-only)))))))) 8513 8514 ;;;###autoload 8515 (defsubst org-element-at-point-no-context (&optional pom) 8516 "Quickly find element at point or POM. 8517 8518 It is a faster version of `org-element-at-point' that is not 8519 guaranteed to return cached element. `:parent' element may be 8520 deferred and slow to retrieve." 8521 (or (org-element-at-point pom 'cached-only) 8522 (org-element-with-disabled-cache (org-element-at-point pom)))) 8523 8524 ;;;###autoload 8525 (defun org-element-context (&optional element) 8526 "Return smallest element or object around point. 8527 8528 Return value is a list like (TYPE PROPS) where TYPE is the type 8529 of the element or object and PROPS a plist of properties 8530 associated to it. 8531 8532 Possible types are defined in `org-element-all-elements' and 8533 `org-element-all-objects'. Properties depend on element or 8534 object type, but always include `:begin', `:end', `:parent' and 8535 `:post-blank'. 8536 8537 As a special case, if point is right after an object and not at 8538 the beginning of any other object, return that object. 8539 8540 Optional argument ELEMENT, when non-nil, is the closest element 8541 containing point, as returned by `org-element-at-point'. 8542 Providing it allows for quicker computation. 8543 8544 This function may modify match data." 8545 (catch 'objects-forbidden 8546 (org-with-wide-buffer 8547 (let* ((pos (point)) 8548 (element (or element (org-element-at-point))) 8549 (type (org-element-type element)) 8550 (post (org-element-post-affiliated element))) 8551 ;; If point is inside an element containing objects or 8552 ;; a secondary string, narrow buffer to the container and 8553 ;; proceed with parsing. Otherwise, return ELEMENT. 8554 (cond 8555 ;; At a parsed affiliated keyword, check if we're inside main 8556 ;; or dual value. 8557 ((and post (< pos post)) 8558 (forward-line 0) 8559 (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) 8560 (cond 8561 ((not (member-ignore-case (match-string 1) 8562 org-element-parsed-keywords)) 8563 (throw 'objects-forbidden element)) 8564 ((<= (match-end 0) pos) 8565 (narrow-to-region (match-end 0) (line-end-position))) 8566 ((and (match-beginning 2) 8567 (>= pos (match-beginning 2)) 8568 (< pos (match-end 2))) 8569 (narrow-to-region (match-beginning 2) (match-end 2))) 8570 (t (throw 'objects-forbidden element))) 8571 ;; Also change type to retrieve correct restrictions. 8572 (setq type 'keyword)) 8573 ;; At an item, objects can only be located within tag, if any. 8574 ((eq type 'item) 8575 (let ((tag (org-element-property :tag element))) 8576 (if (or (not tag) (/= (line-beginning-position) post)) 8577 (throw 'objects-forbidden element) 8578 (forward-line 0) 8579 (search-forward tag (line-end-position)) 8580 (goto-char (match-beginning 0)) 8581 (if (and (>= pos (point)) (< pos (match-end 0))) 8582 (narrow-to-region (point) (match-end 0)) 8583 (throw 'objects-forbidden element))))) 8584 ;; At an headline or inlinetask, objects are in title. 8585 ((memq type '(headline inlinetask)) 8586 (let ((case-fold-search nil)) 8587 (goto-char (org-element-begin element)) 8588 (looking-at org-complex-heading-regexp) 8589 (let ((end (match-end 4))) 8590 (if (not end) (throw 'objects-forbidden element) 8591 (goto-char (match-beginning 4)) 8592 (when (looking-at org-element-comment-string) 8593 (goto-char (match-end 0))) 8594 (if (>= (point) end) (throw 'objects-forbidden element) 8595 (narrow-to-region (point) end)))))) 8596 ;; At a paragraph, a table-row or a verse block, objects are 8597 ;; located within their contents. 8598 ((memq type '(paragraph table-row verse-block)) 8599 (let ((cbeg (org-element-contents-begin element)) 8600 (cend (org-element-contents-end element))) 8601 ;; CBEG is nil for table rules. 8602 (if (and cbeg cend (>= pos cbeg) 8603 (or (< pos cend) (and (= pos cend) (eobp)))) 8604 (narrow-to-region cbeg cend) 8605 (throw 'objects-forbidden element)))) 8606 (t (throw 'objects-forbidden element))) 8607 (goto-char (point-min)) 8608 (let ((restriction (org-element-restriction type)) 8609 (parent element) 8610 last) 8611 (catch 'exit 8612 (while t 8613 (let ((next (org-element--object-lex restriction))) 8614 (when next (org-element-put-property next :parent parent)) 8615 ;; Process NEXT, if any, in order to know if we need to 8616 ;; skip it, return it or move into it. 8617 (if (or (not next) (> (org-element-begin next) pos)) 8618 (throw 'exit (or last parent)) 8619 (let ((end (org-element-end next)) 8620 (cbeg (org-element-contents-begin next)) 8621 (cend (org-element-contents-end next))) 8622 (cond 8623 ;; Skip objects ending before point. Also skip 8624 ;; objects ending at point unless it is also the 8625 ;; end of buffer, since we want to return the 8626 ;; innermost object. 8627 ((and (<= end pos) (/= (point-max) end)) 8628 (goto-char end) 8629 ;; For convenience, when object ends at POS, 8630 ;; without any space, store it in LAST, as we 8631 ;; will return it if no object starts here. 8632 (when (and (= end pos) 8633 (not (memq (char-before) '(?\s ?\t)))) 8634 (setq last next))) 8635 ;; If POS is within a container object, move into 8636 ;; that object. 8637 ((and cbeg cend 8638 (>= pos cbeg) 8639 (or (< pos cend) 8640 ;; At contents' end, if there is no 8641 ;; space before point, also move into 8642 ;; object, for consistency with 8643 ;; convenience feature above. 8644 (and (= pos cend) 8645 (or (= (point-max) pos) 8646 (not (memq (char-before pos) 8647 '(?\s ?\t))))))) 8648 (goto-char cbeg) 8649 (narrow-to-region (point) cend) 8650 (setq parent next) 8651 (setq restriction (org-element-restriction next))) 8652 ;; Otherwise, return NEXT. 8653 (t (throw 'exit next))))))))))))) 8654 8655 (defun org-element-nested-p (elem-A elem-B) 8656 "Non-nil when elements ELEM-A and ELEM-B are nested." 8657 (let ((beg-A (org-element-begin elem-A)) 8658 (beg-B (org-element-begin elem-B)) 8659 (end-A (org-element-end elem-A)) 8660 (end-B (org-element-end elem-B))) 8661 (or (and (>= beg-A beg-B) (<= end-A end-B)) 8662 (and (>= beg-B beg-A) (<= end-B end-A))))) 8663 8664 (defun org-element-swap-A-B (elem-A elem-B) 8665 "Swap elements ELEM-A and ELEM-B. 8666 Assume ELEM-B is after ELEM-A in the buffer. Leave point at the 8667 end of ELEM-A." 8668 (goto-char (org-element-begin elem-A)) 8669 ;; There are two special cases when an element doesn't start at bol: 8670 ;; the first paragraph in an item or in a footnote definition. 8671 (let ((specialp (not (bolp)))) 8672 ;; Only a paragraph without any affiliated keyword can be moved at 8673 ;; ELEM-A position in such a situation. Note that the case of 8674 ;; a footnote definition is impossible: it cannot contain two 8675 ;; paragraphs in a row because it cannot contain a blank line. 8676 (when (and specialp 8677 (or (not (org-element-type-p elem-B 'paragraph)) 8678 (/= (org-element-begin elem-B) 8679 (org-element-contents-begin elem-B)))) 8680 (error "Cannot swap elements")) 8681 ;; Preserve folding state when `org-fold-core-style' is set to 8682 ;; `text-properties'. 8683 (org-fold-core-ignore-modifications 8684 ;; In a special situation, ELEM-A will have no indentation. We'll 8685 ;; give it ELEM-B's (which will in, in turn, have no indentation). 8686 (let* ((ind-B (when specialp 8687 (goto-char (org-element-begin elem-B)) 8688 (current-indentation))) 8689 (beg-A (org-element-begin elem-A)) 8690 (end-A (save-excursion 8691 (goto-char (org-element-end elem-A)) 8692 (skip-chars-backward " \r\t\n") 8693 (line-end-position))) 8694 (beg-B (org-element-begin elem-B)) 8695 (end-B (save-excursion 8696 (goto-char (org-element-end elem-B)) 8697 (skip-chars-backward " \r\t\n") 8698 (line-end-position))) 8699 ;; Store inner folds responsible for visibility status. 8700 (folds 8701 (cons 8702 (org-fold-core-get-regions :from beg-A :to end-A :relative t) 8703 (org-fold-core-get-regions :from beg-B :to end-B :relative t))) 8704 ;; Get contents. 8705 (body-A (buffer-substring beg-A end-A)) 8706 (body-B (buffer-substring beg-B end-B))) 8707 ;; Clear up the folds. 8708 (org-fold-region beg-A end-A nil) 8709 (org-fold-region beg-B end-B nil) 8710 (delete-region beg-B end-B) 8711 (goto-char beg-B) 8712 (when specialp 8713 (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) 8714 (indent-to-column ind-B)) 8715 (insert body-A) 8716 ;; Restore ex ELEM-A folds. 8717 (org-fold-core-regions (car folds) :relative beg-B) 8718 (goto-char beg-A) 8719 (delete-region beg-A end-A) 8720 (insert body-B) 8721 ;; Restore ex ELEM-A folds. 8722 (org-fold-core-regions (cdr folds) :relative beg-A) 8723 (goto-char (org-element-end elem-B)))))) 8724 8725 (provide 'org-element) 8726 8727 ;; Local variables: 8728 ;; generated-autoload-file: "org-loaddefs.el" 8729 ;; End: 8730 8731 ;;; org-element.el ends here