org-element-ast.el (47207B)
1 ;;; org-element-ast.el --- Abstract syntax tree for Org -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2023-2024 Free Software Foundation, Inc. 4 5 ;; Author: Ihor Radchenko <yantar92 at posteo dot net> 6 ;; Keywords: data, lisp 7 8 ;; This file is part of GNU Emacs. 9 10 ;; GNU Emacs is free software: you can redistribute it and/or modify 11 ;; it under the terms of the GNU General Public License as published by 12 ;; the Free Software Foundation, either version 3 of the License, or 13 ;; (at your option) any later version. 14 15 ;; GNU Emacs is distributed in the hope that it will be useful, 16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18 ;; GNU General Public License for more details. 19 20 ;; You should have received a copy of the GNU General Public License 21 ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 22 23 ;;; Commentary: 24 25 ;; This file implements Org abstract syntax tree (AST) data structure. 26 ;; 27 ;; Only the most generic aspects of the syntax tree are considered 28 ;; below. The fine details of Org syntax are implemented elsewhere. 29 ;; 30 ;; Org AST is composed of nested syntax nodes. 31 ;; Within actual Org syntax, the nodes can be either headings, 32 ;; elements, or objects. However, historically, we often call syntax 33 ;; nodes simply "elements", unless the context requires clarification 34 ;; about the node type. In particular, many functions below will have 35 ;; naming pattern `org-element-X', implying `org-element-node-X' -- 36 ;; they will apply to all the node types, not just to elements. 37 ;; 38 ;; 1. Syntax nodes 39 ;; ------------------ 40 ;; Each Org syntax node can be represented as a string or list. 41 ;; 42 ;; The main node representation follows the pattern 43 ;; (TYPE PROPERTIES CONTENTS), where 44 ;; TYPE is a symbol describing the node type. 45 ;; PROPERTIES is the property list attached to it. 46 ;; CONTENTS is a list of child syntax nodes contained within the 47 ;; current node, when applicable. 48 ;; 49 ;;; For example, "*bold text* " node can be represented as 50 ;; 51 ;; (bold (:begin 1 :end 14 :post-blank 2 ...) "bold text") 52 ;; 53 ;; TYPE can be any symbol, including symbol not explicitly defined by 54 ;; Org syntax. If TYPE is not a part of the syntax, the syntax 55 ;; node is called "pseudo element/object", but otherwise considered a 56 ;; valid part of Org syntax tree. Search "Pseudo objects and 57 ;; elements" in lisp/ox-latex.el for an example of using pseudo 58 ;; elements. 59 ;; 60 ;; PROPERTIES is a property list (:property1 value1 :property2 value2 ...) 61 ;; holding properties and value. 62 ;; 63 ;; `:standard-properties', `:parent', `:deferred', and `:secondary' 64 ;; properties are treated specially in the code below. 65 ;; 66 ;; `:standard-properties' holds an array with 67 ;; `org-element--standard-properties' values, in the same order. The 68 ;; values in the array have priority over the same properties 69 ;; specified in the property list. You should not rely on the value 70 ;; of `org-element--standard-properties' in the code. 71 ;; `:standard-properties' may or may not be actually present in 72 ;; PROPERTIES. It is mostly used to speed up property access in 73 ;; performance-critical code, as most of the code requesting property 74 ;; values by constant name is inlined. 75 ;; 76 ;; The previous example can also be presented in more compact form as: 77 ;; 78 ;; (bold (:standard-properties [1 10 ... 2 ...]) "bold text") 79 ;; 80 ;; Using an array allows faster access to frequently used properties. 81 ;; 82 ;; `:parent' holds the containing node, for a child node within the 83 ;; AST. It may or may not be present in PROPERTIES. 84 ;; 85 ;; `:secondary' holds a list of properties that may contain extra AST 86 ;; nodes, in addition to the node contents. 87 ;; 88 ;; `:deferred' property describes how to update not-yet-calculated 89 ;; properties on request. 90 ;; 91 ;; 92 ;; Syntax node can also be represented by a string. Strings always 93 ;; represent syntax node of `plain-text' type with contents being nil 94 ;; and properties represented as string properties at position 0. 95 ;; `:standard-properties' are not considered for `plain-text' nodes as 96 ;; `plain-text' nodes tend to hold much fewer properties. 97 ;; 98 ;; In the above example, `plain-text' node "bold text" is more 99 ;; accurately represented as 100 ;; 101 ;; #("bold text" 0 9 (:parent (bold ...))) 102 ;; 103 ;; with :parent property value pointing back to the containing `bold' 104 ;; node. 105 ;; 106 ;; `anonymous' syntax node is represented as a list with `car' 107 ;; containing another syntax node. Such node has nil type, does not 108 ;; have properties, and its contents is a list of the contained syntax 109 ;; node. `:parent' property of the contained nodes point back to the 110 ;; list itself, except when `anonymous' node holds secondary value 111 ;; (see below), in which case the `:parent' property is set to be the 112 ;; containing node in the AST. 113 ;; 114 ;; Any node representation other then described above is not 115 ;; considered as Org syntax node. 116 ;; 117 ;; 2. Deferred values 118 ;; ------------------ 119 ;; Sometimes, it is computationally expensive or even not possible to 120 ;; calculate property values when creating an AST node. The value 121 ;; calculation can be deferred to the time the value is requested. 122 ;; 123 ;; Property values and contained nodes may have a special value of 124 ;; `org-element-deferred' type. Such values are computed dynamically. 125 ;; Either every time the property value is requested or just the first 126 ;; time. In the latter case, the `org-element-deferred' property 127 ;; value is auto-replaced with the dynamically computed result. 128 ;; 129 ;; Sometimes, even property names (not just property values) cannot, or 130 ;; should not be computed in advance. If a special property 131 ;; `:deferred' has the value of `org-element-deferred-type', it is 132 ;; first resolved for side effects of setting the missing properties. 133 ;; The resolved value is re-assigned to the `:deferred' property. 134 ;; 135 ;; Note that `org-element-copy' unconditionally resolves deferred 136 ;; properties. This is useful to generate pure (in functional sense) 137 ;; AST. 138 ;; 139 ;; The properties listed in `org-element--standard-properties', except 140 ;; `:deferred' and `:parent' are never considered to have deferred value. 141 ;; This constraint makes org-element API significantly faster. 142 ;; 143 ;; 3. Org document representation 144 ;; ------------------------------ 145 ;; Document AST is represented by nested Org syntax nodes. 146 ;; 147 ;; Each node in the AST can hold the contained node in its CONTENTS or 148 ;; as values of properties. 149 ;; 150 ;; For example, (bold (...) "bold text") `bold' node contains 151 ;; `plain-text' node in CONTENTS. 152 ;; 153 ;; The containing node is called "parent node". 154 ;; 155 ;; The contained nodes held inside CONTENTS are called "child nodes". 156 ;; They must have their `:parent' property set to the containing 157 ;; parent node. 158 ;; 159 ;; The contained nodes can also be held as property values. Such 160 ;; nodes are called "secondary nodes". Only certain properties 161 ;; can contribute to AST - the property names listed as the value of 162 ;; special property `:secondary' 163 ;; 164 ;; For example, 165 ;; 166 ;; (headline ((:secondary (:title) 167 ;; :title (#("text" 0 4 (:parent (headline ...))))))) 168 ;; 169 ;; is a parent headline node containing "text" secondary string node 170 ;; inside `:title' property. Note that `:title' is listed in 171 ;; `:secondary' value. 172 ;; 173 ;; The following example illustrates AST structure for an Org document: 174 ;; 175 ;; ---- Org document -------- 176 ;; * Heading with *bold* text 177 ;; Paragraph. 178 ;; ---- end ----------------- 179 ;; 180 ;; (org-data (...) ; `org-data' node. 181 ;; (headline 182 ;; ( 183 ;; ;; `:secondary' property lists property names that contain other 184 ;; ;; syntax tree nodes. 185 ;; 186 ;; :secondary (:title) 187 ;; 188 ;; ;; `:title' property is set to anonymous node containing: 189 ;; ;; `plain-text', `bold', `plain-text'. 190 ;; 191 ;; :title ("Heading with " (bold (:post-blank 1 ...) "bold") "text")) 192 ;; 193 ;; ;; `headline' contents 194 ;; (section (...) 195 ;; (paragraph 196 ;; ;; `:parent' property set to the containing section. 197 ;; (:parent (section ...)) 198 ;; ;; paragraph contents is a `plain-text' node. 199 ;; "Paragraph1.")))) 200 ;; 201 ;; Try calling M-: (org-element-parse-buffer) on the above example Org 202 ;; document to explore a more complete version of Org AST. 203 204 ;;; Code: 205 206 (require 'org-macs) 207 (require 'inline) ; load indentation rules 208 (require 'subr-x) ;; FIXME: Required for Emacs 27 209 210 ;;;; Syntax node type 211 212 (defun org-element-type (node &optional anonymous) 213 "Return type of NODE. 214 215 The function returns the type of the node provided. 216 It can also return the following special value: 217 `plain-text' for a string 218 nil in any other case. 219 220 When optional argument ANONYMOUS is non-nil, return symbol `anonymous' 221 when NODE is an anonymous node." 222 (declare (pure t)) 223 (cond 224 ((stringp node) 'plain-text) 225 ((null node) nil) 226 ((not (consp node)) nil) 227 ((symbolp (car node)) (car node)) 228 ((and anonymous (car node) (org-element-type (car node) t)) 229 'anonymous) 230 (t nil))) 231 232 (define-inline org-element-type-p (node types) 233 "Return non-nil when NODE type is one of TYPES. 234 TYPES can be a type symbol or a list of symbols." 235 (inline-letevals (node types) 236 (if (listp (inline-const-val types)) 237 (inline-quote (memq (org-element-type ,node t) ,types)) 238 (inline-quote (eq (org-element-type ,node t) ,types))))) 239 240 (defun org-element-secondary-p (node) 241 "Non-nil when NODE directly belongs to a secondary node. 242 Return value is the containing property name, as a keyword, or nil." 243 (declare (pure t)) 244 (let* ((parent (org-element-property :parent node)) 245 (properties (org-element-property :secondary parent)) 246 val) 247 (catch 'exit 248 (dolist (p properties) 249 (setq val (org-element-property-raw p parent)) 250 (when (or (eq node val) (memq node val)) 251 (throw 'exit p)))))) 252 253 ;;;; Deferred values 254 255 (cl-defstruct (org-element-deferred 256 (:constructor nil) 257 (:constructor org-element-deferred-create 258 ( auto-undefer-p function &rest arg-value 259 &aux (args arg-value))) 260 (:constructor org-element-deferred-create-alias 261 ( keyword &optional auto-undefer-p 262 &aux 263 (function #'org-element-property-2) 264 (args (list keyword)))) 265 (:constructor org-element-deferred-create-list 266 ( args &optional auto-undefer-p 267 &aux 268 (function #'org-element--deferred-resolve-list))) 269 (:type vector) :named) 270 "Dynamically computed value. 271 272 The value can be obtained by calling FUNCTION with containing syntax 273 node as first argument and ARGS list as remaining arguments. 274 275 If the function throws `:org-element-deferred-retry' signal, assume 276 that the syntax node has been modified by side effect and retry 277 retrieving the value that was previously deferred. 278 279 AUTO-UNDEFER slot flags if the property value should be replaced upon 280 resolution. Some functions may ignore this flag." 281 function args auto-undefer-p) 282 283 (defsubst org-element--deferred-resolve-once (deferred-value &optional node) 284 "Resolve DEFERRED-VALUE for NODE. 285 Throw `:org-element-deferred-retry' if NODE has been modified and we 286 need to re-read the value again." 287 (apply (org-element-deferred-function deferred-value) 288 node 289 (org-element-deferred-args deferred-value))) 290 291 (defsubst org-element--deferred-resolve (value &optional node force-undefer) 292 "Resolve VALUE for NODE recursively. 293 Return a cons cell of the resolved value and the value to store. 294 When no value should be stored, return `org-element-ast--nil' as cdr. 295 When FORCE-UNDEFER is non-nil, resolve all the deferred values, ignoring 296 their `auto-undefer-p' slot. 297 298 Throw `:org-element-deferred-retry' if NODE has been modified and we 299 need to re-read the value again." 300 (let ((value-to-store 'org-element-ast--nil) undefer) 301 (while (org-element-deferred-p value) 302 (setq undefer (or force-undefer (org-element-deferred-auto-undefer-p value)) 303 value (org-element--deferred-resolve-once value node)) 304 (when undefer (setq value-to-store value))) 305 (cons value value-to-store))) 306 307 (defsubst org-element--deferred-resolve-force (value &optional node) 308 "Resolve VALUE for NODE recursively, ignoring `auto-undefer-p'. 309 Return the resolved value. 310 311 Throw `:org-element-deferred-retry' if NODE has been modified and we 312 need to re-read the value again." 313 (car (org-element--deferred-resolve value node 'force))) 314 315 (defsubst org-element--deferred-resolve-list (node &rest list) 316 "Unconditionally resolve all the deferred values in LIST for NODE. 317 Return a new list with all the values resolved. 318 319 Throw `:org-element-deferred-retry' if NODE has been modified and we 320 need to re-read the value again." 321 (mapcar 322 (lambda (value) 323 (if (org-element-deferred-p value) 324 (org-element--deferred-resolve-force value node) 325 value)) 326 list)) 327 328 ;;;; Object properties 329 330 (eval-and-compile ; make available during inline expansion 331 332 (defconst org-element--standard-properties 333 '( :begin :post-affiliated :contents-begin :contents-end :end :post-blank 334 :secondary :mode :granularity 335 :cached :org-element--cache-sync-key 336 :robust-begin :robust-end 337 :true-level 338 :buffer :deferred 339 :structure :parent) 340 "Standard properties stored in every syntax node structure. 341 These properties are stored in an array pre-allocated every time a new 342 object is created. Two exceptions are `anonymous' and `plain-text' 343 node types.") 344 345 (defconst org-element--standard-properties-idxs 346 (let (plist) 347 (seq-do-indexed 348 (lambda (property idx) 349 (setq plist (plist-put plist property idx))) 350 org-element--standard-properties) 351 plist) 352 "Property list holding standard indexes for `org-element--standard-properties'.") 353 354 (define-inline org-element--property-idx (property) 355 "Return standard property index or nil." 356 (declare (pure t)) 357 (inline-letevals (property) 358 (plist-get 359 org-element--standard-properties-idxs 360 (inline-const-val property))))) 361 362 (define-inline org-element--parray (node) 363 "Return standard property array for NODE." 364 (declare (pure t)) 365 (inline-letevals (node) 366 (inline-quote 367 (pcase (org-element-type ,node) 368 (`nil nil) 369 ;; Do not use property array for strings - they usually hold 370 ;; `:parent' property and nothing more. 371 (`plain-text nil) 372 (_ 373 ;; (type (:standard-properties val ...) ...) 374 (if (eq :standard-properties (car (nth 1 ,node))) 375 (cadr (nth 1 ,node)) 376 ;; Non-standard order. Go long way. 377 (plist-get (nth 1 ,node) :standard-properties))))))) 378 379 (define-inline org-element--plist-property (property node &optional dflt) 380 "Extract the value for PROPERTY from NODE's property list. 381 Ignore standard property array." 382 (declare (pure t)) 383 (inline-letevals (property node dflt) 384 (inline-quote 385 (pcase (org-element-type ,node) 386 (`nil ,dflt) 387 (`plain-text 388 (or (get-text-property 0 ,property ,node) 389 (when ,dflt 390 (if 391 ;; FIXME: Byte-compiler throws false positives in Emacs 27. 392 (with-no-warnings 393 (plist-member (text-properties-at 0 ,node) ,property)) 394 nil ,dflt)))) 395 (_ 396 (or (plist-get (nth 1 ,node) ,property) 397 (when ,dflt 398 (if 399 ;; FIXME: Byte-compiler throws false positives in Emacs 27. 400 (with-no-warnings 401 (plist-member (nth 1 ,node) ,property)) 402 nil ,dflt)))))))) 403 404 (define-inline org-element-property-raw (property node &optional dflt) 405 "Extract the value for PROPERTY of an NODE. 406 Do not resolve deferred values. 407 If PROPERTY is not present, return DFLT." 408 (declare (pure t)) 409 (inline-letevals (node property) 410 (let ((idx (org-element--property-idx (inline-const-val property)))) 411 (inline-quote 412 (let ((idx (or ,idx (org-element--property-idx ,property)))) 413 (if-let* ((parray (and idx (org-element--parray ,node)))) 414 (pcase (aref parray idx) 415 (`org-element-ast--nil ,dflt) 416 (val val)) 417 ;; No property array exists. Fall back to `plist-get'. 418 (org-element--plist-property ,property ,node ,dflt))))))) 419 420 (define-inline org-element--put-parray (node &optional parray) 421 "Initialize standard property array in NODE. 422 Return the array or nil when NODE is `plain-text'." 423 (inline-letevals (node parray) 424 (inline-quote 425 (let ((parray ,parray)) 426 (unless (or parray (memq (org-element-type ,node) '(plain-text nil))) 427 (setq parray (make-vector ,(length org-element--standard-properties) nil)) 428 ;; Copy plist standard properties back to parray. 429 (let ((stdplist org-element--standard-properties-idxs)) 430 (while stdplist 431 (aset parray (cadr stdplist) 432 (org-element--plist-property (car stdplist) ,node)) 433 (setq stdplist (cddr stdplist)))) 434 (setcar (cdr ,node) 435 (nconc (list :standard-properties parray) 436 (cadr ,node))) 437 parray))))) 438 439 (define-inline org-element-put-property (node property value) 440 "In NODE, set PROPERTY to VALUE. 441 Return modified NODE." 442 (let ((idx (and (inline-const-p property) 443 (org-element--property-idx property)))) 444 (if idx 445 (inline-letevals (node value) 446 (inline-quote 447 (if (org-element-type-p ,node 'plain-text) 448 ;; Special case: Do not use parray for plain-text. 449 (org-add-props ,node nil ,property ,value) 450 (let ((parray 451 (or (org-element--parray ,node) 452 (org-element--put-parray ,node)))) 453 (when parray (aset parray ,idx ,value)) 454 ,node)))) 455 (inline-letevals (node property value) 456 (inline-quote 457 (let ((idx (org-element--property-idx ,property))) 458 (if (and idx (not (org-element-type-p ,node 'plain-text))) 459 (when-let* 460 ((parray 461 (or (org-element--parray ,node) 462 (org-element--put-parray ,node)))) 463 (aset parray idx ,value)) 464 (pcase (org-element-type ,node) 465 (`nil nil) 466 (`plain-text 467 (org-add-props ,node nil ,property ,value)) 468 (_ 469 ;; Note that `plist-put' adds new elements at the end, 470 ;; thus keeping `:standard-properties' as the first element. 471 (setcar (cdr ,node) (plist-put (nth 1 ,node) ,property ,value))))) 472 ,node)))))) 473 474 (define-inline org-element-put-property-2 (property value node) 475 "Like `org-element-put-property', but NODE is the last argument. 476 See `org-element-put-property' for the meaning of PROPERTY and VALUE." 477 (inline-quote (org-element-put-property ,node ,property ,value))) 478 479 (defun org-element--property (property node &optional dflt force-undefer) 480 "Extract the value from the PROPERTY of a NODE. 481 Return DFLT when PROPERTY is not present. 482 When FORCE-UNDEFER is non-nil, unconditionally resolve deferred 483 properties, replacing their values in NODE." 484 (let ((value (org-element-property-raw property node 'org-element-ast--nil))) 485 ;; PROPERTY not present. 486 (when (and (eq 'org-element-ast--nil value) 487 (org-element-deferred-p 488 (org-element-property-raw :deferred node))) 489 ;; If :deferred has `org-element-deferred' type, resolve it for 490 ;; side-effects, and re-assign the new value. 491 (org-element--property :deferred node nil 'force-undefer) 492 ;; Try to retrieve the value again. 493 (setq value (org-element-property-raw property node dflt))) 494 ;; Deferred property. Resolve it recursively. 495 (when (org-element-deferred-p value) 496 (let ((retry t) (firstiter t)) 497 (while retry 498 (if firstiter (setq firstiter nil) ; avoid extra call to `org-element-property-raw'. 499 (setq value (org-element-property-raw property node 'org-element-ast--nil))) 500 (catch :org-element-deferred-retry 501 (pcase-let 502 ((`(,resolved . ,value-to-store) 503 (org-element--deferred-resolve value node force-undefer))) 504 (setq value resolved) 505 ;; Store the resolved property value, if needed. 506 (unless (eq value-to-store 'org-element-ast--nil) 507 (org-element-put-property node property value-to-store))) 508 ;; Finished resolving. 509 (setq retry nil))))) 510 ;; Return the resolved value. 511 (if (eq value 'org-element-ast--nil) dflt value))) 512 513 (define-inline org-element-property (property node &optional dflt force-undefer) 514 "Extract the value from the PROPERTY of a NODE. 515 Return DFLT when PROPERTY is not present. 516 When FORCE-UNDEFER is non-nil and the property value is computed 517 dynamically, unconditionally replace the dynamic deferred value, 518 modifying NODE by side effect. 519 520 Note: The properties listed in `org-element--standard-properties', 521 except `:deferred', may not be resolved." 522 (if (and (inline-const-p property) 523 (not (memq (inline-const-val property) '(:deferred :parent))) 524 (org-element--property-idx (inline-const-val property))) 525 ;; This is an important optimization, making common org-element 526 ;; API calls much faster. 527 (inline-quote (org-element-property-raw ,property ,node ,dflt)) 528 (inline-quote (org-element--property ,property ,node ,dflt ,force-undefer)))) 529 530 (define-inline org-element-property-2 (node property &optional dflt force-undefer) 531 "Like `org-element-property', but reverse the order of NODE and PROPERTY." 532 (inline-quote (org-element-property ,property ,node ,dflt ,force-undefer))) 533 534 (defsubst org-element-parent (node) 535 "Return `:parent' property of NODE." 536 (org-element-property :parent node)) 537 538 (gv-define-setter org-element-parent (value node) 539 `(org-element-put-property ,node :parent ,value)) 540 541 (gv-define-setter org-element-property (value property node &optional _) 542 `(org-element-put-property ,node ,property ,value)) 543 544 (gv-define-setter org-element-property-raw (value property node &optional _) 545 `(org-element-put-property ,node ,property ,value)) 546 547 (defun org-element--properties-mapc (fun node &optional collect no-standard) 548 "Apply FUN for each property of NODE. 549 FUN will be called with three arguments: property name, property 550 value, and node. If FUN accepts only 2 arguments, it will be called 551 with two arguments: property name and property value. If FUN accepts 552 only a single argument, it will be called with a single argument - 553 property value. 554 555 Do not resolve deferred values, except `:deferred'. 556 `:standard-properties' internal property will be skipped. 557 558 When NO-STANDARD is non-nil, do no map over 559 `org-element--standard-properties'. 560 561 When COLLECT is symbol `set', set the property values to the return 562 values (except the values equal to `org-element-ast--nil') and finally 563 return nil. When COLLECT is non-nil and not symbol `set', collect the 564 return values into a list and return it. 565 Otherwise, return nil." 566 (let ( acc rtn (fun-arity (cdr (func-arity fun))) 567 (type (org-element-type node))) 568 (when type 569 ;; Compute missing properties. 570 (org-element-property :deferred node) 571 ;; Map over parray. 572 (unless no-standard 573 (let ((standard-idxs 574 org-element--standard-properties-idxs) 575 (parray (org-element--parray node))) 576 (when parray 577 (while standard-idxs 578 (setq 579 rtn 580 (pcase fun-arity 581 (1 (funcall fun (aref parray (cadr standard-idxs)))) 582 (2 (funcall 583 fun 584 (car standard-idxs) 585 (aref parray (cadr standard-idxs)))) 586 (_ (funcall 587 fun 588 (car standard-idxs) 589 (aref parray (cadr standard-idxs)) 590 node)))) 591 (when collect 592 (unless (eq rtn (aref parray (cadr standard-idxs))) 593 (if (and (eq collect 'set) (not (eq rtn 'org-element-ast--nil))) 594 (setf (aref parray (cadr standard-idxs)) rtn) 595 (push rtn acc)))) 596 (setq standard-idxs (cddr standard-idxs)))))) 597 ;; Map over plist. 598 (let ((props 599 (if (eq type 'plain-text) 600 (text-properties-at 0 node) 601 (nth 1 node)))) 602 (while props 603 (unless (eq :standard-properties (car props)) 604 (setq rtn 605 (pcase fun-arity 606 (1 (funcall fun (cadr props))) 607 (2 (funcall fun (car props) (cadr props))) 608 (_ (funcall fun (car props) (cadr props) node)))) 609 (when collect 610 (if (and (eq collect 'set) 611 (not (eq rtn 'org-element-ast--nil))) 612 (unless (eq rtn (cadr props)) 613 (if (eq type 'plain-text) 614 (org-add-props node nil (car props) rtn) 615 (setf (cadr props) rtn))) 616 (push rtn acc)))) 617 (setq props (cddr props))))) 618 ;; Return. 619 (when collect (nreverse acc)))) 620 621 (defun org-element--deferred-resolve-force-rec (property val node) 622 "Resolve deferred PROPERTY VAL in NODE recursively. Force undefer." 623 (catch :found 624 (catch :org-element-deferred-retry 625 (throw :found (org-element--deferred-resolve-force val node))) 626 ;; Caught `:org-element-deferred-retry'. Go long way. 627 (org-element-property property node nil t))) 628 629 (defun org-element--deferred-resolve-rec (property val node) 630 "Resolve deferred PROPERTY VAL in NODE recursively. 631 Return the value to be stored." 632 (catch :found 633 (catch :org-element-deferred-retry 634 (throw :found (cdr (org-element--deferred-resolve val node)))) 635 ;; Caught `:org-element-deferred-retry'. Go long way. 636 (org-element-property property node))) 637 638 (defsubst org-element-properties-resolve (node &optional force-undefer) 639 "Resolve all the deferred properties in NODE, modifying the NODE. 640 When FORCE-UNDEFER is non-nil, resolve unconditionally. 641 Return the modified NODE." 642 ;; Compute all the available properties. 643 (org-element-property :deferred node nil force-undefer) 644 (org-element--properties-mapc 645 (if force-undefer 646 #'org-element--deferred-resolve-force-rec 647 #'org-element--deferred-resolve-rec) 648 node 'set 'no-standard) 649 node) 650 651 (defsubst org-element-properties-mapc (fun node &optional undefer) 652 "Apply FUN for each property of NODE for side effect. 653 FUN will be called with three arguments: property name, property 654 value, and node. If FUN accepts only 2 arguments, it will be called 655 with two arguments: property name and property value. If FUN accepts 656 only a single argument, it will be called with a single argument - 657 property value. 658 659 When UNDEFER is non-nil, undefer deferred properties. 660 When UNDEFER is symbol `force', unconditionally replace the property 661 values with undeferred values. 662 663 Return nil." 664 (when undefer 665 (org-element-properties-resolve node (eq 'force undefer))) 666 (org-element--properties-mapc fun node)) 667 668 ;; There is purposely no function like `org-element-properties' that 669 ;; returns a list of properties. Such function would tempt the users 670 ;; to (1) run it, creating a whole new list; (2) filter over that list 671 ;; - the process requiring a lot of extra consing, adding a load onto 672 ;; Emacs GC, memory used, and slowing things up as creating new lists 673 ;; is not free for CPU. 674 (defsubst org-element-properties-map (fun node &optional undefer) 675 "Apply FUN for each property of NODE and return a list of the results. 676 FUN will be called with three arguments: property name, property 677 value, and node. If FUN accepts only 2 arguments, it will be called 678 with two arguments: property name and property value. If FUN accepts 679 only a single argument, it will be called with a single argument - 680 property value. 681 682 When UNDEFER is non-nil, undefer deferred properties unconditionally. 683 When UNDEFER is symbol `force', unconditionally replace the property 684 values with undeferred values." 685 (when undefer 686 (org-element-properties-resolve node (eq 'force undefer))) 687 (org-element--properties-mapc fun node 'collect)) 688 689 ;;;; Node contents. 690 691 (defsubst org-element-contents (node) 692 "Extract contents from NODE. 693 Do not resolve deferred values." 694 (declare (pure t)) 695 (cond ((not (consp node)) nil) 696 ((symbolp (car node)) (nthcdr 2 node)) 697 (t node))) 698 699 (defsubst org-element-set-contents (node &rest contents) 700 "Set NODE's contents to CONTENTS. 701 Return modified NODE. 702 If NODE cannot have contents, return CONTENTS." 703 (pcase (org-element-type node t) 704 (`plain-text contents) 705 ((guard (null node)) contents) 706 ;; Anonymous node. 707 (`anonymous 708 (setcar node (car contents)) 709 (setcdr node (cdr contents)) 710 node) 711 ;; Node with type. 712 (_ (setf (cddr node) contents) 713 node))) 714 715 (defalias 'org-element-resolve-deferred #'org-element-properties-resolve) 716 717 ;;;; Constructor and copier 718 719 (defun org-element-create (type &optional props &rest children) 720 "Create a new syntax node of TYPE. 721 Optional argument PROPS, when non-nil, is a plist defining the 722 properties of the node. CHILDREN can be elements, objects or 723 strings. 724 725 When CHILDREN is a single anonymous node, use its contents as children 726 nodes. This way, 727 (org-element-create \\='section nil (org-element-contents node)) 728 will yield expected results with contents of another node adopted into 729 a newly created one. 730 731 When TYPE is `plain-text', CHILDREN must contain a single node - 732 string. Alternatively, TYPE can be a string. When TYPE is nil or 733 `anonymous', PROPS must be nil." 734 (cl-assert 735 ;; FIXME: Just use `plistp' from Emacs 29 when available. 736 (let ((len (proper-list-p props))) 737 (and len (zerop (% len 2))))) 738 ;; Assign parray. 739 (when (and props (not (stringp type)) (not (eq type 'plain-text))) 740 (let ((node (list 'dummy props))) 741 (org-element--put-parray node) 742 (setq props (nth 1 node)) 743 ;; Remove standard properties from PROPS plist by side effect. 744 (let ((ptail props)) 745 (while ptail 746 (if (not (and (keywordp (car ptail)) 747 (org-element--property-idx (car ptail)))) 748 (setq ptail (cddr ptail)) 749 (if (null (cddr ptail)) ; last property 750 (setq props (nbutlast props 2) 751 ptail nil) 752 (setcar ptail (nth 2 ptail)) 753 (setcdr ptail (seq-drop ptail 3)))))))) 754 (pcase type 755 ((or `nil `anonymous) 756 (cl-assert (null props)) 757 (apply #'org-element-adopt nil children)) 758 (`plain-text 759 (cl-assert (= (length children) 1)) 760 (org-add-props (car children) props)) 761 ((pred stringp) 762 (if props (org-add-props type props) type)) 763 (_ 764 (if (and (= 1 (length children)) 765 (org-element-type-p (car children) 'anonymous)) 766 (apply #'org-element-adopt (list type props) (car children)) 767 (apply #'org-element-adopt (list type props) children))))) 768 769 (defun org-element-copy (datum &optional keep-contents) 770 "Return a copy of DATUM. 771 DATUM is an element, object, string or nil. `:parent' property 772 is cleared and contents are removed in the process. 773 Secondary objects are also copied and their `:parent' is re-assigned. 774 775 When optional argument KEEP-CONTENTS is non-nil, do not remove the 776 contents. Instead, copy the children recursively, updating their 777 `:parent' property. 778 779 As a special case, `anonymous' nodes do not have their contents 780 removed. The contained children are copied recursively, updating 781 their `:parent' property to the copied `anonymous' node. 782 783 When DATUM is `plain-text', all the properties are removed." 784 (pcase (org-element-type datum t) 785 ((guard (null datum)) nil) 786 (`plain-text (substring-no-properties datum)) 787 (`nil (error "Not an Org syntax node: %S" datum)) 788 (`anonymous 789 (let* ((node-copy (copy-sequence datum)) 790 (tail node-copy)) 791 (while tail 792 (setcar tail (org-element-copy (car tail) t)) 793 (org-element-put-property (car tail) :parent node-copy) 794 (setq tail (cdr tail))) 795 node-copy)) 796 (type 797 (let ((node-copy (append (list type (copy-sequence (cadr datum))) (copy-sequence (cddr datum))))) 798 ;; Copy `:standard-properties' 799 (when-let* ((parray (org-element-property-raw :standard-properties node-copy))) 800 (org-element-put-property node-copy :standard-properties (copy-sequence parray))) 801 ;; Clear `:parent'. 802 (org-element-put-property node-copy :parent nil) 803 ;; We cannot simply return the copied property list. When 804 ;; DATUM is i.e. a headline, it's property list `:title' can 805 ;; contain parsed objects. The objects will contain 806 ;; `:parent' property set to the DATUM itself. When copied, 807 ;; these inner `:parent' property values will contain 808 ;; incorrect object decoupled from DATUM. Changes to the 809 ;; DATUM copy will no longer be reflected in the `:parent' 810 ;; properties. So, we need to reassign inner `:parent' 811 ;; properties to the DATUM copy explicitly. 812 (dolist (secondary-prop (org-element-property :secondary node-copy)) 813 (when-let* ((secondary-value (org-element-property secondary-prop node-copy))) 814 (setq secondary-value (org-element-copy secondary-value t)) 815 (if (org-element-type secondary-value) 816 (org-element-put-property secondary-value :parent node-copy) 817 (dolist (el secondary-value) 818 (org-element-put-property el :parent node-copy))) 819 (org-element-put-property node-copy secondary-prop secondary-value))) 820 (when keep-contents 821 (let ((contents (org-element-contents node-copy))) 822 (while contents 823 (setcar contents (org-element-copy (car contents) t)) 824 (setq contents (cdr contents))))) 825 node-copy)))) 826 827 ;;;; AST queries 828 829 (defun org-element-ast-map 830 ( data types fun 831 &optional 832 ignore first-match no-recursion 833 with-properties no-secondary no-undefer) 834 "Map a function on selected syntax nodes. 835 836 DATA is a syntax tree. TYPES is a symbol or list of symbols of 837 node types. FUN is the function called on the matching nodes. 838 It has to accept one argument: the node itself. 839 840 When TYPES is t, call FUN for all the node types. 841 842 FUN can also be a Lisp form. The form will be evaluated as function 843 with symbol `node' bound to the current node. 844 845 When optional argument IGNORE is non-nil, it should be a list holding 846 nodes to be skipped. In that case, the listed nodes and their 847 contents will be skipped. 848 849 When optional argument FIRST-MATCH is non-nil, stop at the first 850 match for which FUN doesn't return nil, and return that value. 851 852 Optional argument NO-RECURSION is a symbol or a list of symbols 853 representing node types. `org-element-map' won't enter any recursive 854 element or object whose type belongs to that list. Though, FUN can 855 still be applied on them. 856 857 When optional argument WITH-PROPERTIES is non-nil, it should hold a list 858 of property names. These properties will be treated as additional 859 secondary properties. 860 861 When optional argument NO-SECONDARY is non-nil, do not recurse into 862 secondary strings. 863 864 When optional argument NO-UNDEFER is non-nil, do not resolve deferred 865 values. 866 867 FUN may also throw `:org-element-skip' signal. Then, 868 `org-element-ast-map' will not recurse into the current node. 869 870 Nil values returned from FUN do not appear in the results." 871 (declare (indent 2)) 872 ;; Ensure TYPES and NO-RECURSION are a list, even of one node. 873 (when types 874 (let* ((types (pcase types 875 ((pred listp) types) 876 (`t t) 877 (_ (list types)))) 878 (no-recursion (if (listp no-recursion) no-recursion 879 (list no-recursion))) 880 (fun (if (functionp fun) fun `(lambda (node) ,fun))) 881 --acc) 882 (letrec ((--walk-tree 883 (lambda (--data) 884 ;; Recursively walk DATA. INFO, if non-nil, is a plist 885 ;; holding contextual information. 886 (let ((--type (org-element-type --data t)) 887 recurse) 888 (cond 889 ((not --data)) 890 ((not --type)) 891 ;; Ignored node in an export context. 892 ((and ignore (memq --data ignore))) 893 ;; List of elements or objects. 894 ((eq --type 'anonymous) 895 (mapc --walk-tree (org-element-contents --data))) 896 (t 897 ;; Check if TYPE is matching among TYPES. If so, 898 ;; apply FUN to --DATA and accumulate return value 899 ;; into --ACC (or exit if FIRST-MATCH is non-nil). 900 (setq recurse t) 901 (when (or (eq types t) (memq --type types)) 902 (let ((result 903 (catch :org-element-skip 904 (setq recurse nil) 905 (prog1 (funcall fun --data) 906 (setq recurse t))))) 907 (cond ((not result)) 908 (first-match (throw :--map-first-match result)) 909 (t (push result --acc))))) 910 ;; Determine if a recursion into --DATA is possible. 911 (cond 912 ;; No recursion requested. 913 ((not recurse)) 914 ;; --TYPE is explicitly removed from recursion. 915 ((memq --type no-recursion)) 916 ;; In any other case, map secondary, affiliated, and contents. 917 (t 918 (when with-properties 919 (dolist (p with-properties) 920 (funcall 921 --walk-tree 922 (if no-undefer 923 (org-element-property-raw p --data) 924 (org-element-property p --data))))) 925 (unless no-secondary 926 (dolist (p (org-element-property :secondary --data)) 927 (funcall 928 --walk-tree 929 (if no-undefer 930 (org-element-property-raw p --data) 931 (org-element-property p --data))))) 932 (mapc --walk-tree (org-element-contents --data)))))))))) 933 (catch :--map-first-match 934 (funcall --walk-tree data) 935 ;; Return value in a proper order. 936 (nreverse --acc)))))) 937 938 (defun org-element-lineage (datum &optional types with-self) 939 "List all ancestors of a given element or object. 940 941 DATUM is an object or element. 942 943 Return ancestors from the closest to the farthest. When optional 944 argument TYPES is a symbol or a list of symbols, return the first 945 element or object in the lineage whose type equals or belongs to that 946 list instead. 947 948 When optional argument WITH-SELF is non-nil, lineage includes 949 DATUM itself as the first element, and TYPES, if provided, also 950 apply to it. 951 952 When DATUM is obtained through `org-element-context' or 953 `org-element-at-point', and org-element-cache is disabled, only 954 ancestors from its section can be found. There is no such limitation 955 when DATUM belongs to a full parse tree." 956 (when (and types (not (listp types))) (setq types (list types))) 957 (let ((up (if with-self datum (org-element-parent datum))) 958 ancestors) 959 (while (and up (not (org-element-type-p up types))) 960 (unless types (push up ancestors)) 961 (setq up (org-element-parent up))) 962 (if types up (nreverse ancestors)))) 963 964 (defun org-element-lineage-map (datum fun &optional types with-self first-match) 965 "Map FUN across ancestors of DATUM, from closest to furthest. 966 Return a list of results. Nil values returned from FUN do not appear 967 in the results. 968 969 DATUM is an object or element. 970 971 FUN is a function accepting a single argument: syntax node. 972 FUN can also be a Lisp form. The form will be evaluated as function 973 with symbol `node' bound to the current node. 974 975 When optional argument TYPES is a list of symbols, only map across 976 nodes with the listed types. 977 978 When optional argument WITH-SELF is non-nil, lineage includes 979 DATUM itself as the first element, and TYPES, if provided, also 980 apply to it. 981 982 When optional argument FIRST-MATCH is non-nil, stop at the first 983 match for which FUN doesn't return nil, and return that value." 984 (declare (indent 2)) 985 (setq fun (if (functionp fun) fun `(lambda (node) ,fun))) 986 (let ((up (if with-self datum (org-element-parent datum))) 987 acc rtn) 988 (catch :--first-match 989 (while up 990 (when (or (not types) (org-element-type-p up types)) 991 (setq rtn (funcall fun up)) 992 (if (and first-match rtn) 993 (throw :--first-match rtn) 994 (when rtn (push rtn acc)))) 995 (setq up (org-element-parent up))) 996 (nreverse acc)))) 997 998 (defun org-element-property-inherited (property node &optional with-self accumulate literal-nil include-nil) 999 "Extract non-nil value from the PROPERTY of a NODE and/or its parents. 1000 1001 PROPERTY is a single property or a list of properties to be considered. 1002 1003 When WITH-SELF is non-nil, consider PROPERTY in the NODE itself. 1004 Otherwise, only start from the immediate parent. 1005 1006 When optional argument ACCUMULATE is nil, return the first non-nil value 1007 \(properties when PROPERTY is a list are considered one by one). 1008 When ACCUMULATE is non-nil, extract all the values, starting from the 1009 outermost ancestor and accumulate them into a single list. The values 1010 that are lists are appended. 1011 1012 When LITERAL-NIL is non-nil, treat property values \"nil\" and nil. 1013 1014 When INCLUDE-NIL is non-nil, do not skip properties with value nil. The 1015 properties that are missing from the property list will still be 1016 skipped." 1017 (unless (listp property) (setq property (list property))) 1018 (let (acc local val) 1019 (catch :found 1020 (unless with-self (setq node (org-element-parent node))) 1021 (while node 1022 (setq local nil) 1023 (dolist (prop property) 1024 (setq val (org-element-property prop node 'org-element-ast--nil)) 1025 (unless (eq val 'org-element-ast--nil) ; not present 1026 (when literal-nil (setq val (org-not-nil val))) 1027 (when (and (not accumulate) (or val include-nil)) 1028 (throw :found val)) 1029 ;; Append to the end. 1030 (if (and include-nil (not val)) 1031 (setq local (append local '(nil))) 1032 (setq local (append local (if (listp val) val (list val))))))) 1033 ;; Append parent to front. 1034 (setq acc (append local acc)) 1035 (setq node (org-element-parent node))) 1036 acc))) 1037 1038 ;;;; AST modification 1039 1040 (defalias 'org-element-adopt-elements #'org-element-adopt) 1041 (defun org-element-adopt (parent &rest children) 1042 "Append CHILDREN to the contents of PARENT. 1043 1044 PARENT is a syntax node. CHILDREN can be elements, objects, or 1045 strings. 1046 1047 If PARENT is nil, create a new anonymous node containing CHILDREN. 1048 1049 The function takes care of setting `:parent' property for each child. 1050 Return the modified PARENT." 1051 (declare (indent 1)) 1052 (if (not children) parent 1053 ;; Link every child to PARENT. If PARENT is nil, it is a secondary 1054 ;; string: parent is the list itself. 1055 (dolist (child children) 1056 (when child 1057 (org-element-put-property child :parent (or parent children)))) 1058 ;; Add CHILDREN at the end of PARENT contents. 1059 (when parent 1060 (apply #'org-element-set-contents 1061 parent 1062 (nconc (org-element-contents parent) children))) 1063 ;; Return modified PARENT element. 1064 (or parent children))) 1065 1066 (defalias 'org-element-extract-element #'org-element-extract) 1067 (defun org-element-extract (node) 1068 "Extract NODE from parse tree. 1069 Remove NODE from the parse tree by side-effect, and return it 1070 with its `:parent' property stripped out." 1071 (let ((parent (org-element-parent node)) 1072 (secondary (org-element-secondary-p node))) 1073 (if secondary 1074 (org-element-put-property 1075 parent secondary 1076 (delq node (org-element-property secondary parent))) 1077 (apply #'org-element-set-contents 1078 parent 1079 (delq node (org-element-contents parent)))) 1080 ;; Return NODE with its :parent removed. 1081 (org-element-put-property node :parent nil))) 1082 1083 (defun org-element-insert-before (node location) 1084 "Insert NODE before LOCATION in parse tree. 1085 LOCATION is an element, object or string within the parse tree. 1086 Parse tree is modified by side effect." 1087 (let* ((parent (org-element-parent location)) 1088 (property (org-element-secondary-p location)) 1089 (siblings (if property (org-element-property property parent) 1090 (org-element-contents parent))) 1091 ;; Special case: LOCATION is the first element of an 1092 ;; independent secondary string (e.g. :title property). Add 1093 ;; NODE in-place. 1094 (specialp (and (not property) 1095 (eq siblings parent) 1096 (eq (car parent) location)))) 1097 ;; Install NODE at the appropriate LOCATION within SIBLINGS. 1098 (cond (specialp) 1099 ((or (null siblings) (eq (car siblings) location)) 1100 (push node siblings)) 1101 ((null location) (nconc siblings (list node))) 1102 (t 1103 (let ((index (cl-position location siblings))) 1104 (unless index (error "No location found to insert node")) 1105 (push node (cdr (nthcdr (1- index) siblings)))))) 1106 ;; Store SIBLINGS at appropriate place in parse tree. 1107 (cond 1108 (specialp (setcdr parent (copy-sequence parent)) (setcar parent node)) 1109 (property (org-element-put-property parent property siblings)) 1110 (t (apply #'org-element-set-contents parent siblings))) 1111 ;; Set appropriate :parent property. 1112 (org-element-put-property node :parent parent))) 1113 1114 (defalias 'org-element-set-element #'org-element-set) 1115 (defun org-element-set (old new &optional keep-props) 1116 "Replace element or object OLD with element or object NEW. 1117 When KEEP-PROPS is non-nil, keep OLD values of the listed property 1118 names. 1119 1120 Return the modified element. 1121 1122 The function takes care of setting `:parent' property for NEW." 1123 ;; Ensure OLD and NEW have the same parent. 1124 (org-element-put-property new :parent (org-element-property :parent old)) 1125 ;; Handle KEEP-PROPS. 1126 (dolist (p keep-props) 1127 (org-element-put-property new p (org-element-property p old))) 1128 (let ((old-type (org-element-type old)) 1129 (new-type (org-element-type new))) 1130 (if (or (eq old-type 'plain-text) 1131 (eq new-type 'plain-text)) 1132 ;; We cannot replace OLD with NEW since strings are not mutable. 1133 ;; We take the long path. 1134 (progn 1135 (org-element-insert-before new old) 1136 (org-element-extract old) 1137 ;; We will return OLD. 1138 (setq old new)) 1139 ;; Since OLD is going to be changed into NEW by side-effect, first 1140 ;; make sure that every element or object within NEW has OLD as 1141 ;; parent. 1142 (dolist (blob (org-element-contents new)) 1143 (org-element-put-property blob :parent old)) 1144 ;; Both OLD and NEW are lists. 1145 (setcar old (car new)) 1146 (setcdr old (cdr new)))) 1147 old) 1148 1149 (provide 'org-element-ast) 1150 ;;; org-element-ast.el ends here