1;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*- 2 3;; Copyright (C) 2012-2021 Free Software Foundation, Inc. 4 5;; Author: Nicolas Goaziou <n.goaziou at gmail dot com> 6;; Keywords: outlines, hypermedia, calendar, wp 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software: you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation, either version 3 of the License, or 13;; (at your option) any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. 22 23;;; Commentary: 24;; 25;; See <https://orgmode.org/worg/dev/org-syntax.html> for details about 26;; Org syntax. 27;; 28;; Lisp-wise, a syntax object can be represented as a list. 29;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: 30;; TYPE is a symbol describing the object. 31;; PROPERTIES is the property list attached to it. See docstring of 32;; appropriate parsing function to get an exhaustive list. 33;; CONTENTS is a list of syntax objects or raw strings contained 34;; in the current object, when applicable. 35;; 36;; For the whole document, TYPE is `org-data' and PROPERTIES is nil. 37;; 38;; The first part of this file defines constants for the Org syntax, 39;; while the second one provide accessors and setters functions. 40;; 41;; The next part implements a parser and an interpreter for each 42;; element and object type in Org syntax. 43;; 44;; The following part creates a fully recursive buffer parser. It 45;; also provides a tool to map a function to elements or objects 46;; matching some criteria in the parse tree. Functions of interest 47;; are `org-element-parse-buffer', `org-element-map' and, to a lesser 48;; extent, `org-element-parse-secondary-string'. 49;; 50;; The penultimate part is the cradle of an interpreter for the 51;; obtained parse tree: `org-element-interpret-data'. 52;; 53;; The library ends by furnishing `org-element-at-point' function, and 54;; a way to give information about document structure around point 55;; with `org-element-context'. A cache mechanism is also provided for 56;; these functions. 57 58 59;;; Code: 60 61(require 'avl-tree) 62(require 'cl-lib) 63(require 'ol) 64(require 'org) 65(require 'org-compat) 66(require 'org-entities) 67(require 'org-footnote) 68(require 'org-list) 69(require 'org-macs) 70(require 'org-table) 71 72(declare-function org-at-heading-p "org" (&optional _)) 73(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) 74(declare-function org-escape-code-in-string "org-src" (s)) 75(declare-function org-macro-escape-arguments "org-macro" (&rest args)) 76(declare-function org-macro-extract-arguments "org-macro" (s)) 77(declare-function org-reduced-level "org" (l)) 78(declare-function org-unescape-code-in-string "org-src" (s)) 79(declare-function outline-next-heading "outline" ()) 80(declare-function outline-previous-heading "outline" ()) 81 82(defvar org-archive-tag) 83(defvar org-clock-line-re) 84(defvar org-closed-string) 85(defvar org-comment-string) 86(defvar org-complex-heading-regexp) 87(defvar org-dblock-start-re) 88(defvar org-deadline-string) 89(defvar org-done-keywords) 90(defvar org-drawer-regexp) 91(defvar org-edit-src-content-indentation) 92(defvar org-emph-re) 93(defvar org-emphasis-regexp-components) 94(defvar org-keyword-time-not-clock-regexp) 95(defvar org-match-substring-regexp) 96(defvar org-odd-levels-only) 97(defvar org-outline-regexp-bol) 98(defvar org-planning-line-re) 99(defvar org-property-drawer-re) 100(defvar org-property-format) 101(defvar org-property-re) 102(defvar org-scheduled-string) 103(defvar org-src-preserve-indentation) 104(defvar org-tags-column) 105(defvar org-time-stamp-formats) 106(defvar org-todo-regexp) 107(defvar org-ts-regexp-both) 108(defvar org-verbatim-re) 109 110 111;;; Definitions And Rules 112;; 113;; Define elements, greater elements and specify recursive objects, 114;; along with the affiliated keywords recognized. Also set up 115;; restrictions on recursive objects combinations. 116;; 117;; `org-element-update-syntax' builds proper syntax regexps according 118;; to current setup. 119 120(defconst org-element-citation-key-re 121 (rx "@" (group (one-or-more (any word "-.:?!`'/*@+|(){}<>&_^$#%~")))) 122 "Regexp matching a citation key. 123Key is located in match group 1.") 124 125(defconst org-element-citation-prefix-re 126 (rx "[cite" 127 (opt "/" (group (one-or-more (any "/_-" alnum)))) ;style 128 ":" 129 (zero-or-more (any "\t\n "))) 130 "Regexp matching a citation prefix. 131Style, if any, is located in match group 1.") 132 133(defvar org-element-paragraph-separate nil 134 "Regexp to separate paragraphs in an Org buffer. 135In the case of lines starting with \"#\" and \":\", this regexp 136is not sufficient to know if point is at a paragraph ending. See 137`org-element-paragraph-parser' for more information.") 138 139(defvar org-element--object-regexp nil 140 "Regexp possibly matching the beginning of an object. 141This regexp allows false positives. Dedicated parser (e.g., 142`org-export-bold-parser') will take care of further filtering. 143Radio links are not matched by this regexp, as they are treated 144specially in `org-element--object-lex'.") 145 146(defun org-element--set-regexps () 147 "Build variable syntax regexps." 148 (setq org-element-paragraph-separate 149 (concat "^\\(?:" 150 ;; Headlines, inlinetasks. 151 "\\*+ " "\\|" 152 ;; Footnote definitions. 153 "\\[fn:[-_[:word:]]+\\]" "\\|" 154 ;; Diary sexps. 155 "%%(" "\\|" 156 "[ \t]*\\(?:" 157 ;; Empty lines. 158 "$" "\\|" 159 ;; Tables (any type). 160 "|" "\\|" 161 "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|" 162 ;; Comments, keyword-like or block-like constructs. 163 ;; Blocks and keywords with dual values need to be 164 ;; double-checked. 165 "#\\(?: \\|$\\|\\+\\(?:" 166 "BEGIN_\\S-+" "\\|" 167 "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)" 168 "\\|" 169 ;; Drawers (any type) and fixed-width areas. Drawers 170 ;; need to be double-checked. 171 ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|" 172 ;; Horizontal rules. 173 "-\\{5,\\}[ \t]*$" "\\|" 174 ;; LaTeX environments. 175 "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|" 176 ;; Clock lines. 177 "CLOCK:" "\\|" 178 ;; Lists. 179 (let ((term (pcase org-plain-list-ordered-item-terminator 180 (?\) ")") (?. "\\.") (_ "[.)]"))) 181 (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) 182 (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" 183 "\\(?:[ \t]\\|$\\)")) 184 "\\)\\)") 185 org-element--object-regexp 186 (mapconcat #'identity 187 (let ((link-types (regexp-opt (org-link-types)))) 188 (list 189 ;; Sub/superscript. 190 "\\(?:[_^][-{(*+.,[:alnum:]]\\)" 191 ;; Bold, code, italic, strike-through, underline 192 ;; and verbatim. 193 (concat "[*~=+_/]" 194 (format "[^%s]" 195 (nth 2 org-emphasis-regexp-components))) 196 ;; Plain links. 197 (concat "\\<" link-types ":") 198 ;; Objects starting with "[": citations, 199 ;; footnote reference, statistics cookie, 200 ;; timestamp (inactive) and regular link. 201 (format "\\[\\(?:%s\\)" 202 (mapconcat 203 #'identity 204 (list "cite[:/]" 205 "fn:" 206 "\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)" 207 "\\[") 208 "\\|")) 209 ;; Objects starting with "@": export snippets. 210 "@@" 211 ;; Objects starting with "{": macro. 212 "{{{" 213 ;; Objects starting with "<" : timestamp 214 ;; (active, diary), target, radio target and 215 ;; angular links. 216 (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)") 217 ;; Objects starting with "$": latex fragment. 218 "\\$" 219 ;; Objects starting with "\": line break, 220 ;; entity, latex fragment. 221 "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)" 222 ;; Objects starting with raw text: inline Babel 223 ;; source block, inline Babel call. 224 "\\(?:call\\|src\\)_")) 225 "\\|"))) 226 227(org-element--set-regexps) 228 229;;;###autoload 230(defun org-element-update-syntax () 231 "Update parser internals." 232 (interactive) 233 (org-element--set-regexps) 234 (org-element-cache-reset 'all)) 235 236(defconst org-element-all-elements 237 '(babel-call center-block clock comment comment-block diary-sexp drawer 238 dynamic-block example-block export-block fixed-width 239 footnote-definition headline horizontal-rule inlinetask item 240 keyword latex-environment node-property paragraph plain-list 241 planning property-drawer quote-block section 242 special-block src-block table table-row verse-block) 243 "Complete list of element types.") 244 245(defconst org-element-greater-elements 246 '(center-block drawer dynamic-block footnote-definition headline inlinetask 247 item plain-list property-drawer quote-block section 248 special-block table) 249 "List of recursive element types aka Greater Elements.") 250 251(defconst org-element-all-objects 252 '(bold citation citation-reference code entity export-snippet 253 footnote-reference inline-babel-call inline-src-block italic line-break 254 latex-fragment link macro radio-target statistics-cookie strike-through 255 subscript superscript table-cell target timestamp underline verbatim) 256 "Complete list of object types.") 257 258(defconst org-element-recursive-objects 259 '(bold citation footnote-reference italic link subscript radio-target 260 strike-through superscript table-cell underline) 261 "List of recursive object types.") 262 263(defconst org-element-object-containers 264 (append org-element-recursive-objects '(paragraph table-row verse-block)) 265 "List of object or element types that can directly contain objects.") 266 267(defconst org-element-affiliated-keywords 268 '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" 269 "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") 270 "List of affiliated keywords as strings. 271By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") 272are affiliated keywords and need not to be in this list.") 273 274(defconst org-element-keyword-translation-alist 275 '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME") 276 ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME") 277 ("RESULT" . "RESULTS") ("HEADERS" . "HEADER")) 278 "Alist of usual translations for keywords. 279The key is the old name and the value the new one. The property 280holding their value will be named after the translated name.") 281 282(defconst org-element-multiple-keywords '("CAPTION" "HEADER") 283 "List of affiliated keywords that can occur more than once in an element. 284 285Their value will be consed into a list of strings, which will be 286returned as the value of the property. 287 288This list is checked after translations have been applied. See 289`org-element-keyword-translation-alist'. 290 291By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") 292allow multiple occurrences and need not to be in this list.") 293 294(defconst org-element-parsed-keywords '("CAPTION") 295 "List of affiliated keywords whose value can be parsed. 296 297Their value will be stored as a secondary string: a list of 298strings and objects. 299 300This list is checked after translations have been applied. See 301`org-element-keyword-translation-alist'.") 302 303(defconst org-element--parsed-properties-alist 304 (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k))))) 305 org-element-parsed-keywords) 306 "Alist of parsed keywords and associated properties. 307This is generated from `org-element-parsed-keywords', which 308see.") 309 310(defconst org-element-dual-keywords '("CAPTION" "RESULTS") 311 "List of affiliated keywords which can have a secondary value. 312 313In Org syntax, they can be written with optional square brackets 314before the colons. For example, RESULTS keyword can be 315associated to a hash value with the following: 316 317 #+RESULTS[hash-string]: some-source 318 319This list is checked after translations have been applied. See 320`org-element-keyword-translation-alist'.") 321 322(defconst org-element--affiliated-re 323 (format "[ \t]*#\\+\\(?:%s\\):[ \t]*" 324 (concat 325 ;; Dual affiliated keywords. 326 (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?" 327 (regexp-opt org-element-dual-keywords)) 328 "\\|" 329 ;; Regular affiliated keywords. 330 (format "\\(?1:%s\\)" 331 (regexp-opt 332 (cl-remove-if 333 (lambda (k) (member k org-element-dual-keywords)) 334 org-element-affiliated-keywords))) 335 "\\|" 336 ;; Export attributes. 337 "\\(?1:ATTR_[-_A-Za-z0-9]+\\)")) 338 "Regexp matching any affiliated keyword. 339 340Keyword name is put in match group 1. Moreover, if keyword 341belongs to `org-element-dual-keywords', put the dual value in 342match group 2. 343 344Don't modify it, set `org-element-affiliated-keywords' instead.") 345 346(defconst org-element-object-restrictions 347 (let* ((minimal-set '(bold code entity italic latex-fragment strike-through 348 subscript superscript underline verbatim)) 349 (standard-set 350 (remq 'citation-reference (remq 'table-cell org-element-all-objects))) 351 (standard-set-no-line-break (remq 'line-break standard-set))) 352 `((bold ,@standard-set) 353 (citation citation-reference) 354 (citation-reference ,@minimal-set) 355 (footnote-reference ,@standard-set) 356 (headline ,@standard-set-no-line-break) 357 (inlinetask ,@standard-set-no-line-break) 358 (italic ,@standard-set) 359 (item ,@standard-set-no-line-break) 360 (keyword ,@(remq 'footnote-reference standard-set)) 361 ;; Ignore all links in a link description. Also ignore 362 ;; radio-targets and line breaks. 363 (link export-snippet inline-babel-call inline-src-block macro 364 statistics-cookie ,@minimal-set) 365 (paragraph ,@standard-set) 366 ;; Remove any variable object from radio target as it would 367 ;; prevent it from being properly recognized. 368 (radio-target ,@minimal-set) 369 (strike-through ,@standard-set) 370 (subscript ,@standard-set) 371 (superscript ,@standard-set) 372 ;; Ignore inline babel call and inline source block as formulas 373 ;; are possible. Also ignore line breaks and statistics 374 ;; cookies. 375 (table-cell citation export-snippet footnote-reference link macro 376 radio-target target timestamp ,@minimal-set) 377 (table-row table-cell) 378 (underline ,@standard-set) 379 (verse-block ,@standard-set))) 380 "Alist of objects restrictions. 381 382key is an element or object type containing objects and value is 383a list of types that can be contained within an element or object 384of such type. 385 386This alist also applies to secondary string. For example, an 387`headline' type element doesn't directly contain objects, but 388still has an entry since one of its properties (`:title') does.") 389 390(defconst org-element-secondary-value-alist 391 '((citation :prefix :suffix) 392 (headline :title) 393 (inlinetask :title) 394 (item :tag) 395 (citation-reference :prefix :suffix)) 396 "Alist between element types and locations of secondary values.") 397 398(defconst org-element--pair-round-table 399 (let ((table (make-syntax-table))) 400 (modify-syntax-entry ?\( "()" table) 401 (modify-syntax-entry ?\) ")(" table) 402 (dolist (char '(?\{ ?\} ?\[ ?\] ?\< ?\>) table) 403 (modify-syntax-entry char " " table))) 404 "Table used internally to pair only round brackets. 405Other brackets are treated as spaces.") 406 407(defconst org-element--pair-square-table 408 (let ((table (make-syntax-table))) 409 (modify-syntax-entry ?\[ "(]" table) 410 (modify-syntax-entry ?\] ")[" table) 411 (dolist (char '(?\{ ?\} ?\( ?\) ?\< ?\>) table) 412 (modify-syntax-entry char " " table))) 413 "Table used internally to pair only square brackets. 414Other brackets are treated as spaces.") 415 416(defconst org-element--pair-curly-table 417 (let ((table (make-syntax-table))) 418 (modify-syntax-entry ?\{ "(}" table) 419 (modify-syntax-entry ?\} "){" table) 420 (dolist (char '(?\[ ?\] ?\( ?\) ?\< ?\>) table) 421 (modify-syntax-entry char " " table))) 422 "Table used internally to pair only curly brackets. 423Other brackets are treated as spaces.") 424 425(defun org-element--parse-paired-brackets (char) 426 "Parse paired brackets at point. 427CHAR is the opening bracket to consider, as a character. Return 428contents between brackets, as a string, or nil. Also move point 429past the brackets." 430 (when (eq char (char-after)) 431 (let ((syntax-table (pcase char 432 (?\{ org-element--pair-curly-table) 433 (?\[ org-element--pair-square-table) 434 (?\( org-element--pair-round-table) 435 (_ nil))) 436 (pos (point))) 437 (when syntax-table 438 (with-syntax-table syntax-table 439 (let ((end (ignore-errors (scan-lists pos 1 0)))) 440 (when end 441 (goto-char end) 442 (buffer-substring-no-properties (1+ pos) (1- end))))))))) 443 444 445;;; Accessors and Setters 446;; 447;; Provide four accessors: `org-element-type', `org-element-property' 448;; `org-element-contents' and `org-element-restriction'. 449;; 450;; Setter functions allow modification of elements by side effect. 451;; There is `org-element-put-property', `org-element-set-contents'. 452;; These low-level functions are useful to build a parse tree. 453;; 454;; `org-element-adopt-elements', `org-element-set-element', 455;; `org-element-extract-element' and `org-element-insert-before' are 456;; high-level functions useful to modify a parse tree. 457;; 458;; `org-element-secondary-p' is a predicate used to know if a given 459;; object belongs to a secondary string. `org-element-class' tells if 460;; some parsed data is an element or an object, handling pseudo 461;; elements and objects. `org-element-copy' returns an element or 462;; object, stripping its parent property in the process. 463 464(defsubst org-element-type (element) 465 "Return type of ELEMENT. 466 467The function returns the type of the element or object provided. 468It can also return the following special value: 469 `plain-text' for a string 470 `org-data' for a complete document 471 nil in any other case." 472 (cond 473 ((not (consp element)) (and (stringp element) 'plain-text)) 474 ((symbolp (car element)) (car element)))) 475 476(defsubst org-element-property (property element) 477 "Extract the value from the PROPERTY of an ELEMENT." 478 (if (stringp element) (get-text-property 0 property element) 479 (plist-get (nth 1 element) property))) 480 481(defsubst org-element-contents (element) 482 "Extract contents from an ELEMENT." 483 (cond ((not (consp element)) nil) 484 ((symbolp (car element)) (nthcdr 2 element)) 485 (t element))) 486 487(defsubst org-element-restriction (element) 488 "Return restriction associated to ELEMENT. 489ELEMENT can be an element, an object or a symbol representing an 490element or object type." 491 (cdr (assq (if (symbolp element) element (org-element-type element)) 492 org-element-object-restrictions))) 493 494(defsubst org-element-put-property (element property value) 495 "In ELEMENT set PROPERTY to VALUE. 496Return modified element." 497 (if (stringp element) (org-add-props element nil property value) 498 (setcar (cdr element) (plist-put (nth 1 element) property value)) 499 element)) 500 501(defsubst org-element-set-contents (element &rest contents) 502 "Set ELEMENT's contents to CONTENTS. 503Return ELEMENT." 504 (cond ((null element) contents) 505 ((not (symbolp (car element))) contents) 506 ((cdr element) (setcdr (cdr element) contents) element) 507 (t (nconc element contents)))) 508 509(defun org-element-secondary-p (object) 510 "Non-nil when OBJECT directly belongs to a secondary string. 511Return value is the property name, as a keyword, or nil." 512 (let* ((parent (org-element-property :parent object)) 513 (properties (cdr (assq (org-element-type parent) 514 org-element-secondary-value-alist)))) 515 (catch 'exit 516 (dolist (p properties) 517 (and (memq object (org-element-property p parent)) 518 (throw 'exit p)))))) 519 520(defsubst org-element-class (datum &optional parent) 521 "Return class for ELEMENT, as a symbol. 522Class is either `element' or `object'. Optional argument PARENT 523is the element or object containing DATUM. It defaults to the 524value of DATUM `:parent' property." 525 (let ((type (org-element-type datum)) 526 (parent (or parent (org-element-property :parent datum)))) 527 (cond 528 ;; Trivial cases. 529 ((memq type org-element-all-objects) 'object) 530 ((memq type org-element-all-elements) 'element) 531 ;; Special cases. 532 ((eq type 'org-data) 'element) 533 ((eq type 'plain-text) 'object) 534 ((not type) 'object) 535 ;; Pseudo object or elements. Make a guess about its class. 536 ;; Basically a pseudo object is contained within another object, 537 ;; a secondary string or a container element. 538 ((not parent) 'element) 539 (t 540 (let ((parent-type (org-element-type parent))) 541 (cond ((not parent-type) 'object) 542 ((memq parent-type org-element-object-containers) 'object) 543 ((org-element-secondary-p datum) 'object) 544 (t 'element))))))) 545 546(defsubst org-element-adopt-elements (parent &rest children) 547 "Append elements to the contents of another element. 548 549PARENT is an element or object. CHILDREN can be elements, 550objects, or a strings. 551 552The function takes care of setting `:parent' property for CHILD. 553Return parent element." 554 (declare (indent 1)) 555 (if (not children) parent 556 ;; Link every child to PARENT. If PARENT is nil, it is a secondary 557 ;; string: parent is the list itself. 558 (dolist (child children) 559 (org-element-put-property child :parent (or parent children))) 560 ;; Add CHILDREN at the end of PARENT contents. 561 (when parent 562 (apply #'org-element-set-contents 563 parent 564 (nconc (org-element-contents parent) children))) 565 ;; Return modified PARENT element. 566 (or parent children))) 567 568(defun org-element-extract-element (element) 569 "Extract ELEMENT from parse tree. 570Remove element from the parse tree by side-effect, and return it 571with its `:parent' property stripped out." 572 (let ((parent (org-element-property :parent element)) 573 (secondary (org-element-secondary-p element))) 574 (if secondary 575 (org-element-put-property 576 parent secondary 577 (delq element (org-element-property secondary parent))) 578 (apply #'org-element-set-contents 579 parent 580 (delq element (org-element-contents parent)))) 581 ;; Return ELEMENT with its :parent removed. 582 (org-element-put-property element :parent nil))) 583 584(defun org-element-insert-before (element location) 585 "Insert ELEMENT before LOCATION in parse tree. 586LOCATION is an element, object or string within the parse tree. 587Parse tree is modified by side effect." 588 (let* ((parent (org-element-property :parent location)) 589 (property (org-element-secondary-p location)) 590 (siblings (if property (org-element-property property parent) 591 (org-element-contents parent))) 592 ;; Special case: LOCATION is the first element of an 593 ;; independent secondary string (e.g. :title property). Add 594 ;; ELEMENT in-place. 595 (specialp (and (not property) 596 (eq siblings parent) 597 (eq (car parent) location)))) 598 ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS. 599 (cond (specialp) 600 ((or (null siblings) (eq (car siblings) location)) 601 (push element siblings)) 602 ((null location) (nconc siblings (list element))) 603 (t 604 (let ((index (cl-position location siblings))) 605 (unless index (error "No location found to insert element")) 606 (push element (cdr (nthcdr (1- index) siblings)))))) 607 ;; Store SIBLINGS at appropriate place in parse tree. 608 (cond 609 (specialp (setcdr parent (copy-sequence parent)) (setcar parent element)) 610 (property (org-element-put-property parent property siblings)) 611 (t (apply #'org-element-set-contents parent siblings))) 612 ;; Set appropriate :parent property. 613 (org-element-put-property element :parent parent))) 614 615(defun org-element-set-element (old new) 616 "Replace element or object OLD with element or object NEW. 617The function takes care of setting `:parent' property for NEW." 618 ;; Ensure OLD and NEW have the same parent. 619 (org-element-put-property new :parent (org-element-property :parent old)) 620 (if (or (memq (org-element-type old) '(plain-text nil)) 621 (memq (org-element-type new) '(plain-text nil))) 622 ;; We cannot replace OLD with NEW since one of them is not an 623 ;; object or element. We take the long path. 624 (progn (org-element-insert-before new old) 625 (org-element-extract-element old)) 626 ;; Since OLD is going to be changed into NEW by side-effect, first 627 ;; make sure that every element or object within NEW has OLD as 628 ;; parent. 629 (dolist (blob (org-element-contents new)) 630 (org-element-put-property blob :parent old)) 631 ;; Transfer contents. 632 (apply #'org-element-set-contents old (org-element-contents new)) 633 ;; Overwrite OLD's properties with NEW's. 634 (setcar (cdr old) (nth 1 new)) 635 ;; Transfer type. 636 (setcar old (car new)))) 637 638(defun org-element-create (type &optional props &rest children) 639 "Create a new element of type TYPE. 640Optional argument PROPS, when non-nil, is a plist defining the 641properties of the element. CHILDREN can be elements, objects or 642strings." 643 (apply #'org-element-adopt-elements (list type props) children)) 644 645(defun org-element-copy (datum) 646 "Return a copy of DATUM. 647DATUM is an element, object, string or nil. `:parent' property 648is cleared and contents are removed in the process." 649 (when datum 650 (let ((type (org-element-type datum))) 651 (pcase type 652 (`org-data (list 'org-data nil)) 653 (`plain-text (substring-no-properties datum)) 654 (`nil (copy-sequence datum)) 655 (_ 656 (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil))))))) 657 658 659 660;;; Greater elements 661;; 662;; For each greater element type, we define a parser and an 663;; interpreter. 664;; 665;; A parser returns the element or object as the list described above. 666;; Most of them accepts no argument. Though, exceptions exist. Hence 667;; every element containing a secondary string (see 668;; `org-element-secondary-value-alist') will accept an optional 669;; argument to toggle parsing of these secondary strings. Moreover, 670;; `item' parser requires current list's structure as its first 671;; element. 672;; 673;; An interpreter accepts two arguments: the list representation of 674;; the element or object, and its contents. The latter may be nil, 675;; depending on the element or object considered. It returns the 676;; appropriate Org syntax, as a string. 677;; 678;; Parsing functions must follow the naming convention: 679;; org-element-TYPE-parser, where TYPE is greater element's type, as 680;; defined in `org-element-greater-elements'. 681;; 682;; Similarly, interpreting functions must follow the naming 683;; convention: org-element-TYPE-interpreter. 684;; 685;; With the exception of `headline' and `item' types, greater elements 686;; cannot contain other greater elements of their own type. 687;; 688;; Beside implementing a parser and an interpreter, adding a new 689;; greater element requires tweaking `org-element--current-element'. 690;; Moreover, the newly defined type must be added to both 691;; `org-element-all-elements' and `org-element-greater-elements'. 692 693 694;;;; Center Block 695 696(defun org-element-center-block-parser (limit affiliated) 697 "Parse a center block. 698 699LIMIT bounds the search. AFFILIATED is a list of which CAR is 700the buffer position at the beginning of the first affiliated 701keyword and CDR is a plist of affiliated keywords along with 702their value. 703 704Return a list whose CAR is `center-block' and CDR is a plist 705containing `:begin', `:end', `:contents-begin', `:contents-end', 706`:post-blank' and `:post-affiliated' keywords. 707 708Assume point is at the beginning of the block." 709 (let ((case-fold-search t)) 710 (if (not (save-excursion 711 (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t))) 712 ;; Incomplete block: parse it as a paragraph. 713 (org-element-paragraph-parser limit affiliated) 714 (let ((block-end-line (match-beginning 0))) 715 (let* ((begin (car affiliated)) 716 (post-affiliated (point)) 717 ;; Empty blocks have no contents. 718 (contents-begin (progn (forward-line) 719 (and (< (point) block-end-line) 720 (point)))) 721 (contents-end (and contents-begin block-end-line)) 722 (pos-before-blank (progn (goto-char block-end-line) 723 (forward-line) 724 (point))) 725 (end (save-excursion 726 (skip-chars-forward " \r\t\n" limit) 727 (if (eobp) (point) (line-beginning-position))))) 728 (list 'center-block 729 (nconc 730 (list :begin begin 731 :end end 732 :contents-begin contents-begin 733 :contents-end contents-end 734 :post-blank (count-lines pos-before-blank end) 735 :post-affiliated post-affiliated) 736 (cdr affiliated)))))))) 737 738(defun org-element-center-block-interpreter (_ contents) 739 "Interpret a center-block element as Org syntax. 740CONTENTS is the contents of the element." 741 (format "#+begin_center\n%s#+end_center" contents)) 742 743 744;;;; Drawer 745 746(defun org-element-drawer-parser (limit affiliated) 747 "Parse a drawer. 748 749LIMIT bounds the search. AFFILIATED is a list of which CAR is 750the buffer position at the beginning of the first affiliated 751keyword and CDR is a plist of affiliated keywords along with 752their value. 753 754Return a list whose CAR is `drawer' and CDR is a plist containing 755`:drawer-name', `:begin', `:end', `:contents-begin', 756`:contents-end', `:post-blank' and `:post-affiliated' keywords. 757 758Assume point is at beginning of drawer." 759 (let ((case-fold-search t)) 760 (if (not (save-excursion 761 (goto-char (min limit (line-end-position))) 762 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) 763 ;; Incomplete drawer: parse it as a paragraph. 764 (org-element-paragraph-parser limit affiliated) 765 (save-excursion 766 (let* ((drawer-end-line (match-beginning 0)) 767 (name (progn (looking-at org-drawer-regexp) 768 (match-string-no-properties 1))) 769 (begin (car affiliated)) 770 (post-affiliated (point)) 771 ;; Empty drawers have no contents. 772 (contents-begin (progn (forward-line) 773 (and (< (point) drawer-end-line) 774 (point)))) 775 (contents-end (and contents-begin drawer-end-line)) 776 (pos-before-blank (progn (goto-char drawer-end-line) 777 (forward-line) 778 (point))) 779 (end (progn (skip-chars-forward " \r\t\n" limit) 780 (if (eobp) (point) (line-beginning-position))))) 781 (list 'drawer 782 (nconc 783 (list :begin begin 784 :end end 785 :drawer-name name 786 :contents-begin contents-begin 787 :contents-end contents-end 788 :post-blank (count-lines pos-before-blank end) 789 :post-affiliated post-affiliated) 790 (cdr affiliated)))))))) 791 792(defun org-element-drawer-interpreter (drawer contents) 793 "Interpret DRAWER element as Org syntax. 794CONTENTS is the contents of the element." 795 (format ":%s:\n%s:END:" 796 (org-element-property :drawer-name drawer) 797 contents)) 798 799 800;;;; Dynamic Block 801 802(defun org-element-dynamic-block-parser (limit affiliated) 803 "Parse a dynamic block. 804 805LIMIT bounds the search. AFFILIATED is a list of which CAR is 806the buffer position at the beginning of the first affiliated 807keyword and CDR is a plist of affiliated keywords along with 808their value. 809 810Return a list whose CAR is `dynamic-block' and CDR is a plist 811containing `:block-name', `:begin', `:end', `:contents-begin', 812`:contents-end', `:arguments', `:post-blank' and 813`:post-affiliated' keywords. 814 815Assume point is at beginning of dynamic block." 816 (let ((case-fold-search t)) 817 (if (not (save-excursion 818 (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) 819 ;; Incomplete block: parse it as a paragraph. 820 (org-element-paragraph-parser limit affiliated) 821 (let ((block-end-line (match-beginning 0))) 822 (save-excursion 823 (let* ((name (progn (looking-at org-dblock-start-re) 824 (match-string-no-properties 1))) 825 (arguments (match-string-no-properties 3)) 826 (begin (car affiliated)) 827 (post-affiliated (point)) 828 ;; Empty blocks have no contents. 829 (contents-begin (progn (forward-line) 830 (and (< (point) block-end-line) 831 (point)))) 832 (contents-end (and contents-begin block-end-line)) 833 (pos-before-blank (progn (goto-char block-end-line) 834 (forward-line) 835 (point))) 836 (end (progn (skip-chars-forward " \r\t\n" limit) 837 (if (eobp) (point) (line-beginning-position))))) 838 (list 'dynamic-block 839 (nconc 840 (list :begin begin 841 :end end 842 :block-name name 843 :arguments arguments 844 :contents-begin contents-begin 845 :contents-end contents-end 846 :post-blank (count-lines pos-before-blank end) 847 :post-affiliated post-affiliated) 848 (cdr affiliated))))))))) 849 850(defun org-element-dynamic-block-interpreter (dynamic-block contents) 851 "Interpret DYNAMIC-BLOCK element as Org syntax. 852CONTENTS is the contents of the element." 853 (format "#+begin: %s%s\n%s#+end:" 854 (org-element-property :block-name dynamic-block) 855 (let ((args (org-element-property :arguments dynamic-block))) 856 (if args (concat " " args) "")) 857 contents)) 858 859 860;;;; Footnote Definition 861 862(defconst org-element--footnote-separator 863 (concat org-outline-regexp-bol "\\|" 864 org-footnote-definition-re "\\|" 865 "^\\([ \t]*\n\\)\\{2,\\}") 866 "Regexp used as a footnote definition separator.") 867 868(defun org-element-footnote-definition-parser (limit affiliated) 869 "Parse a footnote definition. 870 871LIMIT bounds the search. AFFILIATED is a list of which CAR is 872the buffer position at the beginning of the first affiliated 873keyword and CDR is a plist of affiliated keywords along with 874their value. 875 876Return a list whose CAR is `footnote-definition' and CDR is 877a plist containing `:label', `:begin' `:end', `:contents-begin', 878`:contents-end', `:pre-blank',`:post-blank' and 879`:post-affiliated' keywords. 880 881Assume point is at the beginning of the footnote definition." 882 (save-excursion 883 (let* ((label (progn (looking-at org-footnote-definition-re) 884 (match-string-no-properties 1))) 885 (begin (car affiliated)) 886 (post-affiliated (point)) 887 (end 888 (save-excursion 889 (end-of-line) 890 (cond 891 ((not 892 (re-search-forward org-element--footnote-separator limit t)) 893 limit) 894 ((eq ?\[ (char-after (match-beginning 0))) 895 ;; At a new footnote definition, make sure we end 896 ;; before any affiliated keyword above. 897 (forward-line -1) 898 (while (and (> (point) post-affiliated) 899 (looking-at-p org-element--affiliated-re)) 900 (forward-line -1)) 901 (line-beginning-position 2)) 902 ((eq ?* (char-after (match-beginning 0))) (match-beginning 0)) 903 (t (skip-chars-forward " \r\t\n" limit) 904 (if (= limit (point)) limit (line-beginning-position)))))) 905 (pre-blank 0) 906 (contents-begin 907 (progn (search-forward "]") 908 (skip-chars-forward " \r\t\n" end) 909 (cond ((= (point) end) nil) 910 ((= (line-beginning-position) post-affiliated) (point)) 911 (t 912 (setq pre-blank 913 (count-lines (line-beginning-position) begin)) 914 (line-beginning-position))))) 915 (contents-end 916 (progn (goto-char end) 917 (skip-chars-backward " \r\t\n") 918 (line-beginning-position 2)))) 919 (list 'footnote-definition 920 (nconc 921 (list :label label 922 :begin begin 923 :end end 924 :contents-begin contents-begin 925 :contents-end (and contents-begin contents-end) 926 :pre-blank pre-blank 927 :post-blank (count-lines contents-end end) 928 :post-affiliated post-affiliated) 929 (cdr affiliated)))))) 930 931(defun org-element-footnote-definition-interpreter (footnote-definition contents) 932 "Interpret FOOTNOTE-DEFINITION element as Org syntax. 933CONTENTS is the contents of the footnote-definition." 934 (let ((pre-blank 935 (min (or (org-element-property :pre-blank footnote-definition) 936 ;; 0 is specific to paragraphs at the beginning of 937 ;; the footnote definition, so we use 1 as 938 ;; a fall-back value, which is more universal. 939 1) 940 ;; Footnote ends after more than two consecutive empty 941 ;; lines: limit ourselves to 2 newline characters. 942 2))) 943 (concat (format "[fn:%s]" (org-element-property :label footnote-definition)) 944 (if (= pre-blank 0) (concat " " (org-trim contents)) 945 (concat (make-string pre-blank ?\n) contents))))) 946 947 948;;;; Headline 949 950(defun org-element--get-node-properties () 951 "Return node properties associated to headline at point. 952Upcase property names. It avoids confusion between properties 953obtained through property drawer and default properties from the 954parser (e.g. `:end' and :END:). Return value is a plist." 955 (save-excursion 956 (forward-line) 957 (when (looking-at-p org-planning-line-re) (forward-line)) 958 (when (looking-at org-property-drawer-re) 959 (forward-line) 960 (let ((end (match-end 0)) properties) 961 (while (< (line-end-position) end) 962 (looking-at org-property-re) 963 (push (match-string-no-properties 3) properties) 964 (push (intern (concat ":" (upcase (match-string 2)))) properties) 965 (forward-line)) 966 properties)))) 967 968(defun org-element--get-time-properties () 969 "Return time properties associated to headline at point. 970Return value is a plist." 971 (save-excursion 972 (when (progn (forward-line) (looking-at org-planning-line-re)) 973 (let ((end (line-end-position)) plist) 974 (while (re-search-forward org-keyword-time-not-clock-regexp end t) 975 (goto-char (match-end 1)) 976 (skip-chars-forward " \t") 977 (let ((keyword (match-string 1)) 978 (time (org-element-timestamp-parser))) 979 (cond ((equal keyword org-scheduled-string) 980 (setq plist (plist-put plist :scheduled time))) 981 ((equal keyword org-deadline-string) 982 (setq plist (plist-put plist :deadline time))) 983 (t (setq plist (plist-put plist :closed time)))))) 984 plist)))) 985 986(defun org-element-headline-parser (limit &optional raw-secondary-p) 987 "Parse a headline. 988 989Return a list whose CAR is `headline' and CDR is a plist 990containing `:raw-value', `:title', `:begin', `:end', 991`:pre-blank', `:contents-begin' and `:contents-end', `:level', 992`:priority', `:tags', `:todo-keyword', `:todo-type', `:scheduled', 993`:deadline', `:closed', `:archivedp', `:commentedp' 994`:footnote-section-p', `:post-blank' and `:post-affiliated' 995keywords. 996 997The plist also contains any property set in the property drawer, 998with its name in upper cases and colons added at the 999beginning (e.g., `:CUSTOM_ID'). 1000 1001LIMIT is a buffer position bounding the search. 1002 1003When RAW-SECONDARY-P is non-nil, headline's title will not be 1004parsed as a secondary string, but as a plain string instead. 1005 1006Assume point is at beginning of the headline." 1007 (save-excursion 1008 (let* ((begin (point)) 1009 (level (prog1 (org-reduced-level (skip-chars-forward "*")) 1010 (skip-chars-forward " \t"))) 1011 (todo (and org-todo-regexp 1012 (let (case-fold-search) (looking-at (concat org-todo-regexp " "))) 1013 (progn (goto-char (match-end 0)) 1014 (skip-chars-forward " \t") 1015 (match-string 1)))) 1016 (todo-type 1017 (and todo (if (member todo org-done-keywords) 'done 'todo))) 1018 (priority (and (looking-at "\\[#.\\][ \t]*") 1019 (progn (goto-char (match-end 0)) 1020 (aref (match-string 0) 2)))) 1021 (commentedp 1022 (and (let (case-fold-search) (looking-at org-comment-string)) 1023 (goto-char (match-end 0)))) 1024 (title-start (prog1 (point) 1025 (unless (or todo priority commentedp) 1026 ;; Headline like "* :tag:" 1027 (skip-chars-backward " \t")))) 1028 (tags (when (re-search-forward 1029 "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" 1030 (line-end-position) 1031 'move) 1032 (goto-char (match-beginning 0)) 1033 (org-split-string (match-string 1) ":"))) 1034 (title-end (point)) 1035 (raw-value (org-trim 1036 (buffer-substring-no-properties title-start title-end))) 1037 (archivedp (member org-archive-tag tags)) 1038 (footnote-section-p (and org-footnote-section 1039 (string= org-footnote-section raw-value))) 1040 (standard-props (org-element--get-node-properties)) 1041 (time-props (org-element--get-time-properties)) 1042 (end (min (save-excursion (org-end-of-subtree t t)) limit)) 1043 (contents-begin (save-excursion 1044 (forward-line) 1045 (skip-chars-forward " \r\t\n" end) 1046 (and (/= (point) end) (line-beginning-position)))) 1047 (contents-end (and contents-begin 1048 (progn (goto-char end) 1049 (skip-chars-backward " \r\t\n") 1050 (line-beginning-position 2))))) 1051 (let ((headline 1052 (list 'headline 1053 (nconc 1054 (list :raw-value raw-value 1055 :begin begin 1056 :end end 1057 :pre-blank 1058 (if (not contents-begin) 0 1059 (1- (count-lines begin contents-begin))) 1060 :contents-begin contents-begin 1061 :contents-end contents-end 1062 :level level 1063 :priority priority 1064 :tags tags 1065 :todo-keyword todo 1066 :todo-type todo-type 1067 :post-blank 1068 (if contents-end 1069 (count-lines contents-end end) 1070 (1- (count-lines begin end))) 1071 :footnote-section-p footnote-section-p 1072 :archivedp archivedp 1073 :commentedp commentedp 1074 :post-affiliated begin) 1075 time-props 1076 standard-props)))) 1077 (org-element-put-property 1078 headline :title 1079 (if raw-secondary-p raw-value 1080 (org-element--parse-objects 1081 (progn (goto-char title-start) 1082 (skip-chars-forward " \t") 1083 (point)) 1084 (progn (goto-char title-end) 1085 (skip-chars-backward " \t") 1086 (point)) 1087 nil 1088 (org-element-restriction 'headline) 1089 headline))))))) 1090 1091(defun org-element-headline-interpreter (headline contents) 1092 "Interpret HEADLINE element as Org syntax. 1093CONTENTS is the contents of the element." 1094 (let* ((level (org-element-property :level headline)) 1095 (todo (org-element-property :todo-keyword headline)) 1096 (priority (org-element-property :priority headline)) 1097 (title (org-element-interpret-data 1098 (org-element-property :title headline))) 1099 (tags (let ((tag-list (org-element-property :tags headline))) 1100 (and tag-list 1101 (format ":%s:" (mapconcat #'identity tag-list ":"))))) 1102 (commentedp (org-element-property :commentedp headline)) 1103 (pre-blank (or (org-element-property :pre-blank headline) 0)) 1104 (heading 1105 (concat (make-string (if org-odd-levels-only (1- (* level 2)) level) 1106 ?*) 1107 (and todo (concat " " todo)) 1108 (and commentedp (concat " " org-comment-string)) 1109 (and priority (format " [#%c]" priority)) 1110 " " 1111 (if (and org-footnote-section 1112 (org-element-property :footnote-section-p headline)) 1113 org-footnote-section 1114 title)))) 1115 (concat 1116 heading 1117 ;; Align tags. 1118 (when tags 1119 (cond 1120 ((zerop org-tags-column) (format " %s" tags)) 1121 ((< org-tags-column 0) 1122 (concat 1123 (make-string 1124 (max (- (+ org-tags-column (length heading) (length tags))) 1) 1125 ?\s) 1126 tags)) 1127 (t 1128 (concat 1129 (make-string (max (- org-tags-column (length heading)) 1) ?\s) 1130 tags)))) 1131 (make-string (1+ pre-blank) ?\n) 1132 contents))) 1133 1134 1135;;;; Inlinetask 1136 1137(defun org-element-inlinetask-parser (limit &optional raw-secondary-p) 1138 "Parse an inline task. 1139 1140Return a list whose CAR is `inlinetask' and CDR is a plist 1141containing `:title', `:begin', `:end', `:pre-blank', 1142`:contents-begin' and `:contents-end', `:level', `:priority', 1143`:raw-value', `:tags', `:todo-keyword', `:todo-type', 1144`:scheduled', `:deadline', `:closed', `:post-blank' and 1145`:post-affiliated' keywords. 1146 1147The plist also contains any property set in the property drawer, 1148with its name in upper cases and colons added at the 1149beginning (e.g., `:CUSTOM_ID'). 1150 1151When optional argument RAW-SECONDARY-P is non-nil, inline-task's 1152title will not be parsed as a secondary string, but as a plain 1153string instead. 1154 1155Assume point is at beginning of the inline task." 1156 (save-excursion 1157 (let* ((begin (point)) 1158 (level (prog1 (org-reduced-level (skip-chars-forward "*")) 1159 (skip-chars-forward " \t"))) 1160 (todo (and org-todo-regexp 1161 (let (case-fold-search) (looking-at org-todo-regexp)) 1162 (progn (goto-char (match-end 0)) 1163 (skip-chars-forward " \t") 1164 (match-string 0)))) 1165 (todo-type (and todo 1166 (if (member todo org-done-keywords) 'done 'todo))) 1167 (priority (and (looking-at "\\[#.\\][ \t]*") 1168 (progn (goto-char (match-end 0)) 1169 (aref (match-string 0) 2)))) 1170 (title-start (point)) 1171 (tags (when (re-search-forward 1172 "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" 1173 (line-end-position) 1174 'move) 1175 (goto-char (match-beginning 0)) 1176 (org-split-string (match-string 1) ":"))) 1177 (title-end (point)) 1178 (raw-value (org-trim 1179 (buffer-substring-no-properties title-start title-end))) 1180 (task-end (save-excursion 1181 (end-of-line) 1182 (and (re-search-forward org-outline-regexp-bol limit t) 1183 (looking-at-p "[ \t]*END[ \t]*$") 1184 (line-beginning-position)))) 1185 (standard-props (and task-end (org-element--get-node-properties))) 1186 (time-props (and task-end (org-element--get-time-properties))) 1187 (contents-begin (and task-end 1188 (< (point) task-end) 1189 (progn 1190 (forward-line) 1191 (skip-chars-forward " \t\n") 1192 (line-beginning-position)))) 1193 (contents-end (and contents-begin task-end)) 1194 (end (progn (when task-end (goto-char task-end)) 1195 (forward-line) 1196 (skip-chars-forward " \r\t\n" limit) 1197 (if (eobp) (point) (line-beginning-position)))) 1198 (inlinetask 1199 (list 'inlinetask 1200 (nconc 1201 (list :raw-value raw-value 1202 :begin begin 1203 :end end 1204 :pre-blank 1205 (if (not contents-begin) 0 1206 (1- (count-lines begin contents-begin))) 1207 :contents-begin contents-begin 1208 :contents-end contents-end 1209 :level level 1210 :priority priority 1211 :tags tags 1212 :todo-keyword todo 1213 :todo-type todo-type 1214 :post-blank (1- (count-lines (or task-end begin) end)) 1215 :post-affiliated begin) 1216 time-props 1217 standard-props)))) 1218 (org-element-put-property 1219 inlinetask :title 1220 (if raw-secondary-p raw-value 1221 (org-element--parse-objects 1222 (progn (goto-char title-start) 1223 (skip-chars-forward " \t") 1224 (point)) 1225 (progn (goto-char title-end) 1226 (skip-chars-backward " \t") 1227 (point)) 1228 nil 1229 (org-element-restriction 'inlinetask) 1230 inlinetask)))))) 1231 1232(defun org-element-inlinetask-interpreter (inlinetask contents) 1233 "Interpret INLINETASK element as Org syntax. 1234CONTENTS is the contents of inlinetask." 1235 (let* ((level (org-element-property :level inlinetask)) 1236 (todo (org-element-property :todo-keyword inlinetask)) 1237 (priority (org-element-property :priority inlinetask)) 1238 (title (org-element-interpret-data 1239 (org-element-property :title inlinetask))) 1240 (tags (let ((tag-list (org-element-property :tags inlinetask))) 1241 (and tag-list 1242 (format ":%s:" (mapconcat 'identity tag-list ":"))))) 1243 (task (concat (make-string level ?*) 1244 (and todo (concat " " todo)) 1245 (and priority (format " [#%c]" priority)) 1246 (and title (concat " " title))))) 1247 (concat task 1248 ;; Align tags. 1249 (when tags 1250 (cond 1251 ((zerop org-tags-column) (format " %s" tags)) 1252 ((< org-tags-column 0) 1253 (concat 1254 (make-string 1255 (max (- (+ org-tags-column (length task) (length tags))) 1) 1256 ?\s) 1257 tags)) 1258 (t 1259 (concat 1260 (make-string (max (- org-tags-column (length task)) 1) ?\s) 1261 tags)))) 1262 ;; Prefer degenerate inlinetasks when there are no 1263 ;; contents. 1264 (when contents 1265 (concat "\n" 1266 contents 1267 (make-string level ?*) " end"))))) 1268 1269 1270;;;; Item 1271 1272(defun org-element-item-parser (_ struct &optional raw-secondary-p) 1273 "Parse an item. 1274 1275STRUCT is the structure of the plain list. 1276 1277Return a list whose CAR is `item' and CDR is a plist containing 1278`:bullet', `:begin', `:end', `:contents-begin', `:contents-end', 1279`:checkbox', `:counter', `:tag', `:structure', `:pre-blank', 1280`:post-blank' and `:post-affiliated' keywords. 1281 1282When optional argument RAW-SECONDARY-P is non-nil, item's tag, if 1283any, will not be parsed as a secondary string, but as a plain 1284string instead. 1285 1286Assume point is at the beginning of the item." 1287 (save-excursion 1288 (beginning-of-line) 1289 (looking-at org-list-full-item-re) 1290 (let* ((begin (point)) 1291 (bullet (match-string-no-properties 1)) 1292 (checkbox (let ((box (match-string 3))) 1293 (cond ((equal "[ ]" box) 'off) 1294 ((equal "[X]" box) 'on) 1295 ((equal "[-]" box) 'trans)))) 1296 (counter (let ((c (match-string 2))) 1297 (save-match-data 1298 (cond 1299 ((not c) nil) 1300 ((string-match "[A-Za-z]" c) 1301 (- (string-to-char (upcase (match-string 0 c))) 1302 64)) 1303 ((string-match "[0-9]+" c) 1304 (string-to-number (match-string 0 c))))))) 1305 (end (progn (goto-char (nth 6 (assq (point) struct))) 1306 (if (bolp) (point) (line-beginning-position 2)))) 1307 (pre-blank 0) 1308 (contents-begin 1309 (progn 1310 (goto-char 1311 ;; Ignore tags in un-ordered lists: they are just 1312 ;; a part of item's body. 1313 (if (and (match-beginning 4) 1314 (save-match-data (string-match "[.)]" bullet))) 1315 (match-beginning 4) 1316 (match-end 0))) 1317 (skip-chars-forward " \r\t\n" end) 1318 (cond ((= (point) end) nil) 1319 ;; If first line isn't empty, contents really 1320 ;; start at the text after item's meta-data. 1321 ((= (line-beginning-position) begin) (point)) 1322 (t 1323 (setq pre-blank 1324 (count-lines (line-beginning-position) begin)) 1325 (line-beginning-position))))) 1326 (contents-end (and contents-begin 1327 (progn (goto-char end) 1328 (skip-chars-backward " \r\t\n") 1329 (line-beginning-position 2)))) 1330 (item 1331 (list 'item 1332 (list :bullet bullet 1333 :begin begin 1334 :end end 1335 :contents-begin contents-begin 1336 :contents-end contents-end 1337 :checkbox checkbox 1338 :counter counter 1339 :structure struct 1340 :pre-blank pre-blank 1341 :post-blank (count-lines (or contents-end begin) end) 1342 :post-affiliated begin)))) 1343 (org-element-put-property 1344 item :tag 1345 (let ((raw (org-list-get-tag begin struct))) 1346 (when raw 1347 (if raw-secondary-p raw 1348 (org-element--parse-objects 1349 (match-beginning 4) (match-end 4) nil 1350 (org-element-restriction 'item) 1351 item)))))))) 1352 1353(defun org-element-item-interpreter (item contents) 1354 "Interpret ITEM element as Org syntax. 1355CONTENTS is the contents of the element." 1356 (let ((tag (pcase (org-element-property :tag item) 1357 (`nil nil) 1358 (tag (format "%s :: " (org-element-interpret-data tag))))) 1359 (bullet 1360 (org-list-bullet-string 1361 (cond 1362 ((not (string-match-p "[0-9a-zA-Z]" 1363 (org-element-property :bullet item))) "- ") 1364 ((eq org-plain-list-ordered-item-terminator ?\)) "1)") 1365 (t "1."))))) 1366 (concat 1367 bullet 1368 (pcase (org-element-property :counter item) 1369 (`nil nil) 1370 (counter (format "[@%d] " counter))) 1371 (pcase (org-element-property :checkbox item) 1372 (`on "[X] ") 1373 (`off "[ ] ") 1374 (`trans "[-] ") 1375 (_ nil)) 1376 tag 1377 (when contents 1378 (let* ((ind (make-string (if tag 5 (length bullet)) ?\s)) 1379 (pre-blank 1380 (min (or (org-element-property :pre-blank item) 1381 ;; 0 is specific to paragraphs at the 1382 ;; beginning of the item, so we use 1 as 1383 ;; a fall-back value, which is more universal. 1384 1) 1385 ;; Lists ends after more than two consecutive 1386 ;; empty lines: limit ourselves to 2 newline 1387 ;; characters. 1388 2)) 1389 (contents (replace-regexp-in-string 1390 "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) 1391 (if (= pre-blank 0) (org-trim contents) 1392 (concat (make-string pre-blank ?\n) contents))))))) 1393 1394 1395;;;; Plain List 1396 1397(defun org-element--list-struct (limit) 1398 ;; Return structure of list at point. Internal function. See 1399 ;; `org-list-struct' for details. 1400 (let ((case-fold-search t) 1401 (top-ind limit) 1402 (item-re (org-item-re)) 1403 (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ ")) 1404 items struct) 1405 (save-excursion 1406 (catch :exit 1407 (while t 1408 (cond 1409 ;; At limit: end all items. 1410 ((>= (point) limit) 1411 (let ((end (progn (skip-chars-backward " \r\t\n") 1412 (line-beginning-position 2)))) 1413 (dolist (item items) (setcar (nthcdr 6 item) end))) 1414 (throw :exit (sort (nconc items struct) #'car-less-than-car))) 1415 ;; At list end: end all items. 1416 ((looking-at org-list-end-re) 1417 (dolist (item items) (setcar (nthcdr 6 item) (point))) 1418 (throw :exit (sort (nconc items struct) #'car-less-than-car))) 1419 ;; At a new item: end previous sibling. 1420 ((looking-at item-re) 1421 (let ((ind (save-excursion (skip-chars-forward " \t") 1422 (current-column)))) 1423 (setq top-ind (min top-ind ind)) 1424 (while (and items (<= ind (nth 1 (car items)))) 1425 (let ((item (pop items))) 1426 (setcar (nthcdr 6 item) (point)) 1427 (push item struct))) 1428 (push (progn (looking-at org-list-full-item-re) 1429 (let ((bullet (match-string-no-properties 1))) 1430 (list (point) 1431 ind 1432 bullet 1433 (match-string-no-properties 2) ; counter 1434 (match-string-no-properties 3) ; checkbox 1435 ;; Description tag. 1436 (and (save-match-data 1437 (string-match "[-+*]" bullet)) 1438 (match-string-no-properties 4)) 1439 ;; Ending position, unknown so far. 1440 nil))) 1441 items)) 1442 (forward-line)) 1443 ;; Skip empty lines. 1444 ((looking-at "^[ \t]*$") (forward-line)) 1445 ;; Skip inline tasks and blank lines along the way. 1446 ((and inlinetask-re (looking-at inlinetask-re)) 1447 (forward-line) 1448 (let ((origin (point))) 1449 (when (re-search-forward inlinetask-re limit t) 1450 (if (looking-at-p "END[ \t]*$") (forward-line) 1451 (goto-char origin))))) 1452 ;; At some text line. Check if it ends any previous item. 1453 (t 1454 (let ((ind (save-excursion 1455 (skip-chars-forward " \t") 1456 (current-column))) 1457 (end (save-excursion 1458 (skip-chars-backward " \r\t\n") 1459 (line-beginning-position 2)))) 1460 (while (<= ind (nth 1 (car items))) 1461 (let ((item (pop items))) 1462 (setcar (nthcdr 6 item) end) 1463 (push item struct) 1464 (unless items 1465 (throw :exit (sort struct #'car-less-than-car)))))) 1466 ;; Skip blocks (any type) and drawers contents. 1467 (cond 1468 ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)") 1469 (re-search-forward 1470 (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1)) 1471 limit t))) 1472 ((and (looking-at org-drawer-regexp) 1473 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) 1474 (forward-line)))))))) 1475 1476(defun org-element-plain-list-parser (limit affiliated structure) 1477 "Parse a plain list. 1478 1479LIMIT bounds the search. AFFILIATED is a list of which CAR is 1480the buffer position at the beginning of the first affiliated 1481keyword and CDR is a plist of affiliated keywords along with 1482their value. STRUCTURE is the structure of the plain list being 1483parsed. 1484 1485Return a list whose CAR is `plain-list' and CDR is a plist 1486containing `:type', `:begin', `:end', `:contents-begin' and 1487`:contents-end', `:structure', `:post-blank' and 1488`:post-affiliated' keywords. 1489 1490Assume point is at the beginning of the list." 1491 (save-excursion 1492 (let* ((struct (or structure (org-element--list-struct limit))) 1493 (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) 1494 ((nth 5 (assq (point) struct)) 'descriptive) 1495 (t 'unordered))) 1496 (contents-begin (point)) 1497 (begin (car affiliated)) 1498 (contents-end (let* ((item (assq contents-begin struct)) 1499 (ind (nth 1 item)) 1500 (pos (nth 6 item))) 1501 (while (and (setq item (assq pos struct)) 1502 (= (nth 1 item) ind)) 1503 (setq pos (nth 6 item))) 1504 pos)) 1505 (end (progn (goto-char contents-end) 1506 (skip-chars-forward " \r\t\n" limit) 1507 (if (= (point) limit) limit (line-beginning-position))))) 1508 ;; Return value. 1509 (list 'plain-list 1510 (nconc 1511 (list :type type 1512 :begin begin 1513 :end end 1514 :contents-begin contents-begin 1515 :contents-end contents-end 1516 :structure struct 1517 :post-blank (count-lines contents-end end) 1518 :post-affiliated contents-begin) 1519 (cdr affiliated)))))) 1520 1521(defun org-element-plain-list-interpreter (_ contents) 1522 "Interpret plain-list element as Org syntax. 1523CONTENTS is the contents of the element." 1524 (with-temp-buffer 1525 (insert contents) 1526 (goto-char (point-min)) 1527 (org-list-repair) 1528 (buffer-string))) 1529 1530 1531;;;; Property Drawer 1532 1533(defun org-element-property-drawer-parser (limit) 1534 "Parse a property drawer. 1535 1536LIMIT bounds the search. 1537 1538Return a list whose car is `property-drawer' and cdr is a plist 1539containing `:begin', `:end', `:contents-begin', `:contents-end', 1540`:post-blank' and `:post-affiliated' keywords. 1541 1542Assume point is at the beginning of the property drawer." 1543 (save-excursion 1544 (let ((case-fold-search t) 1545 (begin (point)) 1546 (contents-begin (line-beginning-position 2))) 1547 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t) 1548 (let ((contents-end (and (> (match-beginning 0) contents-begin) 1549 (match-beginning 0))) 1550 (before-blank (progn (forward-line) (point))) 1551 (end (progn (skip-chars-forward " \r\t\n" limit) 1552 (if (eobp) (point) (line-beginning-position))))) 1553 (list 'property-drawer 1554 (list :begin begin 1555 :end end 1556 :contents-begin (and contents-end contents-begin) 1557 :contents-end contents-end 1558 :post-blank (count-lines before-blank end) 1559 :post-affiliated begin)))))) 1560 1561(defun org-element-property-drawer-interpreter (_ contents) 1562 "Interpret property-drawer element as Org syntax. 1563CONTENTS is the properties within the drawer." 1564 (format ":PROPERTIES:\n%s:END:" contents)) 1565 1566 1567;;;; Quote Block 1568 1569(defun org-element-quote-block-parser (limit affiliated) 1570 "Parse a quote block. 1571 1572LIMIT bounds the search. AFFILIATED is a list of which CAR is 1573the buffer position at the beginning of the first affiliated 1574keyword and CDR is a plist of affiliated keywords along with 1575their value. 1576 1577Return a list whose CAR is `quote-block' and CDR is a plist 1578containing `:begin', `:end', `:contents-begin', `:contents-end', 1579`:post-blank' and `:post-affiliated' keywords. 1580 1581Assume point is at the beginning of the block." 1582 (let ((case-fold-search t)) 1583 (if (not (save-excursion 1584 (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t))) 1585 ;; Incomplete block: parse it as a paragraph. 1586 (org-element-paragraph-parser limit affiliated) 1587 (let ((block-end-line (match-beginning 0))) 1588 (save-excursion 1589 (let* ((begin (car affiliated)) 1590 (post-affiliated (point)) 1591 ;; Empty blocks have no contents. 1592 (contents-begin (progn (forward-line) 1593 (and (< (point) block-end-line) 1594 (point)))) 1595 (contents-end (and contents-begin block-end-line)) 1596 (pos-before-blank (progn (goto-char block-end-line) 1597 (forward-line) 1598 (point))) 1599 (end (progn (skip-chars-forward " \r\t\n" limit) 1600 (if (eobp) (point) (line-beginning-position))))) 1601 (list 'quote-block 1602 (nconc 1603 (list :begin begin 1604 :end end 1605 :contents-begin contents-begin 1606 :contents-end contents-end 1607 :post-blank (count-lines pos-before-blank end) 1608 :post-affiliated post-affiliated) 1609 (cdr affiliated))))))))) 1610 1611(defun org-element-quote-block-interpreter (_ contents) 1612 "Interpret quote-block element as Org syntax. 1613CONTENTS is the contents of the element." 1614 (format "#+begin_quote\n%s#+end_quote" contents)) 1615 1616 1617;;;; Section 1618 1619(defun org-element-section-parser (_) 1620 "Parse a section. 1621 1622Return a list whose CAR is `section' and CDR is a plist 1623containing `:begin', `:end', `:contents-begin', `contents-end', 1624`:post-blank' and `:post-affiliated' keywords." 1625 (save-excursion 1626 ;; Beginning of section is the beginning of the first non-blank 1627 ;; line after previous headline. 1628 (let ((begin (point)) 1629 (end (progn (org-with-limited-levels (outline-next-heading)) 1630 (point))) 1631 (pos-before-blank (progn (skip-chars-backward " \r\t\n") 1632 (line-beginning-position 2)))) 1633 (list 'section 1634 (list :begin begin 1635 :end end 1636 :contents-begin begin 1637 :contents-end pos-before-blank 1638 :post-blank (count-lines pos-before-blank end) 1639 :post-affiliated begin))))) 1640 1641(defun org-element-section-interpreter (_ contents) 1642 "Interpret section element as Org syntax. 1643CONTENTS is the contents of the element." 1644 contents) 1645 1646 1647;;;; Special Block 1648 1649(defun org-element-special-block-parser (limit affiliated) 1650 "Parse a special block. 1651 1652LIMIT bounds the search. AFFILIATED is a list of which CAR is 1653the buffer position at the beginning of the first affiliated 1654keyword and CDR is a plist of affiliated keywords along with 1655their value. 1656 1657Return a list whose CAR is `special-block' and CDR is a plist 1658containing `:type', `:begin', `:end', `:contents-begin', 1659`:contents-end', `:post-blank' and `:post-affiliated' keywords. 1660 1661Assume point is at the beginning of the block." 1662 (let* ((case-fold-search t) 1663 (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") 1664 (match-string-no-properties 1)))) 1665 (if (not (save-excursion 1666 (re-search-forward 1667 (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) 1668 limit t))) 1669 ;; Incomplete block: parse it as a paragraph. 1670 (org-element-paragraph-parser limit affiliated) 1671 (let ((block-end-line (match-beginning 0))) 1672 (save-excursion 1673 (let* ((begin (car affiliated)) 1674 (post-affiliated (point)) 1675 ;; Empty blocks have no contents. 1676 (contents-begin (progn (forward-line) 1677 (and (< (point) block-end-line) 1678 (point)))) 1679 (contents-end (and contents-begin block-end-line)) 1680 (pos-before-blank (progn (goto-char block-end-line) 1681 (forward-line) 1682 (point))) 1683 (end (progn (skip-chars-forward " \r\t\n" limit) 1684 (if (eobp) (point) (line-beginning-position))))) 1685 (list 'special-block 1686 (nconc 1687 (list :type type 1688 :begin begin 1689 :end end 1690 :contents-begin contents-begin 1691 :contents-end contents-end 1692 :post-blank (count-lines pos-before-blank end) 1693 :post-affiliated post-affiliated) 1694 (cdr affiliated))))))))) 1695 1696(defun org-element-special-block-interpreter (special-block contents) 1697 "Interpret SPECIAL-BLOCK element as Org syntax. 1698CONTENTS is the contents of the element." 1699 (let ((block-type (org-element-property :type special-block))) 1700 (format "#+begin_%s\n%s#+end_%s" block-type contents block-type))) 1701 1702 1703 1704;;; Elements 1705;; 1706;; For each element, a parser and an interpreter are also defined. 1707;; Both follow the same naming convention used for greater elements. 1708;; 1709;; Also, as for greater elements, adding a new element type is done 1710;; through the following steps: implement a parser and an interpreter, 1711;; tweak `org-element--current-element' so that it recognizes the new 1712;; type and add that new type to `org-element-all-elements'. 1713 1714 1715;;;; Babel Call 1716 1717(defun org-element-babel-call-parser (limit affiliated) 1718 "Parse a babel call. 1719 1720LIMIT bounds the search. AFFILIATED is a list of which car is 1721the buffer position at the beginning of the first affiliated 1722keyword and cdr is a plist of affiliated keywords along with 1723their value. 1724 1725Return a list whose car is `babel-call' and cdr is a plist 1726containing `:call', `:inside-header', `:arguments', 1727`:end-header', `:begin', `:end', `:value', `:post-blank' and 1728`:post-affiliated' as keywords." 1729 (save-excursion 1730 (let* ((begin (car affiliated)) 1731 (post-affiliated (point)) 1732 (before-blank (line-beginning-position 2)) 1733 (value (progn (search-forward ":" before-blank t) 1734 (skip-chars-forward " \t") 1735 (org-trim 1736 (buffer-substring-no-properties 1737 (point) (line-end-position))))) 1738 (call 1739 (or (org-string-nw-p 1740 (buffer-substring-no-properties 1741 (point) (progn (skip-chars-forward "^[]()" before-blank) 1742 (point)))))) 1743 (inside-header (org-element--parse-paired-brackets ?\[)) 1744 (arguments (org-string-nw-p 1745 (org-element--parse-paired-brackets ?\())) 1746 (end-header 1747 (org-string-nw-p 1748 (org-trim 1749 (buffer-substring-no-properties (point) (line-end-position))))) 1750 (end (progn (forward-line) 1751 (skip-chars-forward " \r\t\n" limit) 1752 (if (eobp) (point) (line-beginning-position))))) 1753 (list 'babel-call 1754 (nconc 1755 (list :call call 1756 :inside-header inside-header 1757 :arguments arguments 1758 :end-header end-header 1759 :begin begin 1760 :end end 1761 :value value 1762 :post-blank (count-lines before-blank end) 1763 :post-affiliated post-affiliated) 1764 (cdr affiliated)))))) 1765 1766(defun org-element-babel-call-interpreter (babel-call _) 1767 "Interpret BABEL-CALL element as Org syntax." 1768 (concat "#+call: " 1769 (org-element-property :call babel-call) 1770 (let ((h (org-element-property :inside-header babel-call))) 1771 (and h (format "[%s]" h))) 1772 (concat "(" (org-element-property :arguments babel-call) ")") 1773 (let ((h (org-element-property :end-header babel-call))) 1774 (and h (concat " " h))))) 1775 1776 1777;;;; Clock 1778 1779(defun org-element-clock-parser (limit) 1780 "Parse a clock. 1781 1782LIMIT bounds the search. 1783 1784Return a list whose CAR is `clock' and CDR is a plist containing 1785`:status', `:value', `:time', `:begin', `:end', `:post-blank' and 1786`:post-affiliated' as keywords." 1787 (save-excursion 1788 (let* ((case-fold-search nil) 1789 (begin (point)) 1790 (value (progn (search-forward "CLOCK:" (line-end-position) t) 1791 (skip-chars-forward " \t") 1792 (org-element-timestamp-parser))) 1793 (duration (and (search-forward " => " (line-end-position) t) 1794 (progn (skip-chars-forward " \t") 1795 (looking-at "\\(\\S-+\\)[ \t]*$")) 1796 (match-string-no-properties 1))) 1797 (status (if duration 'closed 'running)) 1798 (post-blank (let ((before-blank (progn (forward-line) (point)))) 1799 (skip-chars-forward " \r\t\n" limit) 1800 (skip-chars-backward " \t") 1801 (unless (bolp) (end-of-line)) 1802 (count-lines before-blank (point)))) 1803 (end (point))) 1804 (list 'clock 1805 (list :status status 1806 :value value 1807 :duration duration 1808 :begin begin 1809 :end end 1810 :post-blank post-blank 1811 :post-affiliated begin))))) 1812 1813(defun org-element-clock-interpreter (clock _) 1814 "Interpret CLOCK element as Org syntax." 1815 (concat "CLOCK: " 1816 (org-element-timestamp-interpreter 1817 (org-element-property :value clock) nil) 1818 (let ((duration (org-element-property :duration clock))) 1819 (and duration 1820 (concat " => " 1821 (apply 'format 1822 "%2s:%02s" 1823 (org-split-string duration ":"))))))) 1824 1825 1826;;;; Comment 1827 1828(defun org-element-comment-parser (limit) 1829 "Parse a comment. 1830 1831LIMIT bounds the search. 1832 1833Return a list whose CAR is `comment' and CDR is a plist 1834containing `:begin', `:end', `:value', `:post-blank', 1835`:post-affiliated' keywords. 1836 1837Assume point is at comment beginning." 1838 (save-excursion 1839 (let* ((begin (point)) 1840 (value (prog2 (looking-at "[ \t]*# ?") 1841 (buffer-substring-no-properties 1842 (match-end 0) (line-end-position)) 1843 (forward-line))) 1844 (com-end 1845 ;; Get comments ending. 1846 (progn 1847 (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)")) 1848 ;; Accumulate lines without leading hash and first 1849 ;; whitespace. 1850 (setq value 1851 (concat value 1852 "\n" 1853 (buffer-substring-no-properties 1854 (match-end 0) (line-end-position)))) 1855 (forward-line)) 1856 (point))) 1857 (end (progn (goto-char com-end) 1858 (skip-chars-forward " \r\t\n" limit) 1859 (if (eobp) (point) (line-beginning-position))))) 1860 (list 'comment 1861 (list :begin begin 1862 :end end 1863 :value value 1864 :post-blank (count-lines com-end end) 1865 :post-affiliated begin))))) 1866 1867(defun org-element-comment-interpreter (comment _) 1868 "Interpret COMMENT element as Org syntax. 1869CONTENTS is nil." 1870 (replace-regexp-in-string "^" "# " (org-element-property :value comment))) 1871 1872 1873;;;; Comment Block 1874 1875(defun org-element-comment-block-parser (limit affiliated) 1876 "Parse an export block. 1877 1878LIMIT bounds the search. AFFILIATED is a list of which CAR is 1879the buffer position at the beginning of the first affiliated 1880keyword and CDR is a plist of affiliated keywords along with 1881their value. 1882 1883Return a list whose CAR is `comment-block' and CDR is a plist 1884containing `:begin', `:end', `:value', `:post-blank' and 1885`:post-affiliated' keywords. 1886 1887Assume point is at comment block beginning." 1888 (let ((case-fold-search t)) 1889 (if (not (save-excursion 1890 (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t))) 1891 ;; Incomplete block: parse it as a paragraph. 1892 (org-element-paragraph-parser limit affiliated) 1893 (let ((contents-end (match-beginning 0))) 1894 (save-excursion 1895 (let* ((begin (car affiliated)) 1896 (post-affiliated (point)) 1897 (contents-begin (progn (forward-line) (point))) 1898 (pos-before-blank (progn (goto-char contents-end) 1899 (forward-line) 1900 (point))) 1901 (end (progn (skip-chars-forward " \r\t\n" limit) 1902 (if (eobp) (point) (line-beginning-position)))) 1903 (value (buffer-substring-no-properties 1904 contents-begin contents-end))) 1905 (list 'comment-block 1906 (nconc 1907 (list :begin begin 1908 :end end 1909 :value value 1910 :post-blank (count-lines pos-before-blank end) 1911 :post-affiliated post-affiliated) 1912 (cdr affiliated))))))))) 1913 1914(defun org-element-comment-block-interpreter (comment-block _) 1915 "Interpret COMMENT-BLOCK element as Org syntax." 1916 (format "#+begin_comment\n%s#+end_comment" 1917 (org-element-normalize-string 1918 (org-remove-indentation 1919 (org-element-property :value comment-block))))) 1920 1921 1922;;;; Diary Sexp 1923 1924(defun org-element-diary-sexp-parser (limit affiliated) 1925 "Parse a diary sexp. 1926 1927LIMIT bounds the search. AFFILIATED is a list of which CAR is 1928the buffer position at the beginning of the first affiliated 1929keyword and CDR is a plist of affiliated keywords along with 1930their value. 1931 1932Return a list whose CAR is `diary-sexp' and CDR is a plist 1933containing `:begin', `:end', `:value', `:post-blank' and 1934`:post-affiliated' keywords." 1935 (save-excursion 1936 (let ((begin (car affiliated)) 1937 (post-affiliated (point)) 1938 (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") 1939 (match-string-no-properties 1))) 1940 (pos-before-blank (progn (forward-line) (point))) 1941 (end (progn (skip-chars-forward " \r\t\n" limit) 1942 (if (eobp) (point) (line-beginning-position))))) 1943 (list 'diary-sexp 1944 (nconc 1945 (list :value value 1946 :begin begin 1947 :end end 1948 :post-blank (count-lines pos-before-blank end) 1949 :post-affiliated post-affiliated) 1950 (cdr affiliated)))))) 1951 1952(defun org-element-diary-sexp-interpreter (diary-sexp _) 1953 "Interpret DIARY-SEXP as Org syntax." 1954 (org-element-property :value diary-sexp)) 1955 1956 1957;;;; Example Block 1958 1959(defun org-element-example-block-parser (limit affiliated) 1960 "Parse an example block. 1961 1962LIMIT bounds the search. AFFILIATED is a list of which CAR is 1963the buffer position at the beginning of the first affiliated 1964keyword and CDR is a plist of affiliated keywords along with 1965their value. 1966 1967Return a list whose CAR is `example-block' and CDR is a plist 1968containing `:begin', `:end', `:number-lines', `:preserve-indent', 1969`:retain-labels', `:use-labels', `:label-fmt', `:switches', 1970`:value', `:post-blank' and `:post-affiliated' keywords." 1971 (let ((case-fold-search t)) 1972 (if (not (save-excursion 1973 (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) 1974 ;; Incomplete block: parse it as a paragraph. 1975 (org-element-paragraph-parser limit affiliated) 1976 (let ((contents-end (match-beginning 0))) 1977 (save-excursion 1978 (let* ((switches 1979 (progn 1980 (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") 1981 (match-string-no-properties 1))) 1982 ;; Switches analysis. 1983 (number-lines 1984 (and switches 1985 (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" 1986 switches) 1987 (cons 1988 (if (equal (match-string 1 switches) "-") 1989 'new 1990 'continued) 1991 (if (not (match-end 2)) 0 1992 ;; Subtract 1 to give number of lines before 1993 ;; first line. 1994 (1- (string-to-number (match-string 2 switches))))))) 1995 (preserve-indent 1996 (and switches (string-match "-i\\>" switches))) 1997 ;; Should labels be retained in (or stripped from) example 1998 ;; blocks? 1999 (retain-labels 2000 (or (not switches) 2001 (not (string-match "-r\\>" switches)) 2002 (and number-lines (string-match "-k\\>" switches)))) 2003 ;; What should code-references use - labels or 2004 ;; line-numbers? 2005 (use-labels 2006 (or (not switches) 2007 (and retain-labels 2008 (not (string-match "-k\\>" switches))))) 2009 (label-fmt 2010 (and switches 2011 (string-match "-l +\"\\([^\"\n]+\\)\"" switches) 2012 (match-string 1 switches))) 2013 ;; Standard block parsing. 2014 (begin (car affiliated)) 2015 (post-affiliated (point)) 2016 (contents-begin (line-beginning-position 2)) 2017 (value (org-unescape-code-in-string 2018 (buffer-substring-no-properties 2019 contents-begin contents-end))) 2020 (pos-before-blank (progn (goto-char contents-end) 2021 (forward-line) 2022 (point))) 2023 (end (progn (skip-chars-forward " \r\t\n" limit) 2024 (if (eobp) (point) (line-beginning-position))))) 2025 (list 'example-block 2026 (nconc 2027 (list :begin begin 2028 :end end 2029 :value value 2030 :switches switches 2031 :number-lines number-lines 2032 :preserve-indent preserve-indent 2033 :retain-labels retain-labels 2034 :use-labels use-labels 2035 :label-fmt label-fmt 2036 :post-blank (count-lines pos-before-blank end) 2037 :post-affiliated post-affiliated) 2038 (cdr affiliated))))))))) 2039 2040(defun org-element-example-block-interpreter (example-block _) 2041 "Interpret EXAMPLE-BLOCK element as Org syntax." 2042 (let ((switches (org-element-property :switches example-block)) 2043 (value 2044 (let ((val (org-element-property :value example-block))) 2045 (cond 2046 ((or org-src-preserve-indentation 2047 (org-element-property :preserve-indent example-block)) 2048 val) 2049 ((= 0 org-edit-src-content-indentation) 2050 (org-remove-indentation val)) 2051 (t 2052 (let ((ind (make-string org-edit-src-content-indentation ?\s))) 2053 (replace-regexp-in-string "^[ \t]*\\S-" 2054 (concat ind "\\&") 2055 (org-remove-indentation val)))))))) 2056 (concat "#+begin_example" (and switches (concat " " switches)) "\n" 2057 (org-element-normalize-string (org-escape-code-in-string value)) 2058 "#+end_example"))) 2059 2060 2061;;;; Export Block 2062 2063(defun org-element-export-block-parser (limit affiliated) 2064 "Parse an export block. 2065 2066LIMIT bounds the search. AFFILIATED is a list of which CAR is 2067the buffer position at the beginning of the first affiliated 2068keyword and CDR is a plist of affiliated keywords along with 2069their value. 2070 2071Return a list whose CAR is `export-block' and CDR is a plist 2072containing `:begin', `:end', `:type', `:value', `:post-blank' and 2073`:post-affiliated' keywords. 2074 2075Assume point is at export-block beginning." 2076 (let* ((case-fold-search t)) 2077 (if (not (save-excursion 2078 (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t))) 2079 ;; Incomplete block: parse it as a paragraph. 2080 (org-element-paragraph-parser limit affiliated) 2081 (save-excursion 2082 (let* ((contents-end (match-beginning 0)) 2083 (backend 2084 (progn 2085 (looking-at 2086 "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$") 2087 (match-string-no-properties 1))) 2088 (begin (car affiliated)) 2089 (post-affiliated (point)) 2090 (contents-begin (progn (forward-line) (point))) 2091 (pos-before-blank (progn (goto-char contents-end) 2092 (forward-line) 2093 (point))) 2094 (end (progn (skip-chars-forward " \r\t\n" limit) 2095 (if (eobp) (point) (line-beginning-position)))) 2096 (value (org-unescape-code-in-string 2097 (buffer-substring-no-properties contents-begin 2098 contents-end)))) 2099 (list 'export-block 2100 (nconc 2101 (list :type (and backend (upcase backend)) 2102 :begin begin 2103 :end end 2104 :value value 2105 :post-blank (count-lines pos-before-blank end) 2106 :post-affiliated post-affiliated) 2107 (cdr affiliated)))))))) 2108 2109(defun org-element-export-block-interpreter (export-block _) 2110 "Interpret EXPORT-BLOCK element as Org syntax." 2111 (format "#+begin_export %s\n%s#+end_export" 2112 (org-element-property :type export-block) 2113 (org-element-property :value export-block))) 2114 2115 2116;;;; Fixed-width 2117 2118(defun org-element-fixed-width-parser (limit affiliated) 2119 "Parse a fixed-width section. 2120 2121LIMIT bounds the search. AFFILIATED is a list of which CAR is 2122the buffer position at the beginning of the first affiliated 2123keyword and CDR is a plist of affiliated keywords along with 2124their value. 2125 2126Return a list whose CAR is `fixed-width' and CDR is a plist 2127containing `:begin', `:end', `:value', `:post-blank' and 2128`:post-affiliated' keywords. 2129 2130Assume point is at the beginning of the fixed-width area." 2131 (save-excursion 2132 (let* ((begin (car affiliated)) 2133 (post-affiliated (point)) 2134 (end-area 2135 (progn 2136 (while (and (< (point) limit) 2137 (looking-at "[ \t]*:\\( \\|$\\)")) 2138 (forward-line)) 2139 (if (bolp) (line-end-position 0) (point)))) 2140 (end (progn (skip-chars-forward " \r\t\n" limit) 2141 (if (eobp) (point) (line-beginning-position))))) 2142 (list 'fixed-width 2143 (nconc 2144 (list :begin begin 2145 :end end 2146 :value (replace-regexp-in-string 2147 "^[ \t]*: ?" "" 2148 (buffer-substring-no-properties post-affiliated 2149 end-area)) 2150 :post-blank (count-lines end-area end) 2151 :post-affiliated post-affiliated) 2152 (cdr affiliated)))))) 2153 2154(defun org-element-fixed-width-interpreter (fixed-width _) 2155 "Interpret FIXED-WIDTH element as Org syntax." 2156 (let ((value (org-element-property :value fixed-width))) 2157 (and value (replace-regexp-in-string "^" ": " value)))) 2158 2159 2160;;;; Horizontal Rule 2161 2162(defun org-element-horizontal-rule-parser (limit affiliated) 2163 "Parse an horizontal rule. 2164 2165LIMIT bounds the search. AFFILIATED is a list of which CAR is 2166the buffer position at the beginning of the first affiliated 2167keyword and CDR is a plist of affiliated keywords along with 2168their value. 2169 2170Return a list whose CAR is `horizontal-rule' and CDR is a plist 2171containing `:begin', `:end', `:post-blank' and `:post-affiliated' 2172keywords." 2173 (save-excursion 2174 (let ((begin (car affiliated)) 2175 (post-affiliated (point)) 2176 (post-hr (progn (forward-line) (point))) 2177 (end (progn (skip-chars-forward " \r\t\n" limit) 2178 (if (eobp) (point) (line-beginning-position))))) 2179 (list 'horizontal-rule 2180 (nconc 2181 (list :begin begin 2182 :end end 2183 :post-blank (count-lines post-hr end) 2184 :post-affiliated post-affiliated) 2185 (cdr affiliated)))))) 2186 2187(defun org-element-horizontal-rule-interpreter (&rest _) 2188 "Interpret HORIZONTAL-RULE element as Org syntax." 2189 "-----") 2190 2191 2192;;;; Keyword 2193 2194(defun org-element-keyword-parser (limit affiliated) 2195 "Parse a keyword at point. 2196 2197LIMIT bounds the search. AFFILIATED is a list of which CAR is 2198the buffer position at the beginning of the first affiliated 2199keyword and CDR is a plist of affiliated keywords along with 2200their value. 2201 2202Return a list whose CAR is a normalized `keyword' (uppercase) and 2203CDR is a plist containing `:key', `:value', `:begin', `:end', 2204`:post-blank' and `:post-affiliated' keywords." 2205 (save-excursion 2206 ;; An orphaned affiliated keyword is considered as a regular 2207 ;; keyword. In this case AFFILIATED is nil, so we take care of 2208 ;; this corner case. 2209 (let ((begin (or (car affiliated) (point))) 2210 (post-affiliated (point)) 2211 (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):") 2212 (upcase (match-string-no-properties 1)))) 2213 (value (org-trim (buffer-substring-no-properties 2214 (match-end 0) (point-at-eol)))) 2215 (pos-before-blank (progn (forward-line) (point))) 2216 (end (progn (skip-chars-forward " \r\t\n" limit) 2217 (if (eobp) (point) (line-beginning-position))))) 2218 (list 'keyword 2219 (nconc 2220 (list :key key 2221 :value value 2222 :begin begin 2223 :end end 2224 :post-blank (count-lines pos-before-blank end) 2225 :post-affiliated post-affiliated) 2226 (cdr affiliated)))))) 2227 2228(defun org-element-keyword-interpreter (keyword _) 2229 "Interpret KEYWORD element as Org syntax." 2230 (format "#+%s: %s" 2231 (downcase (org-element-property :key keyword)) 2232 (org-element-property :value keyword))) 2233 2234 2235;;;; Latex Environment 2236 2237(defconst org-element--latex-begin-environment 2238 "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}" 2239 "Regexp matching the beginning of a LaTeX environment. 2240The environment is captured by the first group. 2241 2242See also `org-element--latex-end-environment'.") 2243 2244(defconst org-element--latex-end-environment 2245 "\\\\end{%s}[ \t]*$" 2246 "Format string matching the ending of a LaTeX environment. 2247See also `org-element--latex-begin-environment'.") 2248 2249(defun org-element-latex-environment-parser (limit affiliated) 2250 "Parse a LaTeX environment. 2251 2252LIMIT bounds the search. AFFILIATED is a list of which CAR is 2253the buffer position at the beginning of the first affiliated 2254keyword and CDR is a plist of affiliated keywords along with 2255their value. 2256 2257Return a list whose CAR is `latex-environment' and CDR is a plist 2258containing `:begin', `:end', `:value', `:post-blank' and 2259`:post-affiliated' keywords. 2260 2261Assume point is at the beginning of the latex environment." 2262 (save-excursion 2263 (let ((case-fold-search t) 2264 (code-begin (point))) 2265 (looking-at org-element--latex-begin-environment) 2266 (if (not (re-search-forward (format org-element--latex-end-environment 2267 (regexp-quote (match-string 1))) 2268 limit t)) 2269 ;; Incomplete latex environment: parse it as a paragraph. 2270 (org-element-paragraph-parser limit affiliated) 2271 (let* ((code-end (progn (forward-line) (point))) 2272 (begin (car affiliated)) 2273 (value (buffer-substring-no-properties code-begin code-end)) 2274 (end (progn (skip-chars-forward " \r\t\n" limit) 2275 (if (eobp) (point) (line-beginning-position))))) 2276 (list 'latex-environment 2277 (nconc 2278 (list :begin begin 2279 :end end 2280 :value value 2281 :post-blank (count-lines code-end end) 2282 :post-affiliated code-begin) 2283 (cdr affiliated)))))))) 2284 2285(defun org-element-latex-environment-interpreter (latex-environment _) 2286 "Interpret LATEX-ENVIRONMENT element as Org syntax." 2287 (org-element-property :value latex-environment)) 2288 2289 2290;;;; Node Property 2291 2292(defun org-element-node-property-parser (limit) 2293 "Parse a node-property at point. 2294 2295LIMIT bounds the search. 2296 2297Return a list whose CAR is `node-property' and CDR is a plist 2298containing `:key', `:value', `:begin', `:end', `:post-blank' and 2299`:post-affiliated' keywords." 2300 (looking-at org-property-re) 2301 (let ((case-fold-search t) 2302 (begin (point)) 2303 (key (match-string-no-properties 2)) 2304 (value (match-string-no-properties 3)) 2305 (end (save-excursion 2306 (end-of-line) 2307 (if (re-search-forward org-property-re limit t) 2308 (line-beginning-position) 2309 limit)))) 2310 (list 'node-property 2311 (list :key key 2312 :value value 2313 :begin begin 2314 :end end 2315 :post-blank 0 2316 :post-affiliated begin)))) 2317 2318(defun org-element-node-property-interpreter (node-property _) 2319 "Interpret NODE-PROPERTY element as Org syntax." 2320 (format org-property-format 2321 (format ":%s:" (org-element-property :key node-property)) 2322 (or (org-element-property :value node-property) ""))) 2323 2324 2325;;;; Paragraph 2326 2327(defun org-element-paragraph-parser (limit affiliated) 2328 "Parse a paragraph. 2329 2330LIMIT bounds the search. AFFILIATED is a list of which CAR is 2331the buffer position at the beginning of the first affiliated 2332keyword and CDR is a plist of affiliated keywords along with 2333their value. 2334 2335Return a list whose CAR is `paragraph' and CDR is a plist 2336containing `:begin', `:end', `:contents-begin' and 2337`:contents-end', `:post-blank' and `:post-affiliated' keywords. 2338 2339Assume point is at the beginning of the paragraph." 2340 (save-excursion 2341 (let* ((begin (car affiliated)) 2342 (contents-begin (point)) 2343 (before-blank 2344 (let ((case-fold-search t)) 2345 (end-of-line) 2346 ;; A matching `org-element-paragraph-separate' is not 2347 ;; necessarily the end of the paragraph. In particular, 2348 ;; drawers, blocks or LaTeX environments opening lines 2349 ;; must be closed. Moreover keywords with a secondary 2350 ;; value must belong to "dual keywords". 2351 (while (not 2352 (cond 2353 ((not (and (re-search-forward 2354 org-element-paragraph-separate limit 'move) 2355 (progn (beginning-of-line) t)))) 2356 ((looking-at org-drawer-regexp) 2357 (save-excursion 2358 (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) 2359 ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") 2360 (save-excursion 2361 (re-search-forward 2362 (format "^[ \t]*#\\+END_%s[ \t]*$" 2363 (regexp-quote (match-string 1))) 2364 limit t))) 2365 ((looking-at org-element--latex-begin-environment) 2366 (save-excursion 2367 (re-search-forward 2368 (format org-element--latex-end-environment 2369 (regexp-quote (match-string 1))) 2370 limit t))) 2371 ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:") 2372 (member-ignore-case (match-string 1) 2373 org-element-dual-keywords)) 2374 ;; Everything else is unambiguous. 2375 (t))) 2376 (end-of-line)) 2377 (if (= (point) limit) limit 2378 (goto-char (line-beginning-position))))) 2379 (contents-end (save-excursion 2380 (skip-chars-backward " \r\t\n" contents-begin) 2381 (line-beginning-position 2))) 2382 (end (progn (skip-chars-forward " \r\t\n" limit) 2383 (if (eobp) (point) (line-beginning-position))))) 2384 (list 'paragraph 2385 (nconc 2386 (list :begin begin 2387 :end end 2388 :contents-begin contents-begin 2389 :contents-end contents-end 2390 :post-blank (count-lines before-blank end) 2391 :post-affiliated contents-begin) 2392 (cdr affiliated)))))) 2393 2394(defun org-element-paragraph-interpreter (_ contents) 2395 "Interpret paragraph element as Org syntax. 2396CONTENTS is the contents of the element." 2397 contents) 2398 2399 2400;;;; Planning 2401 2402(defun org-element-planning-parser (limit) 2403 "Parse a planning. 2404 2405LIMIT bounds the search. 2406 2407Return a list whose CAR is `planning' and CDR is a plist 2408containing `:closed', `:deadline', `:scheduled', `:begin', 2409`:end', `:post-blank' and `:post-affiliated' keywords." 2410 (save-excursion 2411 (let* ((case-fold-search nil) 2412 (begin (point)) 2413 (post-blank (let ((before-blank (progn (forward-line) (point)))) 2414 (skip-chars-forward " \r\t\n" limit) 2415 (skip-chars-backward " \t") 2416 (unless (bolp) (end-of-line)) 2417 (count-lines before-blank (point)))) 2418 (end (point)) 2419 closed deadline scheduled) 2420 (goto-char begin) 2421 (while (re-search-forward org-keyword-time-not-clock-regexp end t) 2422 (goto-char (match-end 1)) 2423 (skip-chars-forward " \t" end) 2424 (let ((keyword (match-string 1)) 2425 (time (org-element-timestamp-parser))) 2426 (cond ((equal keyword org-closed-string) (setq closed time)) 2427 ((equal keyword org-deadline-string) (setq deadline time)) 2428 (t (setq scheduled time))))) 2429 (list 'planning 2430 (list :closed closed 2431 :deadline deadline 2432 :scheduled scheduled 2433 :begin begin 2434 :end end 2435 :post-blank post-blank 2436 :post-affiliated begin))))) 2437 2438(defun org-element-planning-interpreter (planning _) 2439 "Interpret PLANNING element as Org syntax." 2440 (mapconcat 2441 #'identity 2442 (delq nil 2443 (list (let ((deadline (org-element-property :deadline planning))) 2444 (when deadline 2445 (concat org-deadline-string " " 2446 (org-element-timestamp-interpreter deadline nil)))) 2447 (let ((scheduled (org-element-property :scheduled planning))) 2448 (when scheduled 2449 (concat org-scheduled-string " " 2450 (org-element-timestamp-interpreter scheduled nil)))) 2451 (let ((closed (org-element-property :closed planning))) 2452 (when closed 2453 (concat org-closed-string " " 2454 (org-element-timestamp-interpreter closed nil)))))) 2455 " ")) 2456 2457 2458;;;; Src Block 2459 2460(defun org-element-src-block-parser (limit affiliated) 2461 "Parse a source block. 2462 2463LIMIT bounds the search. AFFILIATED is a list of which CAR is 2464the buffer position at the beginning of the first affiliated 2465keyword and CDR is a plist of affiliated keywords along with 2466their value. 2467 2468Return a list whose CAR is `src-block' and CDR is a plist 2469containing `:language', `:switches', `:parameters', `:begin', 2470`:end', `:number-lines', `:retain-labels', `:use-labels', 2471`:label-fmt', `:preserve-indent', `:value', `:post-blank' and 2472`:post-affiliated' keywords. 2473 2474Assume point is at the beginning of the block." 2475 (let ((case-fold-search t)) 2476 (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$" 2477 limit t))) 2478 ;; Incomplete block: parse it as a paragraph. 2479 (org-element-paragraph-parser limit affiliated) 2480 (let ((contents-end (match-beginning 0))) 2481 (save-excursion 2482 (let* ((begin (car affiliated)) 2483 (post-affiliated (point)) 2484 ;; Get language as a string. 2485 (language 2486 (progn 2487 (looking-at 2488 "^[ \t]*#\\+BEGIN_SRC\ 2489\\(?: +\\(\\S-+\\)\\)?\ 2490\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\ 2491\\(.*\\)[ \t]*$") 2492 (match-string-no-properties 1))) 2493 ;; Get switches. 2494 (switches (match-string-no-properties 2)) 2495 ;; Get parameters. 2496 (parameters (match-string-no-properties 3)) 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 (and switches 2511 (string-match "-i\\>" switches))) 2512 (label-fmt 2513 (and switches 2514 (string-match "-l +\"\\([^\"\n]+\\)\"" switches) 2515 (match-string 1 switches))) 2516 ;; Should labels be retained in (or stripped from) 2517 ;; source blocks? 2518 (retain-labels 2519 (or (not switches) 2520 (not (string-match "-r\\>" switches)) 2521 (and number-lines (string-match "-k\\>" switches)))) 2522 ;; What should code-references use - labels or 2523 ;; line-numbers? 2524 (use-labels 2525 (or (not switches) 2526 (and retain-labels 2527 (not (string-match "-k\\>" switches))))) 2528 ;; Retrieve code. 2529 (value (org-unescape-code-in-string 2530 (buffer-substring-no-properties 2531 (line-beginning-position 2) contents-end))) 2532 (pos-before-blank (progn (goto-char contents-end) 2533 (forward-line) 2534 (point))) 2535 ;; Get position after ending blank lines. 2536 (end (progn (skip-chars-forward " \r\t\n" limit) 2537 (if (eobp) (point) (line-beginning-position))))) 2538 (list 'src-block 2539 (nconc 2540 (list :language language 2541 :switches (and (org-string-nw-p switches) 2542 (org-trim switches)) 2543 :parameters (and (org-string-nw-p parameters) 2544 (org-trim parameters)) 2545 :begin begin 2546 :end end 2547 :number-lines number-lines 2548 :preserve-indent preserve-indent 2549 :retain-labels retain-labels 2550 :use-labels use-labels 2551 :label-fmt label-fmt 2552 :value value 2553 :post-blank (count-lines pos-before-blank end) 2554 :post-affiliated post-affiliated) 2555 (cdr affiliated))))))))) 2556 2557(defun org-element-src-block-interpreter (src-block _) 2558 "Interpret SRC-BLOCK element as Org syntax." 2559 (let ((lang (org-element-property :language src-block)) 2560 (switches (org-element-property :switches src-block)) 2561 (params (org-element-property :parameters src-block)) 2562 (value 2563 (let ((val (org-element-property :value src-block))) 2564 (cond 2565 ((or org-src-preserve-indentation 2566 (org-element-property :preserve-indent src-block)) 2567 val) 2568 ((zerop org-edit-src-content-indentation) 2569 (org-remove-indentation val)) 2570 (t 2571 (let ((ind (make-string org-edit-src-content-indentation ?\s))) 2572 (replace-regexp-in-string "^[ \t]*\\S-" 2573 (concat ind "\\&") 2574 (org-remove-indentation val)))))))) 2575 (format "#+begin_src%s\n%s#+end_src" 2576 (concat (and lang (concat " " lang)) 2577 (and switches (concat " " switches)) 2578 (and params (concat " " params))) 2579 (org-element-normalize-string (org-escape-code-in-string value))))) 2580 2581 2582;;;; Table 2583 2584(defun org-element-table-parser (limit affiliated) 2585 "Parse a table at point. 2586 2587LIMIT bounds the search. AFFILIATED is a list of which CAR is 2588the buffer position at the beginning of the first affiliated 2589keyword and CDR is a plist of affiliated keywords along with 2590their value. 2591 2592Return a list whose CAR is `table' and CDR is a plist containing 2593`:begin', `:end', `:tblfm', `:type', `:contents-begin', 2594`:contents-end', `:value', `:post-blank' and `:post-affiliated' 2595keywords. 2596 2597Assume point is at the beginning of the table." 2598 (save-excursion 2599 (let* ((case-fold-search t) 2600 (table-begin (point)) 2601 (type (if (looking-at "[ \t]*|") 'org 'table.el)) 2602 (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)" 2603 (if (eq type 'org) "" "+"))) 2604 (begin (car affiliated)) 2605 (table-end 2606 (if (re-search-forward end-re limit 'move) 2607 (goto-char (match-beginning 0)) 2608 (point))) 2609 (tblfm (let (acc) 2610 (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") 2611 (push (match-string-no-properties 1) acc) 2612 (forward-line)) 2613 acc)) 2614 (pos-before-blank (point)) 2615 (end (progn (skip-chars-forward " \r\t\n" limit) 2616 (if (eobp) (point) (line-beginning-position))))) 2617 (list 'table 2618 (nconc 2619 (list :begin begin 2620 :end end 2621 :type type 2622 :tblfm tblfm 2623 ;; Only `org' tables have contents. `table.el' tables 2624 ;; use a `:value' property to store raw table as 2625 ;; a string. 2626 :contents-begin (and (eq type 'org) table-begin) 2627 :contents-end (and (eq type 'org) table-end) 2628 :value (and (eq type 'table.el) 2629 (buffer-substring-no-properties 2630 table-begin table-end)) 2631 :post-blank (count-lines pos-before-blank end) 2632 :post-affiliated table-begin) 2633 (cdr affiliated)))))) 2634 2635(defun org-element-table-interpreter (table contents) 2636 "Interpret TABLE element as Org syntax. 2637CONTENTS is a string, if table's type is `org', or nil." 2638 (if (eq (org-element-property :type table) 'table.el) 2639 (org-remove-indentation (org-element-property :value table)) 2640 (concat (with-temp-buffer (insert contents) 2641 (org-table-align) 2642 (buffer-string)) 2643 (mapconcat (lambda (fm) (concat "#+TBLFM: " fm)) 2644 (reverse (org-element-property :tblfm table)) 2645 "\n")))) 2646 2647 2648;;;; Table Row 2649 2650(defun org-element-table-row-parser (_) 2651 "Parse table row at point. 2652 2653Return a list whose CAR is `table-row' and CDR is a plist 2654containing `:begin', `:end', `:contents-begin', `:contents-end', 2655`:type', `:post-blank' and `:post-affiliated' keywords." 2656 (save-excursion 2657 (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) 2658 (begin (point)) 2659 ;; A table rule has no contents. In that case, ensure 2660 ;; CONTENTS-BEGIN matches CONTENTS-END. 2661 (contents-begin (and (eq type 'standard) (search-forward "|"))) 2662 (contents-end (and (eq type 'standard) 2663 (progn 2664 (end-of-line) 2665 (skip-chars-backward " \t") 2666 (point)))) 2667 (end (line-beginning-position 2))) 2668 (list 'table-row 2669 (list :type type 2670 :begin begin 2671 :end end 2672 :contents-begin contents-begin 2673 :contents-end contents-end 2674 :post-blank 0 2675 :post-affiliated begin))))) 2676 2677(defun org-element-table-row-interpreter (table-row contents) 2678 "Interpret TABLE-ROW element as Org syntax. 2679CONTENTS is the contents of the table row." 2680 (if (eq (org-element-property :type table-row) 'rule) "|-" 2681 (concat "|" contents))) 2682 2683 2684;;;; Verse Block 2685 2686(defun org-element-verse-block-parser (limit affiliated) 2687 "Parse a verse block. 2688 2689LIMIT bounds the search. AFFILIATED is a list of which CAR is 2690the buffer position at the beginning of the first affiliated 2691keyword and CDR is a plist of affiliated keywords along with 2692their value. 2693 2694Return a list whose CAR is `verse-block' and CDR is a plist 2695containing `:begin', `:end', `:contents-begin', `:contents-end', 2696`:post-blank' and `:post-affiliated' keywords. 2697 2698Assume point is at beginning of the block." 2699 (let ((case-fold-search t)) 2700 (if (not (save-excursion 2701 (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t))) 2702 ;; Incomplete block: parse it as a paragraph. 2703 (org-element-paragraph-parser limit affiliated) 2704 (let ((contents-end (match-beginning 0))) 2705 (save-excursion 2706 (let* ((begin (car affiliated)) 2707 (post-affiliated (point)) 2708 (contents-begin (progn (forward-line) (point))) 2709 (pos-before-blank (progn (goto-char contents-end) 2710 (forward-line) 2711 (point))) 2712 (end (progn (skip-chars-forward " \r\t\n" limit) 2713 (if (eobp) (point) (line-beginning-position))))) 2714 (list 'verse-block 2715 (nconc 2716 (list :begin begin 2717 :end end 2718 :contents-begin contents-begin 2719 :contents-end contents-end 2720 :post-blank (count-lines pos-before-blank end) 2721 :post-affiliated post-affiliated) 2722 (cdr affiliated))))))))) 2723 2724(defun org-element-verse-block-interpreter (_ contents) 2725 "Interpret verse-block element as Org syntax. 2726CONTENTS is verse block contents." 2727 (format "#+begin_verse\n%s#+end_verse" contents)) 2728 2729 2730 2731;;; Objects 2732;; 2733;; Unlike to elements, raw text can be found between objects. Hence, 2734;; `org-element--object-lex' is provided to find the next object in 2735;; buffer. 2736;; 2737;; Some object types (e.g., `italic') are recursive. Restrictions on 2738;; object types they can contain will be specified in 2739;; `org-element-object-restrictions'. 2740;; 2741;; Creating a new type of object requires to alter 2742;; `org-element--object-regexp' and `org-element--object-lex', add the 2743;; new type in `org-element-all-objects', and possibly add 2744;; restrictions in `org-element-object-restrictions'. 2745 2746;;;; Bold 2747 2748(defun org-element-bold-parser () 2749 "Parse bold object at point, if any. 2750 2751When at a bold object, return a list whose car is `bold' and cdr 2752is a plist with `:begin', `:end', `:contents-begin' and 2753`:contents-end' and `:post-blank' keywords. Otherwise, return 2754nil. 2755 2756Assume point is at the first star marker." 2757 (save-excursion 2758 (unless (bolp) (backward-char 1)) 2759 (when (looking-at org-emph-re) 2760 (let ((begin (match-beginning 2)) 2761 (contents-begin (match-beginning 4)) 2762 (contents-end (match-end 4)) 2763 (post-blank (progn (goto-char (match-end 2)) 2764 (skip-chars-forward " \t"))) 2765 (end (point))) 2766 (list 'bold 2767 (list :begin begin 2768 :end end 2769 :contents-begin contents-begin 2770 :contents-end contents-end 2771 :post-blank post-blank)))))) 2772 2773(defun org-element-bold-interpreter (_ contents) 2774 "Interpret bold object as Org syntax. 2775CONTENTS is the contents of the object." 2776 (format "*%s*" contents)) 2777 2778 2779;;;; Citation 2780 2781(defun org-element-citation-parser () 2782 "Parse citation object at point, if any. 2783 2784When at a citation object, return a list whose car is `citation' 2785and cdr is a plist with `:style', `:prefix', `:suffix', `:begin', 2786`:end', `:contents-begin', `:contents-end', and `:post-blank' 2787keywords. Otherwise, return nil. 2788 2789Assume point is at the beginning of the citation." 2790 (when (looking-at org-element-citation-prefix-re) 2791 (let* ((begin (point)) 2792 (style (and (match-end 1) 2793 (match-string-no-properties 1))) 2794 ;; Ignore blanks between cite type and prefix or key. 2795 (start (match-end 0)) 2796 (closing (with-syntax-table org-element--pair-square-table 2797 (ignore-errors (scan-lists begin 1 0))))) 2798 (save-excursion 2799 (when (and closing 2800 (re-search-forward org-element-citation-key-re closing t)) 2801 ;; Find prefix, if any. 2802 (let ((first-key-end (match-end 0)) 2803 (types (org-element-restriction 'citation-reference)) 2804 (cite 2805 (list 'citation 2806 (list :style style 2807 :begin begin 2808 :post-blank (progn 2809 (goto-char closing) 2810 (skip-chars-forward " \t")) 2811 :end (point))))) 2812 ;; `:contents-begin' depends on the presence of 2813 ;; a non-empty common prefix. 2814 (goto-char first-key-end) 2815 (if (not (search-backward ";" start t)) 2816 (org-element-put-property cite :contents-begin start) 2817 (when (< start (point)) 2818 (org-element-put-property 2819 cite :prefix 2820 (org-element--parse-objects start (point) nil types cite))) 2821 (forward-char) 2822 (org-element-put-property cite :contents-begin (point))) 2823 ;; `:contents-end' depends on the presence of a non-empty 2824 ;; common suffix. 2825 (goto-char (1- closing)) 2826 (skip-chars-backward " \r\t\n") 2827 (let ((end (point))) 2828 (if (or (not (search-backward ";" first-key-end t)) 2829 (re-search-forward org-element-citation-key-re end t)) 2830 (org-element-put-property cite :contents-end end) 2831 (forward-char) 2832 (when (< (point) end) 2833 (org-element-put-property 2834 cite :suffix 2835 (org-element--parse-objects (point) end nil types cite))) 2836 (org-element-put-property cite :contents-end (point)))) 2837 cite)))))) 2838 2839(defun org-element-citation-interpreter (citation contents) 2840 "Interpret CITATION object as Org syntax. 2841CONTENTS is the contents of the object, as a string." 2842 (let ((prefix (org-element-property :prefix citation)) 2843 (suffix (org-element-property :suffix citation)) 2844 (style (org-element-property :style citation))) 2845 (concat "[cite" 2846 (and style (concat "/" style)) 2847 ":" 2848 (and prefix (concat (org-element-interpret-data prefix) ";")) 2849 (if suffix 2850 (concat contents (org-element-interpret-data suffix)) 2851 ;; Remove spurious semicolon. 2852 (substring contents nil -1)) 2853 "]"))) 2854 2855 2856;;;; Citation Reference 2857 2858(defun org-element-citation-reference-parser () 2859 "Parse citation reference object at point, if any. 2860 2861When at a reference, return a list whose car is 2862`citation-reference', and cdr is a plist with `:key', 2863`:prefix', `:suffix', `:begin', `:end', and `:post-blank' keywords. 2864 2865Assume point is at the beginning of the reference." 2866 (save-excursion 2867 (let ((begin (point))) 2868 (when (re-search-forward org-element-citation-key-re nil t) 2869 (let* ((key (match-string-no-properties 1)) 2870 (key-start (match-beginning 0)) 2871 (key-end (match-end 0)) 2872 (separator (search-forward ";" nil t)) 2873 (end (or separator (point-max))) 2874 (suffix-end (if separator (1- end) end)) 2875 (types (org-element-restriction 'citation-reference)) 2876 (reference 2877 (list 'citation-reference 2878 (list :key key 2879 :begin begin 2880 :end end 2881 :post-blank 0)))) 2882 (when (< begin key-start) 2883 (org-element-put-property 2884 reference :prefix 2885 (org-element--parse-objects begin key-start nil types reference))) 2886 (when (< key-end suffix-end) 2887 (org-element-put-property 2888 reference :suffix 2889 (org-element--parse-objects key-end suffix-end nil types reference))) 2890 reference))))) 2891 2892(defun org-element-citation-reference-interpreter (citation-reference _) 2893 "Interpret CITATION-REFERENCE object as Org syntax." 2894 (concat (org-element-interpret-data 2895 (org-element-property :prefix citation-reference)) 2896 "@" (org-element-property :key citation-reference) 2897 (org-element-interpret-data 2898 (org-element-property :suffix citation-reference)) 2899 ";")) 2900 2901 2902;;;; Code 2903 2904(defun org-element-code-parser () 2905 "Parse code object at point, if any. 2906 2907When at a code object, return a list whose car is `code' and cdr 2908is a plist with `:value', `:begin', `:end' and `:post-blank' 2909keywords. Otherwise, return nil. 2910 2911Assume point is at the first tilde marker." 2912 (save-excursion 2913 (unless (bolp) (backward-char 1)) 2914 (when (looking-at org-verbatim-re) 2915 (let ((begin (match-beginning 2)) 2916 (value (match-string-no-properties 4)) 2917 (post-blank (progn (goto-char (match-end 2)) 2918 (skip-chars-forward " \t"))) 2919 (end (point))) 2920 (list 'code 2921 (list :value value 2922 :begin begin 2923 :end end 2924 :post-blank post-blank)))))) 2925 2926(defun org-element-code-interpreter (code _) 2927 "Interpret CODE object as Org syntax." 2928 (format "~%s~" (org-element-property :value code))) 2929 2930 2931;;;; Entity 2932 2933(defun org-element-entity-parser () 2934 "Parse entity at point, if any. 2935 2936When at an entity, return a list whose car is `entity' and cdr 2937a plist with `:begin', `:end', `:latex', `:latex-math-p', 2938`:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and 2939`:post-blank' as keywords. Otherwise, return nil. 2940 2941Assume point is at the beginning of the entity." 2942 (catch 'no-object 2943 (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)") 2944 (save-excursion 2945 (let* ((value (or (org-entity-get (match-string 1)) 2946 (throw 'no-object nil))) 2947 (begin (match-beginning 0)) 2948 (bracketsp (string= (match-string 2) "{}")) 2949 (post-blank (progn (goto-char (match-end 1)) 2950 (when bracketsp (forward-char 2)) 2951 (skip-chars-forward " \t"))) 2952 (end (point))) 2953 (list 'entity 2954 (list :name (car value) 2955 :latex (nth 1 value) 2956 :latex-math-p (nth 2 value) 2957 :html (nth 3 value) 2958 :ascii (nth 4 value) 2959 :latin1 (nth 5 value) 2960 :utf-8 (nth 6 value) 2961 :begin begin 2962 :end end 2963 :use-brackets-p bracketsp 2964 :post-blank post-blank))))))) 2965 2966(defun org-element-entity-interpreter (entity _) 2967 "Interpret ENTITY object as Org syntax." 2968 (concat "\\" 2969 (org-element-property :name entity) 2970 (when (org-element-property :use-brackets-p entity) "{}"))) 2971 2972 2973;;;; Export Snippet 2974 2975(defun org-element-export-snippet-parser () 2976 "Parse export snippet at point. 2977 2978When at an export snippet, return a list whose car is 2979`export-snippet' and cdr a plist with `:begin', `:end', 2980`:back-end', `:value' and `:post-blank' as keywords. Otherwise, 2981return nil. 2982 2983Assume point is at the beginning of the snippet." 2984 (save-excursion 2985 (let (contents-end) 2986 (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):") 2987 (setq contents-end 2988 (save-match-data (goto-char (match-end 0)) 2989 (re-search-forward "@@" nil t) 2990 (match-beginning 0)))) 2991 (let* ((begin (match-beginning 0)) 2992 (back-end (match-string-no-properties 1)) 2993 (value (buffer-substring-no-properties 2994 (match-end 0) contents-end)) 2995 (post-blank (skip-chars-forward " \t")) 2996 (end (point))) 2997 (list 'export-snippet 2998 (list :back-end back-end 2999 :value value 3000 :begin begin 3001 :end end 3002 :post-blank post-blank))))))) 3003 3004(defun org-element-export-snippet-interpreter (export-snippet _) 3005 "Interpret EXPORT-SNIPPET object as Org syntax." 3006 (format "@@%s:%s@@" 3007 (org-element-property :back-end export-snippet) 3008 (org-element-property :value export-snippet))) 3009 3010 3011;;;; Footnote Reference 3012 3013(defun org-element-footnote-reference-parser () 3014 "Parse footnote reference at point, if any. 3015 3016When at a footnote reference, return a list whose car is 3017`footnote-reference' and cdr a plist with `:label', `:type', 3018`:begin', `:end', `:contents-begin', `:contents-end' and 3019`:post-blank' as keywords. Otherwise, return nil." 3020 (when (looking-at org-footnote-re) 3021 (let ((closing (with-syntax-table org-element--pair-square-table 3022 (ignore-errors (scan-lists (point) 1 0))))) 3023 (when closing 3024 (save-excursion 3025 (let* ((begin (point)) 3026 (label (match-string-no-properties 1)) 3027 (inner-begin (match-end 0)) 3028 (inner-end (1- closing)) 3029 (type (if (match-end 2) 'inline 'standard)) 3030 (post-blank (progn (goto-char closing) 3031 (skip-chars-forward " \t"))) 3032 (end (point))) 3033 (list 'footnote-reference 3034 (list :label label 3035 :type type 3036 :begin begin 3037 :end end 3038 :contents-begin (and (eq type 'inline) inner-begin) 3039 :contents-end (and (eq type 'inline) inner-end) 3040 :post-blank post-blank)))))))) 3041 3042(defun org-element-footnote-reference-interpreter (footnote-reference contents) 3043 "Interpret FOOTNOTE-REFERENCE object as Org syntax. 3044CONTENTS is its definition, when inline, or nil." 3045 (format "[fn:%s%s]" 3046 (or (org-element-property :label footnote-reference) "") 3047 (if contents (concat ":" contents) ""))) 3048 3049 3050;;;; Inline Babel Call 3051 3052(defun org-element-inline-babel-call-parser () 3053 "Parse inline babel call at point, if any. 3054 3055When at an inline babel call, return a list whose car is 3056`inline-babel-call' and cdr a plist with `:call', 3057`:inside-header', `:arguments', `:end-header', `:begin', `:end', 3058`:value' and `:post-blank' as keywords. Otherwise, return nil. 3059 3060Assume point is at the beginning of the babel call." 3061 (save-excursion 3062 (catch :no-object 3063 (when (let ((case-fold-search nil)) 3064 (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]")) 3065 (goto-char (match-end 1)) 3066 (let* ((begin (match-beginning 0)) 3067 (call (match-string-no-properties 1)) 3068 (inside-header 3069 (let ((p (org-element--parse-paired-brackets ?\[))) 3070 (and (org-string-nw-p p) 3071 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3072 (arguments (org-string-nw-p 3073 (or (org-element--parse-paired-brackets ?\() 3074 ;; Parenthesis are mandatory. 3075 (throw :no-object nil)))) 3076 (end-header 3077 (let ((p (org-element--parse-paired-brackets ?\[))) 3078 (and (org-string-nw-p p) 3079 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3080 (value (buffer-substring-no-properties begin (point))) 3081 (post-blank (skip-chars-forward " \t")) 3082 (end (point))) 3083 (list 'inline-babel-call 3084 (list :call call 3085 :inside-header inside-header 3086 :arguments arguments 3087 :end-header end-header 3088 :begin begin 3089 :end end 3090 :value value 3091 :post-blank post-blank))))))) 3092 3093(defun org-element-inline-babel-call-interpreter (inline-babel-call _) 3094 "Interpret INLINE-BABEL-CALL object as Org syntax." 3095 (concat "call_" 3096 (org-element-property :call inline-babel-call) 3097 (let ((h (org-element-property :inside-header inline-babel-call))) 3098 (and h (format "[%s]" h))) 3099 "(" (org-element-property :arguments inline-babel-call) ")" 3100 (let ((h (org-element-property :end-header inline-babel-call))) 3101 (and h (format "[%s]" h))))) 3102 3103 3104;;;; Inline Src Block 3105 3106(defun org-element-inline-src-block-parser () 3107 "Parse inline source block at point, if any. 3108 3109When at an inline source block, return a list whose car is 3110`inline-src-block' and cdr a plist with `:begin', `:end', 3111`:language', `:value', `:parameters' and `:post-blank' as 3112keywords. Otherwise, return nil. 3113 3114Assume point is at the beginning of the inline source block." 3115 (save-excursion 3116 (catch :no-object 3117 (when (let ((case-fold-search nil)) 3118 (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]")) 3119 (goto-char (match-end 1)) 3120 (let ((begin (match-beginning 0)) 3121 (language (match-string-no-properties 1)) 3122 (parameters 3123 (let ((p (org-element--parse-paired-brackets ?\[))) 3124 (and (org-string-nw-p p) 3125 (replace-regexp-in-string "\n[ \t]*" " " (org-trim p))))) 3126 (value (or (org-element--parse-paired-brackets ?\{) 3127 (throw :no-object nil))) 3128 (post-blank (skip-chars-forward " \t"))) 3129 (list 'inline-src-block 3130 (list :language language 3131 :value value 3132 :parameters parameters 3133 :begin begin 3134 :end (point) 3135 :post-blank post-blank))))))) 3136 3137(defun org-element-inline-src-block-interpreter (inline-src-block _) 3138 "Interpret INLINE-SRC-BLOCK object as Org syntax." 3139 (let ((language (org-element-property :language inline-src-block)) 3140 (arguments (org-element-property :parameters inline-src-block)) 3141 (body (org-element-property :value inline-src-block))) 3142 (format "src_%s%s{%s}" 3143 language 3144 (if arguments (format "[%s]" arguments) "") 3145 body))) 3146 3147;;;; Italic 3148 3149(defun org-element-italic-parser () 3150 "Parse italic object at point, if any. 3151 3152When at an italic object, return a list whose car is `italic' and 3153cdr is a plist with `:begin', `:end', `:contents-begin' and 3154`:contents-end' and `:post-blank' keywords. Otherwise, return 3155nil. 3156 3157Assume point is at the first slash marker." 3158 (save-excursion 3159 (unless (bolp) (backward-char 1)) 3160 (when (looking-at org-emph-re) 3161 (let ((begin (match-beginning 2)) 3162 (contents-begin (match-beginning 4)) 3163 (contents-end (match-end 4)) 3164 (post-blank (progn (goto-char (match-end 2)) 3165 (skip-chars-forward " \t"))) 3166 (end (point))) 3167 (list 'italic 3168 (list :begin begin 3169 :end end 3170 :contents-begin contents-begin 3171 :contents-end contents-end 3172 :post-blank post-blank)))))) 3173 3174(defun org-element-italic-interpreter (_ contents) 3175 "Interpret italic object as Org syntax. 3176CONTENTS is the contents of the object." 3177 (format "/%s/" contents)) 3178 3179 3180;;;; Latex Fragment 3181 3182(defun org-element-latex-fragment-parser () 3183 "Parse LaTeX fragment at point, if any. 3184 3185When at a LaTeX fragment, return a list whose car is 3186`latex-fragment' and cdr a plist with `:value', `:begin', `:end', 3187and `:post-blank' as keywords. Otherwise, return nil. 3188 3189Assume point is at the beginning of the LaTeX fragment." 3190 (catch 'no-object 3191 (save-excursion 3192 (let* ((begin (point)) 3193 (after-fragment 3194 (cond 3195 ((not (eq ?$ (char-after))) 3196 (pcase (char-after (1+ (point))) 3197 (?\( (search-forward "\\)" nil t)) 3198 (?\[ (search-forward "\\]" nil t)) 3199 (_ 3200 ;; Macro. 3201 (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\ 3202\\|\\({[^{}\n]*}\\)\\)*") 3203 (match-end 0))))) 3204 ((eq ?$ (char-after (1+ (point)))) 3205 (search-forward "$$" nil t 2)) 3206 (t 3207 (and (not (eq ?$ (char-before))) 3208 (not (memq (char-after (1+ (point))) 3209 '(?\s ?\t ?\n ?, ?. ?\;))) 3210 (search-forward "$" nil t 2) 3211 (not (memq (char-before (match-beginning 0)) 3212 '(?\s ?\t ?\n ?, ?.))) 3213 (looking-at-p 3214 "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)") 3215 (point))))) 3216 (post-blank 3217 (if (not after-fragment) (throw 'no-object nil) 3218 (goto-char after-fragment) 3219 (skip-chars-forward " \t"))) 3220 (end (point))) 3221 (list 'latex-fragment 3222 (list :value (buffer-substring-no-properties begin after-fragment) 3223 :begin begin 3224 :end end 3225 :post-blank post-blank)))))) 3226 3227(defun org-element-latex-fragment-interpreter (latex-fragment _) 3228 "Interpret LATEX-FRAGMENT object as Org syntax." 3229 (org-element-property :value latex-fragment)) 3230 3231;;;; Line Break 3232 3233(defun org-element-line-break-parser () 3234 "Parse line break at point, if any. 3235 3236When at a line break, return a list whose car is `line-break', 3237and cdr a plist with `:begin', `:end' and `:post-blank' keywords. 3238Otherwise, return nil. 3239 3240Assume point is at the beginning of the line break." 3241 (when (and (looking-at-p "\\\\\\\\[ \t]*$") 3242 (not (eq (char-before) ?\\))) 3243 (list 'line-break 3244 (list :begin (point) 3245 :end (line-beginning-position 2) 3246 :post-blank 0)))) 3247 3248(defun org-element-line-break-interpreter (&rest _) 3249 "Interpret LINE-BREAK object as Org syntax." 3250 "\\\\\n") 3251 3252 3253;;;; Link 3254 3255(defun org-element-link-parser () 3256 "Parse link at point, if any. 3257 3258When at a link, return a list whose car is `link' and cdr a plist 3259with `:type', `:path', `:format', `:raw-link', `:application', 3260`:search-option', `:begin', `:end', `:contents-begin', 3261`:contents-end' and `:post-blank' as keywords. Otherwise, return 3262nil. 3263 3264Assume point is at the beginning of the link." 3265 (catch 'no-object 3266 (let ((begin (point)) 3267 end contents-begin contents-end link-end post-blank path type format 3268 raw-link search-option application) 3269 (cond 3270 ;; Type 1: Text targeted from a radio target. 3271 ((and org-target-link-regexp 3272 (save-excursion (or (bolp) (backward-char)) 3273 (looking-at org-target-link-regexp))) 3274 (setq type "radio") 3275 (setq format 'plain) 3276 (setq link-end (match-end 1)) 3277 (setq path (match-string-no-properties 1)) 3278 (setq contents-begin (match-beginning 1)) 3279 (setq contents-end (match-end 1))) 3280 ;; Type 2: Standard link, i.e. [[https://orgmode.org][homepage]] 3281 ((looking-at org-link-bracket-re) 3282 (setq format 'bracket) 3283 (setq contents-begin (match-beginning 2)) 3284 (setq contents-end (match-end 2)) 3285 (setq link-end (match-end 0)) 3286 ;; RAW-LINK is the original link. Decode any encoding. 3287 ;; Expand any abbreviation in it. 3288 ;; 3289 ;; Also treat any newline character and associated 3290 ;; indentation as a single space character. This is not 3291 ;; compatible with RFC 3986, which requires to ignore 3292 ;; them altogether. However, doing so would require 3293 ;; users to encode spaces on the fly when writing links 3294 ;; (e.g., insert [[shell:ls%20*.org]] instead of 3295 ;; [[shell:ls *.org]], which defeats Org's focus on 3296 ;; simplicity. 3297 (setq raw-link (org-link-expand-abbrev 3298 (org-link-unescape 3299 (replace-regexp-in-string 3300 "[ \t]*\n[ \t]*" " " 3301 (match-string-no-properties 1))))) 3302 ;; Determine TYPE of link and set PATH accordingly. According 3303 ;; to RFC 3986, remove whitespaces from URI in external links. 3304 ;; In internal ones, treat indentation as a single space. 3305 (cond 3306 ;; File type. 3307 ((or (file-name-absolute-p raw-link) 3308 (string-match "\\`\\.\\.?/" raw-link)) 3309 (setq type "file") 3310 (setq path raw-link)) 3311 ;; Explicit type (http, irc, bbdb...). 3312 ((string-match org-link-types-re raw-link) 3313 (setq type (match-string 1 raw-link)) 3314 (setq path (substring raw-link (match-end 0)))) 3315 ;; Code-ref type: PATH is the name of the reference. 3316 ((and (string-match-p "\\`(" raw-link) 3317 (string-match-p ")\\'" raw-link)) 3318 (setq type "coderef") 3319 (setq path (substring raw-link 1 -1))) 3320 ;; Custom-id type: PATH is the name of the custom id. 3321 ((= (string-to-char raw-link) ?#) 3322 (setq type "custom-id") 3323 (setq path (substring raw-link 1))) 3324 ;; Fuzzy type: Internal link either matches a target, an 3325 ;; headline name or nothing. PATH is the target or 3326 ;; headline's name. 3327 (t 3328 (setq type "fuzzy") 3329 (setq path raw-link)))) 3330 ;; Type 3: Plain link, e.g., https://orgmode.org 3331 ((looking-at org-link-plain-re) 3332 (setq format 'plain) 3333 (setq raw-link (match-string-no-properties 0)) 3334 (setq type (match-string-no-properties 1)) 3335 (setq link-end (match-end 0)) 3336 (setq path (match-string-no-properties 2))) 3337 ;; Type 4: Angular link, e.g., <https://orgmode.org>. Unlike to 3338 ;; bracket links, follow RFC 3986 and remove any extra 3339 ;; whitespace in URI. 3340 ((looking-at org-link-angle-re) 3341 (setq format 'angle) 3342 (setq type (match-string-no-properties 1)) 3343 (setq link-end (match-end 0)) 3344 (setq raw-link 3345 (buffer-substring-no-properties 3346 (match-beginning 1) (match-end 2))) 3347 (setq path (replace-regexp-in-string 3348 "[ \t]*\n[ \t]*" "" (match-string-no-properties 2)))) 3349 (t (throw 'no-object nil))) 3350 ;; In any case, deduce end point after trailing white space from 3351 ;; LINK-END variable. 3352 (save-excursion 3353 (setq post-blank 3354 (progn (goto-char link-end) (skip-chars-forward " \t"))) 3355 (setq end (point))) 3356 ;; Special "file"-type link processing. Extract opening 3357 ;; application and search option, if any. Also normalize URI. 3358 (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) 3359 (setq application (match-string 1 type)) 3360 (setq type "file") 3361 (when (string-match "::\\(.*\\)\\'" path) 3362 (setq search-option (match-string 1 path)) 3363 (setq path (replace-match "" nil nil path))) 3364 (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) 3365 ;; Translate link, if `org-link-translation-function' is set. 3366 (let ((trans (and (functionp org-link-translation-function) 3367 (funcall org-link-translation-function type path)))) 3368 (when trans 3369 (setq type (car trans)) 3370 (setq path (cdr trans)))) 3371 (list 'link 3372 (list :type type 3373 :path path 3374 :format format 3375 :raw-link (or raw-link path) 3376 :application application 3377 :search-option search-option 3378 :begin begin 3379 :end end 3380 :contents-begin contents-begin 3381 :contents-end contents-end 3382 :post-blank post-blank))))) 3383 3384(defun org-element-link-interpreter (link contents) 3385 "Interpret LINK object as Org syntax. 3386CONTENTS is the contents of the object, or nil." 3387 (let ((type (org-element-property :type link)) 3388 (path (org-element-property :path link))) 3389 (if (string= type "radio") path 3390 (let ((fmt (pcase (org-element-property :format link) 3391 ;; Links with contents and internal links have to 3392 ;; use bracket syntax. Ignore `:format' in these 3393 ;; cases. This is also the default syntax when the 3394 ;; property is not defined, e.g., when the object 3395 ;; was crafted by the user. 3396 ((guard contents) 3397 (format "[[%%s][%s]]" 3398 ;; Since this is going to be used as 3399 ;; a format string, escape percent signs 3400 ;; in description. 3401 (replace-regexp-in-string "%" "%%" contents))) 3402 ((or `bracket 3403 `nil 3404 (guard (member type '("coderef" "custom-id" "fuzzy")))) 3405 "[[%s]]") 3406 ;; Otherwise, just obey to `:format'. 3407 (`angle "<%s>") 3408 (`plain "%s") 3409 (f (error "Wrong `:format' value: %s" f))))) 3410 (format fmt 3411 (pcase type 3412 ("coderef" (format "(%s)" path)) 3413 ("custom-id" (concat "#" path)) 3414 ("file" 3415 (let ((app (org-element-property :application link)) 3416 (opt (org-element-property :search-option link))) 3417 (concat type (and app (concat "+" app)) ":" 3418 path 3419 (and opt (concat "::" opt))))) 3420 ("fuzzy" path) 3421 (_ (concat type ":" path)))))))) 3422 3423 3424;;;; Macro 3425 3426(defun org-element-macro-parser () 3427 "Parse macro at point, if any. 3428 3429When at a macro, return a list whose car is `macro' and cdr 3430a plist with `:key', `:args', `:begin', `:end', `:value' and 3431`:post-blank' as keywords. Otherwise, return nil. 3432 3433Assume point is at the macro." 3434 (save-excursion 3435 (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}") 3436 (let ((begin (point)) 3437 (key (downcase (match-string-no-properties 1))) 3438 (value (match-string-no-properties 0)) 3439 (post-blank (progn (goto-char (match-end 0)) 3440 (skip-chars-forward " \t"))) 3441 (end (point)) 3442 (args (pcase (match-string-no-properties 3) 3443 (`nil nil) 3444 (a (org-macro-extract-arguments 3445 (replace-regexp-in-string 3446 "[ \t\r\n]+" " " (org-trim a))))))) 3447 (list 'macro 3448 (list :key key 3449 :value value 3450 :args args 3451 :begin begin 3452 :end end 3453 :post-blank post-blank)))))) 3454 3455(defun org-element-macro-interpreter (macro _) 3456 "Interpret MACRO object as Org syntax." 3457 (format "{{{%s%s}}}" 3458 (org-element-property :key macro) 3459 (pcase (org-element-property :args macro) 3460 (`nil "") 3461 (args (format "(%s)" (apply #'org-macro-escape-arguments args)))))) 3462 3463 3464;;;; Radio-target 3465 3466(defun org-element-radio-target-parser () 3467 "Parse radio target at point, if any. 3468 3469When at a radio target, return a list whose car is `radio-target' 3470and cdr a plist with `:begin', `:end', `:contents-begin', 3471`:contents-end', `:value' and `:post-blank' as keywords. 3472Otherwise, return nil. 3473 3474Assume point is at the radio target." 3475 (save-excursion 3476 (when (looking-at org-radio-target-regexp) 3477 (let ((begin (point)) 3478 (contents-begin (match-beginning 1)) 3479 (contents-end (match-end 1)) 3480 (value (match-string-no-properties 1)) 3481 (post-blank (progn (goto-char (match-end 0)) 3482 (skip-chars-forward " \t"))) 3483 (end (point))) 3484 (list 'radio-target 3485 (list :begin begin 3486 :end end 3487 :contents-begin contents-begin 3488 :contents-end contents-end 3489 :post-blank post-blank 3490 :value value)))))) 3491 3492(defun org-element-radio-target-interpreter (_ contents) 3493 "Interpret target object as Org syntax. 3494CONTENTS is the contents of the object." 3495 (concat "<<<" contents ">>>")) 3496 3497 3498;;;; Statistics Cookie 3499 3500(defun org-element-statistics-cookie-parser () 3501 "Parse statistics cookie at point, if any. 3502 3503When at a statistics cookie, return a list whose car is 3504`statistics-cookie', and cdr a plist with `:begin', `:end', 3505`:value' and `:post-blank' keywords. Otherwise, return nil. 3506 3507Assume point is at the beginning of the statistics-cookie." 3508 (save-excursion 3509 (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") 3510 (let* ((begin (point)) 3511 (value (buffer-substring-no-properties 3512 (match-beginning 0) (match-end 0))) 3513 (post-blank (progn (goto-char (match-end 0)) 3514 (skip-chars-forward " \t"))) 3515 (end (point))) 3516 (list 'statistics-cookie 3517 (list :begin begin 3518 :end end 3519 :value value 3520 :post-blank post-blank)))))) 3521 3522(defun org-element-statistics-cookie-interpreter (statistics-cookie _) 3523 "Interpret STATISTICS-COOKIE object as Org syntax." 3524 (org-element-property :value statistics-cookie)) 3525 3526 3527;;;; Strike-Through 3528 3529(defun org-element-strike-through-parser () 3530 "Parse strike-through object at point, if any. 3531 3532When at a strike-through object, return a list whose car is 3533`strike-through' and cdr is a plist with `:begin', `:end', 3534`:contents-begin' and `:contents-end' and `:post-blank' keywords. 3535Otherwise, return nil. 3536 3537Assume point is at the first plus sign marker." 3538 (save-excursion 3539 (unless (bolp) (backward-char 1)) 3540 (when (looking-at org-emph-re) 3541 (let ((begin (match-beginning 2)) 3542 (contents-begin (match-beginning 4)) 3543 (contents-end (match-end 4)) 3544 (post-blank (progn (goto-char (match-end 2)) 3545 (skip-chars-forward " \t"))) 3546 (end (point))) 3547 (list 'strike-through 3548 (list :begin begin 3549 :end end 3550 :contents-begin contents-begin 3551 :contents-end contents-end 3552 :post-blank post-blank)))))) 3553 3554(defun org-element-strike-through-interpreter (_ contents) 3555 "Interpret strike-through object as Org syntax. 3556CONTENTS is the contents of the object." 3557 (format "+%s+" contents)) 3558 3559 3560;;;; Subscript 3561 3562(defun org-element-subscript-parser () 3563 "Parse subscript at point, if any. 3564 3565When at a subscript object, return a list whose car is 3566`subscript' and cdr a plist with `:begin', `:end', 3567`:contents-begin', `:contents-end', `:use-brackets-p' and 3568`:post-blank' as keywords. Otherwise, return nil. 3569 3570Assume point is at the underscore." 3571 (save-excursion 3572 (unless (bolp) (backward-char)) 3573 (when (looking-at org-match-substring-regexp) 3574 (let ((bracketsp (match-beginning 4)) 3575 (begin (match-beginning 2)) 3576 (contents-begin (or (match-beginning 4) 3577 (match-beginning 3))) 3578 (contents-end (or (match-end 4) (match-end 3))) 3579 (post-blank (progn (goto-char (match-end 0)) 3580 (skip-chars-forward " \t"))) 3581 (end (point))) 3582 (list 'subscript 3583 (list :begin begin 3584 :end end 3585 :use-brackets-p bracketsp 3586 :contents-begin contents-begin 3587 :contents-end contents-end 3588 :post-blank post-blank)))))) 3589 3590(defun org-element-subscript-interpreter (subscript contents) 3591 "Interpret SUBSCRIPT object as Org syntax. 3592CONTENTS is the contents of the object." 3593 (format 3594 (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") 3595 contents)) 3596 3597 3598;;;; Superscript 3599 3600(defun org-element-superscript-parser () 3601 "Parse superscript at point, if any. 3602 3603When at a superscript object, return a list whose car is 3604`superscript' and cdr a plist with `:begin', `:end', 3605`:contents-begin', `:contents-end', `:use-brackets-p' and 3606`:post-blank' as keywords. Otherwise, return nil. 3607 3608Assume point is at the caret." 3609 (save-excursion 3610 (unless (bolp) (backward-char)) 3611 (when (looking-at org-match-substring-regexp) 3612 (let ((bracketsp (match-beginning 4)) 3613 (begin (match-beginning 2)) 3614 (contents-begin (or (match-beginning 4) 3615 (match-beginning 3))) 3616 (contents-end (or (match-end 4) (match-end 3))) 3617 (post-blank (progn (goto-char (match-end 0)) 3618 (skip-chars-forward " \t"))) 3619 (end (point))) 3620 (list 'superscript 3621 (list :begin begin 3622 :end end 3623 :use-brackets-p bracketsp 3624 :contents-begin contents-begin 3625 :contents-end contents-end 3626 :post-blank post-blank)))))) 3627 3628(defun org-element-superscript-interpreter (superscript contents) 3629 "Interpret SUPERSCRIPT object as Org syntax. 3630CONTENTS is the contents of the object." 3631 (format 3632 (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") 3633 contents)) 3634 3635 3636;;;; Table Cell 3637 3638(defun org-element-table-cell-parser () 3639 "Parse table cell at point. 3640Return a list whose car is `table-cell' and cdr is a plist 3641containing `:begin', `:end', `:contents-begin', `:contents-end' 3642and `:post-blank' keywords." 3643 (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)") 3644 (let* ((begin (match-beginning 0)) 3645 (end (match-end 0)) 3646 (contents-begin (match-beginning 1)) 3647 (contents-end (match-end 1))) 3648 (list 'table-cell 3649 (list :begin begin 3650 :end end 3651 :contents-begin contents-begin 3652 :contents-end contents-end 3653 :post-blank 0)))) 3654 3655(defun org-element-table-cell-interpreter (_ contents) 3656 "Interpret table-cell element as Org syntax. 3657CONTENTS is the contents of the cell, or nil." 3658 (concat " " contents " |")) 3659 3660 3661;;;; Target 3662 3663(defun org-element-target-parser () 3664 "Parse target at point, if any. 3665 3666When at a target, return a list whose car is `target' and cdr 3667a plist with `:begin', `:end', `:value' and `:post-blank' as 3668keywords. Otherwise, return nil. 3669 3670Assume point is at the target." 3671 (save-excursion 3672 (when (looking-at org-target-regexp) 3673 (let ((begin (point)) 3674 (value (match-string-no-properties 1)) 3675 (post-blank (progn (goto-char (match-end 0)) 3676 (skip-chars-forward " \t"))) 3677 (end (point))) 3678 (list 'target 3679 (list :begin begin 3680 :end end 3681 :value value 3682 :post-blank post-blank)))))) 3683 3684(defun org-element-target-interpreter (target _) 3685 "Interpret TARGET object as Org syntax." 3686 (format "<<%s>>" (org-element-property :value target))) 3687 3688 3689;;;; Timestamp 3690 3691(defconst org-element--timestamp-regexp 3692 (concat org-ts-regexp-both 3693 "\\|" 3694 "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" 3695 "\\|" 3696 "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") 3697 "Regexp matching any timestamp type object.") 3698 3699(defun org-element-timestamp-parser () 3700 "Parse time stamp at point, if any. 3701 3702When at a time stamp, return a list whose car is `timestamp', and 3703cdr a plist with `:type', `:raw-value', `:year-start', 3704`:month-start', `:day-start', `:hour-start', `:minute-start', 3705`:year-end', `:month-end', `:day-end', `:hour-end', 3706`:minute-end', `:repeater-type', `:repeater-value', 3707`:repeater-unit', `:warning-type', `:warning-value', 3708`:warning-unit', `:begin', `:end' and `:post-blank' keywords. 3709Otherwise, return nil. 3710 3711Assume point is at the beginning of the timestamp." 3712 (when (looking-at-p org-element--timestamp-regexp) 3713 (save-excursion 3714 (let* ((begin (point)) 3715 (activep (eq (char-after) ?<)) 3716 (raw-value 3717 (progn 3718 (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") 3719 (match-string-no-properties 0))) 3720 (date-start (match-string-no-properties 1)) 3721 (date-end (match-string 3)) 3722 (diaryp (match-beginning 2)) 3723 (post-blank (progn (goto-char (match-end 0)) 3724 (skip-chars-forward " \t"))) 3725 (end (point)) 3726 (time-range 3727 (and (not diaryp) 3728 (string-match 3729 "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" 3730 date-start) 3731 (cons (string-to-number (match-string 2 date-start)) 3732 (string-to-number (match-string 3 date-start))))) 3733 (type (cond (diaryp 'diary) 3734 ((and activep (or date-end time-range)) 'active-range) 3735 (activep 'active) 3736 ((or date-end time-range) 'inactive-range) 3737 (t 'inactive))) 3738 (repeater-props 3739 (and (not diaryp) 3740 (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" 3741 raw-value) 3742 (list 3743 :repeater-type 3744 (let ((type (match-string 1 raw-value))) 3745 (cond ((equal "++" type) 'catch-up) 3746 ((equal ".+" type) 'restart) 3747 (t 'cumulate))) 3748 :repeater-value (string-to-number (match-string 2 raw-value)) 3749 :repeater-unit 3750 (pcase (string-to-char (match-string 3 raw-value)) 3751 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) 3752 (warning-props 3753 (and (not diaryp) 3754 (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) 3755 (list 3756 :warning-type (if (match-string 1 raw-value) 'first 'all) 3757 :warning-value (string-to-number (match-string 2 raw-value)) 3758 :warning-unit 3759 (pcase (string-to-char (match-string 3 raw-value)) 3760 (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) 3761 year-start month-start day-start hour-start minute-start year-end 3762 month-end day-end hour-end minute-end) 3763 ;; Parse date-start. 3764 (unless diaryp 3765 (let ((date (org-parse-time-string date-start t))) 3766 (setq year-start (nth 5 date) 3767 month-start (nth 4 date) 3768 day-start (nth 3 date) 3769 hour-start (nth 2 date) 3770 minute-start (nth 1 date)))) 3771 ;; Compute date-end. It can be provided directly in time-stamp, 3772 ;; or extracted from time range. Otherwise, it defaults to the 3773 ;; same values as date-start. 3774 (unless diaryp 3775 (let ((date (and date-end (org-parse-time-string date-end t)))) 3776 (setq year-end (or (nth 5 date) year-start) 3777 month-end (or (nth 4 date) month-start) 3778 day-end (or (nth 3 date) day-start) 3779 hour-end (or (nth 2 date) (car time-range) hour-start) 3780 minute-end (or (nth 1 date) (cdr time-range) minute-start)))) 3781 (list 'timestamp 3782 (nconc (list :type type 3783 :raw-value raw-value 3784 :year-start year-start 3785 :month-start month-start 3786 :day-start day-start 3787 :hour-start hour-start 3788 :minute-start minute-start 3789 :year-end year-end 3790 :month-end month-end 3791 :day-end day-end 3792 :hour-end hour-end 3793 :minute-end minute-end 3794 :begin begin 3795 :end end 3796 :post-blank post-blank) 3797 repeater-props 3798 warning-props)))))) 3799 3800(defun org-element-timestamp-interpreter (timestamp _) 3801 "Interpret TIMESTAMP object as Org syntax." 3802 (let* ((repeat-string 3803 (concat 3804 (pcase (org-element-property :repeater-type timestamp) 3805 (`cumulate "+") (`catch-up "++") (`restart ".+")) 3806 (let ((val (org-element-property :repeater-value timestamp))) 3807 (and val (number-to-string val))) 3808 (pcase (org-element-property :repeater-unit timestamp) 3809 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) 3810 (warning-string 3811 (concat 3812 (pcase (org-element-property :warning-type timestamp) 3813 (`first "--") (`all "-")) 3814 (let ((val (org-element-property :warning-value timestamp))) 3815 (and val (number-to-string val))) 3816 (pcase (org-element-property :warning-unit timestamp) 3817 (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) 3818 (build-ts-string 3819 ;; Build an Org timestamp string from TIME. ACTIVEP is 3820 ;; non-nil when time stamp is active. If WITH-TIME-P is 3821 ;; non-nil, add a time part. HOUR-END and MINUTE-END 3822 ;; specify a time range in the timestamp. REPEAT-STRING is 3823 ;; the repeater string, if any. 3824 (lambda (time activep &optional with-time-p hour-end minute-end) 3825 (let ((ts (format-time-string 3826 (funcall (if with-time-p #'cdr #'car) 3827 org-time-stamp-formats) 3828 time))) 3829 (when (and hour-end minute-end) 3830 (string-match "[012]?[0-9]:[0-5][0-9]" ts) 3831 (setq ts 3832 (replace-match 3833 (format "\\&-%02d:%02d" hour-end minute-end) 3834 nil nil ts))) 3835 (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) 3836 (dolist (s (list repeat-string warning-string)) 3837 (when (org-string-nw-p s) 3838 (setq ts (concat (substring ts 0 -1) 3839 " " 3840 s 3841 (substring ts -1))))) 3842 ;; Return value. 3843 ts))) 3844 (type (org-element-property :type timestamp))) 3845 (pcase type 3846 ((or `active `inactive) 3847 (let* ((minute-start (org-element-property :minute-start timestamp)) 3848 (minute-end (org-element-property :minute-end timestamp)) 3849 (hour-start (org-element-property :hour-start timestamp)) 3850 (hour-end (org-element-property :hour-end timestamp)) 3851 (time-range-p (and hour-start hour-end minute-start minute-end 3852 (or (/= hour-start hour-end) 3853 (/= minute-start minute-end))))) 3854 (funcall 3855 build-ts-string 3856 (encode-time 0 3857 (or minute-start 0) 3858 (or hour-start 0) 3859 (org-element-property :day-start timestamp) 3860 (org-element-property :month-start timestamp) 3861 (org-element-property :year-start timestamp)) 3862 (eq type 'active) 3863 (and hour-start minute-start) 3864 (and time-range-p hour-end) 3865 (and time-range-p minute-end)))) 3866 ((or `active-range `inactive-range) 3867 (let ((minute-start (org-element-property :minute-start timestamp)) 3868 (minute-end (org-element-property :minute-end timestamp)) 3869 (hour-start (org-element-property :hour-start timestamp)) 3870 (hour-end (org-element-property :hour-end timestamp))) 3871 (concat 3872 (funcall 3873 build-ts-string (encode-time 3874 0 3875 (or minute-start 0) 3876 (or hour-start 0) 3877 (org-element-property :day-start timestamp) 3878 (org-element-property :month-start timestamp) 3879 (org-element-property :year-start timestamp)) 3880 (eq type 'active-range) 3881 (and hour-start minute-start)) 3882 "--" 3883 (funcall build-ts-string 3884 (encode-time 0 3885 (or minute-end 0) 3886 (or hour-end 0) 3887 (org-element-property :day-end timestamp) 3888 (org-element-property :month-end timestamp) 3889 (org-element-property :year-end timestamp)) 3890 (eq type 'active-range) 3891 (and hour-end minute-end))))) 3892 (_ (org-element-property :raw-value timestamp))))) 3893 3894 3895;;;; Underline 3896 3897(defun org-element-underline-parser () 3898 "Parse underline object at point, if any. 3899 3900When at an underline object, return a list whose car is 3901`underline' and cdr is a plist with `:begin', `:end', 3902`:contents-begin' and `:contents-end' and `:post-blank' keywords. 3903Otherwise, return nil. 3904 3905Assume point is at the first underscore marker." 3906 (save-excursion 3907 (unless (bolp) (backward-char 1)) 3908 (when (looking-at org-emph-re) 3909 (let ((begin (match-beginning 2)) 3910 (contents-begin (match-beginning 4)) 3911 (contents-end (match-end 4)) 3912 (post-blank (progn (goto-char (match-end 2)) 3913 (skip-chars-forward " \t"))) 3914 (end (point))) 3915 (list 'underline 3916 (list :begin begin 3917 :end end 3918 :contents-begin contents-begin 3919 :contents-end contents-end 3920 :post-blank post-blank)))))) 3921 3922(defun org-element-underline-interpreter (_ contents) 3923 "Interpret underline object as Org syntax. 3924CONTENTS is the contents of the object." 3925 (format "_%s_" contents)) 3926 3927 3928;;;; Verbatim 3929 3930(defun org-element-verbatim-parser () 3931 "Parse verbatim object at point, if any. 3932 3933When at a verbatim object, return a list whose car is `verbatim' 3934and cdr is a plist with `:value', `:begin', `:end' and 3935`:post-blank' keywords. Otherwise, return nil. 3936 3937Assume point is at the first equal sign marker." 3938 (save-excursion 3939 (unless (bolp) (backward-char 1)) 3940 (when (looking-at org-verbatim-re) 3941 (let ((begin (match-beginning 2)) 3942 (value (match-string-no-properties 4)) 3943 (post-blank (progn (goto-char (match-end 2)) 3944 (skip-chars-forward " \t"))) 3945 (end (point))) 3946 (list 'verbatim 3947 (list :value value 3948 :begin begin 3949 :end end 3950 :post-blank post-blank)))))) 3951 3952(defun org-element-verbatim-interpreter (verbatim _) 3953 "Interpret VERBATIM object as Org syntax." 3954 (format "=%s=" (org-element-property :value verbatim))) 3955 3956 3957 3958;;; Parsing Element Starting At Point 3959;; 3960;; `org-element--current-element' is the core function of this section. 3961;; It returns the Lisp representation of the element starting at 3962;; point. 3963 3964(defun org-element--current-element (limit &optional granularity mode structure) 3965 "Parse the element starting at point. 3966 3967Return value is a list like (TYPE PROPS) where TYPE is the type 3968of the element and PROPS a plist of properties associated to the 3969element. 3970 3971Possible types are defined in `org-element-all-elements'. 3972 3973LIMIT bounds the search. 3974 3975Optional argument GRANULARITY determines the depth of the 3976recursion. Allowed values are `headline', `greater-element', 3977`element', `object' or nil. When it is broader than `object' (or 3978nil), secondary values will not be parsed, since they only 3979contain objects. 3980 3981Optional argument MODE, when non-nil, can be either 3982`first-section', `item', `node-property', `planning', 3983`property-drawer', `section', `table-row', or `top-comment'. 3984 3985 3986If STRUCTURE isn't provided but MODE is set to `item', it will be 3987computed. 3988 3989This function assumes point is always at the beginning of the 3990element it has to parse." 3991 (save-excursion 3992 (let ((case-fold-search t) 3993 ;; Determine if parsing depth allows for secondary strings 3994 ;; parsing. It only applies to elements referenced in 3995 ;; `org-element-secondary-value-alist'. 3996 (raw-secondary-p (and granularity (not (eq granularity 'object))))) 3997 (cond 3998 ;; Item. 3999 ((eq mode 'item) 4000 (org-element-item-parser limit structure raw-secondary-p)) 4001 ;; Table Row. 4002 ((eq mode 'table-row) (org-element-table-row-parser limit)) 4003 ;; Node Property. 4004 ((eq mode 'node-property) (org-element-node-property-parser limit)) 4005 ;; Headline. 4006 ((org-with-limited-levels (org-at-heading-p)) 4007 (org-element-headline-parser limit raw-secondary-p)) 4008 ;; Sections (must be checked after headline). 4009 ((eq mode 'section) (org-element-section-parser limit)) 4010 ((eq mode 'first-section) 4011 (org-element-section-parser 4012 (or (save-excursion (org-with-limited-levels (outline-next-heading))) 4013 limit))) 4014 ;; Comments. 4015 ((looking-at "^[ \t]*#\\(?: \\|$\\)") 4016 (org-element-comment-parser limit)) 4017 ;; Planning. 4018 ((and (eq mode 'planning) 4019 (eq ?* (char-after (line-beginning-position 0))) 4020 (looking-at org-planning-line-re)) 4021 (org-element-planning-parser limit)) 4022 ;; Property drawer. 4023 ((and (pcase mode 4024 (`planning (eq ?* (char-after (line-beginning-position 0)))) 4025 ((or `property-drawer `top-comment) 4026 (save-excursion 4027 (beginning-of-line 0) 4028 (not (looking-at "[[:blank:]]*$")))) 4029 (_ nil)) 4030 (looking-at org-property-drawer-re)) 4031 (org-element-property-drawer-parser limit)) 4032 ;; When not at bol, point is at the beginning of an item or 4033 ;; a footnote definition: next item is always a paragraph. 4034 ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) 4035 ;; Clock. 4036 ((looking-at org-clock-line-re) (org-element-clock-parser limit)) 4037 ;; Inlinetask. 4038 ((looking-at "^\\*+ ") 4039 (org-element-inlinetask-parser limit raw-secondary-p)) 4040 ;; From there, elements can have affiliated keywords. 4041 (t (let ((affiliated (org-element--collect-affiliated-keywords 4042 limit (memq granularity '(nil object))))) 4043 (cond 4044 ;; Jumping over affiliated keywords put point off-limits. 4045 ;; Parse them as regular keywords. 4046 ((and (cdr affiliated) (>= (point) limit)) 4047 (goto-char (car affiliated)) 4048 (org-element-keyword-parser limit nil)) 4049 ;; LaTeX Environment. 4050 ((looking-at org-element--latex-begin-environment) 4051 (org-element-latex-environment-parser limit affiliated)) 4052 ;; Drawer. 4053 ((looking-at org-drawer-regexp) 4054 (org-element-drawer-parser limit affiliated)) 4055 ;; Fixed Width 4056 ((looking-at "[ \t]*:\\( \\|$\\)") 4057 (org-element-fixed-width-parser limit affiliated)) 4058 ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and 4059 ;; Keywords. 4060 ((looking-at "[ \t]*#\\+") 4061 (goto-char (match-end 0)) 4062 (cond 4063 ((looking-at "BEGIN_\\(\\S-+\\)") 4064 (beginning-of-line) 4065 (funcall (pcase (upcase (match-string 1)) 4066 ("CENTER" #'org-element-center-block-parser) 4067 ("COMMENT" #'org-element-comment-block-parser) 4068 ("EXAMPLE" #'org-element-example-block-parser) 4069 ("EXPORT" #'org-element-export-block-parser) 4070 ("QUOTE" #'org-element-quote-block-parser) 4071 ("SRC" #'org-element-src-block-parser) 4072 ("VERSE" #'org-element-verse-block-parser) 4073 (_ #'org-element-special-block-parser)) 4074 limit 4075 affiliated)) 4076 ((looking-at "CALL:") 4077 (beginning-of-line) 4078 (org-element-babel-call-parser limit affiliated)) 4079 ((looking-at "BEGIN:? ") 4080 (beginning-of-line) 4081 (org-element-dynamic-block-parser limit affiliated)) 4082 ((looking-at "\\S-+:") 4083 (beginning-of-line) 4084 (org-element-keyword-parser limit affiliated)) 4085 (t 4086 (beginning-of-line) 4087 (org-element-paragraph-parser limit affiliated)))) 4088 ;; Footnote Definition. 4089 ((looking-at org-footnote-definition-re) 4090 (org-element-footnote-definition-parser limit affiliated)) 4091 ;; Horizontal Rule. 4092 ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") 4093 (org-element-horizontal-rule-parser limit affiliated)) 4094 ;; Diary Sexp. 4095 ((looking-at "%%(") 4096 (org-element-diary-sexp-parser limit affiliated)) 4097 ;; Table. 4098 ((or (looking-at "[ \t]*|") 4099 ;; There is no strict definition of a table.el 4100 ;; table. Try to prevent false positive while being 4101 ;; quick. 4102 (let ((rule-regexp 4103 (rx (zero-or-more (any " \t")) 4104 "+" 4105 (one-or-more (one-or-more "-") "+") 4106 (zero-or-more (any " \t")) 4107 eol)) 4108 (non-table.el-line 4109 (rx bol 4110 (zero-or-more (any " \t")) 4111 (or eol (not (any "+| \t"))))) 4112 (next (line-beginning-position 2))) 4113 ;; Start with a full rule. 4114 (and 4115 (looking-at rule-regexp) 4116 (< next limit) ;no room for a table.el table 4117 (save-excursion 4118 (end-of-line) 4119 (cond 4120 ;; Must end with a full rule. 4121 ((not (re-search-forward non-table.el-line limit 'move)) 4122 (if (bolp) (forward-line -1) (beginning-of-line)) 4123 (looking-at rule-regexp)) 4124 ;; Ignore pseudo-tables with a single 4125 ;; rule. 4126 ((= next (line-beginning-position)) 4127 nil) 4128 ;; Must end with a full rule. 4129 (t 4130 (forward-line -1) 4131 (looking-at rule-regexp))))))) 4132 (org-element-table-parser limit affiliated)) 4133 ;; List. 4134 ((looking-at (org-item-re)) 4135 (org-element-plain-list-parser 4136 limit affiliated 4137 (or structure (org-element--list-struct limit)))) 4138 ;; Default element: Paragraph. 4139 (t (org-element-paragraph-parser limit affiliated))))))))) 4140 4141 4142;; Most elements can have affiliated keywords. When looking for an 4143;; element beginning, we want to move before them, as they belong to 4144;; that element, and, in the meantime, collect information they give 4145;; into appropriate properties. Hence the following function. 4146 4147(defun org-element--collect-affiliated-keywords (limit parse) 4148 "Collect affiliated keywords from point down to LIMIT. 4149 4150Return a list whose CAR is the position at the first of them and 4151CDR a plist of keywords and values and move point to the 4152beginning of the first line after them. 4153 4154As a special case, if element doesn't start at the beginning of 4155the line (e.g., a paragraph starting an item), CAR is current 4156position of point and CDR is nil. 4157 4158When PARSE is non-nil, values from keywords belonging to 4159`org-element-parsed-keywords' are parsed as secondary strings." 4160 (if (not (bolp)) (list (point)) 4161 (let ((case-fold-search t) 4162 (origin (point)) 4163 ;; RESTRICT is the list of objects allowed in parsed 4164 ;; keywords value. If PARSE is nil, no object is allowed. 4165 (restrict (and parse (org-element-restriction 'keyword))) 4166 output) 4167 (while (and (< (point) limit) (looking-at org-element--affiliated-re)) 4168 (let* ((raw-kwd (upcase (match-string 1))) 4169 ;; Apply translation to RAW-KWD. From there, KWD is 4170 ;; the official keyword. 4171 (kwd (or (cdr (assoc raw-kwd 4172 org-element-keyword-translation-alist)) 4173 raw-kwd)) 4174 ;; PARSED? is non-nil when keyword should have its 4175 ;; value parsed. 4176 (parsed? (member kwd org-element-parsed-keywords)) 4177 ;; Find main value for any keyword. 4178 (value 4179 (let ((beg (match-end 0)) 4180 (end (save-excursion 4181 (end-of-line) 4182 (skip-chars-backward " \t") 4183 (point)))) 4184 (if parsed? 4185 (save-match-data 4186 (org-element--parse-objects beg end nil restrict)) 4187 (org-trim (buffer-substring-no-properties beg end))))) 4188 ;; If KWD is a dual keyword, find its secondary value. 4189 ;; Maybe parse it. 4190 (dual? (member kwd org-element-dual-keywords)) 4191 (dual-value 4192 (and dual? 4193 (let ((sec (match-string-no-properties 2))) 4194 (cond 4195 ((and sec parsed?) 4196 (save-match-data 4197 (org-element--parse-objects 4198 (match-beginning 2) (match-end 2) nil restrict))) 4199 (sec sec))))) 4200 ;; Attribute a property name to KWD. 4201 (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) 4202 ;; Now set final shape for VALUE. 4203 (when dual? 4204 (setq value (and (or value dual-value) (cons value dual-value)))) 4205 (when (or (member kwd org-element-multiple-keywords) 4206 ;; Attributes can always appear on multiple lines. 4207 (string-match "^ATTR_" kwd)) 4208 (setq value (cons value (plist-get output kwd-sym)))) 4209 ;; Eventually store the new value in OUTPUT. 4210 (setq output (plist-put output kwd-sym value)) 4211 ;; Move to next keyword. 4212 (forward-line))) 4213 ;; If affiliated keywords are orphaned: move back to first one. 4214 ;; They will be parsed as a paragraph. 4215 (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil)) 4216 ;; Return value. 4217 (cons origin output)))) 4218 4219 4220 4221;;; The Org Parser 4222;; 4223;; The two major functions here are `org-element-parse-buffer', which 4224;; parses Org syntax inside the current buffer, taking into account 4225;; region, narrowing, or even visibility if specified, and 4226;; `org-element-parse-secondary-string', which parses objects within 4227;; a given string. 4228;; 4229;; The (almost) almighty `org-element-map' allows applying a function 4230;; on elements or objects matching some type, and accumulating the 4231;; resulting values. In an export situation, it also skips unneeded 4232;; parts of the parse tree. 4233 4234(defun org-element-parse-buffer (&optional granularity visible-only) 4235 "Recursively parse the buffer and return structure. 4236If narrowing is in effect, only parse the visible part of the 4237buffer. 4238 4239Optional argument GRANULARITY determines the depth of the 4240recursion. It can be set to the following symbols: 4241 4242`headline' Only parse headlines. 4243`greater-element' Don't recurse into greater elements except 4244 headlines and sections. Thus, elements 4245 parsed are the top-level ones. 4246`element' Parse everything but objects and plain text. 4247`object' Parse the complete buffer (default). 4248 4249When VISIBLE-ONLY is non-nil, don't parse contents of hidden 4250elements. 4251 4252An element or object is represented as a list with the 4253pattern (TYPE PROPERTIES CONTENTS), where : 4254 4255 TYPE is a symbol describing the element or object. See 4256 `org-element-all-elements' and `org-element-all-objects' for an 4257 exhaustive list of such symbols. One can retrieve it with 4258 `org-element-type' function. 4259 4260 PROPERTIES is the list of attributes attached to the element or 4261 object, as a plist. Although most of them are specific to the 4262 element or object type, all types share `:begin', `:end', 4263 `:post-blank' and `:parent' properties, which respectively 4264 refer to buffer position where the element or object starts, 4265 ends, the number of white spaces or blank lines after it, and 4266 the element or object containing it. Properties values can be 4267 obtained by using `org-element-property' function. 4268 4269 CONTENTS is a list of elements, objects or raw strings 4270 contained in the current element or object, when applicable. 4271 One can access them with `org-element-contents' function. 4272 4273The Org buffer has `org-data' as type and nil as properties. 4274`org-element-map' function can be used to find specific elements 4275or objects within the parse tree. 4276 4277This function assumes that current major mode is `org-mode'." 4278 (save-excursion 4279 (goto-char (point-min)) 4280 (org-skip-whitespace) 4281 (org-element--parse-elements 4282 (point-at-bol) (point-max) 4283 ;; Start in `first-section' mode so text before the first 4284 ;; headline belongs to a section. 4285 'first-section nil granularity visible-only (list 'org-data nil)))) 4286 4287(defun org-element-parse-secondary-string (string restriction &optional parent) 4288 "Recursively parse objects in STRING and return structure. 4289 4290RESTRICTION is a symbol limiting the object types that will be 4291looked after. 4292 4293Optional argument PARENT, when non-nil, is the element or object 4294containing the secondary string. It is used to set correctly 4295`:parent' property within the string. 4296 4297If STRING is the empty string or nil, return nil." 4298 (cond 4299 ((not string) nil) 4300 ((equal string "") nil) 4301 (t (let ((local-variables (buffer-local-variables))) 4302 (with-temp-buffer 4303 (dolist (v local-variables) 4304 (ignore-errors 4305 (if (symbolp v) (makunbound v) 4306 ;; Don't set file name to avoid mishandling hooks (bug#44524) 4307 (unless (memq (car v) '(buffer-file-name buffer-file-truename)) 4308 (set (make-local-variable (car v)) (cdr v)))))) 4309 ;; Transferring local variables may put the temporary buffer 4310 ;; into a read-only state. Make sure we can insert STRING. 4311 (let ((inhibit-read-only t)) (insert string)) 4312 ;; Prevent "Buffer *temp* modified; kill anyway?". 4313 (restore-buffer-modified-p nil) 4314 (org-element--parse-objects 4315 (point-min) (point-max) nil restriction parent)))))) 4316 4317(defun org-element-map 4318 (data types fun &optional info first-match no-recursion with-affiliated) 4319 "Map a function on selected elements or objects. 4320 4321DATA is a parse tree, an element, an object, a string, or a list 4322of such constructs. TYPES is a symbol or list of symbols of 4323elements or objects types (see `org-element-all-elements' and 4324`org-element-all-objects' for a complete list of types). FUN is 4325the function called on the matching element or object. It has to 4326accept one argument: the element or object itself. 4327 4328When optional argument INFO is non-nil, it should be a plist 4329holding export options. In that case, parts of the parse tree 4330not exportable according to that property list will be skipped. 4331 4332When optional argument FIRST-MATCH is non-nil, stop at the first 4333match for which FUN doesn't return nil, and return that value. 4334 4335Optional argument NO-RECURSION is a symbol or a list of symbols 4336representing elements or objects types. `org-element-map' won't 4337enter any recursive element or object whose type belongs to that 4338list. Though, FUN can still be applied on them. 4339 4340When optional argument WITH-AFFILIATED is non-nil, FUN will also 4341apply to matching objects within parsed affiliated keywords (see 4342`org-element-parsed-keywords'). 4343 4344Nil values returned from FUN do not appear in the results. 4345 4346 4347Examples: 4348--------- 4349 4350Assuming TREE is a variable containing an Org buffer parse tree, 4351the following example will return a flat list of all `src-block' 4352and `example-block' elements in it: 4353 4354 (org-element-map tree \\='(example-block src-block) #\\='identity) 4355 4356The following snippet will find the first headline with a level 4357of 1 and a \"phone\" tag, and will return its beginning position: 4358 4359 (org-element-map tree \\='headline 4360 (lambda (hl) 4361 (and (= (org-element-property :level hl) 1) 4362 (member \"phone\" (org-element-property :tags hl)) 4363 (org-element-property :begin hl))) 4364 nil t) 4365 4366The next example will return a flat list of all `plain-list' type 4367elements in TREE that are not a sub-list themselves: 4368 4369 (org-element-map tree \\='plain-list #\\='identity nil nil \\='plain-list) 4370 4371Eventually, this example will return a flat list of all `bold' 4372type objects containing a `latex-snippet' type object, even 4373looking into captions: 4374 4375 (org-element-map tree \\='bold 4376 (lambda (b) 4377 (and (org-element-map b \\='latex-snippet #\\='identity nil t) b)) 4378 nil nil nil t)" 4379 (declare (indent 2)) 4380 ;; Ensure TYPES and NO-RECURSION are a list, even of one element. 4381 (let* ((types (if (listp types) types (list types))) 4382 (no-recursion (if (listp no-recursion) no-recursion 4383 (list no-recursion))) 4384 ;; Recursion depth is determined by --CATEGORY. 4385 (--category 4386 (catch :--found 4387 (let ((category 'greater-elements) 4388 (all-objects (cons 'plain-text org-element-all-objects))) 4389 (dolist (type types category) 4390 (cond ((memq type all-objects) 4391 ;; If one object is found, the function has 4392 ;; to recurse into every object. 4393 (throw :--found 'objects)) 4394 ((not (memq type org-element-greater-elements)) 4395 ;; If one regular element is found, the 4396 ;; function has to recurse, at least, into 4397 ;; every element it encounters. 4398 (and (not (eq category 'elements)) 4399 (setq category 'elements)))))))) 4400 --acc) 4401 (letrec ((--walk-tree 4402 (lambda (--data) 4403 ;; Recursively walk DATA. INFO, if non-nil, is a plist 4404 ;; holding contextual information. 4405 (let ((--type (org-element-type --data))) 4406 (cond 4407 ((not --data)) 4408 ;; Ignored element in an export context. 4409 ((and info (memq --data (plist-get info :ignore-list)))) 4410 ;; List of elements or objects. 4411 ((not --type) (mapc --walk-tree --data)) 4412 ;; Unconditionally enter parse trees. 4413 ((eq --type 'org-data) 4414 (mapc --walk-tree (org-element-contents --data))) 4415 (t 4416 ;; Check if TYPE is matching among TYPES. If so, 4417 ;; apply FUN to --DATA and accumulate return value 4418 ;; into --ACC (or exit if FIRST-MATCH is non-nil). 4419 (when (memq --type types) 4420 (let ((result (funcall fun --data))) 4421 (cond ((not result)) 4422 (first-match (throw :--map-first-match result)) 4423 (t (push result --acc))))) 4424 ;; If --DATA has a secondary string that can contain 4425 ;; objects with their type among TYPES, look inside. 4426 (when (and (eq --category 'objects) (not (stringp --data))) 4427 (dolist (p (cdr (assq --type 4428 org-element-secondary-value-alist))) 4429 (funcall --walk-tree (org-element-property p --data)))) 4430 ;; If --DATA has any parsed affiliated keywords and 4431 ;; WITH-AFFILIATED is non-nil, look for objects in 4432 ;; them. 4433 (when (and with-affiliated 4434 (eq --category 'objects) 4435 (eq (org-element-class --data) 'element)) 4436 (dolist (kwd-pair org-element--parsed-properties-alist) 4437 (let ((kwd (car kwd-pair)) 4438 (value (org-element-property (cdr kwd-pair) --data))) 4439 ;; Pay attention to the type of parsed 4440 ;; keyword. In particular, preserve order for 4441 ;; multiple keywords. 4442 (cond 4443 ((not value)) 4444 ((member kwd org-element-dual-keywords) 4445 (if (member kwd org-element-multiple-keywords) 4446 (dolist (line (reverse value)) 4447 (funcall --walk-tree (cdr line)) 4448 (funcall --walk-tree (car line))) 4449 (funcall --walk-tree (cdr value)) 4450 (funcall --walk-tree (car value)))) 4451 ((member kwd org-element-multiple-keywords) 4452 (mapc --walk-tree (reverse value))) 4453 (t (funcall --walk-tree value)))))) 4454 ;; Determine if a recursion into --DATA is possible. 4455 (cond 4456 ;; --TYPE is explicitly removed from recursion. 4457 ((memq --type no-recursion)) 4458 ;; --DATA has no contents. 4459 ((not (org-element-contents --data))) 4460 ;; Looking for greater elements but --DATA is 4461 ;; simply an element or an object. 4462 ((and (eq --category 'greater-elements) 4463 (not (memq --type org-element-greater-elements)))) 4464 ;; Looking for elements but --DATA is an object. 4465 ((and (eq --category 'elements) 4466 (eq (org-element-class --data) 'object))) 4467 ;; In any other case, map contents. 4468 (t (mapc --walk-tree (org-element-contents --data)))))))))) 4469 (catch :--map-first-match 4470 (funcall --walk-tree data) 4471 ;; Return value in a proper order. 4472 (nreverse --acc))))) 4473 4474;; The following functions are internal parts of the parser. 4475;; 4476;; The first one, `org-element--parse-elements' acts at the element's 4477;; level. 4478;; 4479;; The second one, `org-element--parse-objects' applies on all objects 4480;; of a paragraph or a secondary string. It calls 4481;; `org-element--object-lex' to find the next object in the current 4482;; container. 4483 4484(defsubst org-element--next-mode (mode type parent?) 4485 "Return next mode according to current one. 4486 4487MODE is a symbol representing the expectation about the next 4488element or object. Meaningful values are `first-section', 4489`item', `node-property', `planning', `property-drawer', 4490`section', `table-row', `top-comment', and nil. 4491 4492TYPE is the type of the current element or object. 4493 4494If PARENT? is non-nil, assume the next element or object will be 4495located inside the current one." 4496 (if parent? 4497 (pcase type 4498 (`headline 'section) 4499 ((and (guard (eq mode 'first-section)) `section) 'top-comment) 4500 (`inlinetask 'planning) 4501 (`plain-list 'item) 4502 (`property-drawer 'node-property) 4503 (`section 'planning) 4504 (`table 'table-row)) 4505 (pcase mode 4506 (`item 'item) 4507 (`node-property 'node-property) 4508 ((and `planning (guard (eq type 'planning))) 'property-drawer) 4509 (`table-row 'table-row) 4510 ((and `top-comment (guard (eq type 'comment))) 'property-drawer)))) 4511 4512(defun org-element--parse-elements 4513 (beg end mode structure granularity visible-only acc) 4514 "Parse elements between BEG and END positions. 4515 4516MODE prioritizes some elements over the others. It can be set to 4517`first-section', `item', `node-property', `planning', 4518`property-drawer', `section', `table-row', `top-comment', or nil. 4519 4520When value is `item', STRUCTURE will be used as the current list 4521structure. 4522 4523GRANULARITY determines the depth of the recursion. See 4524`org-element-parse-buffer' for more information. 4525 4526When VISIBLE-ONLY is non-nil, don't parse contents of hidden 4527elements. 4528 4529Elements are accumulated into ACC." 4530 (save-excursion 4531 (goto-char beg) 4532 ;; When parsing only headlines, skip any text before first one. 4533 (when (and (eq granularity 'headline) (not (org-at-heading-p))) 4534 (org-with-limited-levels (outline-next-heading))) 4535 (let (elements) 4536 (while (< (point) end) 4537 ;; Visible only: skip invisible parts due to folding. 4538 (if (and visible-only (org-invisible-p nil t)) 4539 (progn 4540 (goto-char (org-find-visible)) 4541 (when (and (eolp) (not (eobp))) (forward-char))) 4542 ;; Find current element's type and parse it accordingly to 4543 ;; its category. 4544 (let* ((element (org-element--current-element 4545 end granularity mode structure)) 4546 (type (org-element-type element)) 4547 (cbeg (org-element-property :contents-begin element))) 4548 (goto-char (org-element-property :end element)) 4549 ;; Fill ELEMENT contents by side-effect. 4550 (cond 4551 ;; If element has no contents, don't modify it. 4552 ((not cbeg)) 4553 ;; Greater element: parse it between `contents-begin' and 4554 ;; `contents-end'. Ensure GRANULARITY allows recursion, 4555 ;; or ELEMENT is a headline, in which case going inside 4556 ;; is mandatory, in order to get sub-level headings. 4557 ((and (memq type org-element-greater-elements) 4558 (or (memq granularity '(element object nil)) 4559 (and (eq granularity 'greater-element) 4560 (eq type 'section)) 4561 (eq type 'headline))) 4562 (org-element--parse-elements 4563 cbeg (org-element-property :contents-end element) 4564 ;; Possibly switch to a special mode. 4565 (org-element--next-mode mode type t) 4566 (and (memq type '(item plain-list)) 4567 (org-element-property :structure element)) 4568 granularity visible-only element)) 4569 ;; ELEMENT has contents. Parse objects inside, if 4570 ;; GRANULARITY allows it. 4571 ((memq granularity '(object nil)) 4572 (org-element--parse-objects 4573 cbeg (org-element-property :contents-end element) element 4574 (org-element-restriction type)))) 4575 (push (org-element-put-property element :parent acc) elements) 4576 ;; Update mode. 4577 (setq mode (org-element--next-mode mode type nil))))) 4578 ;; Return result. 4579 (apply #'org-element-set-contents acc (nreverse elements))))) 4580 4581(defun org-element--object-lex (restriction) 4582 "Return next object in current buffer or nil. 4583RESTRICTION is a list of object types, as symbols, that should be 4584looked after. This function assumes that the buffer is narrowed 4585to an appropriate container (e.g., a paragraph)." 4586 (cond 4587 ((memq 'table-cell restriction) (org-element-table-cell-parser)) 4588 ((memq 'citation-reference restriction) 4589 (org-element-citation-reference-parser)) 4590 (t 4591 (let* ((start (point)) 4592 (limit 4593 ;; Object regexp sometimes needs to have a peek at 4594 ;; a character ahead. Therefore, when there is a hard 4595 ;; limit, make it one more than the true beginning of the 4596 ;; radio target. 4597 (save-excursion 4598 (cond ((not org-target-link-regexp) nil) 4599 ((not (memq 'link restriction)) nil) 4600 ((progn 4601 (unless (bolp) (forward-char -1)) 4602 (not (re-search-forward org-target-link-regexp nil t))) 4603 nil) 4604 ;; Since we moved backward, we do not want to 4605 ;; match again an hypothetical 1-character long 4606 ;; radio link before us. Realizing that this can 4607 ;; only happen if such a radio link starts at 4608 ;; beginning of line, we prevent this here. 4609 ((and (= start (1+ (line-beginning-position))) 4610 (= start (match-end 1))) 4611 (and (re-search-forward org-target-link-regexp nil t) 4612 (1+ (match-beginning 1)))) 4613 (t (1+ (match-beginning 1)))))) 4614 found) 4615 (save-excursion 4616 (while (and (not found) 4617 (re-search-forward org-element--object-regexp limit 'move)) 4618 (goto-char (match-beginning 0)) 4619 (let ((result (match-string 0))) 4620 (setq found 4621 (cond 4622 ((string-prefix-p "call_" result t) 4623 (and (memq 'inline-babel-call restriction) 4624 (org-element-inline-babel-call-parser))) 4625 ((string-prefix-p "src_" result t) 4626 (and (memq 'inline-src-block restriction) 4627 (org-element-inline-src-block-parser))) 4628 (t 4629 (pcase (char-after) 4630 (?^ (and (memq 'superscript restriction) 4631 (org-element-superscript-parser))) 4632 (?_ (or (and (memq 'subscript restriction) 4633 (org-element-subscript-parser)) 4634 (and (memq 'underline restriction) 4635 (org-element-underline-parser)))) 4636 (?* (and (memq 'bold restriction) 4637 (org-element-bold-parser))) 4638 (?/ (and (memq 'italic restriction) 4639 (org-element-italic-parser))) 4640 (?~ (and (memq 'code restriction) 4641 (org-element-code-parser))) 4642 (?= (and (memq 'verbatim restriction) 4643 (org-element-verbatim-parser))) 4644 (?+ (and (memq 'strike-through restriction) 4645 (org-element-strike-through-parser))) 4646 (?@ (and (memq 'export-snippet restriction) 4647 (org-element-export-snippet-parser))) 4648 (?{ (and (memq 'macro restriction) 4649 (org-element-macro-parser))) 4650 (?$ (and (memq 'latex-fragment restriction) 4651 (org-element-latex-fragment-parser))) 4652 (?< 4653 (if (eq (aref result 1) ?<) 4654 (or (and (memq 'radio-target restriction) 4655 (org-element-radio-target-parser)) 4656 (and (memq 'target restriction) 4657 (org-element-target-parser))) 4658 (or (and (memq 'timestamp restriction) 4659 (org-element-timestamp-parser)) 4660 (and (memq 'link restriction) 4661 (org-element-link-parser))))) 4662 (?\\ 4663 (if (eq (aref result 1) ?\\) 4664 (and (memq 'line-break restriction) 4665 (org-element-line-break-parser)) 4666 (or (and (memq 'entity restriction) 4667 (org-element-entity-parser)) 4668 (and (memq 'latex-fragment restriction) 4669 (org-element-latex-fragment-parser))))) 4670 (?\[ 4671 (pcase (aref result 1) 4672 ((and ?\[ 4673 (guard (memq 'link restriction))) 4674 (org-element-link-parser)) 4675 ((and ?f 4676 (guard (memq 'footnote-reference restriction))) 4677 (org-element-footnote-reference-parser)) 4678 ((and ?c 4679 (guard (memq 'citation restriction))) 4680 (org-element-citation-parser)) 4681 ((and (or ?% ?/) 4682 (guard (memq 'statistics-cookie restriction))) 4683 (org-element-statistics-cookie-parser)) 4684 (_ 4685 (or (and (memq 'timestamp restriction) 4686 (org-element-timestamp-parser)) 4687 (and (memq 'statistics-cookie restriction) 4688 (org-element-statistics-cookie-parser)))))) 4689 ;; This is probably a plain link. 4690 (_ (and (memq 'link restriction) 4691 (org-element-link-parser))))))) 4692 (or (eobp) (forward-char)))) 4693 (cond (found) 4694 (limit (forward-char -1) 4695 (org-element-link-parser)) ;radio link 4696 (t nil))))))) 4697 4698(defun org-element--parse-objects (beg end acc restriction &optional parent) 4699 "Parse objects between BEG and END and return recursive structure. 4700 4701Objects are accumulated in ACC. RESTRICTION is a list of object 4702successors which are allowed in the current object. 4703 4704ACC becomes the parent for all parsed objects. However, if ACC 4705is nil (i.e., a secondary string is being parsed) and optional 4706argument PARENT is non-nil, use it as the parent for all objects. 4707Eventually, if both ACC and PARENT are nil, the common parent is 4708the list of objects itself." 4709 (save-excursion 4710 (save-restriction 4711 (narrow-to-region beg end) 4712 (goto-char (point-min)) 4713 (let (next-object contents) 4714 (while (and (not (eobp)) 4715 (setq next-object (org-element--object-lex restriction))) 4716 ;; Text before any object. 4717 (let ((obj-beg (org-element-property :begin next-object))) 4718 (unless (= (point) obj-beg) 4719 (let ((text (buffer-substring-no-properties (point) obj-beg))) 4720 (push (if acc (org-element-put-property text :parent acc) text) 4721 contents)))) 4722 ;; Object... 4723 (let ((obj-end (org-element-property :end next-object)) 4724 (cont-beg (org-element-property :contents-begin next-object))) 4725 (when acc (org-element-put-property next-object :parent acc)) 4726 (push (if cont-beg 4727 ;; Fill contents of NEXT-OBJECT if possible. 4728 (org-element--parse-objects 4729 cont-beg 4730 (org-element-property :contents-end next-object) 4731 next-object 4732 (org-element-restriction next-object)) 4733 next-object) 4734 contents) 4735 (goto-char obj-end))) 4736 ;; Text after last object. 4737 (unless (eobp) 4738 (let ((text (buffer-substring-no-properties (point) end))) 4739 (push (if acc (org-element-put-property text :parent acc) text) 4740 contents))) 4741 ;; Result. Set appropriate parent. 4742 (if acc (apply #'org-element-set-contents acc (nreverse contents)) 4743 (let* ((contents (nreverse contents)) 4744 (parent (or parent contents))) 4745 (dolist (datum contents contents) 4746 (org-element-put-property datum :parent parent)))))))) 4747 4748 4749 4750;;; Towards A Bijective Process 4751;; 4752;; The parse tree obtained with `org-element-parse-buffer' is really 4753;; a snapshot of the corresponding Org buffer. Therefore, it can be 4754;; interpreted and expanded into a string with canonical Org syntax. 4755;; Hence `org-element-interpret-data'. 4756;; 4757;; The function relies internally on 4758;; `org-element--interpret-affiliated-keywords'. 4759 4760;;;###autoload 4761(defun org-element-interpret-data (data) 4762 "Interpret DATA as Org syntax. 4763DATA is a parse tree, an element, an object or a secondary string 4764to interpret. Return Org syntax as a string." 4765 (letrec ((fun 4766 (lambda (data parent) 4767 (let* ((type (org-element-type data)) 4768 ;; Find interpreter for current object or 4769 ;; element. If it doesn't exist (e.g. this is 4770 ;; a pseudo object or element), return contents, 4771 ;; if any. 4772 (interpret 4773 (let ((fun (intern 4774 (format "org-element-%s-interpreter" type)))) 4775 (if (fboundp fun) fun (lambda (_ contents) contents)))) 4776 (results 4777 (cond 4778 ;; Secondary string. 4779 ((not type) 4780 (mapconcat (lambda (obj) (funcall fun obj parent)) 4781 data 4782 "")) 4783 ;; Full Org document. 4784 ((eq type 'org-data) 4785 (mapconcat (lambda (obj) (funcall fun obj parent)) 4786 (org-element-contents data) 4787 "")) 4788 ;; Plain text: return it. 4789 ((stringp data) data) 4790 ;; Element or object without contents. 4791 ((not (org-element-contents data)) 4792 (funcall interpret data nil)) 4793 ;; Element or object with contents. 4794 (t 4795 (funcall 4796 interpret 4797 data 4798 ;; Recursively interpret contents. 4799 (mapconcat 4800 (lambda (datum) (funcall fun datum data)) 4801 (org-element-contents 4802 (if (not (memq type '(paragraph verse-block))) 4803 data 4804 ;; Fix indentation of elements containing 4805 ;; objects. We ignore `table-row' 4806 ;; elements as they are one line long 4807 ;; anyway. 4808 (org-element-normalize-contents 4809 data 4810 ;; When normalizing first paragraph of 4811 ;; an item or a footnote-definition, 4812 ;; ignore first line's indentation. 4813 (and (eq type 'paragraph) 4814 (memq (org-element-type parent) 4815 '(footnote-definition item)) 4816 (eq data (car (org-element-contents parent))) 4817 (eq (org-element-property :pre-blank parent) 4818 0))))) 4819 "")))))) 4820 (if (memq type '(org-data nil)) results 4821 ;; Build white spaces. If no `:post-blank' property 4822 ;; is specified, assume its value is 0. 4823 (let ((blank (or (org-element-property :post-blank data) 0))) 4824 (if (eq (org-element-class data parent) 'object) 4825 (concat results (make-string blank ?\s)) 4826 (concat (org-element--interpret-affiliated-keywords data) 4827 (org-element-normalize-string results) 4828 (make-string blank ?\n))))))))) 4829 (funcall fun data nil))) 4830 4831(defun org-element--interpret-affiliated-keywords (element) 4832 "Return ELEMENT's affiliated keywords as Org syntax. 4833If there is no affiliated keyword, return the empty string." 4834 (let ((keyword-to-org 4835 (lambda (key value) 4836 (let (dual) 4837 (when (member key org-element-dual-keywords) 4838 (setq dual (cdr value) value (car value))) 4839 (concat "#+" (downcase key) 4840 (and dual 4841 (format "[%s]" (org-element-interpret-data dual))) 4842 ": " 4843 (if (member key org-element-parsed-keywords) 4844 (org-element-interpret-data value) 4845 value) 4846 "\n"))))) 4847 (mapconcat 4848 (lambda (prop) 4849 (let ((value (org-element-property prop element)) 4850 (keyword (upcase (substring (symbol-name prop) 1)))) 4851 (when value 4852 (if (or (member keyword org-element-multiple-keywords) 4853 ;; All attribute keywords can have multiple lines. 4854 (string-match "^ATTR_" keyword)) 4855 (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) 4856 (reverse value) 4857 "") 4858 (funcall keyword-to-org keyword value))))) 4859 ;; List all ELEMENT's properties matching an attribute line or an 4860 ;; affiliated keyword, but ignore translated keywords since they 4861 ;; cannot belong to the property list. 4862 (cl-loop for prop in (nth 1 element) by 'cddr 4863 when (let ((keyword (upcase (substring (symbol-name prop) 1)))) 4864 (or (string-match "^ATTR_" keyword) 4865 (and 4866 (member keyword org-element-affiliated-keywords) 4867 (not (assoc keyword 4868 org-element-keyword-translation-alist))))) 4869 collect prop) 4870 ""))) 4871 4872;; Because interpretation of the parse tree must return the same 4873;; number of blank lines between elements and the same number of white 4874;; space after objects, some special care must be given to white 4875;; spaces. 4876;; 4877;; The first function, `org-element-normalize-string', ensures any 4878;; string different from the empty string will end with a single 4879;; newline character. 4880;; 4881;; The second function, `org-element-normalize-contents', removes 4882;; global indentation from the contents of the current element. 4883 4884(defun org-element-normalize-string (s) 4885 "Ensure string S ends with a single newline character. 4886 4887If S isn't a string return it unchanged. If S is the empty 4888string, return it. Otherwise, return a new string with a single 4889newline character at its end." 4890 (cond 4891 ((not (stringp s)) s) 4892 ((string= "" s) "") 4893 (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) 4894 (replace-match "\n" nil nil s))))) 4895 4896(defun org-element-normalize-contents (element &optional ignore-first) 4897 "Normalize plain text in ELEMENT's contents. 4898 4899ELEMENT must only contain plain text and objects. 4900 4901If optional argument IGNORE-FIRST is non-nil, ignore first line's 4902indentation to compute maximal common indentation. 4903 4904Return the normalized element that is element with global 4905indentation removed from its contents." 4906 (letrec ((find-min-ind 4907 ;; Return minimal common indentation within BLOB. This is 4908 ;; done by walking recursively BLOB and updating MIN-IND 4909 ;; along the way. FIRST-FLAG is non-nil when the next 4910 ;; object is expected to be a string that doesn't start 4911 ;; with a newline character. It happens for strings at 4912 ;; the beginnings of the contents or right after a line 4913 ;; break. 4914 (lambda (blob first-flag min-ind) 4915 (dolist (datum (org-element-contents blob) min-ind) 4916 (when first-flag 4917 (setq first-flag nil) 4918 (cond 4919 ;; Objects cannot start with spaces: in this 4920 ;; case, indentation is 0. 4921 ((not (stringp datum)) (throw :zero 0)) 4922 ((not (string-match 4923 "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum)) 4924 (throw :zero 0)) 4925 ((equal (match-string 2 datum) "\n") 4926 (put-text-property 4927 (match-beginning 1) (match-end 1) 'org-ind 'empty datum)) 4928 (t 4929 (let ((i (string-width (match-string 1 datum)))) 4930 (put-text-property 4931 (match-beginning 1) (match-end 1) 'org-ind i datum) 4932 (setq min-ind (min i min-ind)))))) 4933 (cond 4934 ((stringp datum) 4935 (let ((s 0)) 4936 (while (string-match 4937 "\n\\([ \t]*\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s) 4938 (setq s (match-end 1)) 4939 (cond 4940 ((equal (match-string 1 datum) "") 4941 (unless (member (match-string 2 datum) '("" "\n")) 4942 (throw :zero 0))) 4943 ((equal (match-string 2 datum) "\n") 4944 (put-text-property (match-beginning 1) (match-end 1) 4945 'org-ind 'empty datum)) 4946 (t 4947 (let ((i (string-width (match-string 1 datum)))) 4948 (put-text-property (match-beginning 1) (match-end 1) 4949 'org-ind i datum) 4950 (setq min-ind (min i min-ind)))))))) 4951 ((eq (org-element-type datum) 'line-break) 4952 (setq first-flag t)) 4953 ((memq (org-element-type datum) org-element-recursive-objects) 4954 (setq min-ind 4955 (funcall find-min-ind datum first-flag min-ind))))))) 4956 (min-ind 4957 (catch :zero 4958 (funcall find-min-ind 4959 element (not ignore-first) most-positive-fixnum)))) 4960 (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element 4961 ;; Build ELEMENT back, replacing each string with the same 4962 ;; string minus common indentation. 4963 (letrec ((build 4964 (lambda (datum) 4965 ;; Return DATUM with all its strings indentation 4966 ;; shortened from MIN-IND white spaces. 4967 (setcdr 4968 (cdr datum) 4969 (mapcar 4970 (lambda (object) 4971 (cond 4972 ((stringp object) 4973 (with-temp-buffer 4974 (insert object) 4975 (let ((s (point-min))) 4976 (while (setq s (text-property-not-all 4977 s (point-max) 'org-ind nil)) 4978 (goto-char s) 4979 (let ((i (get-text-property s 'org-ind))) 4980 (delete-region s (progn 4981 (skip-chars-forward " \t") 4982 (point))) 4983 (when (integerp i) (indent-to (- i min-ind)))))) 4984 (buffer-string))) 4985 ((memq (org-element-type object) 4986 org-element-recursive-objects) 4987 (funcall build object)) 4988 (t object))) 4989 (org-element-contents datum))) 4990 datum))) 4991 (funcall build element))))) 4992 4993 4994 4995;;; Cache 4996;; 4997;; Implement a caching mechanism for `org-element-at-point' and 4998;; `org-element-context', which see. 4999;; 5000;; A single public function is provided: `org-element-cache-reset'. 5001;; 5002;; Cache is disabled by default for now because it sometimes triggers 5003;; freezes, but it can be enabled globally with 5004;; `org-element-use-cache'. `org-element-cache-sync-idle-time', 5005;; `org-element-cache-sync-duration' and 5006;; `org-element-cache-sync-break' can be tweaked to control caching 5007;; behavior. 5008;; 5009;; Internally, parsed elements are stored in an AVL tree, 5010;; `org-element--cache'. This tree is updated lazily: whenever 5011;; a change happens to the buffer, a synchronization request is 5012;; registered in `org-element--cache-sync-requests' (see 5013;; `org-element--cache-submit-request'). During idle time, requests 5014;; are processed by `org-element--cache-sync'. Synchronization also 5015;; happens when an element is required from the cache. In this case, 5016;; the process stops as soon as the needed element is up-to-date. 5017;; 5018;; A synchronization request can only apply on a synchronized part of 5019;; the cache. Therefore, the cache is updated at least to the 5020;; location where the new request applies. Thus, requests are ordered 5021;; from left to right and all elements starting before the first 5022;; request are correct. This property is used by functions like 5023;; `org-element--cache-find' to retrieve elements in the part of the 5024;; cache that can be trusted. 5025;; 5026;; A request applies to every element, starting from its original 5027;; location (or key, see below). When a request is processed, it 5028;; moves forward and may collide the next one. In this case, both 5029;; requests are merged into a new one that starts from that element. 5030;; As a consequence, the whole synchronization complexity does not 5031;; depend on the number of pending requests, but on the number of 5032;; elements the very first request will be applied on. 5033;; 5034;; Elements cannot be accessed through their beginning position, which 5035;; may or may not be up-to-date. Instead, each element in the tree is 5036;; associated to a key, obtained with `org-element--cache-key'. This 5037;; mechanism is robust enough to preserve total order among elements 5038;; even when the tree is only partially synchronized. 5039 5040 5041(defvar org-element-use-cache nil 5042 "Non-nil when Org parser should cache its results. 5043 5044WARNING: for the time being, using cache sometimes triggers 5045freezes. Therefore, it is disabled by default. Activate it if 5046you want to help debugging the issue.") 5047 5048(defvar org-element-cache-sync-idle-time 0.6 5049 "Length, in seconds, of idle time before syncing cache.") 5050 5051(defvar org-element-cache-sync-duration 0.04 5052 "Maximum duration, as a time value, for a cache synchronization. 5053If the synchronization is not over after this delay, the process 5054pauses and resumes after `org-element-cache-sync-break' 5055seconds.") 5056 5057(defvar org-element-cache-sync-break 0.3 5058 "Duration, as a time value, of the pause between synchronizations. 5059See `org-element-cache-sync-duration' for more information.") 5060 5061 5062;;;; Data Structure 5063 5064(defvar org-element--cache nil 5065 "AVL tree used to cache elements. 5066Each node of the tree contains an element. Comparison is done 5067with `org-element--cache-compare'. This cache is used in 5068`org-element-at-point'.") 5069 5070(defvar org-element--cache-sync-requests nil 5071 "List of pending synchronization requests. 5072 5073A request is a vector with the following pattern: 5074 5075 [NEXT BEG END OFFSET PARENT PHASE] 5076 5077Processing a synchronization request consists of three phases: 5078 5079 0. Delete modified elements, 5080 1. Fill missing area in cache, 5081 2. Shift positions and re-parent elements after the changes. 5082 5083During phase 0, NEXT is the key of the first element to be 5084removed, BEG and END is buffer position delimiting the 5085modifications. Elements starting between them (inclusive) are 5086removed. So are elements whose parent is removed. PARENT, when 5087non-nil, is the parent of the first element to be removed. 5088 5089During phase 1, NEXT is the key of the next known element in 5090cache and BEG its beginning position. Parse buffer between that 5091element and the one before it in order to determine the parent of 5092the next element. Set PARENT to the element containing NEXT. 5093 5094During phase 2, NEXT is the key of the next element to shift in 5095the parse tree. All elements starting from this one have their 5096properties relatives to buffer positions shifted by integer 5097OFFSET and, if they belong to element PARENT, are adopted by it. 5098 5099PHASE specifies the phase number, as an integer.") 5100 5101(defvar org-element--cache-sync-timer nil 5102 "Timer used for cache synchronization.") 5103 5104(defvar org-element--cache-sync-keys nil 5105 "Hash table used to store keys during synchronization. 5106See `org-element--cache-key' for more information.") 5107 5108(defsubst org-element--cache-key (element) 5109 "Return a unique key for ELEMENT in cache tree. 5110 5111Keys are used to keep a total order among elements in the cache. 5112Comparison is done with `org-element--cache-key-less-p'. 5113 5114When no synchronization is taking place, a key is simply the 5115beginning position of the element, or that position plus one in 5116the case of an first item (respectively row) in 5117a list (respectively a table). 5118 5119During a synchronization, the key is the one the element had when 5120the cache was synchronized for the last time. Elements added to 5121cache during the synchronization get a new key generated with 5122`org-element--cache-generate-key'. 5123 5124Such keys are stored in `org-element--cache-sync-keys'. The hash 5125table is cleared once the synchronization is complete." 5126 (or (gethash element org-element--cache-sync-keys) 5127 (let* ((begin (org-element-property :begin element)) 5128 ;; Increase beginning position of items (respectively 5129 ;; table rows) by one, so the first item can get 5130 ;; a different key from its parent list (respectively 5131 ;; table). 5132 (key (if (memq (org-element-type element) '(item table-row)) 5133 (1+ begin) 5134 begin))) 5135 (if org-element--cache-sync-requests 5136 (puthash element key org-element--cache-sync-keys) 5137 key)))) 5138 5139(defun org-element--cache-generate-key (lower upper) 5140 "Generate a key between LOWER and UPPER. 5141 5142LOWER and UPPER are fixnums or lists of same, possibly empty. 5143 5144If LOWER and UPPER are equals, return LOWER. Otherwise, return 5145a unique key, as an integer or a list of integers, according to 5146the following rules: 5147 5148 - LOWER and UPPER are compared level-wise until values differ. 5149 5150 - If, at a given level, LOWER and UPPER differ from more than 5151 2, the new key shares all the levels above with LOWER and 5152 gets a new level. Its value is the mean between LOWER and 5153 UPPER: 5154 5155 (1 2) + (1 4) --> (1 3) 5156 5157 - If LOWER has no value to compare with, it is assumed that its 5158 value is `most-negative-fixnum'. E.g., 5159 5160 (1 1) + (1 1 2) 5161 5162 is equivalent to 5163 5164 (1 1 m) + (1 1 2) 5165 5166 where m is `most-negative-fixnum'. Likewise, if UPPER is 5167 short of levels, the current value is `most-positive-fixnum'. 5168 5169 - If they differ from only one, the new key inherits from 5170 current LOWER level and fork it at the next level. E.g., 5171 5172 (2 1) + (3 3) 5173 5174 is equivalent to 5175 5176 (2 1) + (2 M) 5177 5178 where M is `most-positive-fixnum'. 5179 5180 - If the key is only one level long, it is returned as an 5181 integer: 5182 5183 (1 2) + (3 2) --> 2 5184 5185When they are not equals, the function assumes that LOWER is 5186lesser than UPPER, per `org-element--cache-key-less-p'." 5187 (if (equal lower upper) lower 5188 (let ((lower (if (integerp lower) (list lower) lower)) 5189 (upper (if (integerp upper) (list upper) upper)) 5190 skip-upper key) 5191 (catch 'exit 5192 (while t 5193 (let ((min (or (car lower) most-negative-fixnum)) 5194 (max (cond (skip-upper most-positive-fixnum) 5195 ((car upper)) 5196 (t most-positive-fixnum)))) 5197 (if (< (1+ min) max) 5198 (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1)))) 5199 (throw 'exit (if key (nreverse (cons mean key)) mean))) 5200 (when (and (< min max) (not skip-upper)) 5201 ;; When at a given level, LOWER and UPPER differ from 5202 ;; 1, ignore UPPER altogether. Instead create a key 5203 ;; between LOWER and the greatest key with the same 5204 ;; prefix as LOWER so far. 5205 (setq skip-upper t)) 5206 (push min key) 5207 (setq lower (cdr lower) upper (cdr upper))))))))) 5208 5209(defsubst org-element--cache-key-less-p (a b) 5210 "Non-nil if key A is less than key B. 5211A and B are either integers or lists of integers, as returned by 5212`org-element--cache-key'." 5213 (if (integerp a) (if (integerp b) (< a b) (<= a (car b))) 5214 (if (integerp b) (< (car a) b) 5215 (catch 'exit 5216 (while (and a b) 5217 (cond ((car-less-than-car a b) (throw 'exit t)) 5218 ((car-less-than-car b a) (throw 'exit nil)) 5219 (t (setq a (cdr a) b (cdr b))))) 5220 ;; If A is empty, either keys are equal (B is also empty) and 5221 ;; we return nil, or A is lesser than B (B is longer) and we 5222 ;; return a non-nil value. 5223 ;; 5224 ;; If A is not empty, B is necessarily empty and A is greater 5225 ;; than B (A is longer). Therefore, return nil. 5226 (and (null a) b))))) 5227 5228(defun org-element--cache-compare (a b) 5229 "Non-nil when element A is located before element B." 5230 (org-element--cache-key-less-p (org-element--cache-key a) 5231 (org-element--cache-key b))) 5232 5233(defsubst org-element--cache-root () 5234 "Return root value in cache. 5235This function assumes `org-element--cache' is a valid AVL tree." 5236 (avl-tree--node-left (avl-tree--dummyroot org-element--cache))) 5237 5238 5239;;;; Tools 5240 5241(defsubst org-element--cache-active-p () 5242 "Non-nil when cache is active in current buffer." 5243 (and org-element-use-cache 5244 org-element--cache 5245 (derived-mode-p 'org-mode))) 5246 5247(defun org-element--cache-find (pos &optional side) 5248 "Find element in cache starting at POS or before. 5249 5250POS refers to a buffer position. 5251 5252When optional argument SIDE is non-nil, the function checks for 5253elements starting at or past POS instead. If SIDE is `both', the 5254function returns a cons cell where car is the first element 5255starting at or before POS and cdr the first element starting 5256after POS. 5257 5258The function can only find elements in the synchronized part of 5259the cache." 5260 (let ((limit (and org-element--cache-sync-requests 5261 (aref (car org-element--cache-sync-requests) 0))) 5262 (node (org-element--cache-root)) 5263 lower upper) 5264 (while node 5265 (let* ((element (avl-tree--node-data node)) 5266 (begin (org-element-property :begin element))) 5267 (cond 5268 ((and limit 5269 (not (org-element--cache-key-less-p 5270 (org-element--cache-key element) limit))) 5271 (setq node (avl-tree--node-left node))) 5272 ((> begin pos) 5273 (setq upper element 5274 node (avl-tree--node-left node))) 5275 ((< begin pos) 5276 (setq lower element 5277 node (avl-tree--node-right node))) 5278 ;; We found an element in cache starting at POS. If `side' 5279 ;; is `both' we also want the next one in order to generate 5280 ;; a key in-between. 5281 ;; 5282 ;; If the element is the first row or item in a table or 5283 ;; a plain list, we always return the table or the plain 5284 ;; list. 5285 ;; 5286 ;; In any other case, we return the element found. 5287 ((eq side 'both) 5288 (setq lower element) 5289 (setq node (avl-tree--node-right node))) 5290 ((and (memq (org-element-type element) '(item table-row)) 5291 (let ((parent (org-element-property :parent element))) 5292 (and (= (org-element-property :begin element) 5293 (org-element-property :contents-begin parent)) 5294 (setq node nil 5295 lower parent 5296 upper parent))))) 5297 (t 5298 (setq node nil 5299 lower element 5300 upper element))))) 5301 (pcase side 5302 (`both (cons lower upper)) 5303 (`nil lower) 5304 (_ upper)))) 5305 5306(defun org-element--cache-put (element) 5307 "Store ELEMENT in current buffer's cache, if allowed." 5308 (when (org-element--cache-active-p) 5309 (when org-element--cache-sync-requests 5310 ;; During synchronization, first build an appropriate key for 5311 ;; the new element so `avl-tree-enter' can insert it at the 5312 ;; right spot in the cache. 5313 (let ((keys (org-element--cache-find 5314 (org-element-property :begin element) 'both))) 5315 (puthash element 5316 (org-element--cache-generate-key 5317 (and (car keys) (org-element--cache-key (car keys))) 5318 (cond ((cdr keys) (org-element--cache-key (cdr keys))) 5319 (org-element--cache-sync-requests 5320 (aref (car org-element--cache-sync-requests) 0)))) 5321 org-element--cache-sync-keys))) 5322 (avl-tree-enter org-element--cache element))) 5323 5324(defsubst org-element--cache-remove (element) 5325 "Remove ELEMENT from cache. 5326Assume ELEMENT belongs to cache and that a cache is active." 5327 (avl-tree-delete org-element--cache element)) 5328 5329 5330;;;; Synchronization 5331 5332(defsubst org-element--cache-set-timer (buffer) 5333 "Set idle timer for cache synchronization in BUFFER." 5334 (when org-element--cache-sync-timer 5335 (cancel-timer org-element--cache-sync-timer)) 5336 (setq org-element--cache-sync-timer 5337 (run-with-idle-timer 5338 (let ((idle (current-idle-time))) 5339 (if idle (org-time-add idle org-element-cache-sync-break) 5340 org-element-cache-sync-idle-time)) 5341 nil 5342 #'org-element--cache-sync 5343 buffer))) 5344 5345(defsubst org-element--cache-interrupt-p (time-limit) 5346 "Non-nil when synchronization process should be interrupted. 5347TIME-LIMIT is a time value or nil." 5348 (and time-limit 5349 (or (input-pending-p) 5350 (org-time-less-p time-limit nil)))) 5351 5352(defsubst org-element--cache-shift-positions (element offset &optional props) 5353 "Shift ELEMENT properties relative to buffer positions by OFFSET. 5354 5355Properties containing buffer positions are `:begin', `:end', 5356`:contents-begin', `:contents-end' and `:structure'. When 5357optional argument PROPS is a list of keywords, only shift 5358properties provided in that list. 5359 5360Properties are modified by side-effect." 5361 (let ((properties (nth 1 element))) 5362 ;; Shift `:structure' property for the first plain list only: it 5363 ;; is the only one that really matters and it prevents from 5364 ;; shifting it more than once. 5365 (when (and (or (not props) (memq :structure props)) 5366 (eq (org-element-type element) 'plain-list) 5367 (not (eq (org-element-type (plist-get properties :parent)) 5368 'item))) 5369 (dolist (item (plist-get properties :structure)) 5370 (cl-incf (car item) offset) 5371 (cl-incf (nth 6 item) offset))) 5372 (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated)) 5373 (let ((value (and (or (not props) (memq key props)) 5374 (plist-get properties key)))) 5375 (and value (plist-put properties key (+ offset value))))))) 5376 5377(defun org-element--cache-sync (buffer &optional threshold future-change) 5378 "Synchronize cache with recent modification in BUFFER. 5379 5380When optional argument THRESHOLD is non-nil, do the 5381synchronization for all elements starting before or at threshold, 5382then exit. Otherwise, synchronize cache for as long as 5383`org-element-cache-sync-duration' or until Emacs leaves idle 5384state. 5385 5386FUTURE-CHANGE, when non-nil, is a buffer position where changes 5387not registered yet in the cache are going to happen. It is used 5388in `org-element--cache-submit-request', where cache is partially 5389updated before current modification are actually submitted." 5390 (when (buffer-live-p buffer) 5391 (with-current-buffer buffer 5392 (let ((inhibit-quit t) request next) 5393 (when org-element--cache-sync-timer 5394 (cancel-timer org-element--cache-sync-timer)) 5395 (catch 'interrupt 5396 (while org-element--cache-sync-requests 5397 (setq request (car org-element--cache-sync-requests) 5398 next (nth 1 org-element--cache-sync-requests)) 5399 (org-element--cache-process-request 5400 request 5401 (and next (aref next 0)) 5402 threshold 5403 (and (not threshold) 5404 (org-time-add nil 5405 org-element-cache-sync-duration)) 5406 future-change) 5407 ;; Request processed. Merge current and next offsets and 5408 ;; transfer ending position. 5409 (when next 5410 (cl-incf (aref next 3) (aref request 3)) 5411 (aset next 2 (aref request 2))) 5412 (setq org-element--cache-sync-requests 5413 (cdr org-element--cache-sync-requests)))) 5414 ;; If more requests are awaiting, set idle timer accordingly. 5415 ;; Otherwise, reset keys. 5416 (if org-element--cache-sync-requests 5417 (org-element--cache-set-timer buffer) 5418 (clrhash org-element--cache-sync-keys)))))) 5419 5420(defun org-element--cache-process-request 5421 (request next threshold time-limit future-change) 5422 "Process synchronization REQUEST for all entries before NEXT. 5423 5424REQUEST is a vector, built by `org-element--cache-submit-request'. 5425 5426NEXT is a cache key, as returned by `org-element--cache-key'. 5427 5428When non-nil, THRESHOLD is a buffer position. Synchronization 5429stops as soon as a shifted element begins after it. 5430 5431When non-nil, TIME-LIMIT is a time value. Synchronization stops 5432after this time or when Emacs exits idle state. 5433 5434When non-nil, FUTURE-CHANGE is a buffer position where changes 5435not registered yet in the cache are going to happen. See 5436`org-element--cache-submit-request' for more information. 5437 5438Throw `interrupt' if the process stops before completing the 5439request." 5440 (catch 'quit 5441 (when (= (aref request 5) 0) 5442 ;; Phase 0. 5443 ;; 5444 ;; Delete all elements starting after BEG, but not after buffer 5445 ;; position END or past element with key NEXT. Also delete 5446 ;; elements contained within a previously removed element 5447 ;; (stored in `last-container'). 5448 ;; 5449 ;; At each iteration, we start again at tree root since 5450 ;; a deletion modifies structure of the balanced tree. 5451 (catch 'end-phase 5452 (while t 5453 (when (org-element--cache-interrupt-p time-limit) 5454 (throw 'interrupt nil)) 5455 ;; Find first element in cache with key BEG or after it. 5456 (let ((beg (aref request 0)) 5457 (end (aref request 2)) 5458 (node (org-element--cache-root)) 5459 data data-key last-container) 5460 (while node 5461 (let* ((element (avl-tree--node-data node)) 5462 (key (org-element--cache-key element))) 5463 (cond 5464 ((org-element--cache-key-less-p key beg) 5465 (setq node (avl-tree--node-right node))) 5466 ((org-element--cache-key-less-p beg key) 5467 (setq data element 5468 data-key key 5469 node (avl-tree--node-left node))) 5470 (t (setq data element 5471 data-key key 5472 node nil))))) 5473 (if data 5474 (let ((pos (org-element-property :begin data))) 5475 (if (if (or (not next) 5476 (org-element--cache-key-less-p data-key next)) 5477 (<= pos end) 5478 (and last-container 5479 (let ((up data)) 5480 (while (and up (not (eq up last-container))) 5481 (setq up (org-element-property :parent up))) 5482 up))) 5483 (progn (when (and (not last-container) 5484 (> (org-element-property :end data) 5485 end)) 5486 (setq last-container data)) 5487 (org-element--cache-remove data)) 5488 (aset request 0 data-key) 5489 (aset request 1 pos) 5490 (aset request 5 1) 5491 (throw 'end-phase nil))) 5492 ;; No element starting after modifications left in 5493 ;; cache: further processing is futile. 5494 (throw 'quit t)))))) 5495 (when (= (aref request 5) 1) 5496 ;; Phase 1. 5497 ;; 5498 ;; Phase 0 left a hole in the cache. Some elements after it 5499 ;; could have parents within. For example, in the following 5500 ;; buffer: 5501 ;; 5502 ;; - item 5503 ;; 5504 ;; 5505 ;; Paragraph1 5506 ;; 5507 ;; Paragraph2 5508 ;; 5509 ;; if we remove a blank line between "item" and "Paragraph1", 5510 ;; everything down to "Paragraph2" is removed from cache. But 5511 ;; the paragraph now belongs to the list, and its `:parent' 5512 ;; property no longer is accurate. 5513 ;; 5514 ;; Therefore we need to parse again elements in the hole, or at 5515 ;; least in its last section, so that we can re-parent 5516 ;; subsequent elements, during phase 2. 5517 ;; 5518 ;; Note that we only need to get the parent from the first 5519 ;; element in cache after the hole. 5520 ;; 5521 ;; When next key is lesser or equal to the current one, delegate 5522 ;; phase 1 processing to next request in order to preserve key 5523 ;; order among requests. 5524 (let ((key (aref request 0))) 5525 (when (and next (not (org-element--cache-key-less-p key next))) 5526 (let ((next-request (nth 1 org-element--cache-sync-requests))) 5527 (aset next-request 0 key) 5528 (aset next-request 1 (aref request 1)) 5529 (aset next-request 5 1)) 5530 (throw 'quit t))) 5531 ;; Next element will start at its beginning position plus 5532 ;; offset, since it hasn't been shifted yet. Therefore, LIMIT 5533 ;; contains the real beginning position of the first element to 5534 ;; shift and re-parent. 5535 (let ((limit (+ (aref request 1) (aref request 3)))) 5536 (cond ((and threshold (> limit threshold)) (throw 'interrupt nil)) 5537 ((and future-change (>= limit future-change)) 5538 ;; Changes are going to happen around this element and 5539 ;; they will trigger another phase 1 request. Skip the 5540 ;; current one. 5541 (aset request 5 2)) 5542 (t 5543 (let ((parent (org-element--parse-to limit t time-limit))) 5544 (aset request 4 parent) 5545 (aset request 5 2)))))) 5546 ;; Phase 2. 5547 ;; 5548 ;; Shift all elements starting from key START, but before NEXT, by 5549 ;; OFFSET, and re-parent them when appropriate. 5550 ;; 5551 ;; Elements are modified by side-effect so the tree structure 5552 ;; remains intact. 5553 ;; 5554 ;; Once THRESHOLD, if any, is reached, or once there is an input 5555 ;; pending, exit. Before leaving, the current synchronization 5556 ;; request is updated. 5557 (let ((start (aref request 0)) 5558 (offset (aref request 3)) 5559 (parent (aref request 4)) 5560 (node (org-element--cache-root)) 5561 (stack (list nil)) 5562 (leftp t) 5563 exit-flag) 5564 ;; No re-parenting nor shifting planned: request is over. 5565 (when (and (not parent) (zerop offset)) (throw 'quit t)) 5566 (while node 5567 (let* ((data (avl-tree--node-data node)) 5568 (key (org-element--cache-key data))) 5569 (if (and leftp (avl-tree--node-left node) 5570 (not (org-element--cache-key-less-p key start))) 5571 (progn (push node stack) 5572 (setq node (avl-tree--node-left node))) 5573 (unless (org-element--cache-key-less-p key start) 5574 ;; We reached NEXT. Request is complete. 5575 (when (equal key next) (throw 'quit t)) 5576 ;; Handle interruption request. Update current request. 5577 (when (or exit-flag (org-element--cache-interrupt-p time-limit)) 5578 (aset request 0 key) 5579 (aset request 4 parent) 5580 (throw 'interrupt nil)) 5581 ;; Shift element. 5582 (unless (zerop offset) 5583 (org-element--cache-shift-positions data offset)) 5584 (let ((begin (org-element-property :begin data))) 5585 ;; Update PARENT and re-parent DATA, only when 5586 ;; necessary. Propagate new structures for lists. 5587 (while (and parent 5588 (<= (org-element-property :end parent) begin)) 5589 (setq parent (org-element-property :parent parent))) 5590 (cond ((and (not parent) (zerop offset)) (throw 'quit nil)) 5591 ((and parent 5592 (let ((p (org-element-property :parent data))) 5593 (or (not p) 5594 (< (org-element-property :begin p) 5595 (org-element-property :begin parent))))) 5596 (org-element-put-property data :parent parent) 5597 (let ((s (org-element-property :structure parent))) 5598 (when (and s (org-element-property :structure data)) 5599 (org-element-put-property data :structure s))))) 5600 ;; Cache is up-to-date past THRESHOLD. Request 5601 ;; interruption. 5602 (when (and threshold (> begin threshold)) (setq exit-flag t)))) 5603 (setq node (if (setq leftp (avl-tree--node-right node)) 5604 (avl-tree--node-right node) 5605 (pop stack)))))) 5606 ;; We reached end of tree: synchronization complete. 5607 t))) 5608 5609(defun org-element--parse-to (pos &optional syncp time-limit) 5610 "Parse elements in current section, down to POS. 5611 5612Start parsing from the closest between the last known element in 5613cache or headline above. Return the smallest element containing 5614POS. 5615 5616When optional argument SYNCP is non-nil, return the parent of the 5617element containing POS instead. In that case, it is also 5618possible to provide TIME-LIMIT, which is a time value specifying 5619when the parsing should stop. The function throws `interrupt' if 5620the process stopped before finding the expected result." 5621 (catch 'exit 5622 (org-with-wide-buffer 5623 (goto-char pos) 5624 (let* ((cached (and (org-element--cache-active-p) 5625 (org-element--cache-find pos nil))) 5626 (begin (org-element-property :begin cached)) 5627 element next mode) 5628 (cond 5629 ;; Nothing in cache before point: start parsing from first 5630 ;; element following headline above, or first element in 5631 ;; buffer. 5632 ((not cached) 5633 (if (org-with-limited-levels (outline-previous-heading)) 5634 (progn 5635 (setq mode 'planning) 5636 (forward-line)) 5637 (setq mode 'top-comment)) 5638 (skip-chars-forward " \r\t\n") 5639 (beginning-of-line)) 5640 ;; Cache returned exact match: return it. 5641 ((= pos begin) 5642 (throw 'exit (if syncp (org-element-property :parent cached) cached))) 5643 ;; There's a headline between cached value and POS: cached 5644 ;; value is invalid. Start parsing from first element 5645 ;; following the headline. 5646 ((re-search-backward 5647 (org-with-limited-levels org-outline-regexp-bol) begin t) 5648 (forward-line) 5649 (skip-chars-forward " \r\t\n") 5650 (beginning-of-line) 5651 (setq mode 'planning)) 5652 ;; Check if CACHED or any of its ancestors contain point. 5653 ;; 5654 ;; If there is such an element, we inspect it in order to know 5655 ;; if we return it or if we need to parse its contents. 5656 ;; Otherwise, we just start parsing from current location, 5657 ;; which is right after the top-most element containing 5658 ;; CACHED. 5659 ;; 5660 ;; As a special case, if POS is at the end of the buffer, we 5661 ;; want to return the innermost element ending there. 5662 ;; 5663 ;; Also, if we find an ancestor and discover that we need to 5664 ;; parse its contents, make sure we don't start from 5665 ;; `:contents-begin', as we would otherwise go past CACHED 5666 ;; again. Instead, in that situation, we will resume parsing 5667 ;; from NEXT, which is located after CACHED or its higher 5668 ;; ancestor not containing point. 5669 (t 5670 (let ((up cached) 5671 (pos (if (= (point-max) pos) (1- pos) pos))) 5672 (goto-char (or (org-element-property :contents-begin cached) begin)) 5673 (while (let ((end (org-element-property :end up))) 5674 (and (<= end pos) 5675 (goto-char end) 5676 (setq up (org-element-property :parent up))))) 5677 (cond ((not up)) 5678 ((eobp) (setq element up)) 5679 (t (setq element up next (point))))))) 5680 ;; Parse successively each element until we reach POS. 5681 (let ((end (or (org-element-property :end element) 5682 (save-excursion 5683 (org-with-limited-levels (outline-next-heading)) 5684 (point)))) 5685 (parent element)) 5686 (while t 5687 (when syncp 5688 (cond ((= (point) pos) (throw 'exit parent)) 5689 ((org-element--cache-interrupt-p time-limit) 5690 (throw 'interrupt nil)))) 5691 (unless element 5692 (setq element (org-element--current-element 5693 end 'element mode 5694 (org-element-property :structure parent))) 5695 (org-element-put-property element :parent parent) 5696 (org-element--cache-put element)) 5697 (let ((elem-end (org-element-property :end element)) 5698 (type (org-element-type element))) 5699 (cond 5700 ;; Skip any element ending before point. Also skip 5701 ;; element ending at point (unless it is also the end of 5702 ;; buffer) since we're sure that another element begins 5703 ;; after it. 5704 ((and (<= elem-end pos) (/= (point-max) elem-end)) 5705 (goto-char elem-end) 5706 (setq mode (org-element--next-mode mode type nil))) 5707 ;; A non-greater element contains point: return it. 5708 ((not (memq type org-element-greater-elements)) 5709 (throw 'exit element)) 5710 ;; Otherwise, we have to decide if ELEMENT really 5711 ;; contains POS. In that case we start parsing from 5712 ;; contents' beginning. 5713 ;; 5714 ;; If POS is at contents' beginning but it is also at 5715 ;; the beginning of the first item in a list or a table. 5716 ;; In that case, we need to create an anchor for that 5717 ;; list or table, so return it. 5718 ;; 5719 ;; Also, if POS is at the end of the buffer, no element 5720 ;; can start after it, but more than one may end there. 5721 ;; Arbitrarily, we choose to return the innermost of 5722 ;; such elements. 5723 ((let ((cbeg (org-element-property :contents-begin element)) 5724 (cend (org-element-property :contents-end element))) 5725 (when (or syncp 5726 (and cbeg cend 5727 (or (< cbeg pos) 5728 (and (= cbeg pos) 5729 (not (memq type '(plain-list table))))) 5730 (or (> cend pos) 5731 (and (= cend pos) (= (point-max) pos))))) 5732 (goto-char (or next cbeg)) 5733 (setq next nil 5734 mode (org-element--next-mode mode type t) 5735 parent element 5736 end cend)))) 5737 ;; Otherwise, return ELEMENT as it is the smallest 5738 ;; element containing POS. 5739 (t (throw 'exit element)))) 5740 (setq element nil))))))) 5741 5742 5743;;;; Staging Buffer Changes 5744 5745(defconst org-element--cache-sensitive-re 5746 (concat 5747 "^\\*+ " "\\|" 5748 "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|" 5749 "^[ \t]*\\(?:" 5750 "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|" 5751 "\\\\begin{[A-Za-z0-9*]+}" "\\|" 5752 ":\\(?:\\w\\|[-_]\\)+:[ \t]*$" 5753 "\\)") 5754 "Regexp matching a sensitive line, structure wise. 5755A sensitive line is a headline, inlinetask, block, drawer, or 5756latex-environment boundary. When such a line is modified, 5757structure changes in the document may propagate in the whole 5758section, possibly making cache invalid.") 5759 5760(defvar org-element--cache-change-warning nil 5761 "Non-nil when a sensitive line is about to be changed. 5762It is a symbol among nil, t and `headline'.") 5763 5764(defun org-element--cache-before-change (beg end) 5765 "Request extension of area going to be modified if needed. 5766BEG and END are the beginning and end of the range of changed 5767text. See `before-change-functions' for more information." 5768 (when (org-element--cache-active-p) 5769 (org-with-wide-buffer 5770 (goto-char beg) 5771 (beginning-of-line) 5772 (let ((bottom (save-excursion (goto-char end) (line-end-position)))) 5773 (setq org-element--cache-change-warning 5774 (save-match-data 5775 (if (and (org-with-limited-levels (org-at-heading-p)) 5776 (= (line-end-position) bottom)) 5777 'headline 5778 (let ((case-fold-search t)) 5779 (re-search-forward 5780 org-element--cache-sensitive-re bottom t))))))))) 5781 5782(defun org-element--cache-after-change (beg end pre) 5783 "Update buffer modifications for current buffer. 5784BEG and END are the beginning and end of the range of changed 5785text, and the length in bytes of the pre-change text replaced by 5786that range. See `after-change-functions' for more information." 5787 (when (org-element--cache-active-p) 5788 (org-with-wide-buffer 5789 (goto-char beg) 5790 (beginning-of-line) 5791 (save-match-data 5792 (let ((top (point)) 5793 (bottom (save-excursion (goto-char end) (line-end-position)))) 5794 ;; Determine if modified area needs to be extended, according 5795 ;; to both previous and current state. We make a special 5796 ;; case for headline editing: if a headline is modified but 5797 ;; not removed, do not extend. 5798 (when (pcase org-element--cache-change-warning 5799 (`t t) 5800 (`headline 5801 (not (and (org-with-limited-levels (org-at-heading-p)) 5802 (= (line-end-position) bottom)))) 5803 (_ 5804 (let ((case-fold-search t)) 5805 (re-search-forward 5806 org-element--cache-sensitive-re bottom t)))) 5807 ;; Effectively extend modified area. 5808 (org-with-limited-levels 5809 (setq top (progn (goto-char top) 5810 (when (outline-previous-heading) (forward-line)) 5811 (point))) 5812 (setq bottom (progn (goto-char bottom) 5813 (if (outline-next-heading) (1- (point)) 5814 (point)))))) 5815 ;; Store synchronization request. 5816 (let ((offset (- end beg pre))) 5817 (org-element--cache-submit-request top (- bottom offset) offset))))) 5818 ;; Activate a timer to process the request during idle time. 5819 (org-element--cache-set-timer (current-buffer)))) 5820 5821(defun org-element--cache-for-removal (beg end offset) 5822 "Return first element to remove from cache. 5823 5824BEG and END are buffer positions delimiting buffer modifications. 5825OFFSET is the size of the changes. 5826 5827Returned element is usually the first element in cache containing 5828any position between BEG and END. As an exception, greater 5829elements around the changes that are robust to contents 5830modifications are preserved and updated according to the 5831changes." 5832 (let* ((elements (org-element--cache-find (1- beg) 'both)) 5833 (before (car elements)) 5834 (after (cdr elements))) 5835 (if (not before) after 5836 (let ((up before) 5837 (robust-flag t)) 5838 (while up 5839 (if (let ((type (org-element-type up))) 5840 (and (or (memq type '(center-block dynamic-block quote-block 5841 special-block)) 5842 ;; Drawers named "PROPERTIES" are probably 5843 ;; a properties drawer being edited. Force 5844 ;; parsing to check if editing is over. 5845 (and (eq type 'drawer) 5846 (not (string= 5847 (org-element-property :drawer-name up) 5848 "PROPERTIES")))) 5849 (let ((cbeg (org-element-property :contents-begin up))) 5850 (and cbeg 5851 (<= cbeg beg) 5852 (> (org-element-property :contents-end up) end))))) 5853 ;; UP is a robust greater element containing changes. 5854 ;; We only need to extend its ending boundaries. 5855 (org-element--cache-shift-positions 5856 up offset '(:contents-end :end)) 5857 (setq before up) 5858 (when robust-flag (setq robust-flag nil))) 5859 (setq up (org-element-property :parent up))) 5860 ;; We're at top level element containing ELEMENT: if it's 5861 ;; altered by buffer modifications, it is first element in 5862 ;; cache to be removed. Otherwise, that first element is the 5863 ;; following one. 5864 ;; 5865 ;; As a special case, do not remove BEFORE if it is a robust 5866 ;; container for current changes. 5867 (if (or (< (org-element-property :end before) beg) robust-flag) after 5868 before))))) 5869 5870(defun org-element--cache-submit-request (beg end offset) 5871 "Submit a new cache synchronization request for current buffer. 5872BEG and END are buffer positions delimiting the minimal area 5873where cache data should be removed. OFFSET is the size of the 5874change, as an integer." 5875 (let ((next (car org-element--cache-sync-requests)) 5876 delete-to delete-from) 5877 (if (and next 5878 (zerop (aref next 5)) 5879 (> (setq delete-to (+ (aref next 2) (aref next 3))) end) 5880 (<= (setq delete-from (aref next 1)) end)) 5881 ;; Current changes can be merged with first sync request: we 5882 ;; can save a partial cache synchronization. 5883 (progn 5884 (cl-incf (aref next 3) offset) 5885 ;; If last change happened within area to be removed, extend 5886 ;; boundaries of robust parents, if any. Otherwise, find 5887 ;; first element to remove and update request accordingly. 5888 (if (> beg delete-from) 5889 (let ((up (aref next 4))) 5890 (while up 5891 (org-element--cache-shift-positions 5892 up offset '(:contents-end :end)) 5893 (setq up (org-element-property :parent up)))) 5894 (let ((first (org-element--cache-for-removal beg delete-to offset))) 5895 (when first 5896 (aset next 0 (org-element--cache-key first)) 5897 (aset next 1 (org-element-property :begin first)) 5898 (aset next 4 (org-element-property :parent first)))))) 5899 ;; Ensure cache is correct up to END. Also make sure that NEXT, 5900 ;; if any, is no longer a 0-phase request, thus ensuring that 5901 ;; phases are properly ordered. We need to provide OFFSET as 5902 ;; optional parameter since current modifications are not known 5903 ;; yet to the otherwise correct part of the cache (i.e, before 5904 ;; the first request). 5905 (when next (org-element--cache-sync (current-buffer) end beg)) 5906 (let ((first (org-element--cache-for-removal beg end offset))) 5907 (if first 5908 (push (let ((beg (org-element-property :begin first)) 5909 (key (org-element--cache-key first))) 5910 (cond 5911 ;; When changes happen before the first known 5912 ;; element, re-parent and shift the rest of the 5913 ;; cache. 5914 ((> beg end) (vector key beg nil offset nil 1)) 5915 ;; Otherwise, we find the first non robust 5916 ;; element containing END. All elements between 5917 ;; FIRST and this one are to be removed. 5918 ((let ((first-end (org-element-property :end first))) 5919 (and (> first-end end) 5920 (vector key beg first-end offset first 0)))) 5921 (t 5922 (let* ((element (org-element--cache-find end)) 5923 (end (org-element-property :end element)) 5924 (up element)) 5925 (while (and (setq up (org-element-property :parent up)) 5926 (>= (org-element-property :begin up) beg)) 5927 (setq end (org-element-property :end up) 5928 element up)) 5929 (vector key beg end offset element 0))))) 5930 org-element--cache-sync-requests) 5931 ;; No element to remove. No need to re-parent either. 5932 ;; Simply shift additional elements, if any, by OFFSET. 5933 (when org-element--cache-sync-requests 5934 (cl-incf (aref (car org-element--cache-sync-requests) 3) 5935 offset))))))) 5936 5937 5938;;;; Public Functions 5939 5940;;;###autoload 5941(defun org-element-cache-reset (&optional all) 5942 "Reset cache in current buffer. 5943When optional argument ALL is non-nil, reset cache in all Org 5944buffers." 5945 (interactive "P") 5946 (dolist (buffer (if all (buffer-list) (list (current-buffer)))) 5947 (with-current-buffer buffer 5948 (when (and org-element-use-cache (derived-mode-p 'org-mode)) 5949 (setq-local org-element--cache 5950 (avl-tree-create #'org-element--cache-compare)) 5951 (setq-local org-element--cache-sync-keys 5952 (make-hash-table :weakness 'key :test #'eq)) 5953 (setq-local org-element--cache-change-warning nil) 5954 (setq-local org-element--cache-sync-requests nil) 5955 (setq-local org-element--cache-sync-timer nil) 5956 (add-hook 'before-change-functions 5957 #'org-element--cache-before-change nil t) 5958 (add-hook 'after-change-functions 5959 #'org-element--cache-after-change nil t))))) 5960 5961;;;###autoload 5962(defun org-element-cache-refresh (pos) 5963 "Refresh cache at position POS." 5964 (when (org-element--cache-active-p) 5965 (org-element--cache-sync (current-buffer) pos) 5966 (org-element--cache-submit-request pos pos 0) 5967 (org-element--cache-set-timer (current-buffer)))) 5968 5969 5970 5971;;; The Toolbox 5972;; 5973;; The first move is to implement a way to obtain the smallest element 5974;; containing point. This is the job of `org-element-at-point'. It 5975;; basically jumps back to the beginning of section containing point 5976;; and proceed, one element after the other, with 5977;; `org-element--current-element' until the container is found. Note: 5978;; When using `org-element-at-point', secondary values are never 5979;; parsed since the function focuses on elements, not on objects. 5980;; 5981;; At a deeper level, `org-element-context' lists all elements and 5982;; objects containing point. 5983;; 5984;; `org-element-nested-p' and `org-element-swap-A-B' may be used 5985;; internally by navigation and manipulation tools. 5986 5987 5988;;;###autoload 5989(defun org-element-at-point () 5990 "Determine closest element around point. 5991 5992Return value is a list like (TYPE PROPS) where TYPE is the type 5993of the element and PROPS a plist of properties associated to the 5994element. 5995 5996Possible types are defined in `org-element-all-elements'. 5997Properties depend on element or object type, but always include 5998`:begin', `:end', and `:post-blank' properties. 5999 6000As a special case, if point is at the very beginning of the first 6001item in a list or sub-list, returned element will be that list 6002instead of the item. Likewise, if point is at the beginning of 6003the first row of a table, returned element will be the table 6004instead of the first row. 6005 6006When point is at the end of the buffer, return the innermost 6007element ending there." 6008 (org-with-wide-buffer 6009 (let ((origin (point))) 6010 (end-of-line) 6011 (skip-chars-backward " \r\t\n") 6012 (cond 6013 ;; Within blank lines at the beginning of buffer, return nil. 6014 ((bobp) nil) 6015 ;; Within blank lines right after a headline, return that 6016 ;; headline. 6017 ((org-with-limited-levels (org-at-heading-p)) 6018 (beginning-of-line) 6019 (org-element-headline-parser (point-max) t)) 6020 ;; Otherwise parse until we find element containing ORIGIN. 6021 (t 6022 (when (org-element--cache-active-p) 6023 (if (not org-element--cache) (org-element-cache-reset) 6024 (org-element--cache-sync (current-buffer) origin))) 6025 (org-element--parse-to origin)))))) 6026 6027;;;###autoload 6028(defun org-element-context (&optional element) 6029 "Return smallest element or object around point. 6030 6031Return value is a list like (TYPE PROPS) where TYPE is the type 6032of the element or object and PROPS a plist of properties 6033associated to it. 6034 6035Possible types are defined in `org-element-all-elements' and 6036`org-element-all-objects'. Properties depend on element or 6037object type, but always include `:begin', `:end', `:parent' and 6038`:post-blank'. 6039 6040As a special case, if point is right after an object and not at 6041the beginning of any other object, return that object. 6042 6043Optional argument ELEMENT, when non-nil, is the closest element 6044containing point, as returned by `org-element-at-point'. 6045Providing it allows for quicker computation." 6046 (catch 'objects-forbidden 6047 (org-with-wide-buffer 6048 (let* ((pos (point)) 6049 (element (or element (org-element-at-point))) 6050 (type (org-element-type element)) 6051 (post (org-element-property :post-affiliated element))) 6052 ;; If point is inside an element containing objects or 6053 ;; a secondary string, narrow buffer to the container and 6054 ;; proceed with parsing. Otherwise, return ELEMENT. 6055 (cond 6056 ;; At a parsed affiliated keyword, check if we're inside main 6057 ;; or dual value. 6058 ((and post (< pos post)) 6059 (beginning-of-line) 6060 (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) 6061 (cond 6062 ((not (member-ignore-case (match-string 1) 6063 org-element-parsed-keywords)) 6064 (throw 'objects-forbidden element)) 6065 ((< (match-end 0) pos) 6066 (narrow-to-region (match-end 0) (line-end-position))) 6067 ((and (match-beginning 2) 6068 (>= pos (match-beginning 2)) 6069 (< pos (match-end 2))) 6070 (narrow-to-region (match-beginning 2) (match-end 2))) 6071 (t (throw 'objects-forbidden element))) 6072 ;; Also change type to retrieve correct restrictions. 6073 (setq type 'keyword)) 6074 ;; At an item, objects can only be located within tag, if any. 6075 ((eq type 'item) 6076 (let ((tag (org-element-property :tag element))) 6077 (if (or (not tag) (/= (line-beginning-position) post)) 6078 (throw 'objects-forbidden element) 6079 (beginning-of-line) 6080 (search-forward tag (line-end-position)) 6081 (goto-char (match-beginning 0)) 6082 (if (and (>= pos (point)) (< pos (match-end 0))) 6083 (narrow-to-region (point) (match-end 0)) 6084 (throw 'objects-forbidden element))))) 6085 ;; At an headline or inlinetask, objects are in title. 6086 ((memq type '(headline inlinetask)) 6087 (let ((case-fold-search nil)) 6088 (goto-char (org-element-property :begin element)) 6089 (looking-at org-complex-heading-regexp) 6090 (let ((end (match-end 4))) 6091 (if (not end) (throw 'objects-forbidden element) 6092 (goto-char (match-beginning 4)) 6093 (when (looking-at org-comment-string) 6094 (goto-char (match-end 0))) 6095 (if (>= (point) end) (throw 'objects-forbidden element) 6096 (narrow-to-region (point) end)))))) 6097 ;; At a paragraph, a table-row or a verse block, objects are 6098 ;; located within their contents. 6099 ((memq type '(paragraph table-row verse-block)) 6100 (let ((cbeg (org-element-property :contents-begin element)) 6101 (cend (org-element-property :contents-end element))) 6102 ;; CBEG is nil for table rules. 6103 (if (and cbeg cend (>= pos cbeg) 6104 (or (< pos cend) (and (= pos cend) (eobp)))) 6105 (narrow-to-region cbeg cend) 6106 (throw 'objects-forbidden element)))) 6107 (t (throw 'objects-forbidden element))) 6108 (goto-char (point-min)) 6109 (let ((restriction (org-element-restriction type)) 6110 (parent element) 6111 last) 6112 (catch 'exit 6113 (while t 6114 (let ((next (org-element--object-lex restriction))) 6115 (when next (org-element-put-property next :parent parent)) 6116 ;; Process NEXT, if any, in order to know if we need to 6117 ;; skip it, return it or move into it. 6118 (if (or (not next) (> (org-element-property :begin next) pos)) 6119 (throw 'exit (or last parent)) 6120 (let ((end (org-element-property :end next)) 6121 (cbeg (org-element-property :contents-begin next)) 6122 (cend (org-element-property :contents-end next))) 6123 (cond 6124 ;; Skip objects ending before point. Also skip 6125 ;; objects ending at point unless it is also the 6126 ;; end of buffer, since we want to return the 6127 ;; innermost object. 6128 ((and (<= end pos) (/= (point-max) end)) 6129 (goto-char end) 6130 ;; For convenience, when object ends at POS, 6131 ;; without any space, store it in LAST, as we 6132 ;; will return it if no object starts here. 6133 (when (and (= end pos) 6134 (not (memq (char-before) '(?\s ?\t)))) 6135 (setq last next))) 6136 ;; If POS is within a container object, move into 6137 ;; that object. 6138 ((and cbeg cend 6139 (>= pos cbeg) 6140 (or (< pos cend) 6141 ;; At contents' end, if there is no 6142 ;; space before point, also move into 6143 ;; object, for consistency with 6144 ;; convenience feature above. 6145 (and (= pos cend) 6146 (or (= (point-max) pos) 6147 (not (memq (char-before pos) 6148 '(?\s ?\t))))))) 6149 (goto-char cbeg) 6150 (narrow-to-region (point) cend) 6151 (setq parent next) 6152 (setq restriction (org-element-restriction next))) 6153 ;; Otherwise, return NEXT. 6154 (t (throw 'exit next))))))))))))) 6155 6156(defun org-element-lineage (datum &optional types with-self) 6157 "List all ancestors of a given element or object. 6158 6159DATUM is an object or element. 6160 6161Return ancestors from the closest to the farthest. When optional 6162argument TYPES is a list of symbols, return the first element or 6163object in the lineage whose type belongs to that list instead. 6164 6165When optional argument WITH-SELF is non-nil, lineage includes 6166DATUM itself as the first element, and TYPES, if provided, also 6167apply to it. 6168 6169When DATUM is obtained through `org-element-context' or 6170`org-element-at-point', only ancestors from its section can be 6171found. There is no such limitation when DATUM belongs to a full 6172parse tree." 6173 (let ((up (if with-self datum (org-element-property :parent datum))) 6174 ancestors) 6175 (while (and up (not (memq (org-element-type up) types))) 6176 (unless types (push up ancestors)) 6177 (setq up (org-element-property :parent up))) 6178 (if types up (nreverse ancestors)))) 6179 6180(defun org-element-nested-p (elem-A elem-B) 6181 "Non-nil when elements ELEM-A and ELEM-B are nested." 6182 (let ((beg-A (org-element-property :begin elem-A)) 6183 (beg-B (org-element-property :begin elem-B)) 6184 (end-A (org-element-property :end elem-A)) 6185 (end-B (org-element-property :end elem-B))) 6186 (or (and (>= beg-A beg-B) (<= end-A end-B)) 6187 (and (>= beg-B beg-A) (<= end-B end-A))))) 6188 6189(defun org-element-swap-A-B (elem-A elem-B) 6190 "Swap elements ELEM-A and ELEM-B. 6191Assume ELEM-B is after ELEM-A in the buffer. Leave point at the 6192end of ELEM-A." 6193 (goto-char (org-element-property :begin elem-A)) 6194 ;; There are two special cases when an element doesn't start at bol: 6195 ;; the first paragraph in an item or in a footnote definition. 6196 (let ((specialp (not (bolp)))) 6197 ;; Only a paragraph without any affiliated keyword can be moved at 6198 ;; ELEM-A position in such a situation. Note that the case of 6199 ;; a footnote definition is impossible: it cannot contain two 6200 ;; paragraphs in a row because it cannot contain a blank line. 6201 (when (and specialp 6202 (or (not (eq (org-element-type elem-B) 'paragraph)) 6203 (/= (org-element-property :begin elem-B) 6204 (org-element-property :contents-begin elem-B)))) 6205 (error "Cannot swap elements")) 6206 ;; In a special situation, ELEM-A will have no indentation. We'll 6207 ;; give it ELEM-B's (which will in, in turn, have no indentation). 6208 (let* ((ind-B (when specialp 6209 (goto-char (org-element-property :begin elem-B)) 6210 (current-indentation))) 6211 (beg-A (org-element-property :begin elem-A)) 6212 (end-A (save-excursion 6213 (goto-char (org-element-property :end elem-A)) 6214 (skip-chars-backward " \r\t\n") 6215 (point-at-eol))) 6216 (beg-B (org-element-property :begin elem-B)) 6217 (end-B (save-excursion 6218 (goto-char (org-element-property :end elem-B)) 6219 (skip-chars-backward " \r\t\n") 6220 (point-at-eol))) 6221 ;; Store inner overlays responsible for visibility status. 6222 ;; We also need to store their boundaries as they will be 6223 ;; removed from buffer. 6224 (overlays 6225 (cons 6226 (delq nil 6227 (mapcar (lambda (o) 6228 (and (>= (overlay-start o) beg-A) 6229 (<= (overlay-end o) end-A) 6230 (list o (overlay-start o) (overlay-end o)))) 6231 (overlays-in beg-A end-A))) 6232 (delq nil 6233 (mapcar (lambda (o) 6234 (and (>= (overlay-start o) beg-B) 6235 (<= (overlay-end o) end-B) 6236 (list o (overlay-start o) (overlay-end o)))) 6237 (overlays-in beg-B end-B))))) 6238 ;; Get contents. 6239 (body-A (buffer-substring beg-A end-A)) 6240 (body-B (delete-and-extract-region beg-B end-B))) 6241 (goto-char beg-B) 6242 (when specialp 6243 (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) 6244 (indent-to-column ind-B)) 6245 (insert body-A) 6246 ;; Restore ex ELEM-A overlays. 6247 (let ((offset (- beg-B beg-A))) 6248 (dolist (o (car overlays)) 6249 (move-overlay (car o) (+ (nth 1 o) offset) (+ (nth 2 o) offset))) 6250 (goto-char beg-A) 6251 (delete-region beg-A end-A) 6252 (insert body-B) 6253 ;; Restore ex ELEM-B overlays. 6254 (dolist (o (cdr overlays)) 6255 (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset)))) 6256 (goto-char (org-element-property :end elem-B))))) 6257 6258 6259(provide 'org-element) 6260 6261;; Local variables: 6262;; generated-autoload-file: "org-loaddefs.el" 6263;; End: 6264 6265;;; org-element.el ends here 6266