summaryrefslogtreecommitdiff
path: root/lisp/org-element.el
diff options
context:
space:
mode:
authorS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
committerS├ębastien Delafond <sdelafond@gmail.com>2016-11-07 10:41:54 +0100
commitec84430cf4e09ba25ec675debdf802bc28111e06 (patch)
tree9c64bc8a0cd5e8cac82aa5fdf369d40529f140f8 /lisp/org-element.el
parent84539dca3aa301ecfe48858eceef1ced0505388b (diff)
Imported Upstream version 9.0
Diffstat (limited to 'lisp/org-element.el')
-rw-r--r--lisp/org-element.el1669
1 files changed, 870 insertions, 799 deletions
diff --git a/lisp/org-element.el b/lisp/org-element.el
index 2576c3f..027eea4 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -1,4 +1,4 @@
-;;; org-element.el --- Parser And Applications for Org syntax
+;;; org-element.el --- Parser for Org Syntax -*- lexical-binding: t; -*-
;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
@@ -116,9 +116,9 @@
;;; Code:
-(eval-when-compile (require 'cl))
(require 'org)
(require 'avl-tree)
+(require 'cl-lib)
@@ -151,7 +151,7 @@ specially in `org-element--object-lex'.")
;; Headlines, inlinetasks.
org-outline-regexp "\\|"
;; Footnote definitions.
- "\\[\\(?:[0-9]+\\|fn:[-_[:word:]]+\\)\\]" "\\|"
+ "\\[fn:[-_[:word:]]+\\]" "\\|"
;; Diary sexps.
"%%(" "\\|"
"[ \t]*\\(?:"
@@ -177,15 +177,15 @@ specially in `org-element--object-lex'.")
;; Clock lines.
(regexp-quote org-clock-string) "\\|"
;; Lists.
- (let ((term (case org-plain-list-ordered-item-terminator
- (?\) ")") (?. "\\.") (otherwise "[.)]")))
+ (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)))
+ (let ((link-types (regexp-opt (org-link-types))))
(list
;; Sub/superscript.
"\\(?:[_^][-{(*+.,[:alnum:]]\\)"
@@ -199,7 +199,12 @@ specially in `org-element--object-lex'.")
;; Objects starting with "[": regular link,
;; footnote reference, statistics cookie,
;; timestamp (inactive).
- "\\[\\(?:fn:\\|\\(?:[0-9]\\|\\(?:%\\|/[0-9]*\\)\\]\\)\\|\\[\\)"
+ (concat "\\[\\(?:"
+ "fn:" "\\|"
+ "\\[" "\\|"
+ "[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}" "\\|"
+ "[0-9]*\\(?:%\\|/[0-9]*\\)\\]"
+ "\\)")
;; Objects starting with "@": export snippets.
"@@"
;; Objects starting with "{": macro.
@@ -258,17 +263,6 @@ specially in `org-element--object-lex'.")
(append org-element-recursive-objects '(paragraph table-row verse-block))
"List of object or element types that can directly contain objects.")
-(defvar org-element-block-name-alist
- '(("CENTER" . org-element-center-block-parser)
- ("COMMENT" . org-element-comment-block-parser)
- ("EXAMPLE" . org-element-example-block-parser)
- ("QUOTE" . org-element-quote-block-parser)
- ("SRC" . org-element-src-block-parser)
- ("VERSE" . org-element-verse-block-parser))
- "Alist between block names and the associated parsing function.
-Names must be uppercase. Any block whose name has no association
-is parsed with `org-element-special-block-parser'.")
-
(defconst org-element-affiliated-keywords
'("CAPTION" "DATA" "HEADER" "HEADERS" "LABEL" "NAME" "PLOT" "RESNAME" "RESULT"
"RESULTS" "SOURCE" "SRCNAME" "TBLNAME")
@@ -334,7 +328,7 @@ This list is checked after translations have been applied. See
;; Regular affiliated keywords.
(format "\\(?1:%s\\)"
(regexp-opt
- (org-remove-if
+ (cl-remove-if
(lambda (k) (member k org-element-dual-keywords))
org-element-affiliated-keywords)))
"\\|"
@@ -358,10 +352,11 @@ Don't modify it, set `org-element-affiliated-keywords' instead.")
(italic ,@standard-set)
(item ,@standard-set-no-line-break)
(keyword ,@(remq 'footnote-reference standard-set))
- ;; Ignore all links excepted plain links in a link description.
- ;; Also ignore radio-targets and line breaks.
+ ;; Ignore all links excepted plain links and angular links in
+ ;; a link description. Also ignore radio-targets and line
+ ;; breaks.
(link bold code entity export-snippet inline-babel-call inline-src-block
- italic latex-fragment macro plain-link statistics-cookie
+ italic latex-fragment macro simple-link statistics-cookie
strike-through subscript superscript underline verbatim)
(paragraph ,@standard-set)
;; Remove any variable object from radio target as it would
@@ -399,6 +394,15 @@ still has an entry since one of its properties (`:title') does.")
(item :tag))
"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)
@@ -408,6 +412,33 @@ still has an entry since one of its properties (`:title') does.")
"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
@@ -424,8 +455,10 @@ Other brackets are treated as spaces.")
;; 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-copy' returns
-;; an element or object, stripping its parent property in the process.
+;; 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.
@@ -465,10 +498,11 @@ Return modified element."
element))
(defsubst org-element-set-contents (element &rest contents)
- "Set ELEMENT contents to CONTENTS."
- (cond ((not element) (list contents))
+ "Set ELEMENT's contents to CONTENTS.
+Return ELEMENT."
+ (cond ((null element) contents)
((not (symbolp (car element))) contents)
- ((cdr element) (setcdr (cdr element) contents))
+ ((cdr element) (setcdr (cdr element) contents) element)
(t (nconc element contents))))
(defun org-element-secondary-p (object)
@@ -482,6 +516,32 @@ Return value is the property name, as a keyword, or nil."
(and (memq object (org-element-property p parent))
(throw 'exit p))))))
+(defun 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.
@@ -587,11 +647,11 @@ 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)))
- (case type
- (org-data (list 'org-data nil))
- (plain-text (substring-no-properties datum))
- ((nil) (copy-sequence datum))
- (otherwise
+ (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)))))))
@@ -674,8 +734,8 @@ Assume point is at the beginning of the block."
:post-affiliated post-affiliated)
(cdr affiliated))))))))
-(defun org-element-center-block-interpreter (center-block contents)
- "Interpret CENTER-BLOCK element as Org syntax.
+(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))
@@ -702,7 +762,7 @@ Assume point is at beginning of drawer."
(save-excursion
(let* ((drawer-end-line (match-beginning 0))
(name (progn (looking-at org-drawer-regexp)
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(begin (car affiliated))
(post-affiliated (point))
;; Empty drawers have no contents.
@@ -758,8 +818,8 @@ Assume point is at beginning of dynamic block."
(let ((block-end-line (match-beginning 0)))
(save-excursion
(let* ((name (progn (looking-at org-dblock-start-re)
- (org-match-string-no-properties 1)))
- (arguments (org-match-string-no-properties 3))
+ (match-string-no-properties 1)))
+ (arguments (match-string-no-properties 3))
(begin (car affiliated))
(post-affiliated (point))
;; Empty blocks have no contents.
@@ -817,7 +877,7 @@ a plist containing `:label', `:begin' `:end', `:contents-begin',
Assume point is at the beginning of the footnote definition."
(save-excursion
(let* ((label (progn (looking-at org-footnote-definition-re)
- (org-match-string-no-properties 1)))
+ (match-string-no-properties 1)))
(begin (car affiliated))
(post-affiliated (point))
(ending
@@ -832,7 +892,7 @@ Assume point is at the beginning of the footnote definition."
;; before any affiliated keyword above.
(forward-line -1)
(while (and (> (point) post-affiliated)
- (org-looking-at-p org-element--affiliated-re))
+ (looking-at-p org-element--affiliated-re))
(forward-line -1))
(line-beginning-position 2))
(t (match-beginning 0)))))
@@ -861,7 +921,7 @@ Assume point is at the beginning of the footnote definition."
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
CONTENTS is the contents of the footnote-definition."
- (concat (format "[%s]" (org-element-property :label footnote-definition))
+ (concat (format "[fn:%s]" (org-element-property :label footnote-definition))
" "
contents))
@@ -875,13 +935,13 @@ 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 (org-looking-at-p org-planning-line-re) (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 (org-match-string-no-properties 3) properties)
+ (push (match-string-no-properties 3) properties)
(push (intern (concat ":" (upcase (match-string 2)))) properties)
(forward-line))
properties))))
@@ -944,7 +1004,7 @@ Assume point is at beginning of the headline."
(goto-char (match-end 0))))
(title-start (point))
(tags (when (re-search-forward
- (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(line-end-position)
'move)
(goto-char (match-beginning 0))
@@ -995,17 +1055,16 @@ Assume point is at beginning of the headline."
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
- (let ((title (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))))
- (dolist (datum title title)
- (org-element-put-property datum :parent headline)))))))))
+ (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.
@@ -1087,7 +1146,7 @@ Assume point is at beginning of the inline task."
(aref (match-string 0) 2))))
(title-start (point))
(tags (when (re-search-forward
- (org-re "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$")
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
(line-end-position)
'move)
(goto-char (match-beginning 0))
@@ -1098,7 +1157,7 @@ Assume point is at beginning of the inline task."
(task-end (save-excursion
(end-of-line)
(and (re-search-forward org-outline-regexp-bol limit t)
- (org-looking-at-p "END[ \t]*$")
+ (looking-at-p "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)))
@@ -1131,17 +1190,16 @@ Assume point is at beginning of the inline task."
(org-element-put-property
inlinetask :title
(if raw-secondary-p raw-value
- (let ((title (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))))
- (dolist (datum title title)
- (org-element-put-property datum :parent inlinetask))))))))
+ (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.
@@ -1183,7 +1241,7 @@ CONTENTS is the contents of inlinetask."
;;;; Item
-(defun org-element-item-parser (limit struct &optional raw-secondary-p)
+(defun org-element-item-parser (_ struct &optional raw-secondary-p)
"Parse an item.
STRUCT is the structure of the plain list.
@@ -1202,7 +1260,7 @@ Assume point is at the beginning of the item."
(beginning-of-line)
(looking-at org-list-full-item-re)
(let* ((begin (point))
- (bullet (org-match-string-no-properties 1))
+ (bullet (match-string-no-properties 1))
(checkbox (let ((box (match-string 3)))
(cond ((equal "[ ]" box) 'off)
((equal "[X]" box) 'on)
@@ -1253,11 +1311,10 @@ Assume point is at the beginning of the item."
(let ((raw (org-list-get-tag begin struct)))
(when raw
(if raw-secondary-p raw
- (let ((tag (org-element--parse-objects
- (match-beginning 4) (match-end 4) nil
- (org-element-restriction 'item))))
- (dolist (datum tag tag)
- (org-element-put-property datum :parent item))))))))))
+ (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.
@@ -1280,10 +1337,11 @@ CONTENTS is the contents of the element."
(concat
bullet
(and counter (format "[@%d] " counter))
- (case checkbox
- (on "[X] ")
- (off "[ ] ")
- (trans "[-] "))
+ (pcase checkbox
+ (`on "[X] ")
+ (`off "[ ] ")
+ (`trans "[-] ")
+ (_ nil))
(and tag (format "%s :: " tag))
(when contents
(let ((contents (replace-regexp-in-string
@@ -1351,7 +1409,7 @@ CONTENTS is the contents of the element."
(forward-line)
(let ((origin (point)))
(when (re-search-forward inlinetask-re limit t)
- (if (org-looking-at-p "END[ \t]*$") (forward-line)
+ (if (looking-at-p "END[ \t]*$") (forward-line)
(goto-char origin)))))
;; At some text line. Check if it ends any previous item.
(t
@@ -1393,7 +1451,7 @@ containing `:type', `:begin', `:end', `:contents-begin' and
Assume point is at the beginning of the list."
(save-excursion
(let* ((struct (or structure (org-element--list-struct limit)))
- (type (cond ((org-looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
+ (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
((nth 5 (assq (point) struct)) 'descriptive)
(t 'unordered)))
(contents-begin (point))
@@ -1421,8 +1479,8 @@ Assume point is at the beginning of the list."
:post-affiliated contents-begin)
(cdr affiliated))))))
-(defun org-element-plain-list-interpreter (plain-list contents)
- "Interpret PLAIN-LIST element as Org syntax.
+(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)
@@ -1461,8 +1519,8 @@ Assume point is at the beginning of the property drawer."
:post-blank (count-lines before-blank end)
:post-affiliated begin))))))
-(defun org-element-property-drawer-interpreter (property-drawer contents)
- "Interpret PROPERTY-DRAWER element as Org syntax.
+(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))
@@ -1511,19 +1569,17 @@ Assume point is at the beginning of the block."
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-quote-block-interpreter (quote-block contents)
- "Interpret QUOTE-BLOCK element as Org syntax.
+(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 (limit)
+(defun org-element-section-parser (_)
"Parse a section.
-LIMIT bounds the search.
-
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."
@@ -1534,8 +1590,7 @@ containing `:begin', `:end', `:contents-begin', `contents-end',
(end (progn (org-with-limited-levels (outline-next-heading))
(point)))
(pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (forward-line)
- (point))))
+ (line-beginning-position 2))))
(list 'section
(list :begin begin
:end end
@@ -1544,8 +1599,8 @@ containing `:begin', `:end', `:contents-begin', `contents-end',
:post-blank (count-lines pos-before-blank end)
:post-affiliated begin)))))
-(defun org-element-section-interpreter (section contents)
- "Interpret SECTION element as Org syntax.
+(defun org-element-section-interpreter (_ contents)
+ "Interpret section element as Org syntax.
CONTENTS is the contents of the element."
contents)
@@ -1616,9 +1671,6 @@ CONTENTS is the contents of the element."
;; 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'.
-;;
-;; As a special case, when the newly defined type is a block type,
-;; `org-element-block-name-alist' has to be modified accordingly.
;;;; Babel Call
@@ -1665,9 +1717,8 @@ containing `:call', `:inside-header', `:arguments',
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-babel-call-interpreter (babel-call contents)
- "Interpret BABEL-CALL element as Org syntax.
-CONTENTS is nil."
+(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)))
@@ -1696,7 +1747,7 @@ Return a list whose CAR is `clock' and CDR is a plist containing
(duration (and (search-forward " => " (line-end-position) t)
(progn (skip-chars-forward " \t")
(looking-at "\\(\\S-+\\)[ \t]*$"))
- (org-match-string-no-properties 1)))
+ (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)
@@ -1713,9 +1764,8 @@ Return a list whose CAR is `clock' and CDR is a plist containing
:post-blank post-blank
:post-affiliated begin)))))
-(defun org-element-clock-interpreter (clock contents)
- "Interpret CLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-clock-interpreter (clock _)
+ "Interpret CLOCK element as Org syntax."
(concat org-clock-string " "
(org-element-timestamp-interpreter
(org-element-property :value clock) nil)
@@ -1774,7 +1824,7 @@ Assume point is at comment beginning."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-comment-interpreter (comment contents)
+(defun org-element-comment-interpreter (comment _)
"Interpret COMMENT element as Org syntax.
CONTENTS is nil."
(replace-regexp-in-string "^" "# " (org-element-property :value comment)))
@@ -1821,9 +1871,8 @@ Assume point is at comment block beginning."
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-comment-block-interpreter (comment-block contents)
- "Interpret COMMENT-BLOCK element as Org syntax.
-CONTENTS is nil."
+(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
@@ -1847,7 +1896,7 @@ containing `:begin', `:end', `:value', `:post-blank' and
(let ((begin (car affiliated))
(post-affiliated (point))
(value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
- (org-match-string-no-properties 1)))
+ (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)))))
@@ -1860,9 +1909,8 @@ containing `:begin', `:end', `:value', `:post-blank' and
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-diary-sexp-interpreter (diary-sexp contents)
- "Interpret DIARY-SEXP as Org syntax.
-CONTENTS is nil."
+(defun org-element-diary-sexp-interpreter (diary-sexp _)
+ "Interpret DIARY-SEXP as Org syntax."
(org-element-property :value diary-sexp))
@@ -1890,12 +1938,20 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
(let* ((switches
(progn
(looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
- (org-match-string-no-properties 1)))
- ;; Switches analysis
+ (match-string-no-properties 1)))
+ ;; Switches analysis.
(number-lines
- (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
+ (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
@@ -1917,13 +1973,10 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
;; Standard block parsing.
(begin (car affiliated))
(post-affiliated (point))
- (block-ind (progn (skip-chars-forward " \t") (current-column)))
- (contents-begin (progn (forward-line) (point)))
- (value (org-element-remove-indentation
- (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end))
- block-ind))
+ (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)))
@@ -1944,9 +1997,8 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-example-block-interpreter (example-block contents)
- "Interpret EXAMPLE-BLOCK element as Org syntax.
-CONTENTS is nil."
+(defun org-element-example-block-interpreter (example-block _)
+ "Interpret EXAMPLE-BLOCK element as Org syntax."
(let ((switches (org-element-property :switches example-block))
(value (org-element-property :value example-block)))
(concat "#+BEGIN_EXAMPLE" (and switches (concat " " switches)) "\n"
@@ -1955,7 +2007,7 @@ CONTENTS is nil."
(if (or org-src-preserve-indentation
(org-element-property :preserve-indent example-block))
value
- (org-element-remove-indentation value))))
+ (org-remove-indentation value))))
"#+END_EXAMPLE")))
@@ -1974,43 +2026,44 @@ containing `:begin', `:end', `:type', `:value', `:post-blank' and
`:post-affiliated' keywords.
Assume point is at export-block beginning."
- (let* ((case-fold-search t)
- (type (progn (looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (upcase (org-match-string-no-properties 1)))))
+ (let* ((case-fold-search t))
(if (not (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$" type) limit t)))
+ (re-search-forward "^[ \t]*#\\+END_EXPORT[ \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 'export-block
- (nconc
- (list :begin begin
- :end end
- :type type
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr 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 contents)
- "Interpret EXPORT-BLOCK element as Org syntax.
-CONTENTS is nil."
- (let ((type (org-element-property :type export-block)))
- (concat (format "#+BEGIN_%s\n" type)
- (org-element-property :value export-block)
- (format "#+END_%s" type))))
+(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
@@ -2055,9 +2108,8 @@ Assume point is at the beginning of the fixed-width area."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-fixed-width-interpreter (fixed-width contents)
- "Interpret FIXED-WIDTH element as Org syntax.
-CONTENTS is nil."
+(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
@@ -2092,9 +2144,8 @@ keywords."
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-horizontal-rule-interpreter (horizontal-rule contents)
- "Interpret HORIZONTAL-RULE element as Org syntax.
-CONTENTS is nil."
+(defun org-element-horizontal-rule-interpreter (&rest _)
+ "Interpret HORIZONTAL-RULE element as Org syntax."
"-----")
@@ -2118,7 +2169,7 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
(let ((begin (or (car affiliated) (point)))
(post-affiliated (point))
(key (progn (looking-at "[ \t]*#\\+\\(\\S-+*\\):")
- (upcase (org-match-string-no-properties 1))))
+ (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)))
@@ -2134,9 +2185,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
:post-affiliated post-affiliated)
(cdr affiliated))))))
-(defun org-element-keyword-interpreter (keyword contents)
- "Interpret KEYWORD element as Org syntax.
-CONTENTS is nil."
+(defun org-element-keyword-interpreter (keyword _)
+ "Interpret KEYWORD element as Org syntax."
(format "#+%s: %s"
(org-element-property :key keyword)
(org-element-property :value keyword)))
@@ -2192,9 +2242,8 @@ Assume point is at the beginning of the latex environment."
:post-affiliated code-begin)
(cdr affiliated))))))))
-(defun org-element-latex-environment-interpreter (latex-environment contents)
- "Interpret LATEX-ENVIRONMENT element as Org syntax.
-CONTENTS is nil."
+(defun org-element-latex-environment-interpreter (latex-environment _)
+ "Interpret LATEX-ENVIRONMENT element as Org syntax."
(org-element-property :value latex-environment))
@@ -2211,8 +2260,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
(looking-at org-property-re)
(let ((case-fold-search t)
(begin (point))
- (key (org-match-string-no-properties 2))
- (value (org-match-string-no-properties 3))
+ (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)
@@ -2226,9 +2275,8 @@ containing `:key', `:value', `:begin', `:end', `:post-blank' and
:post-blank 0
:post-affiliated begin))))
-(defun org-element-node-property-interpreter (node-property contents)
- "Interpret NODE-PROPERTY element as Org syntax.
-CONTENTS is nil."
+(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) "")))
@@ -2303,8 +2351,8 @@ Assume point is at the beginning of the paragraph."
:post-affiliated contents-begin)
(cdr affiliated))))))
-(defun org-element-paragraph-interpreter (paragraph contents)
- "Interpret PARAGRAPH element as Org syntax.
+(defun org-element-paragraph-interpreter (_ contents)
+ "Interpret paragraph element as Org syntax.
CONTENTS is the contents of the element."
contents)
@@ -2347,11 +2395,10 @@ containing `:closed', `:deadline', `:scheduled', `:begin',
:post-blank post-blank
:post-affiliated begin)))))
-(defun org-element-planning-interpreter (planning contents)
- "Interpret PLANNING element as Org syntax.
-CONTENTS is nil."
+(defun org-element-planning-interpreter (planning _)
+ "Interpret PLANNING element as Org syntax."
(mapconcat
- 'identity
+ #'identity
(delq nil
(list (let ((deadline (org-element-property :deadline planning)))
(when deadline
@@ -2398,20 +2445,28 @@ Assume point is at the beginning of the block."
(language
(progn
(looking-at
- (concat "^[ \t]*#\\+BEGIN_SRC"
- "\\(?: +\\(\\S-+\\)\\)?"
- "\\(\\(?: +\\(?:-l \".*?\"\\|[-+][A-Za-z]\\)\\)+\\)?"
- "\\(.*\\)[ \t]*$"))
- (org-match-string-no-properties 1)))
+ "^[ \t]*#\\+BEGIN_SRC\
+\\(?: +\\(\\S-+\\)\\)?\
+\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\
+\\(.*\\)[ \t]*$")
+ (match-string-no-properties 1)))
;; Get switches.
- (switches (org-match-string-no-properties 2))
+ (switches (match-string-no-properties 2))
;; Get parameters.
- (parameters (org-match-string-no-properties 3))
- ;; Switches analysis
+ (parameters (match-string-no-properties 3))
+ ;; Switches analysis.
(number-lines
- (cond ((not switches) nil)
- ((string-match "-n\\>" switches) 'new)
- ((string-match "+n\\>" switches) 'continued)))
+ (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
@@ -2430,14 +2485,10 @@ Assume point is at the beginning of the block."
(or (not switches)
(and retain-labels
(not (string-match "-k\\>" switches)))))
- ;; Indentation.
- (block-ind (progn (skip-chars-forward " \t") (current-column)))
;; Retrieve code.
- (value (org-element-remove-indentation
- (org-unescape-code-in-string
- (buffer-substring-no-properties
- (progn (forward-line) (point)) contents-end))
- block-ind))
+ (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)))
@@ -2463,9 +2514,8 @@ Assume point is at the beginning of the block."
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-src-block-interpreter (src-block contents)
- "Interpret SRC-BLOCK element as Org syntax.
-CONTENTS is nil."
+(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))
@@ -2475,11 +2525,12 @@ CONTENTS is nil."
((or org-src-preserve-indentation
(org-element-property :preserve-indent src-block))
val)
- ((zerop org-edit-src-content-indentation) 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-" ind val nil nil 1)))))))
+ "^" ind (org-remove-indentation val))))))))
(concat (format "#+BEGIN_SRC%s\n"
(concat (and lang (concat " " lang))
(and switches (concat " " switches))
@@ -2517,7 +2568,7 @@ Assume point is at the beginning of the table."
(point)))
(tblfm (let (acc)
(while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
- (push (org-match-string-no-properties 1) acc)
+ (push (match-string-no-properties 1) acc)
(forward-line))
acc))
(pos-before-blank (point))
@@ -2556,11 +2607,9 @@ CONTENTS is a string, if table's type is `org', or nil."
;;;; Table Row
-(defun org-element-table-row-parser (limit)
+(defun org-element-table-row-parser (_)
"Parse table row at point.
-LIMIT bounds the search.
-
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."
@@ -2569,9 +2618,7 @@ containing `:begin', `:end', `:contents-begin', `:contents-end',
(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 "|")
- (point)))
+ (contents-begin (and (eq type 'standard) (search-forward "|")))
(contents-end (and (eq type 'standard)
(progn
(end-of-line)
@@ -2591,7 +2638,7 @@ containing `:begin', `:end', `:contents-begin', `:contents-end',
"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)))
+ (concat "|" contents)))
;;;; Verse Block
@@ -2634,8 +2681,8 @@ Assume point is at beginning of the block."
:post-affiliated post-affiliated)
(cdr affiliated)))))))))
-(defun org-element-verse-block-interpreter (verse-block contents)
- "Interpret VERSE-BLOCK element as Org syntax.
+(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))
@@ -2683,8 +2730,8 @@ Assume point is at the first star marker."
:contents-end contents-end
:post-blank post-blank))))))
-(defun org-element-bold-interpreter (bold contents)
- "Interpret BOLD object as Org syntax.
+(defun org-element-bold-interpreter (_ contents)
+ "Interpret bold object as Org syntax.
CONTENTS is the contents of the object."
(format "*%s*" contents))
@@ -2703,7 +2750,7 @@ Assume point is at the first tilde marker."
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
(let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
+ (value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2))
(skip-chars-forward " \t")))
(end (point)))
@@ -2713,9 +2760,8 @@ Assume point is at the first tilde marker."
:end end
:post-blank post-blank))))))
-(defun org-element-code-interpreter (code contents)
- "Interpret CODE object as Org syntax.
-CONTENTS is nil."
+(defun org-element-code-interpreter (code _)
+ "Interpret CODE object as Org syntax."
(format "~%s~" (org-element-property :value code)))
@@ -2754,9 +2800,8 @@ Assume point is at the beginning of the entity."
:use-brackets-p bracketsp
:post-blank post-blank)))))))
-(defun org-element-entity-interpreter (entity contents)
- "Interpret ENTITY object as Org syntax.
-CONTENTS is nil."
+(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) "{}")))
@@ -2781,7 +2826,7 @@ Assume point is at the beginning of the snippet."
(re-search-forward "@@" nil t)
(match-beginning 0))))
(let* ((begin (match-beginning 0))
- (back-end (org-match-string-no-properties 1))
+ (back-end (match-string-no-properties 1))
(value (buffer-substring-no-properties
(match-end 0) contents-end))
(post-blank (skip-chars-forward " \t"))
@@ -2793,9 +2838,8 @@ Assume point is at the beginning of the snippet."
:end end
:post-blank post-blank)))))))
-(defun org-element-export-snippet-interpreter (export-snippet contents)
- "Interpret EXPORT-SNIPPET object as Org syntax.
-CONTENTS is nil."
+(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)))
@@ -2816,14 +2860,10 @@ When at a footnote reference, return a list whose car is
(when closing
(save-excursion
(let* ((begin (point))
- (label
- (or (org-match-string-no-properties 2)
- (org-match-string-no-properties 3)
- (and (match-string 1)
- (concat "fn:" (org-match-string-no-properties 1)))))
- (type (if (or (not label) (match-string 1)) 'inline 'standard))
+ (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)))
@@ -2839,9 +2879,9 @@ When at a footnote reference, return a list whose car is
(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 "[%s]"
- (concat (or (org-element-property :label footnote-reference) "fn:")
- (and contents (concat ":" contents)))))
+ (format "[fn:%s%s]"
+ (or (org-element-property :label footnote-reference) "")
+ (if contents (concat ":" contents) "")))
;;;; Inline Babel Call
@@ -2856,31 +2896,39 @@ When at an inline babel call, return a list whose car is
Assume point is at the beginning of the babel call."
(save-excursion
- (unless (bolp) (backward-char))
- (when (let ((case-fold-search t))
- (looking-at org-babel-inline-lob-one-liner-regexp))
- (let ((begin (match-end 1))
- (call (org-match-string-no-properties 2))
- (inside-header (org-string-nw-p (org-match-string-no-properties 4)))
- (arguments (org-string-nw-p (org-match-string-no-properties 6)))
- (end-header (org-string-nw-p (org-match-string-no-properties 8)))
- (value (buffer-substring-no-properties (match-end 1) (match-end 0)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-babel-call
- (list :call call
- :inside-header inside-header
- :arguments arguments
- :end-header end-header
- :begin begin
- :end end
- :value value
- :post-blank post-blank))))))
+ (catch :no-object
+ (when (let ((case-fold-search nil))
+ (looking-at "\\<call_\\([^ \t\n[(]+\\)[([]"))
+ (goto-char (match-end 1))
+ (let* ((begin (match-beginning 0))
+ (call (match-string-no-properties 1))
+ (inside-header
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (arguments (org-string-nw-p
+ (or (org-element--parse-paired-brackets ?\()
+ ;; Parenthesis are mandatory.
+ (throw :no-object nil))))
+ (end-header
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (value (buffer-substring-no-properties begin (point)))
+ (post-blank (skip-chars-forward " \t"))
+ (end (point)))
+ (list 'inline-babel-call
+ (list :call call
+ :inside-header inside-header
+ :arguments arguments
+ :end-header end-header
+ :begin begin
+ :end end
+ :value value
+ :post-blank post-blank)))))))
-(defun org-element-inline-babel-call-interpreter (inline-babel-call contents)
- "Interpret INLINE-BABEL-CALL object as Org syntax.
-CONTENTS is nil."
+(defun org-element-inline-babel-call-interpreter (inline-babel-call _)
+ "Interpret INLINE-BABEL-CALL object as Org syntax."
(concat "call_"
(org-element-property :call inline-babel-call)
(let ((h (org-element-property :inside-header inline-babel-call)))
@@ -2902,26 +2950,29 @@ keywords. Otherwise, return nil.
Assume point is at the beginning of the inline src block."
(save-excursion
- (unless (bolp) (backward-char))
- (when (looking-at org-babel-inline-src-block-regexp)
- (let ((begin (match-beginning 1))
- (language (org-match-string-no-properties 2))
- (parameters (org-match-string-no-properties 4))
- (value (org-match-string-no-properties 5))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'inline-src-block
- (list :language language
- :value value
- :parameters parameters
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (catch :no-object
+ (when (let ((case-fold-search nil))
+ (looking-at "\\<src_\\([^ \t\n[{]+\\)[{[]"))
+ (goto-char (match-end 1))
+ (let ((begin (match-beginning 0))
+ (language (match-string-no-properties 1))
+ (parameters
+ (let ((p (org-element--parse-paired-brackets ?\[)))
+ (and (org-string-nw-p p)
+ (replace-regexp-in-string "\n[ \t]*" " " (org-trim p)))))
+ (value (or (org-element--parse-paired-brackets ?\{)
+ (throw :no-object nil)))
+ (post-blank (skip-chars-forward " \t")))
+ (list 'inline-src-block
+ (list :language language
+ :value value
+ :parameters parameters
+ :begin begin
+ :end (point)
+ :post-blank post-blank)))))))
-(defun org-element-inline-src-block-interpreter (inline-src-block contents)
- "Interpret INLINE-SRC-BLOCK object as Org syntax.
-CONTENTS is nil."
+(defun org-element-inline-src-block-interpreter (inline-src-block _)
+ "Interpret INLINE-SRC-BLOCK object as Org syntax."
(let ((language (org-element-property :language inline-src-block))
(arguments (org-element-property :parameters inline-src-block))
(body (org-element-property :value inline-src-block)))
@@ -2957,8 +3008,8 @@ Assume point is at the first slash marker."
:contents-end contents-end
:post-blank post-blank))))))
-(defun org-element-italic-interpreter (italic contents)
- "Interpret ITALIC object as Org syntax.
+(defun org-element-italic-interpreter (_ contents)
+ "Interpret italic object as Org syntax.
CONTENTS is the contents of the object."
(format "/%s/" contents))
@@ -2986,12 +3037,13 @@ Assume point is at the beginning of the LaTeX fragment."
'(?\s ?\t ?\n ?, ?.)))
(looking-at "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|$\\)")
(point)))
- (case (char-after (1+ (point)))
+ (pcase (char-after (1+ (point)))
(?\( (search-forward "\\)" nil t))
(?\[ (search-forward "\\]" nil t))
- (otherwise
+ (_
;; Macro.
- (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\\|\\({[^{}\n]*}\\)\\)*")
+ (and (looking-at "\\\\[a-zA-Z]+\\*?\\(\\(\\[[^][\n{}]*\\]\\)\
+\\|\\({[^{}\n]*}\\)\\)*")
(match-end 0))))))
(post-blank (if (not after-fragment) (throw 'no-object nil)
(goto-char after-fragment)
@@ -3003,9 +3055,8 @@ Assume point is at the beginning of the LaTeX fragment."
:end end
:post-blank post-blank))))))
-(defun org-element-latex-fragment-interpreter (latex-fragment contents)
- "Interpret LATEX-FRAGMENT object as Org syntax.
-CONTENTS is nil."
+(defun org-element-latex-fragment-interpreter (latex-fragment _)
+ "Interpret LATEX-FRAGMENT object as Org syntax."
(org-element-property :value latex-fragment))
;;;; Line Break
@@ -3018,16 +3069,15 @@ and cdr a plist with `:begin', `:end' and `:post-blank' keywords.
Otherwise, return nil.
Assume point is at the beginning of the line break."
- (when (and (org-looking-at-p "\\\\\\\\[ \t]*$")
+ (when (and (looking-at-p "\\\\\\\\[ \t]*$")
(not (eq (char-before) ?\\)))
(list 'line-break
(list :begin (point)
:end (line-beginning-position 2)
:post-blank 0))))
-(defun org-element-line-break-interpreter (line-break contents)
- "Interpret LINE-BREAK object as Org syntax.
-CONTENTS is nil."
+(defun org-element-line-break-interpreter (&rest _)
+ "Interpret LINE-BREAK object as Org syntax."
"\\\\\n")
@@ -3037,7 +3087,7 @@ CONTENTS is nil."
"Parse link at point, if any.
When at a link, return a list whose car is `link' and cdr a plist
-with `:type', `:path', `:raw-link', `:application',
+with `:type', `:path', `:format', `:raw-link', `:application',
`:search-option', `:begin', `:end', `:contents-begin',
`:contents-end' and `:post-blank' as keywords. Otherwise, return
nil.
@@ -3045,20 +3095,22 @@ nil.
Assume point is at the beginning of the link."
(catch 'no-object
(let ((begin (point))
- end contents-begin contents-end link-end post-blank path type
- raw-link link search-option application)
+ end contents-begin contents-end link-end post-blank path type format
+ raw-link search-option application)
(cond
;; Type 1: Text targeted from a radio target.
((and org-target-link-regexp
(save-excursion (or (bolp) (backward-char))
(looking-at org-target-link-regexp)))
- (setq type "radio"
- link-end (match-end 1)
- path (org-match-string-no-properties 1)
- contents-begin (match-beginning 1)
- contents-end (match-end 1)))
+ (setq type "radio")
+ (setq format 'plain)
+ (setq link-end (match-end 1))
+ (setq path (match-string-no-properties 1))
+ (setq contents-begin (match-beginning 1))
+ (setq contents-end (match-end 1)))
;; Type 2: Standard link, i.e. [[http://orgmode.org][homepage]]
((looking-at org-bracket-link-regexp)
+ (setq format 'bracket)
(setq contents-begin (match-beginning 3))
(setq contents-end (match-end 3))
(setq link-end (match-end 0))
@@ -3076,7 +3128,7 @@ Assume point is at the beginning of the link."
(setq raw-link (org-link-expand-abbrev
(replace-regexp-in-string
"[ \t]*\n[ \t]*" " "
- (org-match-string-no-properties 1))))
+ (match-string-no-properties 1))))
;; Determine TYPE of link and set PATH accordingly. According
;; to RFC 3986, remove whitespaces from URI in external links.
;; In internal ones, treat indentation as a single space.
@@ -3086,16 +3138,13 @@ Assume point is at the beginning of the link."
(string-match "\\`\\.\\.?/" raw-link))
(setq type "file")
(setq path raw-link))
- ;; Explicit type (http, irc, bbdb...). See `org-link-types'.
+ ;; Explicit type (http, irc, bbdb...).
((string-match org-link-types-re raw-link)
(setq type (match-string 1 raw-link))
(setq path (substring raw-link (match-end 0))))
- ;; Id type: PATH is the id.
- ((string-match "\\`id:\\([-a-f0-9]+\\)\\'" raw-link)
- (setq type "id" path (match-string 1 raw-link)))
;; Code-ref type: PATH is the name of the reference.
- ((and (org-string-match-p "\\`(" raw-link)
- (org-string-match-p ")\\'" raw-link))
+ ((and (string-match-p "\\`(" raw-link)
+ (string-match-p ")\\'" raw-link))
(setq type "coderef")
(setq path (substring raw-link 1 -1)))
;; Custom-id type: PATH is the name of the custom id.
@@ -3110,21 +3159,23 @@ Assume point is at the beginning of the link."
(setq path raw-link))))
;; Type 3: Plain link, e.g., http://orgmode.org
((looking-at org-plain-link-re)
- (setq raw-link (org-match-string-no-properties 0)
- type (org-match-string-no-properties 1)
- link-end (match-end 0)
- path (org-match-string-no-properties 2)))
+ (setq format 'plain)
+ (setq raw-link (match-string-no-properties 0))
+ (setq type (match-string-no-properties 1))
+ (setq link-end (match-end 0))
+ (setq path (match-string-no-properties 2)))
;; Type 4: Angular link, e.g., <http://orgmode.org>. Unlike to
;; bracket links, follow RFC 3986 and remove any extra
;; whitespace in URI.
((looking-at org-angle-link-re)
- (setq type (org-match-string-no-properties 1))
+ (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]*" "" (org-match-string-no-properties 2))))
+ "[ \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.
@@ -3149,6 +3200,7 @@ Assume point is at the beginning of the link."
(list 'link
(list :type type
:path path
+ :format format
:raw-link (or raw-link path)
:application application
:search-option search-option
@@ -3164,18 +3216,38 @@ 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
- (format "[[%s]%s]"
- (cond ((string= type "coderef") (format "(%s)" path))
- ((string= type "custom-id") (concat "#" path))
- ((string= type "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)))))
- ((string= type "fuzzy") path)
- (t (concat type ":" path)))
- (if contents (format "[%s]" contents) "")))))
+ (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
@@ -3191,12 +3263,12 @@ Assume point is at the macro."
(save-excursion
(when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\(([ \t\n]*\\([^\000]*?\\))\\)?}}}")
(let ((begin (point))
- (key (downcase (org-match-string-no-properties 1)))
- (value (org-match-string-no-properties 0))
+ (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 (let ((args (org-match-string-no-properties 3)))
+ (args (let ((args (match-string-no-properties 3)))
(and args (org-macro-extract-arguments args)))))
(list 'macro
(list :key key
@@ -3206,9 +3278,8 @@ Assume point is at the macro."
:end end
:post-blank post-blank))))))
-(defun org-element-macro-interpreter (macro contents)
- "Interpret MACRO object as Org syntax.
-CONTENTS is nil."
+(defun org-element-macro-interpreter (macro _)
+ "Interpret MACRO object as Org syntax."
(org-element-property :value macro))
@@ -3228,7 +3299,7 @@ Assume point is at the radio target."
(let ((begin (point))
(contents-begin (match-beginning 1))
(contents-end (match-end 1))
- (value (org-match-string-no-properties 1))
+ (value (match-string-no-properties 1))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
@@ -3240,8 +3311,8 @@ Assume point is at the radio target."
:post-blank post-blank
:value value))))))
-(defun org-element-radio-target-interpreter (target contents)
- "Interpret TARGET object as Org syntax.
+(defun org-element-radio-target-interpreter (_ contents)
+ "Interpret target object as Org syntax.
CONTENTS is the contents of the object."
(concat "<<<" contents ">>>"))
@@ -3270,9 +3341,8 @@ Assume point is at the beginning of the statistics-cookie."
:value value
:post-blank post-blank))))))
-(defun org-element-statistics-cookie-interpreter (statistics-cookie contents)
- "Interpret STATISTICS-COOKIE object as Org syntax.
-CONTENTS is nil."
+(defun org-element-statistics-cookie-interpreter (statistics-cookie _)
+ "Interpret STATISTICS-COOKIE object as Org syntax."
(org-element-property :value statistics-cookie))
@@ -3303,8 +3373,8 @@ Assume point is at the first plus sign marker."
:contents-end contents-end
:post-blank post-blank))))))
-(defun org-element-strike-through-interpreter (strike-through contents)
- "Interpret STRIKE-THROUGH object as Org syntax.
+(defun org-element-strike-through-interpreter (_ contents)
+ "Interpret strike-through object as Org syntax.
CONTENTS is the contents of the object."
(format "+%s+" contents))
@@ -3404,8 +3474,8 @@ and `:post-blank' keywords."
:contents-end contents-end
:post-blank 0))))
-(defun org-element-table-cell-interpreter (table-cell contents)
- "Interpret TABLE-CELL element as Org syntax.
+(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 " |"))
@@ -3423,7 +3493,7 @@ Assume point is at the target."
(save-excursion
(when (looking-at org-target-regexp)
(let ((begin (point))
- (value (org-match-string-no-properties 1))
+ (value (match-string-no-properties 1))
(post-blank (progn (goto-char (match-end 0))
(skip-chars-forward " \t")))
(end (point)))
@@ -3433,9 +3503,8 @@ Assume point is at the target."
:value value
:post-blank post-blank))))))
-(defun org-element-target-interpreter (target contents)
- "Interpret TARGET object as Org syntax.
-CONTENTS is nil."
+(defun org-element-target-interpreter (target _)
+ "Interpret TARGET object as Org syntax."
(format "<<%s>>" (org-element-property :value target)))
@@ -3462,7 +3531,7 @@ cdr a plist with `:type', `:raw-value', `:year-start',
Otherwise, return nil.
Assume point is at the beginning of the timestamp."
- (when (org-looking-at-p org-element--timestamp-regexp)
+ (when (looking-at-p org-element--timestamp-regexp)
(save-excursion
(let* ((begin (point))
(activep (eq (char-after) ?<))
@@ -3500,8 +3569,8 @@ Assume point is at the beginning of the timestamp."
(t 'cumulate)))
:repeater-value (string-to-number (match-string 2 raw-value))
:repeater-unit
- (case (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ (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)
@@ -3509,8 +3578,8 @@ Assume point is at the beginning of the timestamp."
:warning-type (if (match-string 1 raw-value) 'first 'all)
:warning-value (string-to-number (match-string 2 raw-value))
:warning-unit
- (case (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (t 'year)))))
+ (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.
@@ -3550,26 +3619,24 @@ Assume point is at the beginning of the timestamp."
repeater-props
warning-props))))))
-(defun org-element-timestamp-interpreter (timestamp contents)
- "Interpret TIMESTAMP object as Org syntax.
-CONTENTS is nil."
+(defun org-element-timestamp-interpreter (timestamp _)
+ "Interpret TIMESTAMP object as Org syntax."
(let* ((repeat-string
(concat
- (case (org-element-property :repeater-type timestamp)
- (cumulate "+") (catch-up "++") (restart ".+"))
+ (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)))
- (case (org-element-property :repeater-unit timestamp)
- (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (pcase (org-element-property :repeater-unit timestamp)
+ (`hour "h") (`day "d") (`week "w") (`month "m") (`year "y"))))
(warning-string
(concat
- (case (org-element-property :warning-type timestamp)
- (first "--")
- (all "-"))
+ (pcase (org-element-property :warning-type timestamp)
+ (`first "--") (`all "-"))
(let ((val (org-element-property :warning-value timestamp)))
(and val (number-to-string val)))
- (case (org-element-property :warning-unit timestamp)
- (hour "h") (day "d") (week "w") (month "m") (year "y"))))
+ (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
@@ -3578,7 +3645,7 @@ CONTENTS is nil."
;; 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)
+ (funcall (if with-time-p #'cdr #'car)
org-time-stamp-formats)
time)))
(when (and hour-end minute-end)
@@ -3597,8 +3664,8 @@ CONTENTS is nil."
;; Return value.
ts)))
(type (org-element-property :type timestamp)))
- (case type
- ((active inactive)
+ (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))
@@ -3618,7 +3685,7 @@ CONTENTS is nil."
(and hour-start minute-start)
(and time-range-p hour-end)
(and time-range-p minute-end))))
- ((active-range inactive-range)
+ ((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))
@@ -3644,7 +3711,7 @@ CONTENTS is nil."
(org-element-property :year-end timestamp))
(eq type 'active-range)
(and hour-end minute-end)))))
- (otherwise (org-element-property :raw-value timestamp)))))
+ (_ (org-element-property :raw-value timestamp)))))
;;;; Underline
@@ -3674,8 +3741,8 @@ Assume point is at the first underscore marker."
:contents-end contents-end
:post-blank post-blank))))))
-(defun org-element-underline-interpreter (underline contents)
- "Interpret UNDERLINE object as Org syntax.
+(defun org-element-underline-interpreter (_ contents)
+ "Interpret underline object as Org syntax.
CONTENTS is the contents of the object."
(format "_%s_" contents))
@@ -3694,7 +3761,7 @@ Assume point is at the first equal sign marker."
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
(let ((begin (match-beginning 2))
- (value (org-match-string-no-properties 4))
+ (value (match-string-no-properties 4))
(post-blank (progn (goto-char (match-end 2))
(skip-chars-forward " \t")))
(end (point)))
@@ -3704,9 +3771,8 @@ Assume point is at the first equal sign marker."
:end end
:post-blank post-blank))))))
-(defun org-element-verbatim-interpreter (verbatim contents)
- "Interpret VERBATIM object as Org syntax.
-CONTENTS is nil."
+(defun org-element-verbatim-interpreter (verbatim _)
+ "Interpret VERBATIM object as Org syntax."
(format "=%s=" (org-element-property :value verbatim)))
@@ -3808,27 +3874,35 @@ element it has to parse."
;; Keywords.
((looking-at "[ \t]*#")
(goto-char (match-end 0))
- (cond ((looking-at "\\(?: \\|$\\)")
- (beginning-of-line)
- (org-element-comment-parser limit affiliated))
- ((looking-at "\\+BEGIN_\\(\\S-+\\)")
- (beginning-of-line)
- (let ((parser (assoc (upcase (match-string 1))
- org-element-block-name-alist)))
- (if parser (funcall (cdr parser) limit affiliated)
- (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))))
+ (cond
+ ((looking-at "\\(?: \\|$\\)")
+ (beginning-of-line)
+ (org-element-comment-parser limit affiliated))
+ ((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))
@@ -3893,7 +3967,7 @@ position of point and CDR is nil."
(dualp (member kwd org-element-dual-keywords))
(dual-value
(and dualp
- (let ((sec (org-match-string-no-properties 2)))
+ (let ((sec (match-string-no-properties 2)))
(if (or (not sec) (not parsedp)) sec
(save-match-data
(org-element--parse-objects
@@ -4010,14 +4084,11 @@ If STRING is the empty string or nil, return nil."
(dolist (v local-variables)
(ignore-errors
(if (symbolp v) (makunbound v)
- (org-set-local (car v) (cdr v)))))
+ (set (make-local-variable (car v)) (cdr v)))))
(insert string)
(restore-buffer-modified-p nil)
- (let ((data (org-element--parse-objects
- (point-min) (point-max) nil restriction)))
- (when parent
- (dolist (o data) (org-element-put-property o :parent parent)))
- data))))))
+ (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)
@@ -4087,94 +4158,93 @@ looking into captions:
(list no-recursion)))
;; Recursion depth is determined by --CATEGORY.
(--category
- (catch 'found
+ (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))
+ ;; 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
- --walk-tree
- (--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 into it.
- (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)
- (memq --type org-element-all-elements))
- (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)
- (memq --type org-element-all-objects)))
- ;; 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))))
+ --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)))))
(put 'org-element-map 'lisp-indent-function 2)
;; The following functions are internal parts of the parser.
@@ -4195,21 +4265,21 @@ otherwise. Modes can be either `first-section', `item',
`node-property', `planning', `property-drawer', `section',
`table-row' or nil."
(if parentp
- (case type
- (headline 'section)
- (inlinetask 'planning)
- (plain-list 'item)
- (property-drawer 'node-property)
- (section 'planning)
- (table 'table-row))
- (case type
- (item 'item)
- (node-property 'node-property)
- (planning 'property-drawer)
- (table-row 'table-row))))
+ (pcase type
+ (`headline 'section)
+ (`inlinetask 'planning)
+ (`plain-list 'item)
+ (`property-drawer 'node-property)
+ (`section 'planning)
+ (`table 'table-row))
+ (pcase type
+ (`item 'item)
+ (`node-property 'node-property)
+ (`planning 'property-drawer)
+ (`table-row 'table-row))))
(defun org-element--parse-elements
- (beg end mode structure granularity visible-only acc)
+ (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
@@ -4235,49 +4305,49 @@ Elements are accumulated into ACC."
;; 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)))
- ;; Main loop start.
- (while (< (point) end)
- ;; 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))
- ;; Visible only: skip invisible parts between siblings.
- (when (and visible-only (org-invisible-p2))
- (goto-char (min (1+ (org-find-visible)) end)))
- ;; 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'. Make sure GRANULARITY allows the
- ;; 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 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))))
- (org-element-adopt-elements acc element)
- ;; Update mode.
- (setq mode (org-element--next-mode type nil))))
- ;; Return result.
- acc))
+ (let (elements)
+ (while (< (point) end)
+ ;; 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))
+ ;; Visible only: skip invisible parts between siblings.
+ (when (and visible-only (org-invisible-p2))
+ (goto-char (min (1+ (org-find-visible)) end)))
+ ;; 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'. Make sure GRANULARITY allows the
+ ;; 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 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 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.
@@ -4285,27 +4355,41 @@ 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)."
(if (memq 'table-cell restriction) (org-element-table-cell-parser)
- (save-excursion
- (let ((limit (and org-target-link-regexp
- (save-excursion
- (or (bolp) (backward-char))
- (re-search-forward org-target-link-regexp nil t))
- (match-beginning 1)))
- found)
+ (let* ((start (point))
+ (limit
+ (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)
+ (match-beginning 1)))
+ (t (match-beginning 1)))))
+ found)
+ (save-excursion
(while (and (not found)
- (re-search-forward org-element--object-regexp limit t))
+ (re-search-forward org-element--object-regexp limit 'move))
(goto-char (match-beginning 0))
(let ((result (match-string 0)))
(setq found
(cond
- ((eq (compare-strings result nil nil "call_" nil nil t) t)
+ ((string-prefix-p "call_" result t)
(and (memq 'inline-babel-call restriction)
(org-element-inline-babel-call-parser)))
- ((eq (compare-strings result nil nil "src_" nil nil t) t)
+ ((string-prefix-p "src_" result t)
(and (memq 'inline-src-block restriction)
(org-element-inline-src-block-parser)))
(t
- (case (char-after)
+ (pcase (char-after)
(?^ (and (memq 'superscript restriction)
(org-element-superscript-parser)))
(?_ (or (and (memq 'subscript restriction)
@@ -4336,7 +4420,8 @@ to an appropriate container (e.g., a paragraph)."
(org-element-target-parser)))
(or (and (memq 'timestamp restriction)
(org-element-timestamp-parser))
- (and (memq 'link restriction)
+ (and (or (memq 'link restriction)
+ (memq 'simple-link restriction))
(org-element-link-parser)))))
(?\\
(if (eq (aref result 1) ?\\)
@@ -4357,60 +4442,63 @@ to an appropriate container (e.g., a paragraph)."
(and (memq 'statistics-cookie restriction)
(org-element-statistics-cookie-parser)))))
;; This is probably a plain link.
- (otherwise (and (or (memq 'link restriction)
- (memq 'plain-link restriction))
- (org-element-link-parser)))))))
+ (_ (and (or (memq 'link restriction)
+ (memq 'simple-link restriction))
+ (org-element-link-parser)))))))
(or (eobp) (forward-char))))
(cond (found)
- ;; Radio link.
- ((and limit (memq 'link restriction))
- (goto-char limit) (org-element-link-parser)))))))
+ (limit (org-element-link-parser)) ;radio link
+ (t nil))))))
-(defun org-element--parse-objects (beg end acc restriction)
+(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.
+Objects are accumulated in ACC. RESTRICTION is a list of object
+successors which are allowed in the current object.
-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)
+ (let (next-object contents)
(while (and (not (eobp))
(setq next-object (org-element--object-lex restriction)))
- ;; 1. Text before any object. Untabify it.
+ ;; Text before any object.
(let ((obj-beg (org-element-property :begin next-object)))
(unless (= (point) obj-beg)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) obj-beg))))))
- ;; 2. Object...
+ (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)))
- ;; Fill contents of NEXT-OBJECT by side-effect, if it has
- ;; a recursive type.
- (when (and cont-beg
- (memq (car next-object) org-element-recursive-objects))
- (org-element--parse-objects
- cont-beg (org-element-property :contents-end next-object)
- next-object (org-element-restriction next-object)))
- (setq acc (org-element-adopt-elements acc next-object))
- (goto-char obj-end))))
- ;; 3. Text after last object. Untabify it.
- (unless (eobp)
- (setq acc
- (org-element-adopt-elements
- acc
- (replace-regexp-in-string
- "\t" (make-string tab-width ? )
- (buffer-substring-no-properties (point) end)))))
- ;; Result.
- acc)))
+ (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))))))))
@@ -4429,73 +4517,70 @@ the current object."
"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."
- (org-element--interpret-data-1 data nil))
-
-(defun org-element--interpret-data-1 (data parent)
- "Interpret DATA as Org syntax.
-
-DATA is a parse tree, an element, an object or a secondary string
-to interpret. PARENT is used for recursive calls. It contains
-the element or object containing data, or nil.
-
-Return Org syntax as a string."
- (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 (data contents) contents))))
- (results
- (cond
- ;; Secondary string.
- ((not type)
- (mapconcat
- (lambda (obj) (org-element--interpret-data-1 obj parent)) data ""))
- ;; Full Org document.
- ((eq type 'org-data)
- (mapconcat (lambda (obj) (org-element--interpret-data-1 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 (obj) (org-element--interpret-data-1 obj 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)
- (equal data (car (org-element-contents parent)))
- (memq (org-element-type parent)
- '(footnote-definition item))))))
- ""))))))
- (if (memq type '(org-data plain-text nil)) results
- ;; Build white spaces. If no `:post-blank' property is
- ;; specified, assume its value is 0.
- (let ((post-blank (or (org-element-property :post-blank data) 0)))
- (if (or (memq type org-element-all-objects)
- (and parent
- (let ((type (org-element-type parent)))
- (or (not type)
- (memq type org-element-object-containers)))))
- (concat results (make-string post-blank ?\s))
- (concat
- (org-element--interpret-affiliated-keywords data)
- (org-element-normalize-string results)
- (make-string post-blank ?\n)))))))
+ (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)))))))
+ ""))))))
+ (if (memq type '(org-data plain-text 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.
@@ -4529,14 +4614,14 @@ If there is no affiliated keyword, return the empty string."
;; 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.
- (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)
+ (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
@@ -4572,75 +4657,89 @@ 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. The function assumes that
-indentation is not done with TAB characters."
- (let* ((min-ind most-positive-fixnum)
- find-min-ind ; For byte-compiler.
- (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)
- (dolist (object (org-element-contents blob))
- (when first-flag
- (setq first-flag nil)
- ;; Objects cannot start with spaces: in this case,
- ;; indentation is 0.
- (if (not (stringp object)) (throw 'zero (setq min-ind 0))
- (string-match "\\` *" object)
- (let ((len (match-end 0)))
- ;; An indentation of zero means no string will be
- ;; modified. Quit the process.
- (if (zerop len) (throw 'zero (setq min-ind 0))
- (setq min-ind (min len min-ind))))))
- (cond
- ((stringp object)
- (dolist (line (cdr (org-split-string object " *\n")))
- (unless (string= line "")
- (setq min-ind (min (org-get-indentation line) min-ind)))))
- ((eq (org-element-type object) 'line-break) (setq first-flag t))
- ((memq (org-element-type object) org-element-recursive-objects)
- (funcall find-min-ind object first-flag)))))))
- ;; Find minimal indentation in ELEMENT.
- (catch 'zero (funcall find-min-ind element (not ignore-first)))
+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)
+ (catch 'zero
+ (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))
+ (if (equal (match-string 2 datum) "\n")
+ (put-text-property
+ (match-beginning 1) (match-end 1)
+ 'org-ind 'empty
+ datum)
+ (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 (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.
- (let* (build ; For byte compiler.
- (build
- (lambda (blob first-flag)
- ;; Return BLOB with all its strings indentation
- ;; shortened from MIN-IND white spaces. FIRST-FLAG is
- ;; non-nil when the next object is expected to be
- ;; a string that doesn't start with a newline
- ;; character.
- (setcdr (cdr blob)
- (mapcar
- (lambda (object)
- (when first-flag
- (setq first-flag nil)
- (when (stringp object)
- (setq object
- (replace-regexp-in-string
- (format "\\` \\{%d\\}" min-ind)
- "" object))))
- (cond
- ((stringp object)
- (replace-regexp-in-string
- (format "\n \\{%d\\}" min-ind) "\n" object))
- ((memq (org-element-type object)
- org-element-recursive-objects)
- (funcall build object first-flag))
- ((eq (org-element-type object) 'line-break)
- (setq first-flag t)
- object)
- (t object)))
- (org-element-contents blob)))
- blob)))
- (funcall build element (not ignore-first))))))
+ (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)))))
@@ -4722,7 +4821,7 @@ with `org-element--cache-compare'. This cache is used in
Key is an element, as returned by `org-element-at-point', and
value is an alist where each association is:
- \(PARENT COMPLETEP . OBJECTS)
+ (PARENT COMPLETEP . OBJECTS)
where PARENT is an element or object, COMPLETEP is a boolean,
non-nil when all direct children of parent are already cached and
@@ -4736,12 +4835,12 @@ contained within a paragraph
If the paragraph is completely parsed, OBJECTS-DATA will be
- \((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
- \(BOLD-OBJECT t ENTITY-OBJECT))
+ ((PARAGRAPH t BOLD-OBJECT ENTITY-OBJECT)
+ (BOLD-OBJECT t ENTITY-OBJECT))
whereas in a partially parsed paragraph, it could be
- \((PARAGRAPH nil ENTITY-OBJECT))
+ ((PARAGRAPH nil ENTITY-OBJECT))
This cache is used in `org-element-context'.")
@@ -4830,16 +4929,16 @@ the following rules:
gets a new level. Its value is the mean between LOWER and
UPPER:
- \(1 2) + (1 4) --> (1 3)
+ (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)
+ (1 1) + (1 1 2)
is equivalent to
- \(1 1 m) + (1 1 2)
+ (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'.
@@ -4847,18 +4946,18 @@ the following rules:
- 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)
+ (2 1) + (3 3)
is equivalent to
- \(2 1) + (2 M)
+ (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
+ (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'."
@@ -4976,10 +5075,10 @@ the cache."
(setq node nil
lower element
upper element)))))
- (case side
- (both (cons lower upper))
- ((nil) lower)
- (otherwise upper))))
+ (pcase side
+ (`both (cons lower upper))
+ (`nil lower)
+ (_ upper))))
(defun org-element--cache-put (element &optional data)
"Store ELEMENT in current buffer's cache, if allowed.
@@ -5053,8 +5152,8 @@ Properties are modified by side-effect."
(not (eq (org-element-type (plist-get properties :parent))
'item)))
(dolist (item (plist-get properties :structure))
- (incf (car item) offset)
- (incf (nth 6 item) offset)))
+ (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))))
@@ -5093,7 +5192,7 @@ updated before current modification are actually submitted."
;; Request processed. Merge current and next offsets and
;; transfer ending position.
(when next
- (incf (aref next 3) (aref request 3))
+ (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))))
@@ -5483,12 +5582,12 @@ that range. See `after-change-functions' for more information."
;; 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 (case org-element--cache-change-warning
- ((t) t)
- (headline
+ (when (pcase org-element--cache-change-warning
+ (`t t)
+ (`headline
(not (and (org-with-limited-levels (org-at-heading-p))
(= (line-end-position) bottom))))
- (otherwise
+ (_
(let ((case-fold-search t))
(re-search-forward
org-element--cache-sensitive-re bottom t))))
@@ -5569,7 +5668,7 @@ change, as an integer."
;; Current changes can be merged with first sync request: we
;; can save a partial cache synchronization.
(progn
- (incf (aref next 3) offset)
+ (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.
@@ -5619,7 +5718,8 @@ change, as an integer."
;; No element to remove. No need to re-parent either.
;; Simply shift additional elements, if any, by OFFSET.
(when org-element--cache-sync-requests
- (incf (aref (car org-element--cache-sync-requests) 3) offset)))))))
+ (cl-incf (aref (car org-element--cache-sync-requests) 3)
+ offset)))))))
;;;; Public Functions
@@ -5633,14 +5733,14 @@ buffers."
(dolist (buffer (if all (buffer-list) (list (current-buffer))))
(with-current-buffer buffer
(when (and org-element-use-cache (derived-mode-p 'org-mode))
- (org-set-local 'org-element--cache
- (avl-tree-create #'org-element--cache-compare))
- (org-set-local 'org-element--cache-objects (make-hash-table :test #'eq))
- (org-set-local 'org-element--cache-sync-keys
- (make-hash-table :weakness 'key :test #'eq))
- (org-set-local 'org-element--cache-change-warning nil)
- (org-set-local 'org-element--cache-sync-requests nil)
- (org-set-local 'org-element--cache-sync-timer nil)
+ (setq-local org-element--cache
+ (avl-tree-create #'org-element--cache-compare))
+ (setq-local org-element--cache-objects (make-hash-table :test #'eq))
+ (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
@@ -5772,15 +5872,16 @@ Providing it allows for quicker computation."
(throw 'objects-forbidden element)))))
;; At an headline or inlinetask, objects are in title.
((memq type '(headline inlinetask))
- (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 (let (case-fold-search) (looking-at org-comment-string))
- (goto-char (match-end 0)))
- (if (>= (point) end) (throw 'objects-forbidden element)
- (narrow-to-region (point) end)))))
+ (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))
@@ -5988,7 +6089,7 @@ end of ELEM-A."
(goto-char beg-B)
(when specialp
(setq body-B (replace-regexp-in-string "\\`[ \t]*" "" body-B))
- (org-indent-to-column ind-B))
+ (indent-to-column ind-B))
(insert body-A)
;; Restore ex ELEM-A overlays.
(let ((offset (- beg-B beg-A)))
@@ -6002,36 +6103,6 @@ end of ELEM-A."
(move-overlay (car o) (- (nth 1 o) offset) (- (nth 2 o) offset))))
(goto-char (org-element-property :end elem-B)))))
-(defun org-element-remove-indentation (s &optional n)
- "Remove maximum common indentation in string S and return it.
-When optional argument N is a positive integer, remove exactly
-that much characters from indentation, if possible, or return
-S as-is otherwise. Unlike to `org-remove-indentation', this
-function doesn't call `untabify' on S."
- (catch 'exit
- (with-temp-buffer
- (insert s)
- (goto-char (point-min))
- ;; Find maximum common indentation, if not specified.
- (setq n (or n
- (let ((min-ind (point-max)))
- (save-excursion
- (while (re-search-forward "^[ \t]*\\S-" nil t)
- (let ((ind (1- (current-column))))
- (if (zerop ind) (throw 'exit s)
- (setq min-ind (min min-ind ind))))))
- min-ind)))
- (if (zerop n) s
- ;; Remove exactly N indentation, but give up if not possible.
- (while (not (eobp))
- (let ((ind (progn (skip-chars-forward " \t") (current-column))))
- (cond ((eolp) (delete-region (line-beginning-position) (point)))
- ((< ind n) (throw 'exit s))
- (t (org-indent-line-to (- ind n))))
- (forward-line)))
- (buffer-string)))))
-
-
(provide 'org-element)