diff options
Diffstat (limited to 'lisp/org-element.el')
| -rw-r--r-- | lisp/org-element.el | 1669 |
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) |