From 3f4a0d5370ae6c34afe180df96add3b8522f4af1 Mon Sep 17 00:00:00 2001 From: mattkae Date: Wed, 11 May 2022 09:23:58 -0400 Subject: initial commit --- elpa/org-9.5.2/org-element.el | 6265 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 6265 insertions(+) create mode 100644 elpa/org-9.5.2/org-element.el (limited to 'elpa/org-9.5.2/org-element.el') diff --git a/elpa/org-9.5.2/org-element.el b/elpa/org-9.5.2/org-element.el new file mode 100644 index 0000000..f8334cc --- /dev/null +++ b/elpa/org-9.5.2/org-element.el @@ -0,0 +1,6265 @@ +;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*- + +;; Copyright (C) 2012-2021 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see . + +;;; Commentary: +;; +;; See for details about +;; Org syntax. +;; +;; Lisp-wise, a syntax object can be represented as a list. +;; It follows the pattern (TYPE PROPERTIES CONTENTS), where: +;; TYPE is a symbol describing the object. +;; PROPERTIES is the property list attached to it. See docstring of +;; appropriate parsing function to get an exhaustive list. +;; CONTENTS is a list of syntax objects or raw strings contained +;; in the current object, when applicable. +;; +;; For the whole document, TYPE is `org-data' and PROPERTIES is nil. +;; +;; The first part of this file defines constants for the Org syntax, +;; while the second one provide accessors and setters functions. +;; +;; The next part implements a parser and an interpreter for each +;; element and object type in Org syntax. +;; +;; The following part creates a fully recursive buffer parser. It +;; also provides a tool to map a function to elements or objects +;; matching some criteria in the parse tree. Functions of interest +;; are `org-element-parse-buffer', `org-element-map' and, to a lesser +;; extent, `org-element-parse-secondary-string'. +;; +;; The penultimate part is the cradle of an interpreter for the +;; obtained parse tree: `org-element-interpret-data'. +;; +;; The library ends by furnishing `org-element-at-point' function, and +;; a way to give information about document structure around point +;; with `org-element-context'. A cache mechanism is also provided for +;; these functions. + + +;;; Code: + +(require 'avl-tree) +(require 'cl-lib) +(require 'ol) +(require 'org) +(require 'org-compat) +(require 'org-entities) +(require 'org-footnote) +(require 'org-list) +(require 'org-macs) +(require 'org-table) + +(declare-function org-at-heading-p "org" (&optional _)) +(declare-function org-end-of-subtree "org" (&optional invisible-ok to-heading)) +(declare-function org-escape-code-in-string "org-src" (s)) +(declare-function org-macro-escape-arguments "org-macro" (&rest args)) +(declare-function org-macro-extract-arguments "org-macro" (s)) +(declare-function org-reduced-level "org" (l)) +(declare-function org-unescape-code-in-string "org-src" (s)) +(declare-function outline-next-heading "outline" ()) +(declare-function outline-previous-heading "outline" ()) + +(defvar org-archive-tag) +(defvar org-clock-line-re) +(defvar org-closed-string) +(defvar org-comment-string) +(defvar org-complex-heading-regexp) +(defvar org-dblock-start-re) +(defvar org-deadline-string) +(defvar org-done-keywords) +(defvar org-drawer-regexp) +(defvar org-edit-src-content-indentation) +(defvar org-emph-re) +(defvar org-emphasis-regexp-components) +(defvar org-keyword-time-not-clock-regexp) +(defvar org-match-substring-regexp) +(defvar org-odd-levels-only) +(defvar org-outline-regexp-bol) +(defvar org-planning-line-re) +(defvar org-property-drawer-re) +(defvar org-property-format) +(defvar org-property-re) +(defvar org-scheduled-string) +(defvar org-src-preserve-indentation) +(defvar org-tags-column) +(defvar org-time-stamp-formats) +(defvar org-todo-regexp) +(defvar org-ts-regexp-both) +(defvar org-verbatim-re) + + +;;; Definitions And Rules +;; +;; Define elements, greater elements and specify recursive objects, +;; along with the affiliated keywords recognized. Also set up +;; restrictions on recursive objects combinations. +;; +;; `org-element-update-syntax' builds proper syntax regexps according +;; to current setup. + +(defconst org-element-citation-key-re + (rx "@" (group (one-or-more (any word "-.:?!`'/*@+|(){}<>&_^$#%~")))) + "Regexp matching a citation key. +Key is located in match group 1.") + +(defconst org-element-citation-prefix-re + (rx "[cite" + (opt "/" (group (one-or-more (any "/_-" alnum)))) ;style + ":" + (zero-or-more (any "\t\n "))) + "Regexp matching a citation prefix. +Style, if any, is located in match group 1.") + +(defvar org-element-paragraph-separate nil + "Regexp to separate paragraphs in an Org buffer. +In the case of lines starting with \"#\" and \":\", this regexp +is not sufficient to know if point is at a paragraph ending. See +`org-element-paragraph-parser' for more information.") + +(defvar org-element--object-regexp nil + "Regexp possibly matching the beginning of an object. +This regexp allows false positives. Dedicated parser (e.g., +`org-export-bold-parser') will take care of further filtering. +Radio links are not matched by this regexp, as they are treated +specially in `org-element--object-lex'.") + +(defun org-element--set-regexps () + "Build variable syntax regexps." + (setq org-element-paragraph-separate + (concat "^\\(?:" + ;; Headlines, inlinetasks. + "\\*+ " "\\|" + ;; Footnote definitions. + "\\[fn:[-_[:word:]]+\\]" "\\|" + ;; Diary sexps. + "%%(" "\\|" + "[ \t]*\\(?:" + ;; Empty lines. + "$" "\\|" + ;; Tables (any type). + "|" "\\|" + "\\+\\(?:-+\\+\\)+[ \t]*$" "\\|" + ;; Comments, keyword-like or block-like constructs. + ;; Blocks and keywords with dual values need to be + ;; double-checked. + "#\\(?: \\|$\\|\\+\\(?:" + "BEGIN_\\S-+" "\\|" + "\\S-+\\(?:\\[.*\\]\\)?:[ \t]*\\)\\)" + "\\|" + ;; Drawers (any type) and fixed-width areas. Drawers + ;; need to be double-checked. + ":\\(?: \\|$\\|[-_[:word:]]+:[ \t]*$\\)" "\\|" + ;; Horizontal rules. + "-\\{5,\\}[ \t]*$" "\\|" + ;; LaTeX environments. + "\\\\begin{\\([A-Za-z0-9*]+\\)}" "\\|" + ;; Clock lines. + "CLOCK:" "\\|" + ;; Lists. + (let ((term (pcase org-plain-list-ordered-item-terminator + (?\) ")") (?. "\\.") (_ "[.)]"))) + (alpha (and org-list-allow-alphabetical "\\|[A-Za-z]"))) + (concat "\\(?:[-+*]\\|\\(?:[0-9]+" alpha "\\)" term "\\)" + "\\(?:[ \t]\\|$\\)")) + "\\)\\)") + org-element--object-regexp + (mapconcat #'identity + (let ((link-types (regexp-opt (org-link-types)))) + (list + ;; Sub/superscript. + "\\(?:[_^][-{(*+.,[:alnum:]]\\)" + ;; Bold, code, italic, strike-through, underline + ;; and verbatim. + (concat "[*~=+_/]" + (format "[^%s]" + (nth 2 org-emphasis-regexp-components))) + ;; Plain links. + (concat "\\<" link-types ":") + ;; Objects starting with "[": citations, + ;; footnote reference, statistics cookie, + ;; timestamp (inactive) and regular link. + (format "\\[\\(?:%s\\)" + (mapconcat + #'identity + (list "cite[:/]" + "fn:" + "\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)" + "\\[") + "\\|")) + ;; Objects starting with "@": export snippets. + "@@" + ;; Objects starting with "{": macro. + "{{{" + ;; Objects starting with "<" : timestamp + ;; (active, diary), target, radio target and + ;; angular links. + (concat "<\\(?:%%\\|<\\|[0-9]\\|" link-types "\\)") + ;; Objects starting with "$": latex fragment. + "\\$" + ;; Objects starting with "\": line break, + ;; entity, latex fragment. + "\\\\\\(?:[a-zA-Z[(]\\|\\\\[ \t]*$\\|_ +\\)" + ;; Objects starting with raw text: inline Babel + ;; source block, inline Babel call. + "\\(?:call\\|src\\)_")) + "\\|"))) + +(org-element--set-regexps) + +;;;###autoload +(defun org-element-update-syntax () + "Update parser internals." + (interactive) + (org-element--set-regexps) + (org-element-cache-reset 'all)) + +(defconst org-element-all-elements + '(babel-call center-block clock comment comment-block diary-sexp drawer + dynamic-block example-block export-block fixed-width + footnote-definition headline horizontal-rule inlinetask item + keyword latex-environment node-property paragraph plain-list + planning property-drawer quote-block section + special-block src-block table table-row verse-block) + "Complete list of element types.") + +(defconst org-element-greater-elements + '(center-block drawer dynamic-block footnote-definition headline inlinetask + item plain-list property-drawer quote-block section + special-block table) + "List of recursive element types aka Greater Elements.") + +(defconst org-element-all-objects + '(bold citation citation-reference code entity export-snippet + footnote-reference inline-babel-call inline-src-block italic line-break + latex-fragment link macro radio-target statistics-cookie strike-through + subscript superscript table-cell target timestamp underline verbatim) + "Complete list of object types.") + +(defconst org-element-recursive-objects + '(bold citation footnote-reference italic link subscript radio-target + strike-through superscript table-cell underline) + "List of recursive object types.") + +(defconst org-element-object-containers + (append org-element-recursive-objects '(paragraph table-row verse-block)) + "List of object or element types that can directly contain objects.") + +(defconst org-element-affiliated-keywords + '("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT" + "RESULTS" "SOURCE" "SRCNAME" "TBLNAME") + "List of affiliated keywords as strings. +By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") +are affiliated keywords and need not to be in this list.") + +(defconst org-element-keyword-translation-alist + '(("DATA" . "NAME") ("LABEL" . "NAME") ("RESNAME" . "NAME") + ("SOURCE" . "NAME") ("SRCNAME" . "NAME") ("TBLNAME" . "NAME") + ("RESULT" . "RESULTS") ("HEADERS" . "HEADER")) + "Alist of usual translations for keywords. +The key is the old name and the value the new one. The property +holding their value will be named after the translated name.") + +(defconst org-element-multiple-keywords '("CAPTION" "HEADER") + "List of affiliated keywords that can occur more than once in an element. + +Their value will be consed into a list of strings, which will be +returned as the value of the property. + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'. + +By default, all keywords setting attributes (e.g., \"ATTR_LATEX\") +allow multiple occurrences and need not to be in this list.") + +(defconst org-element-parsed-keywords '("CAPTION") + "List of affiliated keywords whose value can be parsed. + +Their value will be stored as a secondary string: a list of +strings and objects. + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'.") + +(defconst org-element--parsed-properties-alist + (mapcar (lambda (k) (cons k (intern (concat ":" (downcase k))))) + org-element-parsed-keywords) + "Alist of parsed keywords and associated properties. +This is generated from `org-element-parsed-keywords', which +see.") + +(defconst org-element-dual-keywords '("CAPTION" "RESULTS") + "List of affiliated keywords which can have a secondary value. + +In Org syntax, they can be written with optional square brackets +before the colons. For example, RESULTS keyword can be +associated to a hash value with the following: + + #+RESULTS[hash-string]: some-source + +This list is checked after translations have been applied. See +`org-element-keyword-translation-alist'.") + +(defconst org-element--affiliated-re + (format "[ \t]*#\\+\\(?:%s\\):[ \t]*" + (concat + ;; Dual affiliated keywords. + (format "\\(?1:%s\\)\\(?:\\[\\(.*\\)\\]\\)?" + (regexp-opt org-element-dual-keywords)) + "\\|" + ;; Regular affiliated keywords. + (format "\\(?1:%s\\)" + (regexp-opt + (cl-remove-if + (lambda (k) (member k org-element-dual-keywords)) + org-element-affiliated-keywords))) + "\\|" + ;; Export attributes. + "\\(?1:ATTR_[-_A-Za-z0-9]+\\)")) + "Regexp matching any affiliated keyword. + +Keyword name is put in match group 1. Moreover, if keyword +belongs to `org-element-dual-keywords', put the dual value in +match group 2. + +Don't modify it, set `org-element-affiliated-keywords' instead.") + +(defconst org-element-object-restrictions + (let* ((minimal-set '(bold code entity italic latex-fragment strike-through + subscript superscript underline verbatim)) + (standard-set + (remq 'citation-reference (remq 'table-cell org-element-all-objects))) + (standard-set-no-line-break (remq 'line-break standard-set))) + `((bold ,@standard-set) + (citation citation-reference) + (citation-reference ,@minimal-set) + (footnote-reference ,@standard-set) + (headline ,@standard-set-no-line-break) + (inlinetask ,@standard-set-no-line-break) + (italic ,@standard-set) + (item ,@standard-set-no-line-break) + (keyword ,@(remq 'footnote-reference standard-set)) + ;; Ignore all links in a link description. Also ignore + ;; radio-targets and line breaks. + (link export-snippet inline-babel-call inline-src-block macro + statistics-cookie ,@minimal-set) + (paragraph ,@standard-set) + ;; Remove any variable object from radio target as it would + ;; prevent it from being properly recognized. + (radio-target ,@minimal-set) + (strike-through ,@standard-set) + (subscript ,@standard-set) + (superscript ,@standard-set) + ;; Ignore inline babel call and inline source block as formulas + ;; are possible. Also ignore line breaks and statistics + ;; cookies. + (table-cell citation export-snippet footnote-reference link macro + radio-target target timestamp ,@minimal-set) + (table-row table-cell) + (underline ,@standard-set) + (verse-block ,@standard-set))) + "Alist of objects restrictions. + +key is an element or object type containing objects and value is +a list of types that can be contained within an element or object +of such type. + +This alist also applies to secondary string. For example, an +`headline' type element doesn't directly contain objects, but +still has an entry since one of its properties (`:title') does.") + +(defconst org-element-secondary-value-alist + '((citation :prefix :suffix) + (headline :title) + (inlinetask :title) + (item :tag) + (citation-reference :prefix :suffix)) + "Alist between element types and locations of secondary values.") + +(defconst org-element--pair-round-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\( "()" table) + (modify-syntax-entry ?\) ")(" table) + (dolist (char '(?\{ ?\} ?\[ ?\] ?\< ?\>) table) + (modify-syntax-entry char " " table))) + "Table used internally to pair only round brackets. +Other brackets are treated as spaces.") + +(defconst org-element--pair-square-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\[ "(]" table) + (modify-syntax-entry ?\] ")[" table) + (dolist (char '(?\{ ?\} ?\( ?\) ?\< ?\>) table) + (modify-syntax-entry char " " table))) + "Table used internally to pair only square brackets. +Other brackets are treated as spaces.") + +(defconst org-element--pair-curly-table + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\{ "(}" table) + (modify-syntax-entry ?\} "){" table) + (dolist (char '(?\[ ?\] ?\( ?\) ?\< ?\>) table) + (modify-syntax-entry char " " table))) + "Table used internally to pair only curly brackets. +Other brackets are treated as spaces.") + +(defun org-element--parse-paired-brackets (char) + "Parse paired brackets at point. +CHAR is the opening bracket to consider, as a character. Return +contents between brackets, as a string, or nil. Also move point +past the brackets." + (when (eq char (char-after)) + (let ((syntax-table (pcase char + (?\{ org-element--pair-curly-table) + (?\[ org-element--pair-square-table) + (?\( org-element--pair-round-table) + (_ nil))) + (pos (point))) + (when syntax-table + (with-syntax-table syntax-table + (let ((end (ignore-errors (scan-lists pos 1 0)))) + (when end + (goto-char end) + (buffer-substring-no-properties (1+ pos) (1- end))))))))) + + +;;; Accessors and Setters +;; +;; Provide four accessors: `org-element-type', `org-element-property' +;; `org-element-contents' and `org-element-restriction'. +;; +;; Setter functions allow modification of elements by side effect. +;; There is `org-element-put-property', `org-element-set-contents'. +;; These low-level functions are useful to build a parse tree. +;; +;; `org-element-adopt-elements', `org-element-set-element', +;; `org-element-extract-element' and `org-element-insert-before' are +;; high-level functions useful to modify a parse tree. +;; +;; `org-element-secondary-p' is a predicate used to know if a given +;; object belongs to a secondary string. `org-element-class' tells if +;; some parsed data is an element or an object, handling pseudo +;; elements and objects. `org-element-copy' returns an element or +;; object, stripping its parent property in the process. + +(defsubst org-element-type (element) + "Return type of ELEMENT. + +The function returns the type of the element or object provided. +It can also return the following special value: + `plain-text' for a string + `org-data' for a complete document + nil in any other case." + (cond + ((not (consp element)) (and (stringp element) 'plain-text)) + ((symbolp (car element)) (car element)))) + +(defsubst org-element-property (property element) + "Extract the value from the PROPERTY of an ELEMENT." + (if (stringp element) (get-text-property 0 property element) + (plist-get (nth 1 element) property))) + +(defsubst org-element-contents (element) + "Extract contents from an ELEMENT." + (cond ((not (consp element)) nil) + ((symbolp (car element)) (nthcdr 2 element)) + (t element))) + +(defsubst org-element-restriction (element) + "Return restriction associated to ELEMENT. +ELEMENT can be an element, an object or a symbol representing an +element or object type." + (cdr (assq (if (symbolp element) element (org-element-type element)) + org-element-object-restrictions))) + +(defsubst org-element-put-property (element property value) + "In ELEMENT set PROPERTY to VALUE. +Return modified element." + (if (stringp element) (org-add-props element nil property value) + (setcar (cdr element) (plist-put (nth 1 element) property value)) + element)) + +(defsubst org-element-set-contents (element &rest contents) + "Set ELEMENT's contents to CONTENTS. +Return ELEMENT." + (cond ((null element) contents) + ((not (symbolp (car element))) contents) + ((cdr element) (setcdr (cdr element) contents) element) + (t (nconc element contents)))) + +(defun org-element-secondary-p (object) + "Non-nil when OBJECT directly belongs to a secondary string. +Return value is the property name, as a keyword, or nil." + (let* ((parent (org-element-property :parent object)) + (properties (cdr (assq (org-element-type parent) + org-element-secondary-value-alist)))) + (catch 'exit + (dolist (p properties) + (and (memq object (org-element-property p parent)) + (throw 'exit p)))))) + +(defsubst org-element-class (datum &optional parent) + "Return class for ELEMENT, as a symbol. +Class is either `element' or `object'. Optional argument PARENT +is the element or object containing DATUM. It defaults to the +value of DATUM `:parent' property." + (let ((type (org-element-type datum)) + (parent (or parent (org-element-property :parent datum)))) + (cond + ;; Trivial cases. + ((memq type org-element-all-objects) 'object) + ((memq type org-element-all-elements) 'element) + ;; Special cases. + ((eq type 'org-data) 'element) + ((eq type 'plain-text) 'object) + ((not type) 'object) + ;; Pseudo object or elements. Make a guess about its class. + ;; Basically a pseudo object is contained within another object, + ;; a secondary string or a container element. + ((not parent) 'element) + (t + (let ((parent-type (org-element-type parent))) + (cond ((not parent-type) 'object) + ((memq parent-type org-element-object-containers) 'object) + ((org-element-secondary-p datum) 'object) + (t 'element))))))) + +(defsubst org-element-adopt-elements (parent &rest children) + "Append elements to the contents of another element. + +PARENT is an element or object. CHILDREN can be elements, +objects, or a strings. + +The function takes care of setting `:parent' property for CHILD. +Return parent element." + (declare (indent 1)) + (if (not children) parent + ;; Link every child to PARENT. If PARENT is nil, it is a secondary + ;; string: parent is the list itself. + (dolist (child children) + (org-element-put-property child :parent (or parent children))) + ;; Add CHILDREN at the end of PARENT contents. + (when parent + (apply #'org-element-set-contents + parent + (nconc (org-element-contents parent) children))) + ;; Return modified PARENT element. + (or parent children))) + +(defun org-element-extract-element (element) + "Extract ELEMENT from parse tree. +Remove element from the parse tree by side-effect, and return it +with its `:parent' property stripped out." + (let ((parent (org-element-property :parent element)) + (secondary (org-element-secondary-p element))) + (if secondary + (org-element-put-property + parent secondary + (delq element (org-element-property secondary parent))) + (apply #'org-element-set-contents + parent + (delq element (org-element-contents parent)))) + ;; Return ELEMENT with its :parent removed. + (org-element-put-property element :parent nil))) + +(defun org-element-insert-before (element location) + "Insert ELEMENT before LOCATION in parse tree. +LOCATION is an element, object or string within the parse tree. +Parse tree is modified by side effect." + (let* ((parent (org-element-property :parent location)) + (property (org-element-secondary-p location)) + (siblings (if property (org-element-property property parent) + (org-element-contents parent))) + ;; Special case: LOCATION is the first element of an + ;; independent secondary string (e.g. :title property). Add + ;; ELEMENT in-place. + (specialp (and (not property) + (eq siblings parent) + (eq (car parent) location)))) + ;; Install ELEMENT at the appropriate LOCATION within SIBLINGS. + (cond (specialp) + ((or (null siblings) (eq (car siblings) location)) + (push element siblings)) + ((null location) (nconc siblings (list element))) + (t + (let ((index (cl-position location siblings))) + (unless index (error "No location found to insert element")) + (push element (cdr (nthcdr (1- index) siblings)))))) + ;; Store SIBLINGS at appropriate place in parse tree. + (cond + (specialp (setcdr parent (copy-sequence parent)) (setcar parent element)) + (property (org-element-put-property parent property siblings)) + (t (apply #'org-element-set-contents parent siblings))) + ;; Set appropriate :parent property. + (org-element-put-property element :parent parent))) + +(defun org-element-set-element (old new) + "Replace element or object OLD with element or object NEW. +The function takes care of setting `:parent' property for NEW." + ;; Ensure OLD and NEW have the same parent. + (org-element-put-property new :parent (org-element-property :parent old)) + (if (or (memq (org-element-type old) '(plain-text nil)) + (memq (org-element-type new) '(plain-text nil))) + ;; We cannot replace OLD with NEW since one of them is not an + ;; object or element. We take the long path. + (progn (org-element-insert-before new old) + (org-element-extract-element old)) + ;; Since OLD is going to be changed into NEW by side-effect, first + ;; make sure that every element or object within NEW has OLD as + ;; parent. + (dolist (blob (org-element-contents new)) + (org-element-put-property blob :parent old)) + ;; Transfer contents. + (apply #'org-element-set-contents old (org-element-contents new)) + ;; Overwrite OLD's properties with NEW's. + (setcar (cdr old) (nth 1 new)) + ;; Transfer type. + (setcar old (car new)))) + +(defun org-element-create (type &optional props &rest children) + "Create a new element of type TYPE. +Optional argument PROPS, when non-nil, is a plist defining the +properties of the element. CHILDREN can be elements, objects or +strings." + (apply #'org-element-adopt-elements (list type props) children)) + +(defun org-element-copy (datum) + "Return a copy of DATUM. +DATUM is an element, object, string or nil. `:parent' property +is cleared and contents are removed in the process." + (when datum + (let ((type (org-element-type datum))) + (pcase type + (`org-data (list 'org-data nil)) + (`plain-text (substring-no-properties datum)) + (`nil (copy-sequence datum)) + (_ + (list type (plist-put (copy-sequence (nth 1 datum)) :parent nil))))))) + + + +;;; Greater elements +;; +;; For each greater element type, we define a parser and an +;; interpreter. +;; +;; A parser returns the element or object as the list described above. +;; Most of them accepts no argument. Though, exceptions exist. Hence +;; every element containing a secondary string (see +;; `org-element-secondary-value-alist') will accept an optional +;; argument to toggle parsing of these secondary strings. Moreover, +;; `item' parser requires current list's structure as its first +;; element. +;; +;; An interpreter accepts two arguments: the list representation of +;; the element or object, and its contents. The latter may be nil, +;; depending on the element or object considered. It returns the +;; appropriate Org syntax, as a string. +;; +;; Parsing functions must follow the naming convention: +;; org-element-TYPE-parser, where TYPE is greater element's type, as +;; defined in `org-element-greater-elements'. +;; +;; Similarly, interpreting functions must follow the naming +;; convention: org-element-TYPE-interpreter. +;; +;; With the exception of `headline' and `item' types, greater elements +;; cannot contain other greater elements of their own type. +;; +;; Beside implementing a parser and an interpreter, adding a new +;; greater element requires tweaking `org-element--current-element'. +;; Moreover, the newly defined type must be added to both +;; `org-element-all-elements' and `org-element-greater-elements'. + + +;;;; Center Block + +(defun org-element-center-block-parser (limit affiliated) + "Parse a center block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `center-block' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((block-end-line (match-beginning 0))) + (let* ((begin (car affiliated)) + (post-affiliated (point)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (save-excursion + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'center-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) + +(defun org-element-center-block-interpreter (_ contents) + "Interpret a center-block element as Org syntax. +CONTENTS is the contents of the element." + (format "#+begin_center\n%s#+end_center" contents)) + + +;;;; Drawer + +(defun org-element-drawer-parser (limit affiliated) + "Parse a drawer. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `drawer' and CDR is a plist containing +`:drawer-name', `:begin', `:end', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at beginning of drawer." + (let ((case-fold-search t)) + (if (not (save-excursion + (goto-char (min limit (line-end-position))) + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) + ;; Incomplete drawer: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (save-excursion + (let* ((drawer-end-line (match-beginning 0)) + (name (progn (looking-at org-drawer-regexp) + (match-string-no-properties 1))) + (begin (car affiliated)) + (post-affiliated (point)) + ;; Empty drawers have no contents. + (contents-begin (progn (forward-line) + (and (< (point) drawer-end-line) + (point)))) + (contents-end (and contents-begin drawer-end-line)) + (pos-before-blank (progn (goto-char drawer-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'drawer + (nconc + (list :begin begin + :end end + :drawer-name name + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) + +(defun org-element-drawer-interpreter (drawer contents) + "Interpret DRAWER element as Org syntax. +CONTENTS is the contents of the element." + (format ":%s:\n%s:END:" + (org-element-property :drawer-name drawer) + contents)) + + +;;;; Dynamic Block + +(defun org-element-dynamic-block-parser (limit affiliated) + "Parse a dynamic block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `dynamic-block' and CDR is a plist +containing `:block-name', `:begin', `:end', `:contents-begin', +`:contents-end', `:arguments', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at beginning of dynamic block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((name (progn (looking-at org-dblock-start-re) + (match-string-no-properties 1))) + (arguments (match-string-no-properties 3)) + (begin (car affiliated)) + (post-affiliated (point)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'dynamic-block + (nconc + (list :begin begin + :end end + :block-name name + :arguments arguments + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-dynamic-block-interpreter (dynamic-block contents) + "Interpret DYNAMIC-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (format "#+begin: %s%s\n%s#+end:" + (org-element-property :block-name dynamic-block) + (let ((args (org-element-property :arguments dynamic-block))) + (if args (concat " " args) "")) + contents)) + + +;;;; Footnote Definition + +(defconst org-element--footnote-separator + (concat org-outline-regexp-bol "\\|" + org-footnote-definition-re "\\|" + "^\\([ \t]*\n\\)\\{2,\\}") + "Regexp used as a footnote definition separator.") + +(defun org-element-footnote-definition-parser (limit affiliated) + "Parse a footnote definition. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `footnote-definition' and CDR is +a plist containing `:label', `:begin' `:end', `:contents-begin', +`:contents-end', `:pre-blank',`:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the footnote definition." + (save-excursion + (let* ((label (progn (looking-at org-footnote-definition-re) + (match-string-no-properties 1))) + (begin (car affiliated)) + (post-affiliated (point)) + (end + (save-excursion + (end-of-line) + (cond + ((not + (re-search-forward org-element--footnote-separator limit t)) + limit) + ((eq ?\[ (char-after (match-beginning 0))) + ;; At a new footnote definition, make sure we end + ;; before any affiliated keyword above. + (forward-line -1) + (while (and (> (point) post-affiliated) + (looking-at-p org-element--affiliated-re)) + (forward-line -1)) + (line-beginning-position 2)) + ((eq ?* (char-after (match-beginning 0))) (match-beginning 0)) + (t (skip-chars-forward " \r\t\n" limit) + (if (= limit (point)) limit (line-beginning-position)))))) + (pre-blank 0) + (contents-begin + (progn (search-forward "]") + (skip-chars-forward " \r\t\n" end) + (cond ((= (point) end) nil) + ((= (line-beginning-position) post-affiliated) (point)) + (t + (setq pre-blank + (count-lines (line-beginning-position) begin)) + (line-beginning-position))))) + (contents-end + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + (list 'footnote-definition + (nconc + (list :label label + :begin begin + :end end + :contents-begin contents-begin + :contents-end (and contents-begin contents-end) + :pre-blank pre-blank + :post-blank (count-lines contents-end end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-footnote-definition-interpreter (footnote-definition contents) + "Interpret FOOTNOTE-DEFINITION element as Org syntax. +CONTENTS is the contents of the footnote-definition." + (let ((pre-blank + (min (or (org-element-property :pre-blank footnote-definition) + ;; 0 is specific to paragraphs at the beginning of + ;; the footnote definition, so we use 1 as + ;; a fall-back value, which is more universal. + 1) + ;; Footnote ends after more than two consecutive empty + ;; lines: limit ourselves to 2 newline characters. + 2))) + (concat (format "[fn:%s]" (org-element-property :label footnote-definition)) + (if (= pre-blank 0) (concat " " (org-trim contents)) + (concat (make-string pre-blank ?\n) contents))))) + + +;;;; Headline + +(defun org-element--get-node-properties () + "Return node properties associated to headline at point. +Upcase property names. It avoids confusion between properties +obtained through property drawer and default properties from the +parser (e.g. `:end' and :END:). Return value is a plist." + (save-excursion + (forward-line) + (when (looking-at-p org-planning-line-re) (forward-line)) + (when (looking-at org-property-drawer-re) + (forward-line) + (let ((end (match-end 0)) properties) + (while (< (line-end-position) end) + (looking-at org-property-re) + (push (match-string-no-properties 3) properties) + (push (intern (concat ":" (upcase (match-string 2)))) properties) + (forward-line)) + properties)))) + +(defun org-element--get-time-properties () + "Return time properties associated to headline at point. +Return value is a plist." + (save-excursion + (when (progn (forward-line) (looking-at org-planning-line-re)) + (let ((end (line-end-position)) plist) + (while (re-search-forward org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t") + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-scheduled-string) + (setq plist (plist-put plist :scheduled time))) + ((equal keyword org-deadline-string) + (setq plist (plist-put plist :deadline time))) + (t (setq plist (plist-put plist :closed time)))))) + plist)))) + +(defun org-element-headline-parser (limit &optional raw-secondary-p) + "Parse a headline. + +Return a list whose CAR is `headline' and CDR is a plist +containing `:raw-value', `:title', `:begin', `:end', +`:pre-blank', `:contents-begin' and `:contents-end', `:level', +`:priority', `:tags', `:todo-keyword', `:todo-type', `:scheduled', +`:deadline', `:closed', `:archivedp', `:commentedp' +`:footnote-section-p', `:post-blank' and `:post-affiliated' +keywords. + +The plist also contains any property set in the property drawer, +with its name in upper cases and colons added at the +beginning (e.g., `:CUSTOM_ID'). + +LIMIT is a buffer position bounding the search. + +When RAW-SECONDARY-P is non-nil, headline's title will not be +parsed as a secondary string, but as a plain string instead. + +Assume point is at beginning of the headline." + (save-excursion + (let* ((begin (point)) + (level (prog1 (org-reduced-level (skip-chars-forward "*")) + (skip-chars-forward " \t"))) + (todo (and org-todo-regexp + (let (case-fold-search) (looking-at (concat org-todo-regexp " "))) + (progn (goto-char (match-end 0)) + (skip-chars-forward " \t") + (match-string 1)))) + (todo-type + (and todo (if (member todo org-done-keywords) 'done 'todo))) + (priority (and (looking-at "\\[#.\\][ \t]*") + (progn (goto-char (match-end 0)) + (aref (match-string 0) 2)))) + (commentedp + (and (let (case-fold-search) (looking-at org-comment-string)) + (goto-char (match-end 0)))) + (title-start (prog1 (point) + (unless (or todo priority commentedp) + ;; Headline like "* :tag:" + (skip-chars-backward " \t")))) + (tags (when (re-search-forward + "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" + (line-end-position) + 'move) + (goto-char (match-beginning 0)) + (org-split-string (match-string 1) ":"))) + (title-end (point)) + (raw-value (org-trim + (buffer-substring-no-properties title-start title-end))) + (archivedp (member org-archive-tag tags)) + (footnote-section-p (and org-footnote-section + (string= org-footnote-section raw-value))) + (standard-props (org-element--get-node-properties)) + (time-props (org-element--get-time-properties)) + (end (min (save-excursion (org-end-of-subtree t t)) limit)) + (contents-begin (save-excursion + (forward-line) + (skip-chars-forward " \r\t\n" end) + (and (/= (point) end) (line-beginning-position)))) + (contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2))))) + (let ((headline + (list 'headline + (nconc + (list :raw-value raw-value + :begin begin + :end end + :pre-blank + (if (not contents-begin) 0 + (1- (count-lines begin contents-begin))) + :contents-begin contents-begin + :contents-end contents-end + :level level + :priority priority + :tags tags + :todo-keyword todo + :todo-type todo-type + :post-blank + (if contents-end + (count-lines contents-end end) + (1- (count-lines begin end))) + :footnote-section-p footnote-section-p + :archivedp archivedp + :commentedp commentedp + :post-affiliated begin) + time-props + standard-props)))) + (org-element-put-property + headline :title + (if raw-secondary-p raw-value + (org-element--parse-objects + (progn (goto-char title-start) + (skip-chars-forward " \t") + (point)) + (progn (goto-char title-end) + (skip-chars-backward " \t") + (point)) + nil + (org-element-restriction 'headline) + headline))))))) + +(defun org-element-headline-interpreter (headline contents) + "Interpret HEADLINE element as Org syntax. +CONTENTS is the contents of the element." + (let* ((level (org-element-property :level headline)) + (todo (org-element-property :todo-keyword headline)) + (priority (org-element-property :priority headline)) + (title (org-element-interpret-data + (org-element-property :title headline))) + (tags (let ((tag-list (org-element-property :tags headline))) + (and tag-list + (format ":%s:" (mapconcat #'identity tag-list ":"))))) + (commentedp (org-element-property :commentedp headline)) + (pre-blank (or (org-element-property :pre-blank headline) 0)) + (heading + (concat (make-string (if org-odd-levels-only (1- (* level 2)) level) + ?*) + (and todo (concat " " todo)) + (and commentedp (concat " " org-comment-string)) + (and priority (format " [#%c]" priority)) + " " + (if (and org-footnote-section + (org-element-property :footnote-section-p headline)) + org-footnote-section + title)))) + (concat + heading + ;; Align tags. + (when tags + (cond + ((zerop org-tags-column) (format " %s" tags)) + ((< org-tags-column 0) + (concat + (make-string + (max (- (+ org-tags-column (length heading) (length tags))) 1) + ?\s) + tags)) + (t + (concat + (make-string (max (- org-tags-column (length heading)) 1) ?\s) + tags)))) + (make-string (1+ pre-blank) ?\n) + contents))) + + +;;;; Inlinetask + +(defun org-element-inlinetask-parser (limit &optional raw-secondary-p) + "Parse an inline task. + +Return a list whose CAR is `inlinetask' and CDR is a plist +containing `:title', `:begin', `:end', `:pre-blank', +`:contents-begin' and `:contents-end', `:level', `:priority', +`:raw-value', `:tags', `:todo-keyword', `:todo-type', +`:scheduled', `:deadline', `:closed', `:post-blank' and +`:post-affiliated' keywords. + +The plist also contains any property set in the property drawer, +with its name in upper cases and colons added at the +beginning (e.g., `:CUSTOM_ID'). + +When optional argument RAW-SECONDARY-P is non-nil, inline-task's +title will not be parsed as a secondary string, but as a plain +string instead. + +Assume point is at beginning of the inline task." + (save-excursion + (let* ((begin (point)) + (level (prog1 (org-reduced-level (skip-chars-forward "*")) + (skip-chars-forward " \t"))) + (todo (and org-todo-regexp + (let (case-fold-search) (looking-at org-todo-regexp)) + (progn (goto-char (match-end 0)) + (skip-chars-forward " \t") + (match-string 0)))) + (todo-type (and todo + (if (member todo org-done-keywords) 'done 'todo))) + (priority (and (looking-at "\\[#.\\][ \t]*") + (progn (goto-char (match-end 0)) + (aref (match-string 0) 2)))) + (title-start (point)) + (tags (when (re-search-forward + "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$" + (line-end-position) + 'move) + (goto-char (match-beginning 0)) + (org-split-string (match-string 1) ":"))) + (title-end (point)) + (raw-value (org-trim + (buffer-substring-no-properties title-start title-end))) + (task-end (save-excursion + (end-of-line) + (and (re-search-forward org-outline-regexp-bol limit t) + (looking-at-p "[ \t]*END[ \t]*$") + (line-beginning-position)))) + (standard-props (and task-end (org-element--get-node-properties))) + (time-props (and task-end (org-element--get-time-properties))) + (contents-begin (and task-end + (< (point) task-end) + (progn + (forward-line) + (skip-chars-forward " \t\n") + (line-beginning-position)))) + (contents-end (and contents-begin task-end)) + (end (progn (when task-end (goto-char task-end)) + (forward-line) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position)))) + (inlinetask + (list 'inlinetask + (nconc + (list :raw-value raw-value + :begin begin + :end end + :pre-blank + (if (not contents-begin) 0 + (1- (count-lines begin contents-begin))) + :contents-begin contents-begin + :contents-end contents-end + :level level + :priority priority + :tags tags + :todo-keyword todo + :todo-type todo-type + :post-blank (1- (count-lines (or task-end begin) end)) + :post-affiliated begin) + time-props + standard-props)))) + (org-element-put-property + inlinetask :title + (if raw-secondary-p raw-value + (org-element--parse-objects + (progn (goto-char title-start) + (skip-chars-forward " \t") + (point)) + (progn (goto-char title-end) + (skip-chars-backward " \t") + (point)) + nil + (org-element-restriction 'inlinetask) + inlinetask)))))) + +(defun org-element-inlinetask-interpreter (inlinetask contents) + "Interpret INLINETASK element as Org syntax. +CONTENTS is the contents of inlinetask." + (let* ((level (org-element-property :level inlinetask)) + (todo (org-element-property :todo-keyword inlinetask)) + (priority (org-element-property :priority inlinetask)) + (title (org-element-interpret-data + (org-element-property :title inlinetask))) + (tags (let ((tag-list (org-element-property :tags inlinetask))) + (and tag-list + (format ":%s:" (mapconcat 'identity tag-list ":"))))) + (task (concat (make-string level ?*) + (and todo (concat " " todo)) + (and priority (format " [#%c]" priority)) + (and title (concat " " title))))) + (concat task + ;; Align tags. + (when tags + (cond + ((zerop org-tags-column) (format " %s" tags)) + ((< org-tags-column 0) + (concat + (make-string + (max (- (+ org-tags-column (length task) (length tags))) 1) + ?\s) + tags)) + (t + (concat + (make-string (max (- org-tags-column (length task)) 1) ?\s) + tags)))) + ;; Prefer degenerate inlinetasks when there are no + ;; contents. + (when contents + (concat "\n" + contents + (make-string level ?*) " end"))))) + + +;;;; Item + +(defun org-element-item-parser (_ struct &optional raw-secondary-p) + "Parse an item. + +STRUCT is the structure of the plain list. + +Return a list whose CAR is `item' and CDR is a plist containing +`:bullet', `:begin', `:end', `:contents-begin', `:contents-end', +`:checkbox', `:counter', `:tag', `:structure', `:pre-blank', +`:post-blank' and `:post-affiliated' keywords. + +When optional argument RAW-SECONDARY-P is non-nil, item's tag, if +any, will not be parsed as a secondary string, but as a plain +string instead. + +Assume point is at the beginning of the item." + (save-excursion + (beginning-of-line) + (looking-at org-list-full-item-re) + (let* ((begin (point)) + (bullet (match-string-no-properties 1)) + (checkbox (let ((box (match-string 3))) + (cond ((equal "[ ]" box) 'off) + ((equal "[X]" box) 'on) + ((equal "[-]" box) 'trans)))) + (counter (let ((c (match-string 2))) + (save-match-data + (cond + ((not c) nil) + ((string-match "[A-Za-z]" c) + (- (string-to-char (upcase (match-string 0 c))) + 64)) + ((string-match "[0-9]+" c) + (string-to-number (match-string 0 c))))))) + (end (progn (goto-char (nth 6 (assq (point) struct))) + (if (bolp) (point) (line-beginning-position 2)))) + (pre-blank 0) + (contents-begin + (progn + (goto-char + ;; Ignore tags in un-ordered lists: they are just + ;; a part of item's body. + (if (and (match-beginning 4) + (save-match-data (string-match "[.)]" bullet))) + (match-beginning 4) + (match-end 0))) + (skip-chars-forward " \r\t\n" end) + (cond ((= (point) end) nil) + ;; If first line isn't empty, contents really + ;; start at the text after item's meta-data. + ((= (line-beginning-position) begin) (point)) + (t + (setq pre-blank + (count-lines (line-beginning-position) begin)) + (line-beginning-position))))) + (contents-end (and contents-begin + (progn (goto-char end) + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + (item + (list 'item + (list :bullet bullet + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :checkbox checkbox + :counter counter + :structure struct + :pre-blank pre-blank + :post-blank (count-lines (or contents-end begin) end) + :post-affiliated begin)))) + (org-element-put-property + item :tag + (let ((raw (org-list-get-tag begin struct))) + (when raw + (if raw-secondary-p raw + (org-element--parse-objects + (match-beginning 4) (match-end 4) nil + (org-element-restriction 'item) + item)))))))) + +(defun org-element-item-interpreter (item contents) + "Interpret ITEM element as Org syntax. +CONTENTS is the contents of the element." + (let ((tag (pcase (org-element-property :tag item) + (`nil nil) + (tag (format "%s :: " (org-element-interpret-data tag))))) + (bullet + (org-list-bullet-string + (cond + ((not (string-match-p "[0-9a-zA-Z]" + (org-element-property :bullet item))) "- ") + ((eq org-plain-list-ordered-item-terminator ?\)) "1)") + (t "1."))))) + (concat + bullet + (pcase (org-element-property :counter item) + (`nil nil) + (counter (format "[@%d] " counter))) + (pcase (org-element-property :checkbox item) + (`on "[X] ") + (`off "[ ] ") + (`trans "[-] ") + (_ nil)) + tag + (when contents + (let* ((ind (make-string (if tag 5 (length bullet)) ?\s)) + (pre-blank + (min (or (org-element-property :pre-blank item) + ;; 0 is specific to paragraphs at the + ;; beginning of the item, so we use 1 as + ;; a fall-back value, which is more universal. + 1) + ;; Lists ends after more than two consecutive + ;; empty lines: limit ourselves to 2 newline + ;; characters. + 2)) + (contents (replace-regexp-in-string + "\\(^\\)[ \t]*\\S-" ind contents nil nil 1))) + (if (= pre-blank 0) (org-trim contents) + (concat (make-string pre-blank ?\n) contents))))))) + + +;;;; Plain List + +(defun org-element--list-struct (limit) + ;; Return structure of list at point. Internal function. See + ;; `org-list-struct' for details. + (let ((case-fold-search t) + (top-ind limit) + (item-re (org-item-re)) + (inlinetask-re (and (featurep 'org-inlinetask) "^\\*+ ")) + items struct) + (save-excursion + (catch :exit + (while t + (cond + ;; At limit: end all items. + ((>= (point) limit) + (let ((end (progn (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + (dolist (item items) (setcar (nthcdr 6 item) end))) + (throw :exit (sort (nconc items struct) #'car-less-than-car))) + ;; At list end: end all items. + ((looking-at org-list-end-re) + (dolist (item items) (setcar (nthcdr 6 item) (point))) + (throw :exit (sort (nconc items struct) #'car-less-than-car))) + ;; At a new item: end previous sibling. + ((looking-at item-re) + (let ((ind (save-excursion (skip-chars-forward " \t") + (current-column)))) + (setq top-ind (min top-ind ind)) + (while (and items (<= ind (nth 1 (car items)))) + (let ((item (pop items))) + (setcar (nthcdr 6 item) (point)) + (push item struct))) + (push (progn (looking-at org-list-full-item-re) + (let ((bullet (match-string-no-properties 1))) + (list (point) + ind + bullet + (match-string-no-properties 2) ; counter + (match-string-no-properties 3) ; checkbox + ;; Description tag. + (and (save-match-data + (string-match "[-+*]" bullet)) + (match-string-no-properties 4)) + ;; Ending position, unknown so far. + nil))) + items)) + (forward-line)) + ;; Skip empty lines. + ((looking-at "^[ \t]*$") (forward-line)) + ;; Skip inline tasks and blank lines along the way. + ((and inlinetask-re (looking-at inlinetask-re)) + (forward-line) + (let ((origin (point))) + (when (re-search-forward inlinetask-re limit t) + (if (looking-at-p "END[ \t]*$") (forward-line) + (goto-char origin))))) + ;; At some text line. Check if it ends any previous item. + (t + (let ((ind (save-excursion + (skip-chars-forward " \t") + (current-column))) + (end (save-excursion + (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + (while (<= ind (nth 1 (car items))) + (let ((item (pop items))) + (setcar (nthcdr 6 item) end) + (push item struct) + (unless items + (throw :exit (sort struct #'car-less-than-car)))))) + ;; Skip blocks (any type) and drawers contents. + (cond + ((and (looking-at "[ \t]*#\\+BEGIN\\(:\\|_\\S-+\\)") + (re-search-forward + (format "^[ \t]*#\\+END%s[ \t]*$" (match-string 1)) + limit t))) + ((and (looking-at org-drawer-regexp) + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))) + (forward-line)))))))) + +(defun org-element-plain-list-parser (limit affiliated structure) + "Parse a plain list. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. STRUCTURE is the structure of the plain list being +parsed. + +Return a list whose CAR is `plain-list' and CDR is a plist +containing `:type', `:begin', `:end', `:contents-begin' and +`:contents-end', `:structure', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the list." + (save-excursion + (let* ((struct (or structure (org-element--list-struct limit))) + (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered) + ((nth 5 (assq (point) struct)) 'descriptive) + (t 'unordered))) + (contents-begin (point)) + (begin (car affiliated)) + (contents-end (let* ((item (assq contents-begin struct)) + (ind (nth 1 item)) + (pos (nth 6 item))) + (while (and (setq item (assq pos struct)) + (= (nth 1 item) ind)) + (setq pos (nth 6 item))) + pos)) + (end (progn (goto-char contents-end) + (skip-chars-forward " \r\t\n" limit) + (if (= (point) limit) limit (line-beginning-position))))) + ;; Return value. + (list 'plain-list + (nconc + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :structure struct + :post-blank (count-lines contents-end end) + :post-affiliated contents-begin) + (cdr affiliated)))))) + +(defun org-element-plain-list-interpreter (_ contents) + "Interpret plain-list element as Org syntax. +CONTENTS is the contents of the element." + (with-temp-buffer + (insert contents) + (goto-char (point-min)) + (org-list-repair) + (buffer-string))) + + +;;;; Property Drawer + +(defun org-element-property-drawer-parser (limit) + "Parse a property drawer. + +LIMIT bounds the search. + +Return a list whose car is `property-drawer' and cdr is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the property drawer." + (save-excursion + (let ((case-fold-search t) + (begin (point)) + (contents-begin (line-beginning-position 2))) + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t) + (let ((contents-end (and (> (match-beginning 0) contents-begin) + (match-beginning 0))) + (before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'property-drawer + (list :begin begin + :end end + :contents-begin (and contents-end contents-begin) + :contents-end contents-end + :post-blank (count-lines before-blank end) + :post-affiliated begin)))))) + +(defun org-element-property-drawer-interpreter (_ contents) + "Interpret property-drawer element as Org syntax. +CONTENTS is the properties within the drawer." + (format ":PROPERTIES:\n%s:END:" contents)) + + +;;;; Quote Block + +(defun org-element-quote-block-parser (limit affiliated) + "Parse a quote block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `quote-block' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'quote-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-quote-block-interpreter (_ contents) + "Interpret quote-block element as Org syntax. +CONTENTS is the contents of the element." + (format "#+begin_quote\n%s#+end_quote" contents)) + + +;;;; Section + +(defun org-element-section-parser (_) + "Parse a section. + +Return a list whose CAR is `section' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `contents-end', +`:post-blank' and `:post-affiliated' keywords." + (save-excursion + ;; Beginning of section is the beginning of the first non-blank + ;; line after previous headline. + (let ((begin (point)) + (end (progn (org-with-limited-levels (outline-next-heading)) + (point))) + (pos-before-blank (progn (skip-chars-backward " \r\t\n") + (line-beginning-position 2)))) + (list 'section + (list :begin begin + :end end + :contents-begin begin + :contents-end pos-before-blank + :post-blank (count-lines pos-before-blank end) + :post-affiliated begin))))) + +(defun org-element-section-interpreter (_ contents) + "Interpret section element as Org syntax. +CONTENTS is the contents of the element." + contents) + + +;;;; Special Block + +(defun org-element-special-block-parser (limit affiliated) + "Parse a special block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `special-block' and CDR is a plist +containing `:type', `:begin', `:end', `:contents-begin', +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the block." + (let* ((case-fold-search t) + (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (match-string-no-properties 1)))) + (if (not (save-excursion + (re-search-forward + (format "^[ \t]*#\\+END_%s[ \t]*$" (regexp-quote type)) + limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((block-end-line (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + ;; Empty blocks have no contents. + (contents-begin (progn (forward-line) + (and (< (point) block-end-line) + (point)))) + (contents-end (and contents-begin block-end-line)) + (pos-before-blank (progn (goto-char block-end-line) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'special-block + (nconc + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-special-block-interpreter (special-block contents) + "Interpret SPECIAL-BLOCK element as Org syntax. +CONTENTS is the contents of the element." + (let ((block-type (org-element-property :type special-block))) + (format "#+begin_%s\n%s#+end_%s" block-type contents block-type))) + + + +;;; Elements +;; +;; For each element, a parser and an interpreter are also defined. +;; Both follow the same naming convention used for greater elements. +;; +;; Also, as for greater elements, adding a new element type is done +;; through the following steps: implement a parser and an interpreter, +;; tweak `org-element--current-element' so that it recognizes the new +;; type and add that new type to `org-element-all-elements'. + + +;;;; Babel Call + +(defun org-element-babel-call-parser (limit affiliated) + "Parse a babel call. + +LIMIT bounds the search. AFFILIATED is a list of which car is +the buffer position at the beginning of the first affiliated +keyword and cdr is a plist of affiliated keywords along with +their value. + +Return a list whose car is `babel-call' and cdr is a plist +containing `:call', `:inside-header', `:arguments', +`:end-header', `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' as keywords." + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (before-blank (line-beginning-position 2)) + (value (progn (search-forward ":" before-blank t) + (skip-chars-forward " \t") + (org-trim + (buffer-substring-no-properties + (point) (line-end-position))))) + (call + (or (org-string-nw-p + (buffer-substring-no-properties + (point) (progn (skip-chars-forward "^[]()" before-blank) + (point)))))) + (inside-header (org-element--parse-paired-brackets ?\[)) + (arguments (org-string-nw-p + (org-element--parse-paired-brackets ?\())) + (end-header + (org-string-nw-p + (org-trim + (buffer-substring-no-properties (point) (line-end-position))))) + (end (progn (forward-line) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'babel-call + (nconc + (list :call call + :inside-header inside-header + :arguments arguments + :end-header end-header + :begin begin + :end end + :value value + :post-blank (count-lines before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-babel-call-interpreter (babel-call _) + "Interpret BABEL-CALL element as Org syntax." + (concat "#+call: " + (org-element-property :call babel-call) + (let ((h (org-element-property :inside-header babel-call))) + (and h (format "[%s]" h))) + (concat "(" (org-element-property :arguments babel-call) ")") + (let ((h (org-element-property :end-header babel-call))) + (and h (concat " " h))))) + + +;;;; Clock + +(defun org-element-clock-parser (limit) + "Parse a clock. + +LIMIT bounds the search. + +Return a list whose CAR is `clock' and CDR is a plist containing +`:status', `:value', `:time', `:begin', `:end', `:post-blank' and +`:post-affiliated' as keywords." + (save-excursion + (let* ((case-fold-search nil) + (begin (point)) + (value (progn (search-forward "CLOCK:" (line-end-position) t) + (skip-chars-forward " \t") + (org-element-timestamp-parser))) + (duration (and (search-forward " => " (line-end-position) t) + (progn (skip-chars-forward " \t") + (looking-at "\\(\\S-+\\)[ \t]*$")) + (match-string-no-properties 1))) + (status (if duration 'closed 'running)) + (post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (unless (bolp) (end-of-line)) + (count-lines before-blank (point)))) + (end (point))) + (list 'clock + (list :status status + :value value + :duration duration + :begin begin + :end end + :post-blank post-blank + :post-affiliated begin))))) + +(defun org-element-clock-interpreter (clock _) + "Interpret CLOCK element as Org syntax." + (concat "CLOCK: " + (org-element-timestamp-interpreter + (org-element-property :value clock) nil) + (let ((duration (org-element-property :duration clock))) + (and duration + (concat " => " + (apply 'format + "%2s:%02s" + (org-split-string duration ":"))))))) + + +;;;; Comment + +(defun org-element-comment-parser (limit) + "Parse a comment. + +LIMIT bounds the search. + +Return a list whose CAR is `comment' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank', +`:post-affiliated' keywords. + +Assume point is at comment beginning." + (save-excursion + (let* ((begin (point)) + (value (prog2 (looking-at "[ \t]*# ?") + (buffer-substring-no-properties + (match-end 0) (line-end-position)) + (forward-line))) + (com-end + ;; Get comments ending. + (progn + (while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)")) + ;; Accumulate lines without leading hash and first + ;; whitespace. + (setq value + (concat value + "\n" + (buffer-substring-no-properties + (match-end 0) (line-end-position)))) + (forward-line)) + (point))) + (end (progn (goto-char com-end) + (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'comment + (list :begin begin + :end end + :value value + :post-blank (count-lines com-end end) + :post-affiliated begin))))) + +(defun org-element-comment-interpreter (comment _) + "Interpret COMMENT element as Org syntax. +CONTENTS is nil." + (replace-regexp-in-string "^" "# " (org-element-property :value comment))) + + +;;;; Comment Block + +(defun org-element-comment-block-parser (limit affiliated) + "Parse an export block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `comment-block' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at comment block beginning." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (progn (forward-line) (point))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position)))) + (value (buffer-substring-no-properties + contents-begin contents-end))) + (list 'comment-block + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-comment-block-interpreter (comment-block _) + "Interpret COMMENT-BLOCK element as Org syntax." + (format "#+begin_comment\n%s#+end_comment" + (org-element-normalize-string + (org-remove-indentation + (org-element-property :value comment-block))))) + + +;;;; Diary Sexp + +(defun org-element-diary-sexp-parser (limit affiliated) + "Parse a diary sexp. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `diary-sexp' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords." + (save-excursion + (let ((begin (car affiliated)) + (post-affiliated (point)) + (value (progn (looking-at "\\(%%(.*\\)[ \t]*$") + (match-string-no-properties 1))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'diary-sexp + (nconc + (list :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-diary-sexp-interpreter (diary-sexp _) + "Interpret DIARY-SEXP as Org syntax." + (org-element-property :value diary-sexp)) + + +;;;; Example Block + +(defun org-element-example-block-parser (limit affiliated) + "Parse an example block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `example-block' and CDR is a plist +containing `:begin', `:end', `:number-lines', `:preserve-indent', +`:retain-labels', `:use-labels', `:label-fmt', `:switches', +`:value', `:post-blank' and `:post-affiliated' keywords." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((switches + (progn + (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?") + (match-string-no-properties 1))) + ;; Switches analysis. + (number-lines + (and switches + (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" + switches) + (cons + (if (equal (match-string 1 switches) "-") + 'new + 'continued) + (if (not (match-end 2)) 0 + ;; Subtract 1 to give number of lines before + ;; first line. + (1- (string-to-number (match-string 2 switches))))))) + (preserve-indent + (and switches (string-match "-i\\>" switches))) + ;; Should labels be retained in (or stripped from) example + ;; blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels + (not (string-match "-k\\>" switches))))) + (label-fmt + (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Standard block parsing. + (begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (line-beginning-position 2)) + (value (org-unescape-code-in-string + (buffer-substring-no-properties + contents-begin contents-end))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'example-block + (nconc + (list :begin begin + :end end + :value value + :switches switches + :number-lines number-lines + :preserve-indent preserve-indent + :retain-labels retain-labels + :use-labels use-labels + :label-fmt label-fmt + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-example-block-interpreter (example-block _) + "Interpret EXAMPLE-BLOCK element as Org syntax." + (let ((switches (org-element-property :switches example-block)) + (value + (let ((val (org-element-property :value example-block))) + (cond + ((or org-src-preserve-indentation + (org-element-property :preserve-indent example-block)) + val) + ((= 0 org-edit-src-content-indentation) + (org-remove-indentation val)) + (t + (let ((ind (make-string org-edit-src-content-indentation ?\s))) + (replace-regexp-in-string "^[ \t]*\\S-" + (concat ind "\\&") + (org-remove-indentation val)))))))) + (concat "#+begin_example" (and switches (concat " " switches)) "\n" + (org-element-normalize-string (org-escape-code-in-string value)) + "#+end_example"))) + + +;;;; Export Block + +(defun org-element-export-block-parser (limit affiliated) + "Parse an export block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `export-block' and CDR is a plist +containing `:begin', `:end', `:type', `:value', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at export-block beginning." + (let* ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (save-excursion + (let* ((contents-end (match-beginning 0)) + (backend + (progn + (looking-at + "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$") + (match-string-no-properties 1))) + (begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (progn (forward-line) (point))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position)))) + (value (org-unescape-code-in-string + (buffer-substring-no-properties contents-begin + contents-end)))) + (list 'export-block + (nconc + (list :type (and backend (upcase backend)) + :begin begin + :end end + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))))) + +(defun org-element-export-block-interpreter (export-block _) + "Interpret EXPORT-BLOCK element as Org syntax." + (format "#+begin_export %s\n%s#+end_export" + (org-element-property :type export-block) + (org-element-property :value export-block))) + + +;;;; Fixed-width + +(defun org-element-fixed-width-parser (limit affiliated) + "Parse a fixed-width section. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `fixed-width' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the fixed-width area." + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (end-area + (progn + (while (and (< (point) limit) + (looking-at "[ \t]*:\\( \\|$\\)")) + (forward-line)) + (if (bolp) (line-end-position 0) (point)))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'fixed-width + (nconc + (list :begin begin + :end end + :value (replace-regexp-in-string + "^[ \t]*: ?" "" + (buffer-substring-no-properties post-affiliated + end-area)) + :post-blank (count-lines end-area end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-fixed-width-interpreter (fixed-width _) + "Interpret FIXED-WIDTH element as Org syntax." + (let ((value (org-element-property :value fixed-width))) + (and value (replace-regexp-in-string "^" ": " value)))) + + +;;;; Horizontal Rule + +(defun org-element-horizontal-rule-parser (limit affiliated) + "Parse an horizontal rule. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `horizontal-rule' and CDR is a plist +containing `:begin', `:end', `:post-blank' and `:post-affiliated' +keywords." + (save-excursion + (let ((begin (car affiliated)) + (post-affiliated (point)) + (post-hr (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'horizontal-rule + (nconc + (list :begin begin + :end end + :post-blank (count-lines post-hr end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-horizontal-rule-interpreter (&rest _) + "Interpret HORIZONTAL-RULE element as Org syntax." + "-----") + + +;;;; Keyword + +(defun org-element-keyword-parser (limit affiliated) + "Parse a keyword at point. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is a normalized `keyword' (uppercase) and +CDR is a plist containing `:key', `:value', `:begin', `:end', +`:post-blank' and `:post-affiliated' keywords." + (save-excursion + ;; An orphaned affiliated keyword is considered as a regular + ;; keyword. In this case AFFILIATED is nil, so we take care of + ;; this corner case. + (let ((begin (or (car affiliated) (point))) + (post-affiliated (point)) + (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):") + (upcase (match-string-no-properties 1)))) + (value (org-trim (buffer-substring-no-properties + (match-end 0) (point-at-eol)))) + (pos-before-blank (progn (forward-line) (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'keyword + (nconc + (list :key key + :value value + :begin begin + :end end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated)))))) + +(defun org-element-keyword-interpreter (keyword _) + "Interpret KEYWORD element as Org syntax." + (format "#+%s: %s" + (downcase (org-element-property :key keyword)) + (org-element-property :value keyword))) + + +;;;; Latex Environment + +(defconst org-element--latex-begin-environment + "^[ \t]*\\\\begin{\\([A-Za-z0-9*]+\\)}" + "Regexp matching the beginning of a LaTeX environment. +The environment is captured by the first group. + +See also `org-element--latex-end-environment'.") + +(defconst org-element--latex-end-environment + "\\\\end{%s}[ \t]*$" + "Format string matching the ending of a LaTeX environment. +See also `org-element--latex-begin-environment'.") + +(defun org-element-latex-environment-parser (limit affiliated) + "Parse a LaTeX environment. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `latex-environment' and CDR is a plist +containing `:begin', `:end', `:value', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the latex environment." + (save-excursion + (let ((case-fold-search t) + (code-begin (point))) + (looking-at org-element--latex-begin-environment) + (if (not (re-search-forward (format org-element--latex-end-environment + (regexp-quote (match-string 1))) + limit t)) + ;; Incomplete latex environment: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let* ((code-end (progn (forward-line) (point))) + (begin (car affiliated)) + (value (buffer-substring-no-properties code-begin code-end)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'latex-environment + (nconc + (list :begin begin + :end end + :value value + :post-blank (count-lines code-end end) + :post-affiliated code-begin) + (cdr affiliated)))))))) + +(defun org-element-latex-environment-interpreter (latex-environment _) + "Interpret LATEX-ENVIRONMENT element as Org syntax." + (org-element-property :value latex-environment)) + + +;;;; Node Property + +(defun org-element-node-property-parser (limit) + "Parse a node-property at point. + +LIMIT bounds the search. + +Return a list whose CAR is `node-property' and CDR is a plist +containing `:key', `:value', `:begin', `:end', `:post-blank' and +`:post-affiliated' keywords." + (looking-at org-property-re) + (let ((case-fold-search t) + (begin (point)) + (key (match-string-no-properties 2)) + (value (match-string-no-properties 3)) + (end (save-excursion + (end-of-line) + (if (re-search-forward org-property-re limit t) + (line-beginning-position) + limit)))) + (list 'node-property + (list :key key + :value value + :begin begin + :end end + :post-blank 0 + :post-affiliated begin)))) + +(defun org-element-node-property-interpreter (node-property _) + "Interpret NODE-PROPERTY element as Org syntax." + (format org-property-format + (format ":%s:" (org-element-property :key node-property)) + (or (org-element-property :value node-property) ""))) + + +;;;; Paragraph + +(defun org-element-paragraph-parser (limit affiliated) + "Parse a paragraph. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `paragraph' and CDR is a plist +containing `:begin', `:end', `:contents-begin' and +`:contents-end', `:post-blank' and `:post-affiliated' keywords. + +Assume point is at the beginning of the paragraph." + (save-excursion + (let* ((begin (car affiliated)) + (contents-begin (point)) + (before-blank + (let ((case-fold-search t)) + (end-of-line) + ;; A matching `org-element-paragraph-separate' is not + ;; necessarily the end of the paragraph. In particular, + ;; drawers, blocks or LaTeX environments opening lines + ;; must be closed. Moreover keywords with a secondary + ;; value must belong to "dual keywords". + (while (not + (cond + ((not (and (re-search-forward + org-element-paragraph-separate limit 'move) + (progn (beginning-of-line) t)))) + ((looking-at org-drawer-regexp) + (save-excursion + (re-search-forward "^[ \t]*:END:[ \t]*$" limit t))) + ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)") + (save-excursion + (re-search-forward + (format "^[ \t]*#\\+END_%s[ \t]*$" + (regexp-quote (match-string 1))) + limit t))) + ((looking-at org-element--latex-begin-environment) + (save-excursion + (re-search-forward + (format org-element--latex-end-environment + (regexp-quote (match-string 1))) + limit t))) + ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:") + (member-ignore-case (match-string 1) + org-element-dual-keywords)) + ;; Everything else is unambiguous. + (t))) + (end-of-line)) + (if (= (point) limit) limit + (goto-char (line-beginning-position))))) + (contents-end (save-excursion + (skip-chars-backward " \r\t\n" contents-begin) + (line-beginning-position 2))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'paragraph + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines before-blank end) + :post-affiliated contents-begin) + (cdr affiliated)))))) + +(defun org-element-paragraph-interpreter (_ contents) + "Interpret paragraph element as Org syntax. +CONTENTS is the contents of the element." + contents) + + +;;;; Planning + +(defun org-element-planning-parser (limit) + "Parse a planning. + +LIMIT bounds the search. + +Return a list whose CAR is `planning' and CDR is a plist +containing `:closed', `:deadline', `:scheduled', `:begin', +`:end', `:post-blank' and `:post-affiliated' keywords." + (save-excursion + (let* ((case-fold-search nil) + (begin (point)) + (post-blank (let ((before-blank (progn (forward-line) (point)))) + (skip-chars-forward " \r\t\n" limit) + (skip-chars-backward " \t") + (unless (bolp) (end-of-line)) + (count-lines before-blank (point)))) + (end (point)) + closed deadline scheduled) + (goto-char begin) + (while (re-search-forward org-keyword-time-not-clock-regexp end t) + (goto-char (match-end 1)) + (skip-chars-forward " \t" end) + (let ((keyword (match-string 1)) + (time (org-element-timestamp-parser))) + (cond ((equal keyword org-closed-string) (setq closed time)) + ((equal keyword org-deadline-string) (setq deadline time)) + (t (setq scheduled time))))) + (list 'planning + (list :closed closed + :deadline deadline + :scheduled scheduled + :begin begin + :end end + :post-blank post-blank + :post-affiliated begin))))) + +(defun org-element-planning-interpreter (planning _) + "Interpret PLANNING element as Org syntax." + (mapconcat + #'identity + (delq nil + (list (let ((deadline (org-element-property :deadline planning))) + (when deadline + (concat org-deadline-string " " + (org-element-timestamp-interpreter deadline nil)))) + (let ((scheduled (org-element-property :scheduled planning))) + (when scheduled + (concat org-scheduled-string " " + (org-element-timestamp-interpreter scheduled nil)))) + (let ((closed (org-element-property :closed planning))) + (when closed + (concat org-closed-string " " + (org-element-timestamp-interpreter closed nil)))))) + " ")) + + +;;;; Src Block + +(defun org-element-src-block-parser (limit affiliated) + "Parse a source block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `src-block' and CDR is a plist +containing `:language', `:switches', `:parameters', `:begin', +`:end', `:number-lines', `:retain-labels', `:use-labels', +`:label-fmt', `:preserve-indent', `:value', `:post-blank' and +`:post-affiliated' keywords. + +Assume point is at the beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion (re-search-forward "^[ \t]*#\\+END_SRC[ \t]*$" + limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + ;; Get language as a string. + (language + (progn + (looking-at + "^[ \t]*#\\+BEGIN_SRC\ +\\(?: +\\(\\S-+\\)\\)?\ +\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\ +\\(.*\\)[ \t]*$") + (match-string-no-properties 1))) + ;; Get switches. + (switches (match-string-no-properties 2)) + ;; Get parameters. + (parameters (match-string-no-properties 3)) + ;; Switches analysis. + (number-lines + (and switches + (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>" + switches) + (cons + (if (equal (match-string 1 switches) "-") + 'new + 'continued) + (if (not (match-end 2)) 0 + ;; Subtract 1 to give number of lines before + ;; first line. + (1- (string-to-number (match-string 2 switches))))))) + (preserve-indent (and switches + (string-match "-i\\>" switches))) + (label-fmt + (and switches + (string-match "-l +\"\\([^\"\n]+\\)\"" switches) + (match-string 1 switches))) + ;; Should labels be retained in (or stripped from) + ;; source blocks? + (retain-labels + (or (not switches) + (not (string-match "-r\\>" switches)) + (and number-lines (string-match "-k\\>" switches)))) + ;; What should code-references use - labels or + ;; line-numbers? + (use-labels + (or (not switches) + (and retain-labels + (not (string-match "-k\\>" switches))))) + ;; Retrieve code. + (value (org-unescape-code-in-string + (buffer-substring-no-properties + (line-beginning-position 2) contents-end))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + ;; Get position after ending blank lines. + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'src-block + (nconc + (list :language language + :switches (and (org-string-nw-p switches) + (org-trim switches)) + :parameters (and (org-string-nw-p parameters) + (org-trim parameters)) + :begin begin + :end end + :number-lines number-lines + :preserve-indent preserve-indent + :retain-labels retain-labels + :use-labels use-labels + :label-fmt label-fmt + :value value + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-src-block-interpreter (src-block _) + "Interpret SRC-BLOCK element as Org syntax." + (let ((lang (org-element-property :language src-block)) + (switches (org-element-property :switches src-block)) + (params (org-element-property :parameters src-block)) + (value + (let ((val (org-element-property :value src-block))) + (cond + ((or org-src-preserve-indentation + (org-element-property :preserve-indent src-block)) + val) + ((zerop org-edit-src-content-indentation) + (org-remove-indentation val)) + (t + (let ((ind (make-string org-edit-src-content-indentation ?\s))) + (replace-regexp-in-string "^[ \t]*\\S-" + (concat ind "\\&") + (org-remove-indentation val)))))))) + (format "#+begin_src%s\n%s#+end_src" + (concat (and lang (concat " " lang)) + (and switches (concat " " switches)) + (and params (concat " " params))) + (org-element-normalize-string (org-escape-code-in-string value))))) + + +;;;; Table + +(defun org-element-table-parser (limit affiliated) + "Parse a table at point. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `table' and CDR is a plist containing +`:begin', `:end', `:tblfm', `:type', `:contents-begin', +`:contents-end', `:value', `:post-blank' and `:post-affiliated' +keywords. + +Assume point is at the beginning of the table." + (save-excursion + (let* ((case-fold-search t) + (table-begin (point)) + (type (if (looking-at "[ \t]*|") 'org 'table.el)) + (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)" + (if (eq type 'org) "" "+"))) + (begin (car affiliated)) + (table-end + (if (re-search-forward end-re limit 'move) + (goto-char (match-beginning 0)) + (point))) + (tblfm (let (acc) + (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$") + (push (match-string-no-properties 1) acc) + (forward-line)) + acc)) + (pos-before-blank (point)) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'table + (nconc + (list :begin begin + :end end + :type type + :tblfm tblfm + ;; Only `org' tables have contents. `table.el' tables + ;; use a `:value' property to store raw table as + ;; a string. + :contents-begin (and (eq type 'org) table-begin) + :contents-end (and (eq type 'org) table-end) + :value (and (eq type 'table.el) + (buffer-substring-no-properties + table-begin table-end)) + :post-blank (count-lines pos-before-blank end) + :post-affiliated table-begin) + (cdr affiliated)))))) + +(defun org-element-table-interpreter (table contents) + "Interpret TABLE element as Org syntax. +CONTENTS is a string, if table's type is `org', or nil." + (if (eq (org-element-property :type table) 'table.el) + (org-remove-indentation (org-element-property :value table)) + (concat (with-temp-buffer (insert contents) + (org-table-align) + (buffer-string)) + (mapconcat (lambda (fm) (concat "#+TBLFM: " fm)) + (reverse (org-element-property :tblfm table)) + "\n")))) + + +;;;; Table Row + +(defun org-element-table-row-parser (_) + "Parse table row at point. + +Return a list whose CAR is `table-row' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:type', `:post-blank' and `:post-affiliated' keywords." + (save-excursion + (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard)) + (begin (point)) + ;; A table rule has no contents. In that case, ensure + ;; CONTENTS-BEGIN matches CONTENTS-END. + (contents-begin (and (eq type 'standard) (search-forward "|"))) + (contents-end (and (eq type 'standard) + (progn + (end-of-line) + (skip-chars-backward " \t") + (point)))) + (end (line-beginning-position 2))) + (list 'table-row + (list :type type + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0 + :post-affiliated begin))))) + +(defun org-element-table-row-interpreter (table-row contents) + "Interpret TABLE-ROW element as Org syntax. +CONTENTS is the contents of the table row." + (if (eq (org-element-property :type table-row) 'rule) "|-" + (concat "|" contents))) + + +;;;; Verse Block + +(defun org-element-verse-block-parser (limit affiliated) + "Parse a verse block. + +LIMIT bounds the search. AFFILIATED is a list of which CAR is +the buffer position at the beginning of the first affiliated +keyword and CDR is a plist of affiliated keywords along with +their value. + +Return a list whose CAR is `verse-block' and CDR is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end', +`:post-blank' and `:post-affiliated' keywords. + +Assume point is at beginning of the block." + (let ((case-fold-search t)) + (if (not (save-excursion + (re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t))) + ;; Incomplete block: parse it as a paragraph. + (org-element-paragraph-parser limit affiliated) + (let ((contents-end (match-beginning 0))) + (save-excursion + (let* ((begin (car affiliated)) + (post-affiliated (point)) + (contents-begin (progn (forward-line) (point))) + (pos-before-blank (progn (goto-char contents-end) + (forward-line) + (point))) + (end (progn (skip-chars-forward " \r\t\n" limit) + (if (eobp) (point) (line-beginning-position))))) + (list 'verse-block + (nconc + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank (count-lines pos-before-blank end) + :post-affiliated post-affiliated) + (cdr affiliated))))))))) + +(defun org-element-verse-block-interpreter (_ contents) + "Interpret verse-block element as Org syntax. +CONTENTS is verse block contents." + (format "#+begin_verse\n%s#+end_verse" contents)) + + + +;;; Objects +;; +;; Unlike to elements, raw text can be found between objects. Hence, +;; `org-element--object-lex' is provided to find the next object in +;; buffer. +;; +;; Some object types (e.g., `italic') are recursive. Restrictions on +;; object types they can contain will be specified in +;; `org-element-object-restrictions'. +;; +;; Creating a new type of object requires to alter +;; `org-element--object-regexp' and `org-element--object-lex', add the +;; new type in `org-element-all-objects', and possibly add +;; restrictions in `org-element-object-restrictions'. + +;;;; Bold + +(defun org-element-bold-parser () + "Parse bold object at point, if any. + +When at a bold object, return a list whose car is `bold' and cdr +is a plist with `:begin', `:end', `:contents-begin' and +`:contents-end' and `:post-blank' keywords. Otherwise, return +nil. + +Assume point is at the first star marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (when (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'bold + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) + +(defun org-element-bold-interpreter (_ contents) + "Interpret bold object as Org syntax. +CONTENTS is the contents of the object." + (format "*%s*" contents)) + + +;;;; Citation + +(defun org-element-citation-parser () + "Parse citation object at point, if any. + +When at a citation object, return a list whose car is `citation' +and cdr is a plist with `:style', `:prefix', `:suffix', `:begin', +`:end', `:contents-begin', `:contents-end', and `:post-blank' +keywords. Otherwise, return nil. + +Assume point is at the beginning of the citation." + (when (looking-at org-element-citation-prefix-re) + (let* ((begin (point)) + (style (and (match-end 1) + (match-string-no-properties 1))) + ;; Ignore blanks between cite type and prefix or key. + (start (match-end 0)) + (closing (with-syntax-table org-element--pair-square-table + (ignore-errors (scan-lists begin 1 0))))) + (save-excursion + (when (and closing + (re-search-forward org-element-citation-key-re closing t)) + ;; Find prefix, if any. + (let ((first-key-end (match-end 0)) + (types (org-element-restriction 'citation-reference)) + (cite + (list 'citation + (list :style style + :begin begin + :post-blank (progn + (goto-char closing) + (skip-chars-forward " \t")) + :end (point))))) + ;; `:contents-begin' depends on the presence of + ;; a non-empty common prefix. + (goto-char first-key-end) + (if (not (search-backward ";" start t)) + (org-element-put-property cite :contents-begin start) + (when (< start (point)) + (org-element-put-property + cite :prefix + (org-element--parse-objects start (point) nil types cite))) + (forward-char) + (org-element-put-property cite :contents-begin (point))) + ;; `:contents-end' depends on the presence of a non-empty + ;; common suffix. + (goto-char (1- closing)) + (skip-chars-backward " \r\t\n") + (let ((end (point))) + (if (or (not (search-backward ";" first-key-end t)) + (re-search-forward org-element-citation-key-re end t)) + (org-element-put-property cite :contents-end end) + (forward-char) + (when (< (point) end) + (org-element-put-property + cite :suffix + (org-element--parse-objects (point) end nil types cite))) + (org-element-put-property cite :contents-end (point)))) + cite)))))) + +(defun org-element-citation-interpreter (citation contents) + "Interpret CITATION object as Org syntax. +CONTENTS is the contents of the object, as a string." + (let ((prefix (org-element-property :prefix citation)) + (suffix (org-element-property :suffix citation)) + (style (org-element-property :style citation))) + (concat "[cite" + (and style (concat "/" style)) + ":" + (and prefix (concat (org-element-interpret-data prefix) ";")) + (if suffix + (concat contents (org-element-interpret-data suffix)) + ;; Remove spurious semicolon. + (substring contents nil -1)) + "]"))) + + +;;;; Citation Reference + +(defun org-element-citation-reference-parser () + "Parse citation reference object at point, if any. + +When at a reference, return a list whose car is +`citation-reference', and cdr is a plist with `:key', +`:prefix', `:suffix', `:begin', `:end', and `:post-blank' keywords. + +Assume point is at the beginning of the reference." + (save-excursion + (let ((begin (point))) + (when (re-search-forward org-element-citation-key-re nil t) + (let* ((key (match-string-no-properties 1)) + (key-start (match-beginning 0)) + (key-end (match-end 0)) + (separator (search-forward ";" nil t)) + (end (or separator (point-max))) + (suffix-end (if separator (1- end) end)) + (types (org-element-restriction 'citation-reference)) + (reference + (list 'citation-reference + (list :key key + :begin begin + :end end + :post-blank 0)))) + (when (< begin key-start) + (org-element-put-property + reference :prefix + (org-element--parse-objects begin key-start nil types reference))) + (when (< key-end suffix-end) + (org-element-put-property + reference :suffix + (org-element--parse-objects key-end suffix-end nil types reference))) + reference))))) + +(defun org-element-citation-reference-interpreter (citation-reference _) + "Interpret CITATION-REFERENCE object as Org syntax." + (concat (org-element-interpret-data + (org-element-property :prefix citation-reference)) + "@" (org-element-property :key citation-reference) + (org-element-interpret-data + (org-element-property :suffix citation-reference)) + ";")) + + +;;;; Code + +(defun org-element-code-parser () + "Parse code object at point, if any. + +When at a code object, return a list whose car is `code' and cdr +is a plist with `:value', `:begin', `:end' and `:post-blank' +keywords. Otherwise, return nil. + +Assume point is at the first tilde marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (when (looking-at org-verbatim-re) + (let ((begin (match-beginning 2)) + (value (match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'code + (list :value value + :begin begin + :end end + :post-blank post-blank)))))) + +(defun org-element-code-interpreter (code _) + "Interpret CODE object as Org syntax." + (format "~%s~" (org-element-property :value code))) + + +;;;; Entity + +(defun org-element-entity-parser () + "Parse entity at point, if any. + +When at an entity, return a list whose car is `entity' and cdr +a plist with `:begin', `:end', `:latex', `:latex-math-p', +`:html', `:latin1', `:utf-8', `:ascii', `:use-brackets-p' and +`:post-blank' as keywords. Otherwise, return nil. + +Assume point is at the beginning of the entity." + (catch 'no-object + (when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)") + (save-excursion + (let* ((value (or (org-entity-get (match-string 1)) + (throw 'no-object nil))) + (begin (match-beginning 0)) + (bracketsp (string= (match-string 2) "{}")) + (post-blank (progn (goto-char (match-end 1)) + (when bracketsp (forward-char 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'entity + (list :name (car value) + :latex (nth 1 value) + :latex-math-p (nth 2 value) + :html (nth 3 value) + :ascii (nth 4 value) + :latin1 (nth 5 value) + :utf-8 (nth 6 value) + :begin begin + :end end + :use-brackets-p bracketsp + :post-blank post-blank))))))) + +(defun org-element-entity-interpreter (entity _) + "Interpret ENTITY object as Org syntax." + (concat "\\" + (org-element-property :name entity) + (when (org-element-property :use-brackets-p entity) "{}"))) + + +;;;; Export Snippet + +(defun org-element-export-snippet-parser () + "Parse export snippet at point. + +When at an export snippet, return a list whose car is +`export-snippet' and cdr a plist with `:begin', `:end', +`:back-end', `:value' and `:post-blank' as keywords. Otherwise, +return nil. + +Assume point is at the beginning of the snippet." + (save-excursion + (let (contents-end) + (when (and (looking-at "@@\\([-A-Za-z0-9]+\\):") + (setq contents-end + (save-match-data (goto-char (match-end 0)) + (re-search-forward "@@" nil t) + (match-beginning 0)))) + (let* ((begin (match-beginning 0)) + (back-end (match-string-no-properties 1)) + (value (buffer-substring-no-properties + (match-end 0) contents-end)) + (post-blank (skip-chars-forward " \t")) + (end (point))) + (list 'export-snippet + (list :back-end back-end + :value value + :begin begin + :end end + :post-blank post-blank))))))) + +(defun org-element-export-snippet-interpreter (export-snippet _) + "Interpret EXPORT-SNIPPET object as Org syntax." + (format "@@%s:%s@@" + (org-element-property :back-end export-snippet) + (org-element-property :value export-snippet))) + + +;;;; Footnote Reference + +(defun org-element-footnote-reference-parser () + "Parse footnote reference at point, if any. + +When at a footnote reference, return a list whose car is +`footnote-reference' and cdr a plist with `:label', `:type', +`:begin', `:end', `:contents-begin', `:contents-end' and +`:post-blank' as keywords. Otherwise, return nil." + (when (looking-at org-footnote-re) + (let ((closing (with-syntax-table org-element--pair-square-table + (ignore-errors (scan-lists (point) 1 0))))) + (when closing + (save-excursion + (let* ((begin (point)) + (label (match-string-no-properties 1)) + (inner-begin (match-end 0)) + (inner-end (1- closing)) + (type (if (match-end 2) 'inline 'standard)) + (post-blank (progn (goto-char closing) + (skip-chars-forward " \t"))) + (end (point))) + (list 'footnote-reference + (list :label label + :type type + :begin begin + :end end + :contents-begin (and (eq type 'inline) inner-begin) + :contents-end (and (eq type 'inline) inner-end) + :post-blank post-blank)))))))) + +(defun org-element-footnote-reference-interpreter (footnote-reference contents) + "Interpret FOOTNOTE-REFERENCE object as Org syntax. +CONTENTS is its definition, when inline, or nil." + (format "[fn:%s%s]" + (or (org-element-property :label footnote-reference) "") + (if contents (concat ":" contents) ""))) + + +;;;; Inline Babel Call + +(defun org-element-inline-babel-call-parser () + "Parse inline babel call at point, if any. + +When at an inline babel call, return a list whose car is +`inline-babel-call' and cdr a plist with `:call', +`:inside-header', `:arguments', `:end-header', `:begin', `:end', +`:value' and `:post-blank' as keywords. Otherwise, return nil. + +Assume point is at the beginning of the babel call." + (save-excursion + (catch :no-object + (when (let ((case-fold-search nil)) + (looking-at "\\. Unlike to + ;; bracket links, follow RFC 3986 and remove any extra + ;; whitespace in URI. + ((looking-at org-link-angle-re) + (setq format 'angle) + (setq type (match-string-no-properties 1)) + (setq link-end (match-end 0)) + (setq raw-link + (buffer-substring-no-properties + (match-beginning 1) (match-end 2))) + (setq path (replace-regexp-in-string + "[ \t]*\n[ \t]*" "" (match-string-no-properties 2)))) + (t (throw 'no-object nil))) + ;; In any case, deduce end point after trailing white space from + ;; LINK-END variable. + (save-excursion + (setq post-blank + (progn (goto-char link-end) (skip-chars-forward " \t"))) + (setq end (point))) + ;; Special "file"-type link processing. Extract opening + ;; application and search option, if any. Also normalize URI. + (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type) + (setq application (match-string 1 type)) + (setq type "file") + (when (string-match "::\\(.*\\)\\'" path) + (setq search-option (match-string 1 path)) + (setq path (replace-match "" nil nil path))) + (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path))) + ;; Translate link, if `org-link-translation-function' is set. + (let ((trans (and (functionp org-link-translation-function) + (funcall org-link-translation-function type path)))) + (when trans + (setq type (car trans)) + (setq path (cdr trans)))) + (list 'link + (list :type type + :path path + :format format + :raw-link (or raw-link path) + :application application + :search-option search-option + :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank))))) + +(defun org-element-link-interpreter (link contents) + "Interpret LINK object as Org syntax. +CONTENTS is the contents of the object, or nil." + (let ((type (org-element-property :type link)) + (path (org-element-property :path link))) + (if (string= type "radio") path + (let ((fmt (pcase (org-element-property :format link) + ;; Links with contents and internal links have to + ;; use bracket syntax. Ignore `:format' in these + ;; cases. This is also the default syntax when the + ;; property is not defined, e.g., when the object + ;; was crafted by the user. + ((guard contents) + (format "[[%%s][%s]]" + ;; Since this is going to be used as + ;; a format string, escape percent signs + ;; in description. + (replace-regexp-in-string "%" "%%" contents))) + ((or `bracket + `nil + (guard (member type '("coderef" "custom-id" "fuzzy")))) + "[[%s]]") + ;; Otherwise, just obey to `:format'. + (`angle "<%s>") + (`plain "%s") + (f (error "Wrong `:format' value: %s" f))))) + (format fmt + (pcase type + ("coderef" (format "(%s)" path)) + ("custom-id" (concat "#" path)) + ("file" + (let ((app (org-element-property :application link)) + (opt (org-element-property :search-option link))) + (concat type (and app (concat "+" app)) ":" + path + (and opt (concat "::" opt))))) + ("fuzzy" path) + (_ (concat type ":" path)))))))) + + +;;;; Macro + +(defun org-element-macro-parser () + "Parse macro at point, if any. + +When at a macro, return a list whose car is `macro' and cdr +a plist with `:key', `:args', `:begin', `:end', `:value' and +`:post-blank' as keywords. Otherwise, return nil. + +Assume point is at the macro." + (save-excursion + (when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}") + (let ((begin (point)) + (key (downcase (match-string-no-properties 1))) + (value (match-string-no-properties 0)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (args (pcase (match-string-no-properties 3) + (`nil nil) + (a (org-macro-extract-arguments + (replace-regexp-in-string + "[ \t\r\n]+" " " (org-trim a))))))) + (list 'macro + (list :key key + :value value + :args args + :begin begin + :end end + :post-blank post-blank)))))) + +(defun org-element-macro-interpreter (macro _) + "Interpret MACRO object as Org syntax." + (format "{{{%s%s}}}" + (org-element-property :key macro) + (pcase (org-element-property :args macro) + (`nil "") + (args (format "(%s)" (apply #'org-macro-escape-arguments args)))))) + + +;;;; Radio-target + +(defun org-element-radio-target-parser () + "Parse radio target at point, if any. + +When at a radio target, return a list whose car is `radio-target' +and cdr a plist with `:begin', `:end', `:contents-begin', +`:contents-end', `:value' and `:post-blank' as keywords. +Otherwise, return nil. + +Assume point is at the radio target." + (save-excursion + (when (looking-at org-radio-target-regexp) + (let ((begin (point)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1)) + (value (match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'radio-target + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank + :value value)))))) + +(defun org-element-radio-target-interpreter (_ contents) + "Interpret target object as Org syntax. +CONTENTS is the contents of the object." + (concat "<<<" contents ">>>")) + + +;;;; Statistics Cookie + +(defun org-element-statistics-cookie-parser () + "Parse statistics cookie at point, if any. + +When at a statistics cookie, return a list whose car is +`statistics-cookie', and cdr a plist with `:begin', `:end', +`:value' and `:post-blank' keywords. Otherwise, return nil. + +Assume point is at the beginning of the statistics-cookie." + (save-excursion + (when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]") + (let* ((begin (point)) + (value (buffer-substring-no-properties + (match-beginning 0) (match-end 0))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'statistics-cookie + (list :begin begin + :end end + :value value + :post-blank post-blank)))))) + +(defun org-element-statistics-cookie-interpreter (statistics-cookie _) + "Interpret STATISTICS-COOKIE object as Org syntax." + (org-element-property :value statistics-cookie)) + + +;;;; Strike-Through + +(defun org-element-strike-through-parser () + "Parse strike-through object at point, if any. + +When at a strike-through object, return a list whose car is +`strike-through' and cdr is a plist with `:begin', `:end', +`:contents-begin' and `:contents-end' and `:post-blank' keywords. +Otherwise, return nil. + +Assume point is at the first plus sign marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (when (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'strike-through + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) + +(defun org-element-strike-through-interpreter (_ contents) + "Interpret strike-through object as Org syntax. +CONTENTS is the contents of the object." + (format "+%s+" contents)) + + +;;;; Subscript + +(defun org-element-subscript-parser () + "Parse subscript at point, if any. + +When at a subscript object, return a list whose car is +`subscript' and cdr a plist with `:begin', `:end', +`:contents-begin', `:contents-end', `:use-brackets-p' and +`:post-blank' as keywords. Otherwise, return nil. + +Assume point is at the underscore." + (save-excursion + (unless (bolp) (backward-char)) + (when (looking-at org-match-substring-regexp) + (let ((bracketsp (match-beginning 4)) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 4) + (match-beginning 3))) + (contents-end (or (match-end 4) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'subscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) + +(defun org-element-subscript-interpreter (subscript contents) + "Interpret SUBSCRIPT object as Org syntax. +CONTENTS is the contents of the object." + (format + (if (org-element-property :use-brackets-p subscript) "_{%s}" "_%s") + contents)) + + +;;;; Superscript + +(defun org-element-superscript-parser () + "Parse superscript at point, if any. + +When at a superscript object, return a list whose car is +`superscript' and cdr a plist with `:begin', `:end', +`:contents-begin', `:contents-end', `:use-brackets-p' and +`:post-blank' as keywords. Otherwise, return nil. + +Assume point is at the caret." + (save-excursion + (unless (bolp) (backward-char)) + (when (looking-at org-match-substring-regexp) + (let ((bracketsp (match-beginning 4)) + (begin (match-beginning 2)) + (contents-begin (or (match-beginning 4) + (match-beginning 3))) + (contents-end (or (match-end 4) (match-end 3))) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'superscript + (list :begin begin + :end end + :use-brackets-p bracketsp + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) + +(defun org-element-superscript-interpreter (superscript contents) + "Interpret SUPERSCRIPT object as Org syntax. +CONTENTS is the contents of the object." + (format + (if (org-element-property :use-brackets-p superscript) "^{%s}" "^%s") + contents)) + + +;;;; Table Cell + +(defun org-element-table-cell-parser () + "Parse table cell at point. +Return a list whose car is `table-cell' and cdr is a plist +containing `:begin', `:end', `:contents-begin', `:contents-end' +and `:post-blank' keywords." + (looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)") + (let* ((begin (match-beginning 0)) + (end (match-end 0)) + (contents-begin (match-beginning 1)) + (contents-end (match-end 1))) + (list 'table-cell + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank 0)))) + +(defun org-element-table-cell-interpreter (_ contents) + "Interpret table-cell element as Org syntax. +CONTENTS is the contents of the cell, or nil." + (concat " " contents " |")) + + +;;;; Target + +(defun org-element-target-parser () + "Parse target at point, if any. + +When at a target, return a list whose car is `target' and cdr +a plist with `:begin', `:end', `:value' and `:post-blank' as +keywords. Otherwise, return nil. + +Assume point is at the target." + (save-excursion + (when (looking-at org-target-regexp) + (let ((begin (point)) + (value (match-string-no-properties 1)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'target + (list :begin begin + :end end + :value value + :post-blank post-blank)))))) + +(defun org-element-target-interpreter (target _) + "Interpret TARGET object as Org syntax." + (format "<<%s>>" (org-element-property :value target))) + + +;;;; Timestamp + +(defconst org-element--timestamp-regexp + (concat org-ts-regexp-both + "\\|" + "\\(?:<[0-9]+-[0-9]+-[0-9]+[^>\n]+?\\+[0-9]+[dwmy]>\\)" + "\\|" + "\\(?:<%%\\(?:([^>\n]+)\\)>\\)") + "Regexp matching any timestamp type object.") + +(defun org-element-timestamp-parser () + "Parse time stamp at point, if any. + +When at a time stamp, return a list whose car is `timestamp', and +cdr a plist with `:type', `:raw-value', `:year-start', +`:month-start', `:day-start', `:hour-start', `:minute-start', +`:year-end', `:month-end', `:day-end', `:hour-end', +`:minute-end', `:repeater-type', `:repeater-value', +`:repeater-unit', `:warning-type', `:warning-value', +`:warning-unit', `:begin', `:end' and `:post-blank' keywords. +Otherwise, return nil. + +Assume point is at the beginning of the timestamp." + (when (looking-at-p org-element--timestamp-regexp) + (save-excursion + (let* ((begin (point)) + (activep (eq (char-after) ?<)) + (raw-value + (progn + (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?") + (match-string-no-properties 0))) + (date-start (match-string-no-properties 1)) + (date-end (match-string 3)) + (diaryp (match-beginning 2)) + (post-blank (progn (goto-char (match-end 0)) + (skip-chars-forward " \t"))) + (end (point)) + (time-range + (and (not diaryp) + (string-match + "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)" + date-start) + (cons (string-to-number (match-string 2 date-start)) + (string-to-number (match-string 3 date-start))))) + (type (cond (diaryp 'diary) + ((and activep (or date-end time-range)) 'active-range) + (activep 'active) + ((or date-end time-range) 'inactive-range) + (t 'inactive))) + (repeater-props + (and (not diaryp) + (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)" + raw-value) + (list + :repeater-type + (let ((type (match-string 1 raw-value))) + (cond ((equal "++" type) 'catch-up) + ((equal ".+" type) 'restart) + (t 'cumulate))) + :repeater-value (string-to-number (match-string 2 raw-value)) + :repeater-unit + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) + (warning-props + (and (not diaryp) + (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value) + (list + :warning-type (if (match-string 1 raw-value) 'first 'all) + :warning-value (string-to-number (match-string 2 raw-value)) + :warning-unit + (pcase (string-to-char (match-string 3 raw-value)) + (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))) + year-start month-start day-start hour-start minute-start year-end + month-end day-end hour-end minute-end) + ;; Parse date-start. + (unless diaryp + (let ((date (org-parse-time-string date-start t))) + (setq year-start (nth 5 date) + month-start (nth 4 date) + day-start (nth 3 date) + hour-start (nth 2 date) + minute-start (nth 1 date)))) + ;; Compute date-end. It can be provided directly in time-stamp, + ;; or extracted from time range. Otherwise, it defaults to the + ;; same values as date-start. + (unless diaryp + (let ((date (and date-end (org-parse-time-string date-end t)))) + (setq year-end (or (nth 5 date) year-start) + month-end (or (nth 4 date) month-start) + day-end (or (nth 3 date) day-start) + hour-end (or (nth 2 date) (car time-range) hour-start) + minute-end (or (nth 1 date) (cdr time-range) minute-start)))) + (list 'timestamp + (nconc (list :type type + :raw-value raw-value + :year-start year-start + :month-start month-start + :day-start day-start + :hour-start hour-start + :minute-start minute-start + :year-end year-end + :month-end month-end + :day-end day-end + :hour-end hour-end + :minute-end minute-end + :begin begin + :end end + :post-blank post-blank) + repeater-props + warning-props)))))) + +(defun org-element-timestamp-interpreter (timestamp _) + "Interpret TIMESTAMP object as Org syntax." + (let* ((repeat-string + (concat + (pcase (org-element-property :repeater-type timestamp) + (`cumulate "+") (`catch-up "++") (`restart ".+")) + (let ((val (org-element-property :repeater-value timestamp))) + (and val (number-to-string val))) + (pcase (org-element-property :repeater-unit timestamp) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) + (warning-string + (concat + (pcase (org-element-property :warning-type timestamp) + (`first "--") (`all "-")) + (let ((val (org-element-property :warning-value timestamp))) + (and val (number-to-string val))) + (pcase (org-element-property :warning-unit timestamp) + (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y")))) + (build-ts-string + ;; Build an Org timestamp string from TIME. ACTIVEP is + ;; non-nil when time stamp is active. If WITH-TIME-P is + ;; non-nil, add a time part. HOUR-END and MINUTE-END + ;; specify a time range in the timestamp. REPEAT-STRING is + ;; the repeater string, if any. + (lambda (time activep &optional with-time-p hour-end minute-end) + (let ((ts (format-time-string + (funcall (if with-time-p #'cdr #'car) + org-time-stamp-formats) + time))) + (when (and hour-end minute-end) + (string-match "[012]?[0-9]:[0-5][0-9]" ts) + (setq ts + (replace-match + (format "\\&-%02d:%02d" hour-end minute-end) + nil nil ts))) + (unless activep (setq ts (format "[%s]" (substring ts 1 -1)))) + (dolist (s (list repeat-string warning-string)) + (when (org-string-nw-p s) + (setq ts (concat (substring ts 0 -1) + " " + s + (substring ts -1))))) + ;; Return value. + ts))) + (type (org-element-property :type timestamp))) + (pcase type + ((or `active `inactive) + (let* ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp)) + (time-range-p (and hour-start hour-end minute-start minute-end + (or (/= hour-start hour-end) + (/= minute-start minute-end))))) + (funcall + build-ts-string + (encode-time 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active) + (and hour-start minute-start) + (and time-range-p hour-end) + (and time-range-p minute-end)))) + ((or `active-range `inactive-range) + (let ((minute-start (org-element-property :minute-start timestamp)) + (minute-end (org-element-property :minute-end timestamp)) + (hour-start (org-element-property :hour-start timestamp)) + (hour-end (org-element-property :hour-end timestamp))) + (concat + (funcall + build-ts-string (encode-time + 0 + (or minute-start 0) + (or hour-start 0) + (org-element-property :day-start timestamp) + (org-element-property :month-start timestamp) + (org-element-property :year-start timestamp)) + (eq type 'active-range) + (and hour-start minute-start)) + "--" + (funcall build-ts-string + (encode-time 0 + (or minute-end 0) + (or hour-end 0) + (org-element-property :day-end timestamp) + (org-element-property :month-end timestamp) + (org-element-property :year-end timestamp)) + (eq type 'active-range) + (and hour-end minute-end))))) + (_ (org-element-property :raw-value timestamp))))) + + +;;;; Underline + +(defun org-element-underline-parser () + "Parse underline object at point, if any. + +When at an underline object, return a list whose car is +`underline' and cdr is a plist with `:begin', `:end', +`:contents-begin' and `:contents-end' and `:post-blank' keywords. +Otherwise, return nil. + +Assume point is at the first underscore marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (when (looking-at org-emph-re) + (let ((begin (match-beginning 2)) + (contents-begin (match-beginning 4)) + (contents-end (match-end 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'underline + (list :begin begin + :end end + :contents-begin contents-begin + :contents-end contents-end + :post-blank post-blank)))))) + +(defun org-element-underline-interpreter (_ contents) + "Interpret underline object as Org syntax. +CONTENTS is the contents of the object." + (format "_%s_" contents)) + + +;;;; Verbatim + +(defun org-element-verbatim-parser () + "Parse verbatim object at point, if any. + +When at a verbatim object, return a list whose car is `verbatim' +and cdr is a plist with `:value', `:begin', `:end' and +`:post-blank' keywords. Otherwise, return nil. + +Assume point is at the first equal sign marker." + (save-excursion + (unless (bolp) (backward-char 1)) + (when (looking-at org-verbatim-re) + (let ((begin (match-beginning 2)) + (value (match-string-no-properties 4)) + (post-blank (progn (goto-char (match-end 2)) + (skip-chars-forward " \t"))) + (end (point))) + (list 'verbatim + (list :value value + :begin begin + :end end + :post-blank post-blank)))))) + +(defun org-element-verbatim-interpreter (verbatim _) + "Interpret VERBATIM object as Org syntax." + (format "=%s=" (org-element-property :value verbatim))) + + + +;;; Parsing Element Starting At Point +;; +;; `org-element--current-element' is the core function of this section. +;; It returns the Lisp representation of the element starting at +;; point. + +(defun org-element--current-element (limit &optional granularity mode structure) + "Parse the element starting at point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. + +LIMIT bounds the search. + +Optional argument GRANULARITY determines the depth of the +recursion. Allowed values are `headline', `greater-element', +`element', `object' or nil. When it is broader than `object' (or +nil), secondary values will not be parsed, since they only +contain objects. + +Optional argument MODE, when non-nil, can be either +`first-section', `item', `node-property', `planning', +`property-drawer', `section', `table-row', or `top-comment'. + + +If STRUCTURE isn't provided but MODE is set to `item', it will be +computed. + +This function assumes point is always at the beginning of the +element it has to parse." + (save-excursion + (let ((case-fold-search t) + ;; Determine if parsing depth allows for secondary strings + ;; parsing. It only applies to elements referenced in + ;; `org-element-secondary-value-alist'. + (raw-secondary-p (and granularity (not (eq granularity 'object))))) + (cond + ;; Item. + ((eq mode 'item) + (org-element-item-parser limit structure raw-secondary-p)) + ;; Table Row. + ((eq mode 'table-row) (org-element-table-row-parser limit)) + ;; Node Property. + ((eq mode 'node-property) (org-element-node-property-parser limit)) + ;; Headline. + ((org-with-limited-levels (org-at-heading-p)) + (org-element-headline-parser limit raw-secondary-p)) + ;; Sections (must be checked after headline). + ((eq mode 'section) (org-element-section-parser limit)) + ((eq mode 'first-section) + (org-element-section-parser + (or (save-excursion (org-with-limited-levels (outline-next-heading))) + limit))) + ;; Comments. + ((looking-at "^[ \t]*#\\(?: \\|$\\)") + (org-element-comment-parser limit)) + ;; Planning. + ((and (eq mode 'planning) + (eq ?* (char-after (line-beginning-position 0))) + (looking-at org-planning-line-re)) + (org-element-planning-parser limit)) + ;; Property drawer. + ((and (pcase mode + (`planning (eq ?* (char-after (line-beginning-position 0)))) + ((or `property-drawer `top-comment) + (save-excursion + (beginning-of-line 0) + (not (looking-at "[[:blank:]]*$")))) + (_ nil)) + (looking-at org-property-drawer-re)) + (org-element-property-drawer-parser limit)) + ;; When not at bol, point is at the beginning of an item or + ;; a footnote definition: next item is always a paragraph. + ((not (bolp)) (org-element-paragraph-parser limit (list (point)))) + ;; Clock. + ((looking-at org-clock-line-re) (org-element-clock-parser limit)) + ;; Inlinetask. + ((looking-at "^\\*+ ") + (org-element-inlinetask-parser limit raw-secondary-p)) + ;; From there, elements can have affiliated keywords. + (t (let ((affiliated (org-element--collect-affiliated-keywords + limit (memq granularity '(nil object))))) + (cond + ;; Jumping over affiliated keywords put point off-limits. + ;; Parse them as regular keywords. + ((and (cdr affiliated) (>= (point) limit)) + (goto-char (car affiliated)) + (org-element-keyword-parser limit nil)) + ;; LaTeX Environment. + ((looking-at org-element--latex-begin-environment) + (org-element-latex-environment-parser limit affiliated)) + ;; Drawer. + ((looking-at org-drawer-regexp) + (org-element-drawer-parser limit affiliated)) + ;; Fixed Width + ((looking-at "[ \t]*:\\( \\|$\\)") + (org-element-fixed-width-parser limit affiliated)) + ;; Inline Comments, Blocks, Babel Calls, Dynamic Blocks and + ;; Keywords. + ((looking-at "[ \t]*#\\+") + (goto-char (match-end 0)) + (cond + ((looking-at "BEGIN_\\(\\S-+\\)") + (beginning-of-line) + (funcall (pcase (upcase (match-string 1)) + ("CENTER" #'org-element-center-block-parser) + ("COMMENT" #'org-element-comment-block-parser) + ("EXAMPLE" #'org-element-example-block-parser) + ("EXPORT" #'org-element-export-block-parser) + ("QUOTE" #'org-element-quote-block-parser) + ("SRC" #'org-element-src-block-parser) + ("VERSE" #'org-element-verse-block-parser) + (_ #'org-element-special-block-parser)) + limit + affiliated)) + ((looking-at "CALL:") + (beginning-of-line) + (org-element-babel-call-parser limit affiliated)) + ((looking-at "BEGIN:? ") + (beginning-of-line) + (org-element-dynamic-block-parser limit affiliated)) + ((looking-at "\\S-+:") + (beginning-of-line) + (org-element-keyword-parser limit affiliated)) + (t + (beginning-of-line) + (org-element-paragraph-parser limit affiliated)))) + ;; Footnote Definition. + ((looking-at org-footnote-definition-re) + (org-element-footnote-definition-parser limit affiliated)) + ;; Horizontal Rule. + ((looking-at "[ \t]*-\\{5,\\}[ \t]*$") + (org-element-horizontal-rule-parser limit affiliated)) + ;; Diary Sexp. + ((looking-at "%%(") + (org-element-diary-sexp-parser limit affiliated)) + ;; Table. + ((or (looking-at "[ \t]*|") + ;; There is no strict definition of a table.el + ;; table. Try to prevent false positive while being + ;; quick. + (let ((rule-regexp + (rx (zero-or-more (any " \t")) + "+" + (one-or-more (one-or-more "-") "+") + (zero-or-more (any " \t")) + eol)) + (non-table.el-line + (rx bol + (zero-or-more (any " \t")) + (or eol (not (any "+| \t"))))) + (next (line-beginning-position 2))) + ;; Start with a full rule. + (and + (looking-at rule-regexp) + (< next limit) ;no room for a table.el table + (save-excursion + (end-of-line) + (cond + ;; Must end with a full rule. + ((not (re-search-forward non-table.el-line limit 'move)) + (if (bolp) (forward-line -1) (beginning-of-line)) + (looking-at rule-regexp)) + ;; Ignore pseudo-tables with a single + ;; rule. + ((= next (line-beginning-position)) + nil) + ;; Must end with a full rule. + (t + (forward-line -1) + (looking-at rule-regexp))))))) + (org-element-table-parser limit affiliated)) + ;; List. + ((looking-at (org-item-re)) + (org-element-plain-list-parser + limit affiliated + (or structure (org-element--list-struct limit)))) + ;; Default element: Paragraph. + (t (org-element-paragraph-parser limit affiliated))))))))) + + +;; Most elements can have affiliated keywords. When looking for an +;; element beginning, we want to move before them, as they belong to +;; that element, and, in the meantime, collect information they give +;; into appropriate properties. Hence the following function. + +(defun org-element--collect-affiliated-keywords (limit parse) + "Collect affiliated keywords from point down to LIMIT. + +Return a list whose CAR is the position at the first of them and +CDR a plist of keywords and values and move point to the +beginning of the first line after them. + +As a special case, if element doesn't start at the beginning of +the line (e.g., a paragraph starting an item), CAR is current +position of point and CDR is nil. + +When PARSE is non-nil, values from keywords belonging to +`org-element-parsed-keywords' are parsed as secondary strings." + (if (not (bolp)) (list (point)) + (let ((case-fold-search t) + (origin (point)) + ;; RESTRICT is the list of objects allowed in parsed + ;; keywords value. If PARSE is nil, no object is allowed. + (restrict (and parse (org-element-restriction 'keyword))) + output) + (while (and (< (point) limit) (looking-at org-element--affiliated-re)) + (let* ((raw-kwd (upcase (match-string 1))) + ;; Apply translation to RAW-KWD. From there, KWD is + ;; the official keyword. + (kwd (or (cdr (assoc raw-kwd + org-element-keyword-translation-alist)) + raw-kwd)) + ;; PARSED? is non-nil when keyword should have its + ;; value parsed. + (parsed? (member kwd org-element-parsed-keywords)) + ;; Find main value for any keyword. + (value + (let ((beg (match-end 0)) + (end (save-excursion + (end-of-line) + (skip-chars-backward " \t") + (point)))) + (if parsed? + (save-match-data + (org-element--parse-objects beg end nil restrict)) + (org-trim (buffer-substring-no-properties beg end))))) + ;; If KWD is a dual keyword, find its secondary value. + ;; Maybe parse it. + (dual? (member kwd org-element-dual-keywords)) + (dual-value + (and dual? + (let ((sec (match-string-no-properties 2))) + (cond + ((and sec parsed?) + (save-match-data + (org-element--parse-objects + (match-beginning 2) (match-end 2) nil restrict))) + (sec sec))))) + ;; Attribute a property name to KWD. + (kwd-sym (and kwd (intern (concat ":" (downcase kwd)))))) + ;; Now set final shape for VALUE. + (when dual? + (setq value (and (or value dual-value) (cons value dual-value)))) + (when (or (member kwd org-element-multiple-keywords) + ;; Attributes can always appear on multiple lines. + (string-match "^ATTR_" kwd)) + (setq value (cons value (plist-get output kwd-sym)))) + ;; Eventually store the new value in OUTPUT. + (setq output (plist-put output kwd-sym value)) + ;; Move to next keyword. + (forward-line))) + ;; If affiliated keywords are orphaned: move back to first one. + ;; They will be parsed as a paragraph. + (when (looking-at "[ \t]*$") (goto-char origin) (setq output nil)) + ;; Return value. + (cons origin output)))) + + + +;;; The Org Parser +;; +;; The two major functions here are `org-element-parse-buffer', which +;; parses Org syntax inside the current buffer, taking into account +;; region, narrowing, or even visibility if specified, and +;; `org-element-parse-secondary-string', which parses objects within +;; a given string. +;; +;; The (almost) almighty `org-element-map' allows applying a function +;; on elements or objects matching some type, and accumulating the +;; resulting values. In an export situation, it also skips unneeded +;; parts of the parse tree. + +(defun org-element-parse-buffer (&optional granularity visible-only) + "Recursively parse the buffer and return structure. +If narrowing is in effect, only parse the visible part of the +buffer. + +Optional argument GRANULARITY determines the depth of the +recursion. It can be set to the following symbols: + +`headline' Only parse headlines. +`greater-element' Don't recurse into greater elements except + headlines and sections. Thus, elements + parsed are the top-level ones. +`element' Parse everything but objects and plain text. +`object' Parse the complete buffer (default). + +When VISIBLE-ONLY is non-nil, don't parse contents of hidden +elements. + +An element or object is represented as a list with the +pattern (TYPE PROPERTIES CONTENTS), where : + + TYPE is a symbol describing the element or object. See + `org-element-all-elements' and `org-element-all-objects' for an + exhaustive list of such symbols. One can retrieve it with + `org-element-type' function. + + PROPERTIES is the list of attributes attached to the element or + object, as a plist. Although most of them are specific to the + element or object type, all types share `:begin', `:end', + `:post-blank' and `:parent' properties, which respectively + refer to buffer position where the element or object starts, + ends, the number of white spaces or blank lines after it, and + the element or object containing it. Properties values can be + obtained by using `org-element-property' function. + + CONTENTS is a list of elements, objects or raw strings + contained in the current element or object, when applicable. + One can access them with `org-element-contents' function. + +The Org buffer has `org-data' as type and nil as properties. +`org-element-map' function can be used to find specific elements +or objects within the parse tree. + +This function assumes that current major mode is `org-mode'." + (save-excursion + (goto-char (point-min)) + (org-skip-whitespace) + (org-element--parse-elements + (point-at-bol) (point-max) + ;; Start in `first-section' mode so text before the first + ;; headline belongs to a section. + 'first-section nil granularity visible-only (list 'org-data nil)))) + +(defun org-element-parse-secondary-string (string restriction &optional parent) + "Recursively parse objects in STRING and return structure. + +RESTRICTION is a symbol limiting the object types that will be +looked after. + +Optional argument PARENT, when non-nil, is the element or object +containing the secondary string. It is used to set correctly +`:parent' property within the string. + +If STRING is the empty string or nil, return nil." + (cond + ((not string) nil) + ((equal string "") nil) + (t (let ((local-variables (buffer-local-variables))) + (with-temp-buffer + (dolist (v local-variables) + (ignore-errors + (if (symbolp v) (makunbound v) + ;; Don't set file name to avoid mishandling hooks (bug#44524) + (unless (memq (car v) '(buffer-file-name buffer-file-truename)) + (set (make-local-variable (car v)) (cdr v)))))) + ;; Transferring local variables may put the temporary buffer + ;; into a read-only state. Make sure we can insert STRING. + (let ((inhibit-read-only t)) (insert string)) + ;; Prevent "Buffer *temp* modified; kill anyway?". + (restore-buffer-modified-p nil) + (org-element--parse-objects + (point-min) (point-max) nil restriction parent)))))) + +(defun org-element-map + (data types fun &optional info first-match no-recursion with-affiliated) + "Map a function on selected elements or objects. + +DATA is a parse tree, an element, an object, a string, or a list +of such constructs. TYPES is a symbol or list of symbols of +elements or objects types (see `org-element-all-elements' and +`org-element-all-objects' for a complete list of types). FUN is +the function called on the matching element or object. It has to +accept one argument: the element or object itself. + +When optional argument INFO is non-nil, it should be a plist +holding export options. In that case, parts of the parse tree +not exportable according to that property list will be skipped. + +When optional argument FIRST-MATCH is non-nil, stop at the first +match for which FUN doesn't return nil, and return that value. + +Optional argument NO-RECURSION is a symbol or a list of symbols +representing elements or objects types. `org-element-map' won't +enter any recursive element or object whose type belongs to that +list. Though, FUN can still be applied on them. + +When optional argument WITH-AFFILIATED is non-nil, FUN will also +apply to matching objects within parsed affiliated keywords (see +`org-element-parsed-keywords'). + +Nil values returned from FUN do not appear in the results. + + +Examples: +--------- + +Assuming TREE is a variable containing an Org buffer parse tree, +the following example will return a flat list of all `src-block' +and `example-block' elements in it: + + (org-element-map tree \\='(example-block src-block) #\\='identity) + +The following snippet will find the first headline with a level +of 1 and a \"phone\" tag, and will return its beginning position: + + (org-element-map tree \\='headline + (lambda (hl) + (and (= (org-element-property :level hl) 1) + (member \"phone\" (org-element-property :tags hl)) + (org-element-property :begin hl))) + nil t) + +The next example will return a flat list of all `plain-list' type +elements in TREE that are not a sub-list themselves: + + (org-element-map tree \\='plain-list #\\='identity nil nil \\='plain-list) + +Eventually, this example will return a flat list of all `bold' +type objects containing a `latex-snippet' type object, even +looking into captions: + + (org-element-map tree \\='bold + (lambda (b) + (and (org-element-map b \\='latex-snippet #\\='identity nil t) b)) + nil nil nil t)" + (declare (indent 2)) + ;; Ensure TYPES and NO-RECURSION are a list, even of one element. + (let* ((types (if (listp types) types (list types))) + (no-recursion (if (listp no-recursion) no-recursion + (list no-recursion))) + ;; Recursion depth is determined by --CATEGORY. + (--category + (catch :--found + (let ((category 'greater-elements) + (all-objects (cons 'plain-text org-element-all-objects))) + (dolist (type types category) + (cond ((memq type all-objects) + ;; If one object is found, the function has + ;; to recurse into every object. + (throw :--found 'objects)) + ((not (memq type org-element-greater-elements)) + ;; If one regular element is found, the + ;; function has to recurse, at least, into + ;; every element it encounters. + (and (not (eq category 'elements)) + (setq category 'elements)))))))) + --acc) + (letrec ((--walk-tree + (lambda (--data) + ;; Recursively walk DATA. INFO, if non-nil, is a plist + ;; holding contextual information. + (let ((--type (org-element-type --data))) + (cond + ((not --data)) + ;; Ignored element in an export context. + ((and info (memq --data (plist-get info :ignore-list)))) + ;; List of elements or objects. + ((not --type) (mapc --walk-tree --data)) + ;; Unconditionally enter parse trees. + ((eq --type 'org-data) + (mapc --walk-tree (org-element-contents --data))) + (t + ;; Check if TYPE is matching among TYPES. If so, + ;; apply FUN to --DATA and accumulate return value + ;; into --ACC (or exit if FIRST-MATCH is non-nil). + (when (memq --type types) + (let ((result (funcall fun --data))) + (cond ((not result)) + (first-match (throw :--map-first-match result)) + (t (push result --acc))))) + ;; If --DATA has a secondary string that can contain + ;; objects with their type among TYPES, look inside. + (when (and (eq --category 'objects) (not (stringp --data))) + (dolist (p (cdr (assq --type + org-element-secondary-value-alist))) + (funcall --walk-tree (org-element-property p --data)))) + ;; If --DATA has any parsed affiliated keywords and + ;; WITH-AFFILIATED is non-nil, look for objects in + ;; them. + (when (and with-affiliated + (eq --category 'objects) + (eq (org-element-class --data) 'element)) + (dolist (kwd-pair org-element--parsed-properties-alist) + (let ((kwd (car kwd-pair)) + (value (org-element-property (cdr kwd-pair) --data))) + ;; Pay attention to the type of parsed + ;; keyword. In particular, preserve order for + ;; multiple keywords. + (cond + ((not value)) + ((member kwd org-element-dual-keywords) + (if (member kwd org-element-multiple-keywords) + (dolist (line (reverse value)) + (funcall --walk-tree (cdr line)) + (funcall --walk-tree (car line))) + (funcall --walk-tree (cdr value)) + (funcall --walk-tree (car value)))) + ((member kwd org-element-multiple-keywords) + (mapc --walk-tree (reverse value))) + (t (funcall --walk-tree value)))))) + ;; Determine if a recursion into --DATA is possible. + (cond + ;; --TYPE is explicitly removed from recursion. + ((memq --type no-recursion)) + ;; --DATA has no contents. + ((not (org-element-contents --data))) + ;; Looking for greater elements but --DATA is + ;; simply an element or an object. + ((and (eq --category 'greater-elements) + (not (memq --type org-element-greater-elements)))) + ;; Looking for elements but --DATA is an object. + ((and (eq --category 'elements) + (eq (org-element-class --data) 'object))) + ;; In any other case, map contents. + (t (mapc --walk-tree (org-element-contents --data)))))))))) + (catch :--map-first-match + (funcall --walk-tree data) + ;; Return value in a proper order. + (nreverse --acc))))) + +;; The following functions are internal parts of the parser. +;; +;; The first one, `org-element--parse-elements' acts at the element's +;; level. +;; +;; The second one, `org-element--parse-objects' applies on all objects +;; of a paragraph or a secondary string. It calls +;; `org-element--object-lex' to find the next object in the current +;; container. + +(defsubst org-element--next-mode (mode type parent?) + "Return next mode according to current one. + +MODE is a symbol representing the expectation about the next +element or object. Meaningful values are `first-section', +`item', `node-property', `planning', `property-drawer', +`section', `table-row', `top-comment', and nil. + +TYPE is the type of the current element or object. + +If PARENT? is non-nil, assume the next element or object will be +located inside the current one." + (if parent? + (pcase type + (`headline 'section) + ((and (guard (eq mode 'first-section)) `section) 'top-comment) + (`inlinetask 'planning) + (`plain-list 'item) + (`property-drawer 'node-property) + (`section 'planning) + (`table 'table-row)) + (pcase mode + (`item 'item) + (`node-property 'node-property) + ((and `planning (guard (eq type 'planning))) 'property-drawer) + (`table-row 'table-row) + ((and `top-comment (guard (eq type 'comment))) 'property-drawer)))) + +(defun org-element--parse-elements + (beg end mode structure granularity visible-only acc) + "Parse elements between BEG and END positions. + +MODE prioritizes some elements over the others. It can be set to +`first-section', `item', `node-property', `planning', +`property-drawer', `section', `table-row', `top-comment', or nil. + +When value is `item', STRUCTURE will be used as the current list +structure. + +GRANULARITY determines the depth of the recursion. See +`org-element-parse-buffer' for more information. + +When VISIBLE-ONLY is non-nil, don't parse contents of hidden +elements. + +Elements are accumulated into ACC." + (save-excursion + (goto-char beg) + ;; When parsing only headlines, skip any text before first one. + (when (and (eq granularity 'headline) (not (org-at-heading-p))) + (org-with-limited-levels (outline-next-heading))) + (let (elements) + (while (< (point) end) + ;; Visible only: skip invisible parts due to folding. + (if (and visible-only (org-invisible-p nil t)) + (progn + (goto-char (org-find-visible)) + (when (and (eolp) (not (eobp))) (forward-char))) + ;; Find current element's type and parse it accordingly to + ;; its category. + (let* ((element (org-element--current-element + end granularity mode structure)) + (type (org-element-type element)) + (cbeg (org-element-property :contents-begin element))) + (goto-char (org-element-property :end element)) + ;; Fill ELEMENT contents by side-effect. + (cond + ;; If element has no contents, don't modify it. + ((not cbeg)) + ;; Greater element: parse it between `contents-begin' and + ;; `contents-end'. Ensure GRANULARITY allows recursion, + ;; or ELEMENT is a headline, in which case going inside + ;; is mandatory, in order to get sub-level headings. + ((and (memq type org-element-greater-elements) + (or (memq granularity '(element object nil)) + (and (eq granularity 'greater-element) + (eq type 'section)) + (eq type 'headline))) + (org-element--parse-elements + cbeg (org-element-property :contents-end element) + ;; Possibly switch to a special mode. + (org-element--next-mode mode type t) + (and (memq type '(item plain-list)) + (org-element-property :structure element)) + granularity visible-only element)) + ;; ELEMENT has contents. Parse objects inside, if + ;; GRANULARITY allows it. + ((memq granularity '(object nil)) + (org-element--parse-objects + cbeg (org-element-property :contents-end element) element + (org-element-restriction type)))) + (push (org-element-put-property element :parent acc) elements) + ;; Update mode. + (setq mode (org-element--next-mode mode type nil))))) + ;; Return result. + (apply #'org-element-set-contents acc (nreverse elements))))) + +(defun org-element--object-lex (restriction) + "Return next object in current buffer or nil. +RESTRICTION is a list of object types, as symbols, that should be +looked after. This function assumes that the buffer is narrowed +to an appropriate container (e.g., a paragraph)." + (cond + ((memq 'table-cell restriction) (org-element-table-cell-parser)) + ((memq 'citation-reference restriction) + (org-element-citation-reference-parser)) + (t + (let* ((start (point)) + (limit + ;; Object regexp sometimes needs to have a peek at + ;; a character ahead. Therefore, when there is a hard + ;; limit, make it one more than the true beginning of the + ;; radio target. + (save-excursion + (cond ((not org-target-link-regexp) nil) + ((not (memq 'link restriction)) nil) + ((progn + (unless (bolp) (forward-char -1)) + (not (re-search-forward org-target-link-regexp nil t))) + nil) + ;; Since we moved backward, we do not want to + ;; match again an hypothetical 1-character long + ;; radio link before us. Realizing that this can + ;; only happen if such a radio link starts at + ;; beginning of line, we prevent this here. + ((and (= start (1+ (line-beginning-position))) + (= start (match-end 1))) + (and (re-search-forward org-target-link-regexp nil t) + (1+ (match-beginning 1)))) + (t (1+ (match-beginning 1)))))) + found) + (save-excursion + (while (and (not found) + (re-search-forward org-element--object-regexp limit 'move)) + (goto-char (match-beginning 0)) + (let ((result (match-string 0))) + (setq found + (cond + ((string-prefix-p "call_" result t) + (and (memq 'inline-babel-call restriction) + (org-element-inline-babel-call-parser))) + ((string-prefix-p "src_" result t) + (and (memq 'inline-src-block restriction) + (org-element-inline-src-block-parser))) + (t + (pcase (char-after) + (?^ (and (memq 'superscript restriction) + (org-element-superscript-parser))) + (?_ (or (and (memq 'subscript restriction) + (org-element-subscript-parser)) + (and (memq 'underline restriction) + (org-element-underline-parser)))) + (?* (and (memq 'bold restriction) + (org-element-bold-parser))) + (?/ (and (memq 'italic restriction) + (org-element-italic-parser))) + (?~ (and (memq 'code restriction) + (org-element-code-parser))) + (?= (and (memq 'verbatim restriction) + (org-element-verbatim-parser))) + (?+ (and (memq 'strike-through restriction) + (org-element-strike-through-parser))) + (?@ (and (memq 'export-snippet restriction) + (org-element-export-snippet-parser))) + (?{ (and (memq 'macro restriction) + (org-element-macro-parser))) + (?$ (and (memq 'latex-fragment restriction) + (org-element-latex-fragment-parser))) + (?< + (if (eq (aref result 1) ?<) + (or (and (memq 'radio-target restriction) + (org-element-radio-target-parser)) + (and (memq 'target restriction) + (org-element-target-parser))) + (or (and (memq 'timestamp restriction) + (org-element-timestamp-parser)) + (and (memq 'link restriction) + (org-element-link-parser))))) + (?\\ + (if (eq (aref result 1) ?\\) + (and (memq 'line-break restriction) + (org-element-line-break-parser)) + (or (and (memq 'entity restriction) + (org-element-entity-parser)) + (and (memq 'latex-fragment restriction) + (org-element-latex-fragment-parser))))) + (?\[ + (pcase (aref result 1) + ((and ?\[ + (guard (memq 'link restriction))) + (org-element-link-parser)) + ((and ?f + (guard (memq 'footnote-reference restriction))) + (org-element-footnote-reference-parser)) + ((and ?c + (guard (memq 'citation restriction))) + (org-element-citation-parser)) + ((and (or ?% ?/) + (guard (memq 'statistics-cookie restriction))) + (org-element-statistics-cookie-parser)) + (_ + (or (and (memq 'timestamp restriction) + (org-element-timestamp-parser)) + (and (memq 'statistics-cookie restriction) + (org-element-statistics-cookie-parser)))))) + ;; This is probably a plain link. + (_ (and (memq 'link restriction) + (org-element-link-parser))))))) + (or (eobp) (forward-char)))) + (cond (found) + (limit (forward-char -1) + (org-element-link-parser)) ;radio link + (t nil))))))) + +(defun org-element--parse-objects (beg end acc restriction &optional parent) + "Parse objects between BEG and END and return recursive structure. + +Objects are accumulated in ACC. RESTRICTION is a list of object +successors which are allowed in the current object. + +ACC becomes the parent for all parsed objects. However, if ACC +is nil (i.e., a secondary string is being parsed) and optional +argument PARENT is non-nil, use it as the parent for all objects. +Eventually, if both ACC and PARENT are nil, the common parent is +the list of objects itself." + (save-excursion + (save-restriction + (narrow-to-region beg end) + (goto-char (point-min)) + (let (next-object contents) + (while (and (not (eobp)) + (setq next-object (org-element--object-lex restriction))) + ;; Text before any object. + (let ((obj-beg (org-element-property :begin next-object))) + (unless (= (point) obj-beg) + (let ((text (buffer-substring-no-properties (point) obj-beg))) + (push (if acc (org-element-put-property text :parent acc) text) + contents)))) + ;; Object... + (let ((obj-end (org-element-property :end next-object)) + (cont-beg (org-element-property :contents-begin next-object))) + (when acc (org-element-put-property next-object :parent acc)) + (push (if cont-beg + ;; Fill contents of NEXT-OBJECT if possible. + (org-element--parse-objects + cont-beg + (org-element-property :contents-end next-object) + next-object + (org-element-restriction next-object)) + next-object) + contents) + (goto-char obj-end))) + ;; Text after last object. + (unless (eobp) + (let ((text (buffer-substring-no-properties (point) end))) + (push (if acc (org-element-put-property text :parent acc) text) + contents))) + ;; Result. Set appropriate parent. + (if acc (apply #'org-element-set-contents acc (nreverse contents)) + (let* ((contents (nreverse contents)) + (parent (or parent contents))) + (dolist (datum contents contents) + (org-element-put-property datum :parent parent)))))))) + + + +;;; Towards A Bijective Process +;; +;; The parse tree obtained with `org-element-parse-buffer' is really +;; a snapshot of the corresponding Org buffer. Therefore, it can be +;; interpreted and expanded into a string with canonical Org syntax. +;; Hence `org-element-interpret-data'. +;; +;; The function relies internally on +;; `org-element--interpret-affiliated-keywords'. + +;;;###autoload +(defun org-element-interpret-data (data) + "Interpret DATA as Org syntax. +DATA is a parse tree, an element, an object or a secondary string +to interpret. Return Org syntax as a string." + (letrec ((fun + (lambda (data parent) + (let* ((type (org-element-type data)) + ;; Find interpreter for current object or + ;; element. If it doesn't exist (e.g. this is + ;; a pseudo object or element), return contents, + ;; if any. + (interpret + (let ((fun (intern + (format "org-element-%s-interpreter" type)))) + (if (fboundp fun) fun (lambda (_ contents) contents)))) + (results + (cond + ;; Secondary string. + ((not type) + (mapconcat (lambda (obj) (funcall fun obj parent)) + data + "")) + ;; Full Org document. + ((eq type 'org-data) + (mapconcat (lambda (obj) (funcall fun obj parent)) + (org-element-contents data) + "")) + ;; Plain text: return it. + ((stringp data) data) + ;; Element or object without contents. + ((not (org-element-contents data)) + (funcall interpret data nil)) + ;; Element or object with contents. + (t + (funcall + interpret + data + ;; Recursively interpret contents. + (mapconcat + (lambda (datum) (funcall fun datum data)) + (org-element-contents + (if (not (memq type '(paragraph verse-block))) + data + ;; Fix indentation of elements containing + ;; objects. We ignore `table-row' + ;; elements as they are one line long + ;; anyway. + (org-element-normalize-contents + data + ;; When normalizing first paragraph of + ;; an item or a footnote-definition, + ;; ignore first line's indentation. + (and (eq type 'paragraph) + (memq (org-element-type parent) + '(footnote-definition item)) + (eq data (car (org-element-contents parent))) + (eq (org-element-property :pre-blank parent) + 0))))) + "")))))) + (if (memq type '(org-data nil)) results + ;; Build white spaces. If no `:post-blank' property + ;; is specified, assume its value is 0. + (let ((blank (or (org-element-property :post-blank data) 0))) + (if (eq (org-element-class data parent) 'object) + (concat results (make-string blank ?\s)) + (concat (org-element--interpret-affiliated-keywords data) + (org-element-normalize-string results) + (make-string blank ?\n))))))))) + (funcall fun data nil))) + +(defun org-element--interpret-affiliated-keywords (element) + "Return ELEMENT's affiliated keywords as Org syntax. +If there is no affiliated keyword, return the empty string." + (let ((keyword-to-org + (lambda (key value) + (let (dual) + (when (member key org-element-dual-keywords) + (setq dual (cdr value) value (car value))) + (concat "#+" (downcase key) + (and dual + (format "[%s]" (org-element-interpret-data dual))) + ": " + (if (member key org-element-parsed-keywords) + (org-element-interpret-data value) + value) + "\n"))))) + (mapconcat + (lambda (prop) + (let ((value (org-element-property prop element)) + (keyword (upcase (substring (symbol-name prop) 1)))) + (when value + (if (or (member keyword org-element-multiple-keywords) + ;; All attribute keywords can have multiple lines. + (string-match "^ATTR_" keyword)) + (mapconcat (lambda (line) (funcall keyword-to-org keyword line)) + (reverse value) + "") + (funcall keyword-to-org keyword value))))) + ;; List all ELEMENT's properties matching an attribute line or an + ;; affiliated keyword, but ignore translated keywords since they + ;; cannot belong to the property list. + (cl-loop for prop in (nth 1 element) by 'cddr + when (let ((keyword (upcase (substring (symbol-name prop) 1)))) + (or (string-match "^ATTR_" keyword) + (and + (member keyword org-element-affiliated-keywords) + (not (assoc keyword + org-element-keyword-translation-alist))))) + collect prop) + ""))) + +;; Because interpretation of the parse tree must return the same +;; number of blank lines between elements and the same number of white +;; space after objects, some special care must be given to white +;; spaces. +;; +;; The first function, `org-element-normalize-string', ensures any +;; string different from the empty string will end with a single +;; newline character. +;; +;; The second function, `org-element-normalize-contents', removes +;; global indentation from the contents of the current element. + +(defun org-element-normalize-string (s) + "Ensure string S ends with a single newline character. + +If S isn't a string return it unchanged. If S is the empty +string, return it. Otherwise, return a new string with a single +newline character at its end." + (cond + ((not (stringp s)) s) + ((string= "" s) "") + (t (and (string-match "\\(\n[ \t]*\\)*\\'" s) + (replace-match "\n" nil nil s))))) + +(defun org-element-normalize-contents (element &optional ignore-first) + "Normalize plain text in ELEMENT's contents. + +ELEMENT must only contain plain text and objects. + +If optional argument IGNORE-FIRST is non-nil, ignore first line's +indentation to compute maximal common indentation. + +Return the normalized element that is element with global +indentation removed from its contents." + (letrec ((find-min-ind + ;; Return minimal common indentation within BLOB. This is + ;; done by walking recursively BLOB and updating MIN-IND + ;; along the way. FIRST-FLAG is non-nil when the next + ;; object is expected to be a string that doesn't start + ;; with a newline character. It happens for strings at + ;; the beginnings of the contents or right after a line + ;; break. + (lambda (blob first-flag min-ind) + (dolist (datum (org-element-contents blob) min-ind) + (when first-flag + (setq first-flag nil) + (cond + ;; Objects cannot start with spaces: in this + ;; case, indentation is 0. + ((not (stringp datum)) (throw :zero 0)) + ((not (string-match + "\\`\\([ \t]+\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum)) + (throw :zero 0)) + ((equal (match-string 2 datum) "\n") + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind 'empty datum)) + (t + (let ((i (string-width (match-string 1 datum)))) + (put-text-property + (match-beginning 1) (match-end 1) 'org-ind i datum) + (setq min-ind (min i min-ind)))))) + (cond + ((stringp datum) + (let ((s 0)) + (while (string-match + "\n\\([ \t]*\\)\\([^ \t\n]\\|\n\\|\\'\\)" datum s) + (setq s (match-end 1)) + (cond + ((equal (match-string 1 datum) "") + (unless (member (match-string 2 datum) '("" "\n")) + (throw :zero 0))) + ((equal (match-string 2 datum) "\n") + (put-text-property (match-beginning 1) (match-end 1) + 'org-ind 'empty datum)) + (t + (let ((i (string-width (match-string 1 datum)))) + (put-text-property (match-beginning 1) (match-end 1) + 'org-ind i datum) + (setq min-ind (min i min-ind)))))))) + ((eq (org-element-type datum) 'line-break) + (setq first-flag t)) + ((memq (org-element-type datum) org-element-recursive-objects) + (setq min-ind + (funcall find-min-ind datum first-flag min-ind))))))) + (min-ind + (catch :zero + (funcall find-min-ind + element (not ignore-first) most-positive-fixnum)))) + (if (or (zerop min-ind) (= min-ind most-positive-fixnum)) element + ;; Build ELEMENT back, replacing each string with the same + ;; string minus common indentation. + (letrec ((build + (lambda (datum) + ;; Return DATUM with all its strings indentation + ;; shortened from MIN-IND white spaces. + (setcdr + (cdr datum) + (mapcar + (lambda (object) + (cond + ((stringp object) + (with-temp-buffer + (insert object) + (let ((s (point-min))) + (while (setq s (text-property-not-all + s (point-max) 'org-ind nil)) + (goto-char s) + (let ((i (get-text-property s 'org-ind))) + (delete-region s (progn + (skip-chars-forward " \t") + (point))) + (when (integerp i) (indent-to (- i min-ind)))))) + (buffer-string))) + ((memq (org-element-type object) + org-element-recursive-objects) + (funcall build object)) + (t object))) + (org-element-contents datum))) + datum))) + (funcall build element))))) + + + +;;; Cache +;; +;; Implement a caching mechanism for `org-element-at-point' and +;; `org-element-context', which see. +;; +;; A single public function is provided: `org-element-cache-reset'. +;; +;; Cache is disabled by default for now because it sometimes triggers +;; freezes, but it can be enabled globally with +;; `org-element-use-cache'. `org-element-cache-sync-idle-time', +;; `org-element-cache-sync-duration' and +;; `org-element-cache-sync-break' can be tweaked to control caching +;; behavior. +;; +;; Internally, parsed elements are stored in an AVL tree, +;; `org-element--cache'. This tree is updated lazily: whenever +;; a change happens to the buffer, a synchronization request is +;; registered in `org-element--cache-sync-requests' (see +;; `org-element--cache-submit-request'). During idle time, requests +;; are processed by `org-element--cache-sync'. Synchronization also +;; happens when an element is required from the cache. In this case, +;; the process stops as soon as the needed element is up-to-date. +;; +;; A synchronization request can only apply on a synchronized part of +;; the cache. Therefore, the cache is updated at least to the +;; location where the new request applies. Thus, requests are ordered +;; from left to right and all elements starting before the first +;; request are correct. This property is used by functions like +;; `org-element--cache-find' to retrieve elements in the part of the +;; cache that can be trusted. +;; +;; A request applies to every element, starting from its original +;; location (or key, see below). When a request is processed, it +;; moves forward and may collide the next one. In this case, both +;; requests are merged into a new one that starts from that element. +;; As a consequence, the whole synchronization complexity does not +;; depend on the number of pending requests, but on the number of +;; elements the very first request will be applied on. +;; +;; Elements cannot be accessed through their beginning position, which +;; may or may not be up-to-date. Instead, each element in the tree is +;; associated to a key, obtained with `org-element--cache-key'. This +;; mechanism is robust enough to preserve total order among elements +;; even when the tree is only partially synchronized. + + +(defvar org-element-use-cache nil + "Non-nil when Org parser should cache its results. + +WARNING: for the time being, using cache sometimes triggers +freezes. Therefore, it is disabled by default. Activate it if +you want to help debugging the issue.") + +(defvar org-element-cache-sync-idle-time 0.6 + "Length, in seconds, of idle time before syncing cache.") + +(defvar org-element-cache-sync-duration 0.04 + "Maximum duration, as a time value, for a cache synchronization. +If the synchronization is not over after this delay, the process +pauses and resumes after `org-element-cache-sync-break' +seconds.") + +(defvar org-element-cache-sync-break 0.3 + "Duration, as a time value, of the pause between synchronizations. +See `org-element-cache-sync-duration' for more information.") + + +;;;; Data Structure + +(defvar org-element--cache nil + "AVL tree used to cache elements. +Each node of the tree contains an element. Comparison is done +with `org-element--cache-compare'. This cache is used in +`org-element-at-point'.") + +(defvar org-element--cache-sync-requests nil + "List of pending synchronization requests. + +A request is a vector with the following pattern: + + [NEXT BEG END OFFSET PARENT PHASE] + +Processing a synchronization request consists of three phases: + + 0. Delete modified elements, + 1. Fill missing area in cache, + 2. Shift positions and re-parent elements after the changes. + +During phase 0, NEXT is the key of the first element to be +removed, BEG and END is buffer position delimiting the +modifications. Elements starting between them (inclusive) are +removed. So are elements whose parent is removed. PARENT, when +non-nil, is the parent of the first element to be removed. + +During phase 1, NEXT is the key of the next known element in +cache and BEG its beginning position. Parse buffer between that +element and the one before it in order to determine the parent of +the next element. Set PARENT to the element containing NEXT. + +During phase 2, NEXT is the key of the next element to shift in +the parse tree. All elements starting from this one have their +properties relatives to buffer positions shifted by integer +OFFSET and, if they belong to element PARENT, are adopted by it. + +PHASE specifies the phase number, as an integer.") + +(defvar org-element--cache-sync-timer nil + "Timer used for cache synchronization.") + +(defvar org-element--cache-sync-keys nil + "Hash table used to store keys during synchronization. +See `org-element--cache-key' for more information.") + +(defsubst org-element--cache-key (element) + "Return a unique key for ELEMENT in cache tree. + +Keys are used to keep a total order among elements in the cache. +Comparison is done with `org-element--cache-key-less-p'. + +When no synchronization is taking place, a key is simply the +beginning position of the element, or that position plus one in +the case of an first item (respectively row) in +a list (respectively a table). + +During a synchronization, the key is the one the element had when +the cache was synchronized for the last time. Elements added to +cache during the synchronization get a new key generated with +`org-element--cache-generate-key'. + +Such keys are stored in `org-element--cache-sync-keys'. The hash +table is cleared once the synchronization is complete." + (or (gethash element org-element--cache-sync-keys) + (let* ((begin (org-element-property :begin element)) + ;; Increase beginning position of items (respectively + ;; table rows) by one, so the first item can get + ;; a different key from its parent list (respectively + ;; table). + (key (if (memq (org-element-type element) '(item table-row)) + (1+ begin) + begin))) + (if org-element--cache-sync-requests + (puthash element key org-element--cache-sync-keys) + key)))) + +(defun org-element--cache-generate-key (lower upper) + "Generate a key between LOWER and UPPER. + +LOWER and UPPER are fixnums or lists of same, possibly empty. + +If LOWER and UPPER are equals, return LOWER. Otherwise, return +a unique key, as an integer or a list of integers, according to +the following rules: + + - LOWER and UPPER are compared level-wise until values differ. + + - If, at a given level, LOWER and UPPER differ from more than + 2, the new key shares all the levels above with LOWER and + gets a new level. Its value is the mean between LOWER and + UPPER: + + (1 2) + (1 4) --> (1 3) + + - If LOWER has no value to compare with, it is assumed that its + value is `most-negative-fixnum'. E.g., + + (1 1) + (1 1 2) + + is equivalent to + + (1 1 m) + (1 1 2) + + where m is `most-negative-fixnum'. Likewise, if UPPER is + short of levels, the current value is `most-positive-fixnum'. + + - If they differ from only one, the new key inherits from + current LOWER level and fork it at the next level. E.g., + + (2 1) + (3 3) + + is equivalent to + + (2 1) + (2 M) + + where M is `most-positive-fixnum'. + + - If the key is only one level long, it is returned as an + integer: + + (1 2) + (3 2) --> 2 + +When they are not equals, the function assumes that LOWER is +lesser than UPPER, per `org-element--cache-key-less-p'." + (if (equal lower upper) lower + (let ((lower (if (integerp lower) (list lower) lower)) + (upper (if (integerp upper) (list upper) upper)) + skip-upper key) + (catch 'exit + (while t + (let ((min (or (car lower) most-negative-fixnum)) + (max (cond (skip-upper most-positive-fixnum) + ((car upper)) + (t most-positive-fixnum)))) + (if (< (1+ min) max) + (let ((mean (+ (ash min -1) (ash max -1) (logand min max 1)))) + (throw 'exit (if key (nreverse (cons mean key)) mean))) + (when (and (< min max) (not skip-upper)) + ;; When at a given level, LOWER and UPPER differ from + ;; 1, ignore UPPER altogether. Instead create a key + ;; between LOWER and the greatest key with the same + ;; prefix as LOWER so far. + (setq skip-upper t)) + (push min key) + (setq lower (cdr lower) upper (cdr upper))))))))) + +(defsubst org-element--cache-key-less-p (a b) + "Non-nil if key A is less than key B. +A and B are either integers or lists of integers, as returned by +`org-element--cache-key'." + (if (integerp a) (if (integerp b) (< a b) (<= a (car b))) + (if (integerp b) (< (car a) b) + (catch 'exit + (while (and a b) + (cond ((car-less-than-car a b) (throw 'exit t)) + ((car-less-than-car b a) (throw 'exit nil)) + (t (setq a (cdr a) b (cdr b))))) + ;; If A is empty, either keys are equal (B is also empty) and + ;; we return nil, or A is lesser than B (B is longer) and we + ;; return a non-nil value. + ;; + ;; If A is not empty, B is necessarily empty and A is greater + ;; than B (A is longer). Therefore, return nil. + (and (null a) b))))) + +(defun org-element--cache-compare (a b) + "Non-nil when element A is located before element B." + (org-element--cache-key-less-p (org-element--cache-key a) + (org-element--cache-key b))) + +(defsubst org-element--cache-root () + "Return root value in cache. +This function assumes `org-element--cache' is a valid AVL tree." + (avl-tree--node-left (avl-tree--dummyroot org-element--cache))) + + +;;;; Tools + +(defsubst org-element--cache-active-p () + "Non-nil when cache is active in current buffer." + (and org-element-use-cache + org-element--cache + (derived-mode-p 'org-mode))) + +(defun org-element--cache-find (pos &optional side) + "Find element in cache starting at POS or before. + +POS refers to a buffer position. + +When optional argument SIDE is non-nil, the function checks for +elements starting at or past POS instead. If SIDE is `both', the +function returns a cons cell where car is the first element +starting at or before POS and cdr the first element starting +after POS. + +The function can only find elements in the synchronized part of +the cache." + (let ((limit (and org-element--cache-sync-requests + (aref (car org-element--cache-sync-requests) 0))) + (node (org-element--cache-root)) + lower upper) + (while node + (let* ((element (avl-tree--node-data node)) + (begin (org-element-property :begin element))) + (cond + ((and limit + (not (org-element--cache-key-less-p + (org-element--cache-key element) limit))) + (setq node (avl-tree--node-left node))) + ((> begin pos) + (setq upper element + node (avl-tree--node-left node))) + ((< begin pos) + (setq lower element + node (avl-tree--node-right node))) + ;; We found an element in cache starting at POS. If `side' + ;; is `both' we also want the next one in order to generate + ;; a key in-between. + ;; + ;; If the element is the first row or item in a table or + ;; a plain list, we always return the table or the plain + ;; list. + ;; + ;; In any other case, we return the element found. + ((eq side 'both) + (setq lower element) + (setq node (avl-tree--node-right node))) + ((and (memq (org-element-type element) '(item table-row)) + (let ((parent (org-element-property :parent element))) + (and (= (org-element-property :begin element) + (org-element-property :contents-begin parent)) + (setq node nil + lower parent + upper parent))))) + (t + (setq node nil + lower element + upper element))))) + (pcase side + (`both (cons lower upper)) + (`nil lower) + (_ upper)))) + +(defun org-element--cache-put (element) + "Store ELEMENT in current buffer's cache, if allowed." + (when (org-element--cache-active-p) + (when org-element--cache-sync-requests + ;; During synchronization, first build an appropriate key for + ;; the new element so `avl-tree-enter' can insert it at the + ;; right spot in the cache. + (let ((keys (org-element--cache-find + (org-element-property :begin element) 'both))) + (puthash element + (org-element--cache-generate-key + (and (car keys) (org-element--cache-key (car keys))) + (cond ((cdr keys) (org-element--cache-key (cdr keys))) + (org-element--cache-sync-requests + (aref (car org-element--cache-sync-requests) 0)))) + org-element--cache-sync-keys))) + (avl-tree-enter org-element--cache element))) + +(defsubst org-element--cache-remove (element) + "Remove ELEMENT from cache. +Assume ELEMENT belongs to cache and that a cache is active." + (avl-tree-delete org-element--cache element)) + + +;;;; Synchronization + +(defsubst org-element--cache-set-timer (buffer) + "Set idle timer for cache synchronization in BUFFER." + (when org-element--cache-sync-timer + (cancel-timer org-element--cache-sync-timer)) + (setq org-element--cache-sync-timer + (run-with-idle-timer + (let ((idle (current-idle-time))) + (if idle (org-time-add idle org-element-cache-sync-break) + org-element-cache-sync-idle-time)) + nil + #'org-element--cache-sync + buffer))) + +(defsubst org-element--cache-interrupt-p (time-limit) + "Non-nil when synchronization process should be interrupted. +TIME-LIMIT is a time value or nil." + (and time-limit + (or (input-pending-p) + (org-time-less-p time-limit nil)))) + +(defsubst org-element--cache-shift-positions (element offset &optional props) + "Shift ELEMENT properties relative to buffer positions by OFFSET. + +Properties containing buffer positions are `:begin', `:end', +`:contents-begin', `:contents-end' and `:structure'. When +optional argument PROPS is a list of keywords, only shift +properties provided in that list. + +Properties are modified by side-effect." + (let ((properties (nth 1 element))) + ;; Shift `:structure' property for the first plain list only: it + ;; is the only one that really matters and it prevents from + ;; shifting it more than once. + (when (and (or (not props) (memq :structure props)) + (eq (org-element-type element) 'plain-list) + (not (eq (org-element-type (plist-get properties :parent)) + 'item))) + (dolist (item (plist-get properties :structure)) + (cl-incf (car item) offset) + (cl-incf (nth 6 item) offset))) + (dolist (key '(:begin :contents-begin :contents-end :end :post-affiliated)) + (let ((value (and (or (not props) (memq key props)) + (plist-get properties key)))) + (and value (plist-put properties key (+ offset value))))))) + +(defun org-element--cache-sync (buffer &optional threshold future-change) + "Synchronize cache with recent modification in BUFFER. + +When optional argument THRESHOLD is non-nil, do the +synchronization for all elements starting before or at threshold, +then exit. Otherwise, synchronize cache for as long as +`org-element-cache-sync-duration' or until Emacs leaves idle +state. + +FUTURE-CHANGE, when non-nil, is a buffer position where changes +not registered yet in the cache are going to happen. It is used +in `org-element--cache-submit-request', where cache is partially +updated before current modification are actually submitted." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (let ((inhibit-quit t) request next) + (when org-element--cache-sync-timer + (cancel-timer org-element--cache-sync-timer)) + (catch 'interrupt + (while org-element--cache-sync-requests + (setq request (car org-element--cache-sync-requests) + next (nth 1 org-element--cache-sync-requests)) + (org-element--cache-process-request + request + (and next (aref next 0)) + threshold + (and (not threshold) + (org-time-add nil + org-element-cache-sync-duration)) + future-change) + ;; Request processed. Merge current and next offsets and + ;; transfer ending position. + (when next + (cl-incf (aref next 3) (aref request 3)) + (aset next 2 (aref request 2))) + (setq org-element--cache-sync-requests + (cdr org-element--cache-sync-requests)))) + ;; If more requests are awaiting, set idle timer accordingly. + ;; Otherwise, reset keys. + (if org-element--cache-sync-requests + (org-element--cache-set-timer buffer) + (clrhash org-element--cache-sync-keys)))))) + +(defun org-element--cache-process-request + (request next threshold time-limit future-change) + "Process synchronization REQUEST for all entries before NEXT. + +REQUEST is a vector, built by `org-element--cache-submit-request'. + +NEXT is a cache key, as returned by `org-element--cache-key'. + +When non-nil, THRESHOLD is a buffer position. Synchronization +stops as soon as a shifted element begins after it. + +When non-nil, TIME-LIMIT is a time value. Synchronization stops +after this time or when Emacs exits idle state. + +When non-nil, FUTURE-CHANGE is a buffer position where changes +not registered yet in the cache are going to happen. See +`org-element--cache-submit-request' for more information. + +Throw `interrupt' if the process stops before completing the +request." + (catch 'quit + (when (= (aref request 5) 0) + ;; Phase 0. + ;; + ;; Delete all elements starting after BEG, but not after buffer + ;; position END or past element with key NEXT. Also delete + ;; elements contained within a previously removed element + ;; (stored in `last-container'). + ;; + ;; At each iteration, we start again at tree root since + ;; a deletion modifies structure of the balanced tree. + (catch 'end-phase + (while t + (when (org-element--cache-interrupt-p time-limit) + (throw 'interrupt nil)) + ;; Find first element in cache with key BEG or after it. + (let ((beg (aref request 0)) + (end (aref request 2)) + (node (org-element--cache-root)) + data data-key last-container) + (while node + (let* ((element (avl-tree--node-data node)) + (key (org-element--cache-key element))) + (cond + ((org-element--cache-key-less-p key beg) + (setq node (avl-tree--node-right node))) + ((org-element--cache-key-less-p beg key) + (setq data element + data-key key + node (avl-tree--node-left node))) + (t (setq data element + data-key key + node nil))))) + (if data + (let ((pos (org-element-property :begin data))) + (if (if (or (not next) + (org-element--cache-key-less-p data-key next)) + (<= pos end) + (and last-container + (let ((up data)) + (while (and up (not (eq up last-container))) + (setq up (org-element-property :parent up))) + up))) + (progn (when (and (not last-container) + (> (org-element-property :end data) + end)) + (setq last-container data)) + (org-element--cache-remove data)) + (aset request 0 data-key) + (aset request 1 pos) + (aset request 5 1) + (throw 'end-phase nil))) + ;; No element starting after modifications left in + ;; cache: further processing is futile. + (throw 'quit t)))))) + (when (= (aref request 5) 1) + ;; Phase 1. + ;; + ;; Phase 0 left a hole in the cache. Some elements after it + ;; could have parents within. For example, in the following + ;; buffer: + ;; + ;; - item + ;; + ;; + ;; Paragraph1 + ;; + ;; Paragraph2 + ;; + ;; if we remove a blank line between "item" and "Paragraph1", + ;; everything down to "Paragraph2" is removed from cache. But + ;; the paragraph now belongs to the list, and its `:parent' + ;; property no longer is accurate. + ;; + ;; Therefore we need to parse again elements in the hole, or at + ;; least in its last section, so that we can re-parent + ;; subsequent elements, during phase 2. + ;; + ;; Note that we only need to get the parent from the first + ;; element in cache after the hole. + ;; + ;; When next key is lesser or equal to the current one, delegate + ;; phase 1 processing to next request in order to preserve key + ;; order among requests. + (let ((key (aref request 0))) + (when (and next (not (org-element--cache-key-less-p key next))) + (let ((next-request (nth 1 org-element--cache-sync-requests))) + (aset next-request 0 key) + (aset next-request 1 (aref request 1)) + (aset next-request 5 1)) + (throw 'quit t))) + ;; Next element will start at its beginning position plus + ;; offset, since it hasn't been shifted yet. Therefore, LIMIT + ;; contains the real beginning position of the first element to + ;; shift and re-parent. + (let ((limit (+ (aref request 1) (aref request 3)))) + (cond ((and threshold (> limit threshold)) (throw 'interrupt nil)) + ((and future-change (>= limit future-change)) + ;; Changes are going to happen around this element and + ;; they will trigger another phase 1 request. Skip the + ;; current one. + (aset request 5 2)) + (t + (let ((parent (org-element--parse-to limit t time-limit))) + (aset request 4 parent) + (aset request 5 2)))))) + ;; Phase 2. + ;; + ;; Shift all elements starting from key START, but before NEXT, by + ;; OFFSET, and re-parent them when appropriate. + ;; + ;; Elements are modified by side-effect so the tree structure + ;; remains intact. + ;; + ;; Once THRESHOLD, if any, is reached, or once there is an input + ;; pending, exit. Before leaving, the current synchronization + ;; request is updated. + (let ((start (aref request 0)) + (offset (aref request 3)) + (parent (aref request 4)) + (node (org-element--cache-root)) + (stack (list nil)) + (leftp t) + exit-flag) + ;; No re-parenting nor shifting planned: request is over. + (when (and (not parent) (zerop offset)) (throw 'quit t)) + (while node + (let* ((data (avl-tree--node-data node)) + (key (org-element--cache-key data))) + (if (and leftp (avl-tree--node-left node) + (not (org-element--cache-key-less-p key start))) + (progn (push node stack) + (setq node (avl-tree--node-left node))) + (unless (org-element--cache-key-less-p key start) + ;; We reached NEXT. Request is complete. + (when (equal key next) (throw 'quit t)) + ;; Handle interruption request. Update current request. + (when (or exit-flag (org-element--cache-interrupt-p time-limit)) + (aset request 0 key) + (aset request 4 parent) + (throw 'interrupt nil)) + ;; Shift element. + (unless (zerop offset) + (org-element--cache-shift-positions data offset)) + (let ((begin (org-element-property :begin data))) + ;; Update PARENT and re-parent DATA, only when + ;; necessary. Propagate new structures for lists. + (while (and parent + (<= (org-element-property :end parent) begin)) + (setq parent (org-element-property :parent parent))) + (cond ((and (not parent) (zerop offset)) (throw 'quit nil)) + ((and parent + (let ((p (org-element-property :parent data))) + (or (not p) + (< (org-element-property :begin p) + (org-element-property :begin parent))))) + (org-element-put-property data :parent parent) + (let ((s (org-element-property :structure parent))) + (when (and s (org-element-property :structure data)) + (org-element-put-property data :structure s))))) + ;; Cache is up-to-date past THRESHOLD. Request + ;; interruption. + (when (and threshold (> begin threshold)) (setq exit-flag t)))) + (setq node (if (setq leftp (avl-tree--node-right node)) + (avl-tree--node-right node) + (pop stack)))))) + ;; We reached end of tree: synchronization complete. + t))) + +(defun org-element--parse-to (pos &optional syncp time-limit) + "Parse elements in current section, down to POS. + +Start parsing from the closest between the last known element in +cache or headline above. Return the smallest element containing +POS. + +When optional argument SYNCP is non-nil, return the parent of the +element containing POS instead. In that case, it is also +possible to provide TIME-LIMIT, which is a time value specifying +when the parsing should stop. The function throws `interrupt' if +the process stopped before finding the expected result." + (catch 'exit + (org-with-wide-buffer + (goto-char pos) + (let* ((cached (and (org-element--cache-active-p) + (org-element--cache-find pos nil))) + (begin (org-element-property :begin cached)) + element next mode) + (cond + ;; Nothing in cache before point: start parsing from first + ;; element following headline above, or first element in + ;; buffer. + ((not cached) + (if (org-with-limited-levels (outline-previous-heading)) + (progn + (setq mode 'planning) + (forward-line)) + (setq mode 'top-comment)) + (skip-chars-forward " \r\t\n") + (beginning-of-line)) + ;; Cache returned exact match: return it. + ((= pos begin) + (throw 'exit (if syncp (org-element-property :parent cached) cached))) + ;; There's a headline between cached value and POS: cached + ;; value is invalid. Start parsing from first element + ;; following the headline. + ((re-search-backward + (org-with-limited-levels org-outline-regexp-bol) begin t) + (forward-line) + (skip-chars-forward " \r\t\n") + (beginning-of-line) + (setq mode 'planning)) + ;; Check if CACHED or any of its ancestors contain point. + ;; + ;; If there is such an element, we inspect it in order to know + ;; if we return it or if we need to parse its contents. + ;; Otherwise, we just start parsing from current location, + ;; which is right after the top-most element containing + ;; CACHED. + ;; + ;; As a special case, if POS is at the end of the buffer, we + ;; want to return the innermost element ending there. + ;; + ;; Also, if we find an ancestor and discover that we need to + ;; parse its contents, make sure we don't start from + ;; `:contents-begin', as we would otherwise go past CACHED + ;; again. Instead, in that situation, we will resume parsing + ;; from NEXT, which is located after CACHED or its higher + ;; ancestor not containing point. + (t + (let ((up cached) + (pos (if (= (point-max) pos) (1- pos) pos))) + (goto-char (or (org-element-property :contents-begin cached) begin)) + (while (let ((end (org-element-property :end up))) + (and (<= end pos) + (goto-char end) + (setq up (org-element-property :parent up))))) + (cond ((not up)) + ((eobp) (setq element up)) + (t (setq element up next (point))))))) + ;; Parse successively each element until we reach POS. + (let ((end (or (org-element-property :end element) + (save-excursion + (org-with-limited-levels (outline-next-heading)) + (point)))) + (parent element)) + (while t + (when syncp + (cond ((= (point) pos) (throw 'exit parent)) + ((org-element--cache-interrupt-p time-limit) + (throw 'interrupt nil)))) + (unless element + (setq element (org-element--current-element + end 'element mode + (org-element-property :structure parent))) + (org-element-put-property element :parent parent) + (org-element--cache-put element)) + (let ((elem-end (org-element-property :end element)) + (type (org-element-type element))) + (cond + ;; Skip any element ending before point. Also skip + ;; element ending at point (unless it is also the end of + ;; buffer) since we're sure that another element begins + ;; after it. + ((and (<= elem-end pos) (/= (point-max) elem-end)) + (goto-char elem-end) + (setq mode (org-element--next-mode mode type nil))) + ;; A non-greater element contains point: return it. + ((not (memq type org-element-greater-elements)) + (throw 'exit element)) + ;; Otherwise, we have to decide if ELEMENT really + ;; contains POS. In that case we start parsing from + ;; contents' beginning. + ;; + ;; If POS is at contents' beginning but it is also at + ;; the beginning of the first item in a list or a table. + ;; In that case, we need to create an anchor for that + ;; list or table, so return it. + ;; + ;; Also, if POS is at the end of the buffer, no element + ;; can start after it, but more than one may end there. + ;; Arbitrarily, we choose to return the innermost of + ;; such elements. + ((let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + (when (or syncp + (and cbeg cend + (or (< cbeg pos) + (and (= cbeg pos) + (not (memq type '(plain-list table))))) + (or (> cend pos) + (and (= cend pos) (= (point-max) pos))))) + (goto-char (or next cbeg)) + (setq next nil + mode (org-element--next-mode mode type t) + parent element + end cend)))) + ;; Otherwise, return ELEMENT as it is the smallest + ;; element containing POS. + (t (throw 'exit element)))) + (setq element nil))))))) + + +;;;; Staging Buffer Changes + +(defconst org-element--cache-sensitive-re + (concat + "^\\*+ " "\\|" + "\\\\end{[A-Za-z0-9*]+}[ \t]*$" "\\|" + "^[ \t]*\\(?:" + "#\\+\\(?:BEGIN[:_]\\|END\\(?:_\\|:?[ \t]*$\\)\\)" "\\|" + "\\\\begin{[A-Za-z0-9*]+}" "\\|" + ":\\(?:\\w\\|[-_]\\)+:[ \t]*$" + "\\)") + "Regexp matching a sensitive line, structure wise. +A sensitive line is a headline, inlinetask, block, drawer, or +latex-environment boundary. When such a line is modified, +structure changes in the document may propagate in the whole +section, possibly making cache invalid.") + +(defvar org-element--cache-change-warning nil + "Non-nil when a sensitive line is about to be changed. +It is a symbol among nil, t and `headline'.") + +(defun org-element--cache-before-change (beg end) + "Request extension of area going to be modified if needed. +BEG and END are the beginning and end of the range of changed +text. See `before-change-functions' for more information." + (when (org-element--cache-active-p) + (org-with-wide-buffer + (goto-char beg) + (beginning-of-line) + (let ((bottom (save-excursion (goto-char end) (line-end-position)))) + (setq org-element--cache-change-warning + (save-match-data + (if (and (org-with-limited-levels (org-at-heading-p)) + (= (line-end-position) bottom)) + 'headline + (let ((case-fold-search t)) + (re-search-forward + org-element--cache-sensitive-re bottom t))))))))) + +(defun org-element--cache-after-change (beg end pre) + "Update buffer modifications for current buffer. +BEG and END are the beginning and end of the range of changed +text, and the length in bytes of the pre-change text replaced by +that range. See `after-change-functions' for more information." + (when (org-element--cache-active-p) + (org-with-wide-buffer + (goto-char beg) + (beginning-of-line) + (save-match-data + (let ((top (point)) + (bottom (save-excursion (goto-char end) (line-end-position)))) + ;; Determine if modified area needs to be extended, according + ;; to both previous and current state. We make a special + ;; case for headline editing: if a headline is modified but + ;; not removed, do not extend. + (when (pcase org-element--cache-change-warning + (`t t) + (`headline + (not (and (org-with-limited-levels (org-at-heading-p)) + (= (line-end-position) bottom)))) + (_ + (let ((case-fold-search t)) + (re-search-forward + org-element--cache-sensitive-re bottom t)))) + ;; Effectively extend modified area. + (org-with-limited-levels + (setq top (progn (goto-char top) + (when (outline-previous-heading) (forward-line)) + (point))) + (setq bottom (progn (goto-char bottom) + (if (outline-next-heading) (1- (point)) + (point)))))) + ;; Store synchronization request. + (let ((offset (- end beg pre))) + (org-element--cache-submit-request top (- bottom offset) offset))))) + ;; Activate a timer to process the request during idle time. + (org-element--cache-set-timer (current-buffer)))) + +(defun org-element--cache-for-removal (beg end offset) + "Return first element to remove from cache. + +BEG and END are buffer positions delimiting buffer modifications. +OFFSET is the size of the changes. + +Returned element is usually the first element in cache containing +any position between BEG and END. As an exception, greater +elements around the changes that are robust to contents +modifications are preserved and updated according to the +changes." + (let* ((elements (org-element--cache-find (1- beg) 'both)) + (before (car elements)) + (after (cdr elements))) + (if (not before) after + (let ((up before) + (robust-flag t)) + (while up + (if (let ((type (org-element-type up))) + (and (or (memq type '(center-block dynamic-block quote-block + special-block)) + ;; Drawers named "PROPERTIES" are probably + ;; a properties drawer being edited. Force + ;; parsing to check if editing is over. + (and (eq type 'drawer) + (not (string= + (org-element-property :drawer-name up) + "PROPERTIES")))) + (let ((cbeg (org-element-property :contents-begin up))) + (and cbeg + (<= cbeg beg) + (> (org-element-property :contents-end up) end))))) + ;; UP is a robust greater element containing changes. + ;; We only need to extend its ending boundaries. + (org-element--cache-shift-positions + up offset '(:contents-end :end)) + (setq before up) + (when robust-flag (setq robust-flag nil))) + (setq up (org-element-property :parent up))) + ;; We're at top level element containing ELEMENT: if it's + ;; altered by buffer modifications, it is first element in + ;; cache to be removed. Otherwise, that first element is the + ;; following one. + ;; + ;; As a special case, do not remove BEFORE if it is a robust + ;; container for current changes. + (if (or (< (org-element-property :end before) beg) robust-flag) after + before))))) + +(defun org-element--cache-submit-request (beg end offset) + "Submit a new cache synchronization request for current buffer. +BEG and END are buffer positions delimiting the minimal area +where cache data should be removed. OFFSET is the size of the +change, as an integer." + (let ((next (car org-element--cache-sync-requests)) + delete-to delete-from) + (if (and next + (zerop (aref next 5)) + (> (setq delete-to (+ (aref next 2) (aref next 3))) end) + (<= (setq delete-from (aref next 1)) end)) + ;; Current changes can be merged with first sync request: we + ;; can save a partial cache synchronization. + (progn + (cl-incf (aref next 3) offset) + ;; If last change happened within area to be removed, extend + ;; boundaries of robust parents, if any. Otherwise, find + ;; first element to remove and update request accordingly. + (if (> beg delete-from) + (let ((up (aref next 4))) + (while up + (org-element--cache-shift-positions + up offset '(:contents-end :end)) + (setq up (org-element-property :parent up)))) + (let ((first (org-element--cache-for-removal beg delete-to offset))) + (when first + (aset next 0 (org-element--cache-key first)) + (aset next 1 (org-element-property :begin first)) + (aset next 4 (org-element-property :parent first)))))) + ;; Ensure cache is correct up to END. Also make sure that NEXT, + ;; if any, is no longer a 0-phase request, thus ensuring that + ;; phases are properly ordered. We need to provide OFFSET as + ;; optional parameter since current modifications are not known + ;; yet to the otherwise correct part of the cache (i.e, before + ;; the first request). + (when next (org-element--cache-sync (current-buffer) end beg)) + (let ((first (org-element--cache-for-removal beg end offset))) + (if first + (push (let ((beg (org-element-property :begin first)) + (key (org-element--cache-key first))) + (cond + ;; When changes happen before the first known + ;; element, re-parent and shift the rest of the + ;; cache. + ((> beg end) (vector key beg nil offset nil 1)) + ;; Otherwise, we find the first non robust + ;; element containing END. All elements between + ;; FIRST and this one are to be removed. + ((let ((first-end (org-element-property :end first))) + (and (> first-end end) + (vector key beg first-end offset first 0)))) + (t + (let* ((element (org-element--cache-find end)) + (end (org-element-property :end element)) + (up element)) + (while (and (setq up (org-element-property :parent up)) + (>= (org-element-property :begin up) beg)) + (setq end (org-element-property :end up) + element up)) + (vector key beg end offset element 0))))) + org-element--cache-sync-requests) + ;; No element to remove. No need to re-parent either. + ;; Simply shift additional elements, if any, by OFFSET. + (when org-element--cache-sync-requests + (cl-incf (aref (car org-element--cache-sync-requests) 3) + offset))))))) + + +;;;; Public Functions + +;;;###autoload +(defun org-element-cache-reset (&optional all) + "Reset cache in current buffer. +When optional argument ALL is non-nil, reset cache in all Org +buffers." + (interactive "P") + (dolist (buffer (if all (buffer-list) (list (current-buffer)))) + (with-current-buffer buffer + (when (and org-element-use-cache (derived-mode-p 'org-mode)) + (setq-local org-element--cache + (avl-tree-create #'org-element--cache-compare)) + (setq-local org-element--cache-sync-keys + (make-hash-table :weakness 'key :test #'eq)) + (setq-local org-element--cache-change-warning nil) + (setq-local org-element--cache-sync-requests nil) + (setq-local org-element--cache-sync-timer nil) + (add-hook 'before-change-functions + #'org-element--cache-before-change nil t) + (add-hook 'after-change-functions + #'org-element--cache-after-change nil t))))) + +;;;###autoload +(defun org-element-cache-refresh (pos) + "Refresh cache at position POS." + (when (org-element--cache-active-p) + (org-element--cache-sync (current-buffer) pos) + (org-element--cache-submit-request pos pos 0) + (org-element--cache-set-timer (current-buffer)))) + + + +;;; The Toolbox +;; +;; The first move is to implement a way to obtain the smallest element +;; containing point. This is the job of `org-element-at-point'. It +;; basically jumps back to the beginning of section containing point +;; and proceed, one element after the other, with +;; `org-element--current-element' until the container is found. Note: +;; When using `org-element-at-point', secondary values are never +;; parsed since the function focuses on elements, not on objects. +;; +;; At a deeper level, `org-element-context' lists all elements and +;; objects containing point. +;; +;; `org-element-nested-p' and `org-element-swap-A-B' may be used +;; internally by navigation and manipulation tools. + + +;;;###autoload +(defun org-element-at-point () + "Determine closest element around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element and PROPS a plist of properties associated to the +element. + +Possible types are defined in `org-element-all-elements'. +Properties depend on element or object type, but always include +`:begin', `:end', and `:post-blank' properties. + +As a special case, if point is at the very beginning of the first +item in a list or sub-list, returned element will be that list +instead of the item. Likewise, if point is at the beginning of +the first row of a table, returned element will be the table +instead of the first row. + +When point is at the end of the buffer, return the innermost +element ending there." + (org-with-wide-buffer + (let ((origin (point))) + (end-of-line) + (skip-chars-backward " \r\t\n") + (cond + ;; Within blank lines at the beginning of buffer, return nil. + ((bobp) nil) + ;; Within blank lines right after a headline, return that + ;; headline. + ((org-with-limited-levels (org-at-heading-p)) + (beginning-of-line) + (org-element-headline-parser (point-max) t)) + ;; Otherwise parse until we find element containing ORIGIN. + (t + (when (org-element--cache-active-p) + (if (not org-element--cache) (org-element-cache-reset) + (org-element--cache-sync (current-buffer) origin))) + (org-element--parse-to origin)))))) + +;;;###autoload +(defun org-element-context (&optional element) + "Return smallest element or object around point. + +Return value is a list like (TYPE PROPS) where TYPE is the type +of the element or object and PROPS a plist of properties +associated to it. + +Possible types are defined in `org-element-all-elements' and +`org-element-all-objects'. Properties depend on element or +object type, but always include `:begin', `:end', `:parent' and +`:post-blank'. + +As a special case, if point is right after an object and not at +the beginning of any other object, return that object. + +Optional argument ELEMENT, when non-nil, is the closest element +containing point, as returned by `org-element-at-point'. +Providing it allows for quicker computation." + (catch 'objects-forbidden + (org-with-wide-buffer + (let* ((pos (point)) + (element (or element (org-element-at-point))) + (type (org-element-type element)) + (post (org-element-property :post-affiliated element))) + ;; If point is inside an element containing objects or + ;; a secondary string, narrow buffer to the container and + ;; proceed with parsing. Otherwise, return ELEMENT. + (cond + ;; At a parsed affiliated keyword, check if we're inside main + ;; or dual value. + ((and post (< pos post)) + (beginning-of-line) + (let ((case-fold-search t)) (looking-at org-element--affiliated-re)) + (cond + ((not (member-ignore-case (match-string 1) + org-element-parsed-keywords)) + (throw 'objects-forbidden element)) + ((< (match-end 0) pos) + (narrow-to-region (match-end 0) (line-end-position))) + ((and (match-beginning 2) + (>= pos (match-beginning 2)) + (< pos (match-end 2))) + (narrow-to-region (match-beginning 2) (match-end 2))) + (t (throw 'objects-forbidden element))) + ;; Also change type to retrieve correct restrictions. + (setq type 'keyword)) + ;; At an item, objects can only be located within tag, if any. + ((eq type 'item) + (let ((tag (org-element-property :tag element))) + (if (or (not tag) (/= (line-beginning-position) post)) + (throw 'objects-forbidden element) + (beginning-of-line) + (search-forward tag (line-end-position)) + (goto-char (match-beginning 0)) + (if (and (>= pos (point)) (< pos (match-end 0))) + (narrow-to-region (point) (match-end 0)) + (throw 'objects-forbidden element))))) + ;; At an headline or inlinetask, objects are in title. + ((memq type '(headline inlinetask)) + (let ((case-fold-search nil)) + (goto-char (org-element-property :begin element)) + (looking-at org-complex-heading-regexp) + (let ((end (match-end 4))) + (if (not end) (throw 'objects-forbidden element) + (goto-char (match-beginning 4)) + (when (looking-at org-comment-string) + (goto-char (match-end 0))) + (if (>= (point) end) (throw 'objects-forbidden element) + (narrow-to-region (point) end)))))) + ;; At a paragraph, a table-row or a verse block, objects are + ;; located within their contents. + ((memq type '(paragraph table-row verse-block)) + (let ((cbeg (org-element-property :contents-begin element)) + (cend (org-element-property :contents-end element))) + ;; CBEG is nil for table rules. + (if (and cbeg cend (>= pos cbeg) + (or (< pos cend) (and (= pos cend) (eobp)))) + (narrow-to-region cbeg cend) + (throw 'objects-forbidden element)))) + (t (throw 'objects-forbidden element))) + (goto-char (point-min)) + (let ((restriction (org-element-restriction type)) + (parent element) + last) + (catch 'exit + (while t + (let ((next (org-element--object-lex restriction))) + (when next (org-element-put-property next :parent parent)) + ;; Process NEXT, if any, in order to know if we need to + ;; skip it, return it or move into it. + (if (or (not next) (> (org-element-property :begin next) pos)) + (throw 'exit (or last parent)) + (let ((end (org-element-property :end next)) + (cbeg (org-element-property :contents-begin next)) + (cend (org-element-property :contents-end next))) + (cond + ;; Skip objects ending before point. Also skip + ;; objects ending at point unless it is also the + ;; end of buffer, since we want to return the + ;; innermost object. + ((and (<= end pos) (/= (point-max) end)) + (goto-char end) + ;; For convenience, when object ends at POS, + ;; without any space, store it in LAST, as we + ;; will return it if no object starts here. + (when (and (= end pos) + (not (memq (char-before) '(?\s ?\t)))) + (setq last next))) + ;; If POS is within a container object, move into + ;; that object. + ((and cbeg cend + (>= pos cbeg) + (or (< pos cend) + ;; At contents' end, if there is no + ;; space before point, also move into + ;; object, for consistency with + ;; convenience feature above. + (and (= pos cend) + (or (= (point-max) pos) + (not (memq (char-before pos) + '(?\s ?\t))))))) + (goto-char cbeg) + (narrow-to-region (point) cend) + (setq parent next) + (setq restriction (org-element-restriction next))) + ;; Otherwise, return NEXT. + (t (throw 'exit next))))))))))))) + +(defun org-element-lineage (datum &optional types with-self) + "List all ancestors of a given element or object. + +DATUM is an object or element. + +Return ancestors from the closest to the farthest. When optional +argument TYPES is a list of symbols, return the first element or +object in the lineage whose type belongs to that list instead. + +When optional argument WITH-SELF is non-nil, lineage includes +DATUM itself as the first element, and TYPES, if provided, also +apply to it. + +When DATUM is obtained through `org-element-context' or +`org-element-at-point', only ancestors from its section can be +found. There is no such limitation when DATUM belongs to a full +parse tree." + (let ((up (if with-self datum (org-element-property :parent datum))) + ancestors) + (while (and up (not (memq (org-element-type up) types))) + (unless types (push up ancestors)) + (setq up (org-element-property :parent up))) + (if types up (nreverse ancestors)))) + +(defun org-element-nested-p (elem-A elem-B) + "Non-nil when elements ELEM-A and ELEM-B are nested." + (let ((beg-A (org-element-property :begin elem-A)) + (beg-B (org-element-property :begin elem-B)) + (end-A (org-element-property :end elem-A)) + (end-B (org-element-property :end elem-B))) + (or (and (>= beg-A beg-B) (<= end-A end-B)) + (and (>= beg-B beg-A) (<= end-B end-A))))) + +(defun org-element-swap-A-B (elem-A elem-B) + "Swap elements ELEM-A and ELEM-B. +Assume ELEM-B is after ELEM-A in the buffer. Leave point at the +end of ELEM-A." + (goto-char (org-element-property :begin elem-A)) + ;; There are two special cases when an element doesn't start at bol: + ;; the first paragraph in an item or in a footnote definition. + (let ((specialp (not (bolp)))) + ;; Only a paragraph without any affiliated keyword can be moved at + ;; ELEM-A position in such a situation. Note that the case of + ;; a footnote definition is impossible: it cannot contain two + ;; paragraphs in a row because it cannot contain a blank line. + (when (and specialp + (or (not (eq (org-element-type elem-B) 'paragraph)) + (/= (org-element-property :begin elem-B) + (org-element-property :contents-begin elem-B)))) + (error "Cannot swap elements")) + ;; In a special situation, ELEM-A will have no indentation. We'll + ;; give it ELEM-B's (which will in, in turn, have no indentation). + (let* ((ind-B (when specialp + (goto-char (org-element-property :begin elem-B)) + (current-indentation))) + (beg-A (org-element-property :begin elem-A)) + (end-A (save-excursion + (goto-char (org-element-property :end elem-A)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + (beg-B (org-element-property :begin elem-B)) + (end-B (save-excursion + (goto-char (org-element-property :end elem-B)) + (skip-chars-backward " \r\t\n") + (point-at-eol))) + ;; Store inner overlays responsible for visibility status. + ;; We also need to store their boundaries as they will be + ;; removed from buffer. + (overlays + (cons + (delq nil + (mapcar (lambda (o) + (and (>= (overlay-start o) beg-A) + (<= (overlay-end o) end-A) + (list o (overlay-start o) (overlay-end o)))) + (overlays-in beg-A end-A))) + (delq nil + (mapcar (lambda (o) + (and (>= (overlay-start o) beg-B) + (<= (overlay-end o) end-B) + (list o (overlay-start o) (overlay-end o)))) + (overlays-in beg-B end-B))))) + ;; Get contents. + (body-A (buffer-substring beg-A end-A)) + (body-B (delete-and-extract-region beg-B end-B))) + (goto-char beg-B) + (when specialp + (setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B)) + (indent-to-column ind-B)) + (insert body-A) + ;; Restore ex ELEM-A overlays. + (let ((offset (- beg-B beg-A))) + (dolist (o (car overlays)) + (move-overlay (car o) (+ (nth 1 o) offset) (+ (nth 2 o) offset))) + (goto-char beg-A) + (delete-region beg-A end-A) + (insert body-B) + ;; Restore ex ELEM-B overlays. + (dolist (o (cdr overlays)) + (move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset)))) + (goto-char (org-element-property :end elem-B))))) + + +(provide 'org-element) + +;; Local variables: +;; generated-autoload-file: "org-loaddefs.el" +;; End: + +;;; org-element.el ends here -- cgit v1.2.1