* [PATCH] org-element: Hide parsers boilerplate into plist-creating macros
@ 2020-09-08 17:19 akater
2020-09-09 8:46 ` Bastien
0 siblings, 1 reply; 5+ messages in thread
From: akater @ 2020-09-08 17:19 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1.1: Type: text/plain, Size: 2128 bytes --]
We replace some repetetive code with macro calls org-prog-plist and
org-let*-prog-plist. The macros are not very conventional but hopefully
their docstrings are illustrative enough. In effect, all subexpressions
of the form
:begin begin
:end end
:contents-begin contents-begin
:contents-end contents-end
and so on, are removed, together with some let* forms.
Macros expand to code that is essentially the original code, only the
order of key-value pairs in resulting plists is different.
One might argue that it is desirable to have key-value pairs plisted in
specific order, maybe somewhat unified. A rejoinder: plists are meant
to be order-independent while those who delve into these fairly
low-level plists regularly enough to be bothered by the properties'
order, can be considered org-element experts (voluntary or not); I
believe it is only instructive to an expert to be reminded of the
structure of the algorithm that constructs plist in question, especially
if such algorithms are highly imperative. That said, I did rearrange
some assignments to make resulting plists look a little prettier. I
also outlined (but not implemented) a mechanism for (partially)
specifying positions, in comments.
I tested most redefined parsers with new definitions applying them to
one sample object of each kind. Left untested (as I'm not familiar with
Org markup for the corresponding objects) are
- inlinetask-parser
- diary-sexp-parser
- horizontal-rule-parser
- planning-parser
- entity-parser
- export-snippet-parser
- latex-fragment-parser
- macro-parser
- radio-target-parser
- statistics-cookie-parser
- target-parser
Still, diff shows that only trivial subexpressions, as described above,
are discarded there. I did check that Org(+contrib) builds with this
patch.
Minor note on org-element-inline-babel-call-parser:
org-element--parse-paired-brackets alters point. That's why I felt it
would be more appropriate to put the corresponding binding/assignment on
top level of an explicitly imperative macro, rather than keep the
binding in a more localized let form, as extent of the operation is not
localized.
[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 800 bytes --]
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Hide boilerplate in org-element.el --]
[-- Type: text/x-diff, Size: 123767 bytes --]
From d9d108f97917c1b55841df907510bcc89f8db406 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Thu, 16 Apr 2020 02:25:59 +0000
Subject: [PATCH] org-element: Hide parsers boilerplate into plist-creating
macros
* lisp/org-element.el (org-prog-plist, org-let*-prog-plists) (org-let*-prog-plist): New macros. Build plists without boilerplate.
(org-fold, org-dekeyword): New functions. Dependencies for the above.
* lisp/org-element.el (org-element-center-block-parser)
(org-element-drawer-parser, org-element-dynamic-block-parser)
(org-element-footnote-definition-parser)
(org-element-plain-list-parser, org-element-property-drawer-parser)
(org-element-quote-block-parser, org-element-section-parser)
(org-element-special-block-parser, org-element-babel-call-parser)
(org-element-clock-parser, org-element-comment-parser)
(org-element-comment-block-parser, org-element-diary-sexp-parser)
(org-element-example-block-parser, org-element-export-block-parser)
(org-element-fixed-width-parser, org-element-horizontal-rule-parser)
(org-element-keyword-parser, org-element-latex-environment-parser)
(org-element-node-property-parser, org-element-paragraph-parser)
(org-element-planning-parser, org-element-src-block-parser)
(org-element-table-parser, org-element-table-row-parser)
(org-element-verse-block-parser, org-element-entity-parser)
(org-element-footnote-reference-parser, org-element-inline-babel-call-parser)
(org-element-inline-src-block-parser, org-element-latex-fragment-parser)
(org-element-link-parser): Use org-prog-plist to build plist
(org-element-headline-parser, org-element-inlinetask-parser)
(org-element-item-parser, org-element-timestamp-parser): Use
org-let*-prog-plist to build plist
(org-element-radio-target-parser, org-element-statistics-cookie-parser) (org-element-subscript-parser, org-element-superscript-parser) (org-element-table-cell-parser, org-element-target-parser) (org-element-underline-parser, org-element-verbatim-parser): Use
just #'list to build plist
(org-element-comment-block-parser): Fix a typo in docstring.
---
lisp/org-element.el | 2584 +++++++++++++++++++------------------------
lisp/org-macs.el | 259 +++++
2 files changed, 1421 insertions(+), 1422 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index a693cb68d..e40f881b9 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -691,29 +691,26 @@ Assume point is at the beginning of the block."
(re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((block-end-line (match-beginning 0)))
- (let* ((begin (car affiliated))
- (post-affiliated (point))
+ (list 'center-block
+ (nconc
+ (org-prog-plist
+ block-end-line (match-beginning 0)
+ :begin (car affiliated)
+ :post-affiliated (point)
;; Empty blocks have no contents.
- (contents-begin (progn (forward-line)
+ :contents-begin (progn (forward-line)
(and (< (point) block-end-line)
- (point))))
- (contents-end (and contents-begin block-end-line))
- (pos-before-blank (progn (goto-char block-end-line)
- (forward-line)
- (point)))
- (end (save-excursion
+ (point)))
+ :contents-end (and contents-begin block-end-line)
+ pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point))
+ :end (save-excursion
(skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'center-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (if (eobp) (point)
+ (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end))
+ (cdr affiliated))))))
(defun org-element-center-block-interpreter (_ contents)
"Interpret a center-block element as Org syntax.
@@ -740,32 +737,28 @@ Assume point is at beginning of drawer."
(if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
;; Incomplete drawer: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (save-excursion
- (let* ((drawer-end-line (match-beginning 0))
- (name (progn (looking-at org-drawer-regexp)
- (match-string-no-properties 1)))
- (begin (car affiliated))
- (post-affiliated (point))
- ;; Empty drawers have no contents.
- (contents-begin (progn (forward-line)
- (and (< (point) drawer-end-line)
- (point))))
- (contents-end (and contents-begin drawer-end-line))
- (pos-before-blank (progn (goto-char drawer-end-line)
- (forward-line)
+ (list
+ 'drawer
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ drawer-end-line (match-beginning 0)
+ :drawer-name (progn (looking-at org-drawer-regexp)
+ (match-string-no-properties 1))
+ :begin (car affiliated)
+ :post-affiliated (point)
+ ;; Empty drawers have no contents.
+ :contents-begin (progn (forward-line)
+ (and (< (point) drawer-end-line)
(point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'drawer
- (nconc
- (list :begin begin
- :end end
- :drawer-name name
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ :contents-end (and contents-begin drawer-end-line)
+ pos-before-blank (progn (goto-char drawer-end-line)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))))
(defun org-element-drawer-interpreter (drawer contents)
"Interpret DRAWER element as Org syntax.
@@ -796,34 +789,28 @@ Assume point is at beginning of dynamic block."
(re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((block-end-line (match-beginning 0)))
- (save-excursion
- (let* ((name (progn (looking-at org-dblock-start-re)
- (match-string-no-properties 1)))
- (arguments (match-string-no-properties 3))
- (begin (car affiliated))
- (post-affiliated (point))
+ (list 'dynamic-block
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ block-end-line (match-beginning 0)
+ :block-name (progn (looking-at org-dblock-start-re)
+ (match-string-no-properties 1))
+ :arguments (match-string-no-properties 3)
+ :begin (car affiliated)
+ :post-affiliated (point)
;; Empty blocks have no contents.
- (contents-begin (progn (forward-line)
+ :contents-begin (progn (forward-line)
(and (< (point) block-end-line)
- (point))))
- (contents-end (and contents-begin block-end-line))
- (pos-before-blank (progn (goto-char block-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'dynamic-block
- (nconc
- (list :begin begin
- :end end
- :block-name name
- :arguments arguments
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (point)))
+ :contents-end (and contents-begin block-end-line)
+ pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))))
(defun org-element-dynamic-block-interpreter (dynamic-block contents)
"Interpret DYNAMIC-BLOCK element as Org syntax.
@@ -857,54 +844,49 @@ a plist containing `:label', `:begin' `:end', `:contents-begin',
`:post-affiliated' keywords.
Assume point is at the beginning of the footnote definition."
- (save-excursion
- (let* ((label (progn (looking-at org-footnote-definition-re)
- (match-string-no-properties 1)))
- (begin (car affiliated))
- (post-affiliated (point))
- (end
- (save-excursion
- (end-of-line)
- (cond
- ((not
- (re-search-forward org-element--footnote-separator limit t))
- limit)
- ((eq ?\[ (char-after (match-beginning 0)))
- ;; At a new footnote definition, make sure we end
- ;; before any affiliated keyword above.
- (forward-line -1)
- (while (and (> (point) post-affiliated)
- (looking-at-p org-element--affiliated-re))
- (forward-line -1))
- (line-beginning-position 2))
- ((eq ?* (char-after (match-beginning 0))) (match-beginning 0))
- (t (skip-chars-forward " \r\t\n" limit)
- (if (= limit (point)) limit (line-beginning-position))))))
- (pre-blank 0)
- (contents-begin
- (progn (search-forward "]")
- (skip-chars-forward " \r\t\n" end)
- (cond ((= (point) end) nil)
- ((= (line-beginning-position) post-affiliated) (point))
- (t
- (setq pre-blank
- (count-lines (line-beginning-position) begin))
- (line-beginning-position)))))
- (contents-end
- (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- (list 'footnote-definition
- (nconc
- (list :label label
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end (and contents-begin contents-end)
- :pre-blank pre-blank
- :post-blank (count-lines contents-end end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list
+ 'footnote-definition
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :label (progn (looking-at org-footnote-definition-re)
+ (match-string-no-properties 1))
+ :begin (car affiliated)
+ :post-affiliated (point)
+ :end
+ (save-excursion
+ (end-of-line)
+ (cond
+ ((not
+ (re-search-forward org-element--footnote-separator limit t))
+ limit)
+ ((eq ?\[ (char-after (match-beginning 0)))
+ ;; At a new footnote definition, make sure we end
+ ;; before any affiliated keyword above.
+ (forward-line -1)
+ (while (and (> (point) post-affiliated)
+ (looking-at-p org-element--affiliated-re))
+ (forward-line -1))
+ (line-beginning-position 2))
+ ((eq ?* (char-after (match-beginning 0))) (match-beginning 0))
+ (t (skip-chars-forward " \r\t\n" limit)
+ (if (= limit (point)) limit (line-beginning-position)))))
+ :pre-blank 0
+ :contents-begin
+ (progn (search-forward "]")
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ((= (line-beginning-position) post-affiliated) (point))
+ (t
+ (setq pre-blank
+ (count-lines (line-beginning-position) begin))
+ (line-beginning-position))))
+ :contents-end (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ :contents-end (and contents-begin contents-end)
+ :post-blank (count-lines contents-end end)))
+ (cdr affiliated))))
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
@@ -983,72 +965,59 @@ parsed as a secondary string, but as a plain string instead.
Assume point is at beginning of the headline."
(save-excursion
- (let* ((begin (point))
- (level (prog1 (org-reduced-level (skip-chars-forward "*"))
- (skip-chars-forward " \t")))
- (todo (and org-todo-regexp
- (let (case-fold-search) (looking-at (concat org-todo-regexp " ")))
- (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (match-string 1))))
- (todo-type
- (and todo (if (member todo org-done-keywords) 'done 'todo)))
- (priority (and (looking-at "\\[#.\\][ \t]*")
- (progn (goto-char (match-end 0))
- (aref (match-string 0) 2))))
- (commentedp
- (and (let (case-fold-search) (looking-at org-comment-string))
- (goto-char (match-end 0))))
- (title-start (point))
- (tags (when (re-search-forward
- "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
- (line-end-position)
- 'move)
- (goto-char (match-beginning 0))
- (org-split-string (match-string 1) ":")))
- (title-end (point))
- (raw-value (org-trim
- (buffer-substring-no-properties title-start title-end)))
- (archivedp (member org-archive-tag tags))
- (footnote-section-p (and org-footnote-section
- (string= org-footnote-section raw-value)))
- (standard-props (org-element--get-node-properties))
- (time-props (org-element--get-time-properties))
- (end (min (save-excursion (org-end-of-subtree t t)) limit))
- (contents-begin (save-excursion
- (forward-line)
- (skip-chars-forward " \r\t\n" end)
- (and (/= (point) end) (line-beginning-position))))
- (contents-end (and contents-begin
- (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2)))))
+ (org-let*-prog-plist
+ (plist
+ :begin (point)
+ :level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t"))
+ todo (and org-todo-regexp
+ (let (case-fold-search)
+ (looking-at (concat org-todo-regexp " ")))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 1)))
+ :todo-type
+ (and todo (if (member todo org-done-keywords) 'done 'todo))
+ :priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2)))
+ :commentedp
+ (and (let (case-fold-search) (looking-at org-comment-string))
+ (goto-char (match-end 0)))
+ title-start (point)
+ :tags (when (re-search-forward
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":"))
+ title-end (point)
+ :raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end))
+ :archivedp (member org-archive-tag tags)
+ :footnote-section-p (and org-footnote-section
+ (string= org-footnote-section raw-value))
+ standard-props (org-element--get-node-properties)
+ time-props (org-element--get-time-properties)
+ :end (min (save-excursion (org-end-of-subtree t t)) limit)
+ :contents-begin (save-excursion
+ (forward-line)
+ (skip-chars-forward " \r\t\n" end)
+ (and (/= (point) end)
+ (line-beginning-position)))
+ :contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ :pre-blank (if (not contents-begin) 0
+ (1- (count-lines begin contents-begin)))
+ :todo-keyword todo
+ :post-blank (if contents-end
+ (count-lines contents-end end)
+ (1- (count-lines begin end)))
+ :post-affiliated begin)
(let ((headline
- (list 'headline
- (nconc
- (list :raw-value raw-value
- :begin begin
- :end end
- :pre-blank
- (if (not contents-begin) 0
- (1- (count-lines begin contents-begin)))
- :contents-begin contents-begin
- :contents-end contents-end
- :level level
- :priority priority
- :tags tags
- :todo-keyword todo
- :todo-type todo-type
- :post-blank
- (if contents-end
- (count-lines contents-end end)
- (1- (count-lines begin end)))
- :footnote-section-p footnote-section-p
- :archivedp archivedp
- :commentedp commentedp
- :post-affiliated begin)
- time-props
- standard-props))))
+ (list 'headline (nconc plist time-props standard-props))))
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
@@ -1129,80 +1098,70 @@ string instead.
Assume point is at beginning of the inline task."
(save-excursion
- (let* ((begin (point))
- (level (prog1 (org-reduced-level (skip-chars-forward "*"))
- (skip-chars-forward " \t")))
- (todo (and org-todo-regexp
- (let (case-fold-search) (looking-at org-todo-regexp))
- (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (match-string 0))))
- (todo-type (and todo
- (if (member todo org-done-keywords) 'done 'todo)))
- (priority (and (looking-at "\\[#.\\][ \t]*")
- (progn (goto-char (match-end 0))
- (aref (match-string 0) 2))))
- (title-start (point))
- (tags (when (re-search-forward
- "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
- (line-end-position)
- 'move)
- (goto-char (match-beginning 0))
- (org-split-string (match-string 1) ":")))
- (title-end (point))
- (raw-value (org-trim
- (buffer-substring-no-properties title-start title-end)))
- (task-end (save-excursion
- (end-of-line)
- (and (re-search-forward org-outline-regexp-bol limit t)
- (looking-at-p "[ \t]*END[ \t]*$")
- (line-beginning-position))))
- (standard-props (and task-end (org-element--get-node-properties)))
- (time-props (and task-end (org-element--get-time-properties)))
- (contents-begin (and task-end
- (< (point) task-end)
- (progn
- (forward-line)
- (skip-chars-forward " \t\n")
- (line-beginning-position))))
- (contents-end (and contents-begin task-end))
- (end (progn (when task-end (goto-char task-end))
- (forward-line)
- (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (inlinetask
- (list 'inlinetask
- (nconc
- (list :raw-value raw-value
- :begin begin
- :end end
- :pre-blank
- (if (not contents-begin) 0
- (1- (count-lines begin contents-begin)))
- :contents-begin contents-begin
- :contents-end contents-end
- :level level
- :priority priority
- :tags tags
- :todo-keyword todo
- :todo-type todo-type
- :post-blank (1- (count-lines (or task-end begin) end))
- :post-affiliated begin)
- time-props
- standard-props))))
- (org-element-put-property
- inlinetask :title
- (if raw-secondary-p raw-value
- (org-element--parse-objects
- (progn (goto-char title-start)
- (skip-chars-forward " \t")
- (point))
- (progn (goto-char title-end)
- (skip-chars-backward " \t")
- (point))
- nil
- (org-element-restriction 'inlinetask)
- inlinetask))))))
+ (org-let*-prog-plist
+ (plist
+ :begin (point)
+ :level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t"))
+ :todo (and org-todo-regexp
+ (let (case-fold-search) (looking-at org-todo-regexp))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 0)))
+ :todo-type (and todo
+ (if (member todo org-done-keywords) 'done 'todo))
+ :priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2)))
+ title-start (point)
+ :tags (when (re-search-forward
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":"))
+ title-end (point)
+ :raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end))
+ :task-end (save-excursion
+ (end-of-line)
+ (and (re-search-forward org-outline-regexp-bol limit t)
+ (looking-at-p "[ \t]*END[ \t]*$")
+ (line-beginning-position)))
+ standard-props (and task-end
+ (org-element--get-node-properties))
+ time-props (and task-end (org-element--get-time-properties))
+ :contents-begin (and task-end
+ (< (point) task-end)
+ (progn
+ (forward-line)
+ (skip-chars-forward " \t\n")
+ (line-beginning-position)))
+ :contents-end (and contents-begin task-end)
+ :end (progn (when task-end (goto-char task-end))
+ (forward-line)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :pre-blank (if (not contents-begin) 0
+ (1- (count-lines begin contents-begin)))
+ :todo-keyword todo
+ :post-blank (1- (count-lines (or task-end begin) end))
+ :post-affiliated begin)
+ (let ((inlinetask
+ (list 'inlinetask (nconc plist time-props standard-props))))
+ (org-element-put-property
+ inlinetask :title
+ (if raw-secondary-p raw-value
+ (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
+ (org-element-restriction 'inlinetask)
+ inlinetask)))))))
(defun org-element-inlinetask-interpreter (inlinetask contents)
"Interpret INLINETASK element as Org syntax.
@@ -1262,68 +1221,61 @@ Assume point is at the beginning of the item."
(save-excursion
(beginning-of-line)
(looking-at org-list-full-item-re)
- (let* ((begin (point))
- (bullet (match-string-no-properties 1))
- (checkbox (let ((box (match-string 3)))
- (cond ((equal "[ ]" box) 'off)
- ((equal "[X]" box) 'on)
- ((equal "[-]" box) 'trans))))
- (counter (let ((c (match-string 2)))
- (save-match-data
- (cond
- ((not c) nil)
- ((string-match "[A-Za-z]" c)
- (- (string-to-char (upcase (match-string 0 c)))
- 64))
- ((string-match "[0-9]+" c)
- (string-to-number (match-string 0 c)))))))
- (end (progn (goto-char (nth 6 (assq (point) struct)))
- (if (bolp) (point) (line-beginning-position 2))))
- (pre-blank 0)
- (contents-begin
- (progn
- (goto-char
- ;; Ignore tags in un-ordered lists: they are just
- ;; a part of item's body.
- (if (and (match-beginning 4)
- (save-match-data (string-match "[.)]" bullet)))
- (match-beginning 4)
- (match-end 0)))
- (skip-chars-forward " \r\t\n" end)
- (cond ((= (point) end) nil)
- ;; If first line isn't empty, contents really
- ;; start at the text after item's meta-data.
- ((= (line-beginning-position) begin) (point))
- (t
- (setq pre-blank
- (count-lines (line-beginning-position) begin))
- (line-beginning-position)))))
- (contents-end (and contents-begin
- (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- (item
- (list 'item
- (list :bullet bullet
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :checkbox checkbox
- :counter counter
- :structure struct
- :pre-blank pre-blank
- :post-blank (count-lines (or contents-end begin) end)
- :post-affiliated begin))))
- (org-element-put-property
- item :tag
- (let ((raw (org-list-get-tag begin struct)))
- (when raw
- (if raw-secondary-p raw
- (org-element--parse-objects
- (match-beginning 4) (match-end 4) nil
- (org-element-restriction 'item)
- item))))))))
+ (org-let*-prog-plist
+ (plist
+ :begin (point)
+ :bullet (match-string-no-properties 1)
+ :checkbox (let ((box (match-string 3)))
+ (cond ((equal "[ ]" box) 'off)
+ ((equal "[X]" box) 'on)
+ ((equal "[-]" box) 'trans)))
+ :counter (let ((c (match-string 2)))
+ (save-match-data
+ (cond
+ ((not c) nil)
+ ((string-match "[A-Za-z]" c)
+ (- (string-to-char (upcase (match-string 0 c)))
+ 64))
+ ((string-match "[0-9]+" c)
+ (string-to-number (match-string 0 c))))))
+ :end (progn (goto-char (nth 6 (assq (point) struct)))
+ (if (bolp) (point) (line-beginning-position 2)))
+ :pre-blank 0
+ :contents-begin
+ (progn
+ (goto-char
+ ;; Ignore tags in un-ordered lists: they are just
+ ;; a part of item's body.
+ (if (and (match-beginning 4)
+ (save-match-data (string-match "[.)]" bullet)))
+ (match-beginning 4)
+ (match-end 0)))
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ;; If first line isn't empty, contents really
+ ;; start at the text after item's meta-data.
+ ((= (line-beginning-position) begin) (point))
+ (t
+ (setq pre-blank
+ (count-lines (line-beginning-position) begin))
+ (line-beginning-position))))
+ :contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ :structure struct
+ :post-blank (count-lines (or contents-end begin) end)
+ :post-affiliated begin)
+ (let ((item (list 'item plist)))
+ (org-element-put-property
+ item :tag
+ (let ((raw (org-list-get-tag begin struct)))
+ (when raw
+ (if raw-secondary-p raw
+ (org-element--parse-objects
+ (match-beginning 4) (match-end 4) nil
+ (org-element-restriction 'item)
+ item)))))))))
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
@@ -1463,35 +1415,30 @@ containing `:type', `:begin', `:end', `:contents-begin' and
`:post-affiliated' keywords.
Assume point is at the beginning of the list."
- (save-excursion
- (let* ((struct (or structure (org-element--list-struct limit)))
- (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
- ((nth 5 (assq (point) struct)) 'descriptive)
- (t 'unordered)))
- (contents-begin (point))
- (begin (car affiliated))
- (contents-end (let* ((item (assq contents-begin struct))
- (ind (nth 1 item))
- (pos (nth 6 item)))
- (while (and (setq item (assq pos struct))
- (= (nth 1 item) ind))
- (setq pos (nth 6 item)))
- pos))
- (end (progn (goto-char contents-end)
- (skip-chars-forward " \r\t\n" limit)
- (if (= (point) limit) limit (line-beginning-position)))))
- ;; Return value.
- (list 'plain-list
- (nconc
- (list :type type
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :structure struct
- :post-blank (count-lines contents-end end)
- :post-affiliated contents-begin)
- (cdr affiliated))))))
+ (list 'plain-list
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ struct (or structure (org-element--list-struct limit))
+ :type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
+ ((nth 5 (assq (point) struct)) 'descriptive)
+ (t 'unordered))
+ :contents-begin (point)
+ :begin (car affiliated)
+ :contents-end (let* ((item (assq contents-begin struct))
+ (ind (nth 1 item))
+ (pos (nth 6 item)))
+ (while (and (setq item (assq pos struct))
+ (= (nth 1 item) ind))
+ (setq pos (nth 6 item)))
+ pos)
+ :end (progn (goto-char contents-end)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (= (point) limit) limit (line-beginning-position)))
+ :structure struct
+ :post-blank (count-lines contents-end end)
+ :post-affiliated contents-begin))
+ (cdr affiliated))))
(defun org-element-plain-list-interpreter (_ contents)
"Interpret plain-list element as Org syntax.
@@ -1515,23 +1462,21 @@ containing `:begin', `:end', `:contents-begin', `:contents-end',
`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the property drawer."
- (save-excursion
- (let ((case-fold-search t)
- (begin (point))
- (contents-begin (line-beginning-position 2)))
- (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)
- (let ((contents-end (and (> (match-beginning 0) contents-begin)
- (match-beginning 0)))
- (before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'property-drawer
- (list :begin begin
- :end end
- :contents-begin (and contents-end contents-begin)
- :contents-end contents-end
- :post-blank (count-lines before-blank end)
- :post-affiliated begin))))))
+ (list 'property-drawer
+ (save-excursion
+ (org-prog-plist
+ case-fold-search t
+ :begin (point)
+ contents-begin (line-beginning-position 2)
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)
+ :contents-end (and (> (match-beginning 0) contents-begin)
+ (match-beginning 0))
+ before-blank (progn (forward-line) (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :contents-begin (and contents-end contents-begin)
+ :post-blank (count-lines before-blank end)
+ :post-affiliated begin))))
(defun org-element-property-drawer-interpreter (_ contents)
"Interpret property-drawer element as Org syntax.
@@ -1559,29 +1504,25 @@ Assume point is at the beginning of the block."
(re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((block-end-line (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- ;; Empty blocks have no contents.
- (contents-begin (progn (forward-line)
- (and (< (point) block-end-line)
- (point))))
- (contents-end (and contents-begin block-end-line))
- (pos-before-blank (progn (goto-char block-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'quote-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'quote-block
+ (nconc
+ (let ((block-end-line (match-beginning 0)))
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ ;; Empty blocks have no contents.
+ :contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point)))
+ :contents-end (and contents-begin block-end-line)
+ pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end))))
+ (cdr affiliated))))))
(defun org-element-quote-block-interpreter (_ contents)
"Interpret quote-block element as Org syntax.
@@ -1597,21 +1538,21 @@ CONTENTS is the contents of the element."
Return a list whose CAR is `section' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `contents-end',
`:post-blank' and `:post-affiliated' keywords."
- (save-excursion
- ;; Beginning of section is the beginning of the first non-blank
- ;; line after previous headline.
- (let ((begin (point))
- (end (progn (org-with-limited-levels (outline-next-heading))
- (point)))
- (pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- (list 'section
- (list :begin begin
- :end end
- :contents-begin begin
- :contents-end pos-before-blank
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated begin)))))
+ (list 'section
+ (save-excursion
+ (org-prog-plist
+ ;; Beginning of section is the beginning of the first non-blank
+ ;; line after previous headline
+ :begin (point)
+ :end (progn
+ (org-with-limited-levels (outline-next-heading))
+ (point))
+ pos-before-blank (progn (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ :contents-begin begin
+ :contents-end pos-before-blank
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated begin))))
(defun org-element-section-interpreter (_ contents)
"Interpret section element as Org syntax.
@@ -1644,29 +1585,25 @@ Assume point is at the beginning of the block."
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- ;; Empty blocks have no contents.
- (contents-begin (progn (forward-line)
- (and (< (point) block-end-line)
- (point))))
- (contents-end (and contents-begin block-end-line))
- (pos-before-blank (progn (goto-char block-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'special-block
- (nconc
- (list :type type
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'special-block
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :type type
+ :begin (car affiliated)
+ :post-affiliated (point)
+ ;; Empty blocks have no contents.
+ :contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point)))
+ :contents-end (and contents-begin block-end-line)
+ pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated)))))))
(defun org-element-special-block-interpreter (special-block contents)
"Interpret SPECIAL-BLOCK element as Org syntax.
@@ -1701,42 +1638,36 @@ Return a list whose car is `babel-call' and cdr is a plist
containing `:call', `:inside-header', `:arguments',
`:end-header', `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' as keywords."
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (before-blank (line-beginning-position 2))
- (value (progn (search-forward ":" before-blank t)
- (skip-chars-forward " \t")
- (org-trim
- (buffer-substring-no-properties
- (point) (line-end-position)))))
- (call
- (or (org-string-nw-p
- (buffer-substring-no-properties
- (point) (progn (skip-chars-forward "^[]()" before-blank)
- (point))))))
- (inside-header (org-element--parse-paired-brackets ?\[))
- (arguments (org-string-nw-p
- (org-element--parse-paired-brackets ?\()))
- (end-header
- (org-string-nw-p
- (org-trim
- (buffer-substring-no-properties (point) (line-end-position)))))
- (end (progn (forward-line)
- (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'babel-call
- (nconc
- (list :call call
- :inside-header inside-header
- :arguments arguments
- :end-header end-header
- :begin begin
- :end end
- :value value
- :post-blank (count-lines before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'babel-call
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ before-blank (line-beginning-position 2)
+ :value (progn (search-forward ":" before-blank t)
+ (skip-chars-forward " \t")
+ (org-trim
+ (buffer-substring-no-properties
+ (point) (line-end-position))))
+ :call
+ (or (org-string-nw-p
+ (buffer-substring-no-properties
+ (point) (progn (skip-chars-forward "^[]()" before-blank)
+ (point)))))
+ :inside-header (org-element--parse-paired-brackets ?\[)
+ :arguments (org-string-nw-p
+ (org-element--parse-paired-brackets ?\())
+ :end-header
+ (org-string-nw-p
+ (org-trim
+ (buffer-substring-no-properties (point) (line-end-position))))
+ :end (progn (forward-line)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point)
+ (line-beginning-position)))
+ :post-blank (count-lines before-blank end)))
+ (cdr affiliated))))
(defun org-element-babel-call-interpreter (babel-call _)
"Interpret BABEL-CALL element as Org syntax."
@@ -1759,31 +1690,26 @@ LIMIT bounds the search.
Return a list whose CAR is `clock' and CDR is a plist containing
`:status', `:value', `:time', `:begin', `:end', `:post-blank' and
`:post-affiliated' as keywords."
- (save-excursion
- (let* ((case-fold-search nil)
- (begin (point))
- (value (progn (search-forward "CLOCK:" (line-end-position) t)
- (skip-chars-forward " \t")
- (org-element-timestamp-parser)))
- (duration (and (search-forward " => " (line-end-position) t)
- (progn (skip-chars-forward " \t")
- (looking-at "\\(\\S-+\\)[ \t]*$"))
- (match-string-no-properties 1)))
- (status (if duration 'closed 'running))
- (post-blank (let ((before-blank (progn (forward-line) (point))))
- (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (unless (bolp) (end-of-line))
- (count-lines before-blank (point))))
- (end (point)))
- (list 'clock
- (list :status status
- :value value
- :duration duration
- :begin begin
- :end end
- :post-blank post-blank
- :post-affiliated begin)))))
+ (list 'clock
+ (save-excursion
+ (org-prog-plist
+ case-fold-search nil
+ :begin (point)
+ :value (progn (search-forward "CLOCK:" (line-end-position) t)
+ (skip-chars-forward " \t")
+ (org-element-timestamp-parser))
+ :duration (and (search-forward " => " (line-end-position) t)
+ (progn (skip-chars-forward " \t")
+ (looking-at "\\(\\S-+\\)[ \t]*$"))
+ (match-string-no-properties 1))
+ :status (if duration 'closed 'running)
+ :post-blank (let ((before-blank (progn (forward-line) (point))))
+ (skip-chars-forward " \r\t\n" limit)
+ (skip-chars-backward " \t")
+ (unless (bolp) (end-of-line))
+ (count-lines before-blank (point)))
+ :end (point)
+ :post-affiliated begin))))
(defun org-element-clock-interpreter (clock _)
"Interpret CLOCK element as Org syntax."
@@ -1810,13 +1736,15 @@ containing `:begin', `:end', `:value', `:post-blank',
`:post-affiliated' keywords.
Assume point is at comment beginning."
- (save-excursion
- (let* ((begin (point))
- (value (prog2 (looking-at "[ \t]*# ?")
- (buffer-substring-no-properties
- (match-end 0) (line-end-position))
- (forward-line)))
- (com-end
+ (list 'comment
+ (save-excursion
+ (org-prog-plist
+ :begin (point)
+ :value (prog2 (looking-at "[ \t]*# ?")
+ (buffer-substring-no-properties
+ (match-end 0) (line-end-position))
+ (forward-line))
+ com-end
;; Get comments ending.
(progn
(while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)"))
@@ -1828,16 +1756,12 @@ Assume point is at comment beginning."
(buffer-substring-no-properties
(match-end 0) (line-end-position))))
(forward-line))
- (point)))
- (end (progn (goto-char com-end)
- (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'comment
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines com-end end)
- :post-affiliated begin)))))
+ (point))
+ :end (progn (goto-char com-end)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines com-end end)
+ :post-affiliated begin))))
(defun org-element-comment-interpreter (comment _)
"Interpret COMMENT element as Org syntax.
@@ -1848,7 +1772,7 @@ CONTENTS is nil."
;;;; Comment Block
(defun org-element-comment-block-parser (limit affiliated)
- "Parse an export block.
+ "Parse a comment block.
LIMIT bounds the search. AFFILIATED is a list of which CAR is
the buffer position at the beginning of the first affiliated
@@ -1865,26 +1789,23 @@ Assume point is at comment block beginning."
(re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (progn (forward-line) (point)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (value (buffer-substring-no-properties
- contents-begin contents-end)))
- (list 'comment-block
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'comment-block
+ (nconc
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (org-prog-plist
+ :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)
+ :post-blank (count-lines pos-before-blank end))))
+ (cdr affiliated))))))
(defun org-element-comment-block-interpreter (comment-block _)
"Interpret COMMENT-BLOCK element as Org syntax."
@@ -1907,22 +1828,19 @@ their value.
Return a list whose CAR is `diary-sexp' and CDR is a plist
containing `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' keywords."
- (save-excursion
- (let ((begin (car affiliated))
- (post-affiliated (point))
- (value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
- (match-string-no-properties 1)))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'diary-sexp
- (nconc
- (list :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'diary-sexp
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ :value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
+ (match-string-no-properties 1))
+ pos-before-blank (progn (forward-line) (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))
(defun org-element-diary-sexp-interpreter (diary-sexp _)
"Interpret DIARY-SEXP as Org syntax."
@@ -1948,69 +1866,61 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((switches
- (progn
- (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
- (match-string-no-properties 1)))
- ;; Switches analysis.
- (number-lines
- (and switches
- (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
- switches)
- (cons
- (if (equal (match-string 1 switches) "-")
- 'new
- 'continued)
- (if (not (match-end 2)) 0
- ;; Subtract 1 to give number of lines before
- ;; first line.
- (1- (string-to-number (match-string 2 switches)))))))
- (preserve-indent
- (and switches (string-match "-i\\>" switches)))
- ;; Should labels be retained in (or stripped from) example
- ;; blocks?
- (retain-labels
- (or (not switches)
- (not (string-match "-r\\>" switches))
- (and number-lines (string-match "-k\\>" switches))))
- ;; What should code-references use - labels or
- ;; line-numbers?
- (use-labels
- (or (not switches)
- (and retain-labels
- (not (string-match "-k\\>" switches)))))
- (label-fmt
- (and switches
- (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
- ;; Standard block parsing.
- (begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (line-beginning-position 2))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'example-block
- (nconc
- (list :begin begin
- :end end
- :value value
- :switches switches
- :number-lines number-lines
- :preserve-indent preserve-indent
- :retain-labels retain-labels
- :use-labels use-labels
- :label-fmt label-fmt
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'example-block
+ (nconc
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (org-prog-plist
+ :switches
+ (progn
+ (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
+ (match-string-no-properties 1))
+ ;; Switches analysis.
+ :number-lines
+ (and switches
+ (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
+ switches)
+ (cons
+ (if (equal (match-string 1 switches) "-")
+ 'new
+ 'continued)
+ (if (not (match-end 2)) 0
+ ;; Subtract 1 to give number of lines before
+ ;; first line.
+ (1- (string-to-number (match-string 2 switches))))))
+ :preserve-indent
+ (and switches (string-match "-i\\>" switches))
+ ;; Should labels be retained in (or stripped from) example
+ ;; blocks?
+ :retain-labels
+ (or (not switches)
+ (not (string-match "-r\\>" switches))
+ (and number-lines (string-match "-k\\>" switches)))
+ ;; What should code-references use - labels or
+ ;; line-numbers?
+ :use-labels
+ (or (not switches)
+ (and retain-labels
+ (not (string-match "-k\\>" switches))))
+ :label-fmt
+ (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches))
+ ;; Standard block parsing.
+ :begin (car affiliated)
+ :post-affiliated (point)
+ contents-begin (line-beginning-position 2)
+ :value (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ contents-begin contents-end))
+ pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point)
+ (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end))))
+ (cdr affiliated))))))
(defun org-element-example-block-interpreter (example-block _)
"Interpret EXAMPLE-BLOCK element as Org syntax."
@@ -2053,33 +1963,30 @@ Assume point is at export-block beginning."
(re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (save-excursion
- (let* ((contents-end (match-beginning 0))
- (backend
- (progn
- (looking-at
- "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$")
- (match-string-no-properties 1)))
- (begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (progn (forward-line) (point)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties contents-begin
- contents-end))))
- (list 'export-block
- (nconc
- (list :type (and backend (upcase backend))
- :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (list 'export-block
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ 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))
+ :type (and backend (upcase backend))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))))
(defun org-element-export-block-interpreter (export-block _)
"Interpret EXPORT-BLOCK element as Org syntax."
@@ -2103,28 +2010,25 @@ containing `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' keywords.
Assume point is at the beginning of the fixed-width area."
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (end-area
- (progn
- (while (and (< (point) limit)
- (looking-at "[ \t]*:\\( \\|$\\)"))
- (forward-line))
- (if (bolp) (line-end-position 0) (point))))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'fixed-width
- (nconc
- (list :begin begin
- :end end
- :value (replace-regexp-in-string
- "^[ \t]*: ?" ""
- (buffer-substring-no-properties post-affiliated
- end-area))
- :post-blank (count-lines end-area end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'fixed-width
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ end-area (progn
+ (while (and (< (point) limit)
+ (looking-at "[ \t]*:\\( \\|$\\)"))
+ (forward-line))
+ (if (bolp) (line-end-position 0) (point)))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :value (replace-regexp-in-string
+ "^[ \t]*: ?" ""
+ (buffer-substring-no-properties post-affiliated
+ end-area))
+ :post-blank (count-lines end-area end)))
+ (cdr affiliated))))
(defun org-element-fixed-width-interpreter (fixed-width _)
"Interpret FIXED-WIDTH element as Org syntax."
@@ -2145,19 +2049,16 @@ their value.
Return a list whose CAR is `horizontal-rule' and CDR is a plist
containing `:begin', `:end', `:post-blank' and `:post-affiliated'
keywords."
- (save-excursion
- (let ((begin (car affiliated))
- (post-affiliated (point))
- (post-hr (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'horizontal-rule
- (nconc
- (list :begin begin
- :end end
- :post-blank (count-lines post-hr end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'horizontal-rule
+ (nconc (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ post-hr (progn (forward-line) (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines post-hr end)))
+ (cdr affiliated))))
(defun org-element-horizontal-rule-interpreter (&rest _)
"Interpret HORIZONTAL-RULE element as Org syntax."
@@ -2177,28 +2078,24 @@ their value.
Return a list whose CAR is a normalized `keyword' (uppercase) and
CDR is a plist containing `:key', `:value', `:begin', `:end',
`:post-blank' and `:post-affiliated' keywords."
- (save-excursion
- ;; An orphaned affiliated keyword is considered as a regular
- ;; keyword. In this case AFFILIATED is nil, so we take care of
- ;; this corner case.
- (let ((begin (or (car affiliated) (point)))
- (post-affiliated (point))
- (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):")
- (upcase (match-string-no-properties 1))))
- (value (org-trim (buffer-substring-no-properties
- (match-end 0) (point-at-eol))))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'keyword
- (nconc
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'keyword
+ (nconc
+ (save-excursion
+ ;; An orphaned affiliated keyword is considered as a regular
+ ;; keyword. In this case AFFILIATED is nil, so we take care of
+ ;; this corner case.
+ (org-prog-plist
+ :begin (or (car affiliated) (point))
+ :post-affiliated (point)
+ :key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):")
+ (upcase (match-string-no-properties 1)))
+ :value (org-trim (buffer-substring-no-properties
+ (match-end 0) (point-at-eol)))
+ pos-before-blank (progn (forward-line) (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))
(defun org-element-keyword-interpreter (keyword _)
"Interpret KEYWORD element as Org syntax."
@@ -2243,19 +2140,17 @@ Assume point is at the beginning of the latex environment."
limit t))
;; Incomplete latex environment: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let* ((code-end (progn (forward-line) (point)))
- (begin (car affiliated))
- (value (buffer-substring-no-properties code-begin code-end))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'latex-environment
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines code-end end)
- :post-affiliated code-begin)
- (cdr affiliated))))))))
+ (list 'latex-environment
+ (nconc
+ (org-prog-plist
+ code-end (progn (forward-line) (point))
+ :begin (car affiliated)
+ :value (buffer-substring-no-properties code-begin code-end)
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines code-end end)
+ :post-affiliated code-begin)
+ (cdr affiliated)))))))
(defun org-element-latex-environment-interpreter (latex-environment _)
"Interpret LATEX-ENVIRONMENT element as Org syntax."
@@ -2273,22 +2168,18 @@ Return a list whose CAR is `node-property' and CDR is a plist
containing `:key', `:value', `:begin', `:end', `:post-blank' and
`:post-affiliated' keywords."
(looking-at org-property-re)
- (let ((case-fold-search t)
- (begin (point))
- (key (match-string-no-properties 2))
- (value (match-string-no-properties 3))
- (end (save-excursion
- (end-of-line)
- (if (re-search-forward org-property-re limit t)
- (line-beginning-position)
- limit))))
- (list 'node-property
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank 0
- :post-affiliated begin))))
+ (list 'node-property
+ (org-prog-plist case-fold-search t
+ :begin (point)
+ :key (match-string-no-properties 2)
+ :value (match-string-no-properties 3)
+ :end (save-excursion
+ (end-of-line)
+ (if (re-search-forward org-property-re limit t)
+ (line-beginning-position)
+ limit))
+ :post-blank 0
+ :post-affiliated begin)))
(defun org-element-node-property-interpreter (node-property _)
"Interpret NODE-PROPERTY element as Org syntax."
@@ -2312,59 +2203,56 @@ containing `:begin', `:end', `:contents-begin' and
`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the paragraph."
- (save-excursion
- (let* ((begin (car affiliated))
- (contents-begin (point))
- (before-blank
- (let ((case-fold-search t))
- (end-of-line)
- ;; A matching `org-element-paragraph-separate' is not
- ;; necessarily the end of the paragraph. In particular,
- ;; drawers, blocks or LaTeX environments opening lines
- ;; must be closed. Moreover keywords with a secondary
- ;; value must belong to "dual keywords".
- (while (not
- (cond
- ((not (and (re-search-forward
- org-element-paragraph-separate limit 'move)
- (progn (beginning-of-line) t))))
- ((looking-at org-drawer-regexp)
- (save-excursion
- (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
- ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$"
- (regexp-quote (match-string 1)))
- limit t)))
- ((looking-at org-element--latex-begin-environment)
- (save-excursion
- (re-search-forward
- (format org-element--latex-end-environment
- (regexp-quote (match-string 1)))
- limit t)))
- ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:")
- (member-ignore-case (match-string 1)
- org-element-dual-keywords))
- ;; Everything else is unambiguous.
- (t)))
- (end-of-line))
- (if (= (point) limit) limit
- (goto-char (line-beginning-position)))))
- (contents-end (save-excursion
- (skip-chars-backward " \r\t\n" contents-begin)
- (line-beginning-position 2)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'paragraph
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines before-blank end)
- :post-affiliated contents-begin)
- (cdr affiliated))))))
+ (list 'paragraph
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :contents-begin (point)
+ before-blank
+ (let ((case-fold-search t))
+ (end-of-line)
+ ;; A matching `org-element-paragraph-separate' is not
+ ;; necessarily the end of the paragraph. In particular,
+ ;; drawers, blocks or LaTeX environments opening lines
+ ;; must be closed. Moreover keywords with a secondary
+ ;; value must belong to "dual keywords".
+ (while (not
+ (cond
+ ((not (and (re-search-forward
+ org-element-paragraph-separate limit 'move)
+ (progn (beginning-of-line) t))))
+ ((looking-at org-drawer-regexp)
+ (save-excursion
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
+ ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (save-excursion
+ (re-search-forward
+ (format "^[ \t]*#\\+END_%s[ \t]*$"
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at org-element--latex-begin-environment)
+ (save-excursion
+ (re-search-forward
+ (format org-element--latex-end-environment
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:")
+ (member-ignore-case (match-string 1)
+ org-element-dual-keywords))
+ ;; Everything else is unambiguous.
+ (t)))
+ (end-of-line))
+ (if (= (point) limit) limit
+ (goto-char (line-beginning-position))))
+ :contents-end (save-excursion
+ (skip-chars-backward " \r\t\n" contents-begin)
+ (line-beginning-position 2))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines before-blank end)
+ :post-affiliated contents-begin))
+ (cdr affiliated))))
(defun org-element-paragraph-interpreter (_ contents)
"Interpret paragraph element as Org syntax.
@@ -2383,32 +2271,27 @@ Return a list whose CAR is `planning' and CDR is a plist
containing `:closed', `:deadline', `:scheduled', `:begin',
`:end', `:post-blank' and `:post-affiliated' keywords."
(save-excursion
- (let* ((case-fold-search nil)
- (begin (point))
- (post-blank (let ((before-blank (progn (forward-line) (point))))
- (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (unless (bolp) (end-of-line))
- (count-lines before-blank (point))))
- (end (point))
- closed deadline scheduled)
- (goto-char begin)
- (while (re-search-forward org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
- (skip-chars-forward " \t" end)
- (let ((keyword (match-string 1))
- (time (org-element-timestamp-parser)))
- (cond ((equal keyword org-closed-string) (setq closed time))
- ((equal keyword org-deadline-string) (setq deadline time))
- (t (setq scheduled time)))))
- (list 'planning
- (list :closed closed
- :deadline deadline
- :scheduled scheduled
- :begin begin
- :end end
- :post-blank post-blank
- :post-affiliated begin)))))
+ (list 'planning
+ (org-prog-plist
+ case-fold-search nil
+ :begin (point)
+ :post-blank (let ((before-blank (progn (forward-line) (point))))
+ (skip-chars-forward " \r\t\n" limit)
+ (skip-chars-backward " \t")
+ (unless (bolp) (end-of-line))
+ (count-lines before-blank (point)))
+ :end (point)
+ :closed nil :deadline nil :scheduled nil
+ (goto-char begin)
+ (while (re-search-forward org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t" end)
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-closed-string) (setq closed time))
+ ((equal keyword org-deadline-string) (setq deadline time))
+ (t (setq scheduled time)))))
+ :post-affiliated begin))))
(defun org-element-planning-interpreter (planning _)
"Interpret PLANNING element as Org syntax."
@@ -2452,82 +2335,75 @@ Assume point is at the beginning of the block."
limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- ;; Get language as a string.
- (language
- (progn
- (looking-at
- "^[ \t]*#\\+BEGIN_SRC\
+ (list 'src-block
+ (nconc
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ ;; Get language as a string.
+ :language
+ (progn
+ (looking-at
+ "^[ \t]*#\\+BEGIN_SRC\
\\(?: +\\(\\S-+\\)\\)?\
\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\
\\(.*\\)[ \t]*$")
- (match-string-no-properties 1)))
- ;; Get switches.
- (switches (match-string-no-properties 2))
- ;; Get parameters.
- (parameters (match-string-no-properties 3))
- ;; Switches analysis.
- (number-lines
- (and switches
- (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
- switches)
- (cons
- (if (equal (match-string 1 switches) "-")
- 'new
- 'continued)
- (if (not (match-end 2)) 0
- ;; Subtract 1 to give number of lines before
- ;; first line.
- (1- (string-to-number (match-string 2 switches)))))))
- (preserve-indent (and switches
- (string-match "-i\\>" switches)))
- (label-fmt
- (and switches
- (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
- ;; Should labels be retained in (or stripped from)
- ;; source blocks?
- (retain-labels
- (or (not switches)
- (not (string-match "-r\\>" switches))
- (and number-lines (string-match "-k\\>" switches))))
- ;; What should code-references use - labels or
- ;; line-numbers?
- (use-labels
- (or (not switches)
- (and retain-labels
- (not (string-match "-k\\>" switches)))))
- ;; Retrieve code.
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- (line-beginning-position 2) contents-end)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- ;; Get position after ending blank lines.
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'src-block
- (nconc
- (list :language language
- :switches (and (org-string-nw-p switches)
- (org-trim switches))
- :parameters (and (org-string-nw-p parameters)
- (org-trim parameters))
- :begin begin
- :end end
- :number-lines number-lines
- :preserve-indent preserve-indent
- :retain-labels retain-labels
- :use-labels use-labels
- :label-fmt label-fmt
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (match-string-no-properties 1))
+ ;; Get switches.
+ switches (match-string-no-properties 2)
+ ;; Get parameters.
+ parameters (match-string-no-properties 3)
+ ;; Switches analysis.
+ :number-lines
+ (and switches
+ (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
+ switches)
+ (cons
+ (if (equal (match-string 1 switches) "-")
+ 'new
+ 'continued)
+ (if (not (match-end 2)) 0
+ ;; Subtract 1 to give number of lines before
+ ;; first line.
+ (1- (string-to-number (match-string 2 switches))))))
+ :preserve-indent (and switches
+ (string-match "-i\\>" switches))
+ :label-fmt
+ (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches))
+ ;; Should labels be retained in (or stripped from)
+ ;; source blocks?
+ :retain-labels
+ (or (not switches)
+ (not (string-match "-r\\>" switches))
+ (and number-lines (string-match "-k\\>" switches)))
+ ;; What should code-references use - labels or
+ ;; line-numbers?
+ :use-labels
+ (or (not switches)
+ (and retain-labels
+ (not (string-match "-k\\>" switches))))
+ ;; Retrieve code.
+ :value (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ (line-beginning-position 2) contents-end))
+ pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point))
+ ;; Get position after ending blank lines.
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point)
+ (line-beginning-position)))
+ ;; Update switches and parameters
+ :switches (and (org-string-nw-p switches)
+ (org-trim switches))
+ :parameters (and (org-string-nw-p parameters)
+ (org-trim parameters))
+ :post-blank (count-lines pos-before-blank end))))
+ (cdr affiliated))))))
(defun org-element-src-block-interpreter (src-block _)
"Interpret SRC-BLOCK element as Org syntax."
@@ -2570,42 +2446,37 @@ Return a list whose CAR is `table' and CDR is a plist containing
keywords.
Assume point is at the beginning of the table."
- (save-excursion
- (let* ((case-fold-search t)
- (table-begin (point))
- (type (if (looking-at "[ \t]*|") 'org 'table.el))
- (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
- (if (eq type 'org) "" "+")))
- (begin (car affiliated))
- (table-end
- (if (re-search-forward end-re limit 'move)
- (goto-char (match-beginning 0))
- (point)))
- (tblfm (let (acc)
- (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
- (push (match-string-no-properties 1) acc)
- (forward-line))
- acc))
- (pos-before-blank (point))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'table
- (nconc
- (list :begin begin
- :end end
- :type type
- :tblfm tblfm
- ;; Only `org' tables have contents. `table.el' tables
- ;; use a `:value' property to store raw table as
- ;; a string.
- :contents-begin (and (eq type 'org) table-begin)
- :contents-end (and (eq type 'org) table-end)
- :value (and (eq type 'table.el)
- (buffer-substring-no-properties
- table-begin table-end))
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated table-begin)
- (cdr affiliated))))))
+ (list 'table
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ case-fold-search t
+ table-begin (point)
+ :type (if (looking-at "[ \t]*|") 'org 'table.el)
+ end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
+ (if (eq type 'org) "" "+"))
+ :begin (car affiliated)
+ table-end (if (re-search-forward end-re limit 'move)
+ (goto-char (match-beginning 0))
+ (point))
+ :tblfm (let (acc)
+ (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
+ (push (match-string-no-properties 1) acc)
+ (forward-line))
+ acc)
+ pos-before-blank (point)
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ ;; Only `org' tables have contents. `table.el' tables
+ ;; use a `:value' property to store raw table as
+ ;; a string.
+ :contents-begin (and (eq type 'org) table-begin)
+ :contents-end (and (eq type 'org) table-end)
+ :value (and (eq type 'table.el)
+ (buffer-substring-no-properties table-begin table-end))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated table-begin))
+ (cdr affiliated))))
(defun org-element-table-interpreter (table contents)
"Interpret TABLE element as Org syntax.
@@ -2628,26 +2499,21 @@ CONTENTS is a string, if table's type is `org', or nil."
Return a list whose CAR is `table-row' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
`:type', `:post-blank' and `:post-affiliated' keywords."
- (save-excursion
- (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
- (begin (point))
- ;; A table rule has no contents. In that case, ensure
- ;; CONTENTS-BEGIN matches CONTENTS-END.
- (contents-begin (and (eq type 'standard) (search-forward "|")))
- (contents-end (and (eq type 'standard)
- (progn
- (end-of-line)
- (skip-chars-backward " \t")
- (point))))
- (end (line-beginning-position 2)))
- (list 'table-row
- (list :type type
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank 0
- :post-affiliated begin)))))
+ (list 'table-row
+ (save-excursion
+ (org-prog-plist
+ :type (if (looking-at "^[ \t]*|-") 'rule 'standard)
+ :begin (point)
+ ;; A table rule has no contents. In that case, ensure
+ ;; CONTENTS-BEGIN matches CONTENTS-END.
+ :contents-begin (and (eq type 'standard) (search-forward "|"))
+ :contents-end (and (eq type 'standard)
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ :end (line-beginning-position 2)
+ :post-blank 0
+ :post-affiliated begin))))
(defun org-element-table-row-interpreter (table-row contents)
"Interpret TABLE-ROW element as Org syntax.
@@ -2676,25 +2542,21 @@ Assume point is at beginning of the block."
(re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (progn (forward-line) (point)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'verse-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'verse-block
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ :contents-begin (progn (forward-line) (point))
+ :contents-end (match-beginning 0)
+ 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)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))))
(defun org-element-verse-block-interpreter (_ contents)
"Interpret verse-block element as Org syntax.
@@ -2732,18 +2594,12 @@ Assume point is at the first star marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'bold
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'bold (list :begin (match-beginning 2)
+ :contents-begin (match-beginning 4)
+ :contents-end (match-end 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-bold-interpreter (_ contents)
"Interpret bold object as Org syntax.
@@ -2764,16 +2620,11 @@ Assume point is at the first tilde marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-verbatim-re)
- (let ((begin (match-beginning 2))
- (value (match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'code
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (list 'code (list :value (match-string-no-properties 4)
+ :begin (match-beginning 2)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-code-interpreter (code _)
"Interpret CODE object as Org syntax."
@@ -2793,27 +2644,25 @@ a plist with `:begin', `:end', `:latex', `:latex-math-p',
Assume point is at the beginning of the entity."
(catch 'no-object
(when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)")
- (save-excursion
- (let* ((value (or (org-entity-get (match-string 1))
- (throw 'no-object nil)))
- (begin (match-beginning 0))
- (bracketsp (string= (match-string 2) "{}"))
- (post-blank (progn (goto-char (match-end 1))
- (when bracketsp (forward-char 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'entity
- (list :name (car value)
- :latex (nth 1 value)
- :latex-math-p (nth 2 value)
- :html (nth 3 value)
- :ascii (nth 4 value)
- :latin1 (nth 5 value)
- :utf-8 (nth 6 value)
- :begin begin
- :end end
- :use-brackets-p bracketsp
- :post-blank post-blank)))))))
+ (list 'entity
+ (save-excursion
+ (org-prog-plist
+ value (or (org-entity-get (match-string 1))
+ (throw 'no-object nil))
+ :begin (match-beginning 0)
+ bracketsp (string= (match-string 2) "{}")
+ :post-blank (progn (goto-char (match-end 1))
+ (when bracketsp (forward-char 2))
+ (skip-chars-forward " \t"))
+ :end (point)
+ :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :use-brackets-p bracketsp))))))
(defun org-element-entity-interpreter (entity _)
"Interpret ENTITY object as Org syntax."
@@ -2840,18 +2689,12 @@ Assume point is at the beginning of the snippet."
(save-match-data (goto-char (match-end 0))
(re-search-forward "@@" nil t)
(match-beginning 0))))
- (let* ((begin (match-beginning 0))
- (back-end (match-string-no-properties 1))
- (value (buffer-substring-no-properties
- (match-end 0) contents-end))
- (post-blank (skip-chars-forward " \t"))
- (end (point)))
- (list 'export-snippet
- (list :back-end back-end
- :value value
- :begin begin
- :end end
- :post-blank post-blank)))))))
+ (list 'export-snippet (list :begin (match-beginning 0)
+ :back-end (match-string-no-properties 1)
+ :value (buffer-substring-no-properties
+ (match-end 0) contents-end)
+ :post-blank (skip-chars-forward " \t")
+ :end (point)))))))
(defun org-element-export-snippet-interpreter (export-snippet _)
"Interpret EXPORT-SNIPPET object as Org syntax."
@@ -2873,23 +2716,19 @@ When at a footnote reference, return a list whose car is
(let ((closing (with-syntax-table org-element--pair-square-table
(ignore-errors (scan-lists (point) 1 0)))))
(when closing
- (save-excursion
- (let* ((begin (point))
- (label (match-string-no-properties 1))
- (inner-begin (match-end 0))
- (inner-end (1- closing))
- (type (if (match-end 2) 'inline 'standard))
- (post-blank (progn (goto-char closing)
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'footnote-reference
- (list :label label
- :type type
- :begin begin
- :end end
- :contents-begin (and (eq type 'inline) inner-begin)
- :contents-end (and (eq type 'inline) inner-end)
- :post-blank post-blank))))))))
+ (list 'footnote-reference
+ (save-excursion
+ (org-prog-plist
+ :label (match-string-no-properties 1)
+ :begin (point)
+ 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)
+ :contents-begin (and (eq type 'inline) inner-begin)
+ :contents-end (and (eq type 'inline) inner-end))))))))
(defun org-element-footnote-reference-interpreter (footnote-reference contents)
"Interpret FOOTNOTE-REFERENCE object as Org syntax.
@@ -2915,32 +2754,25 @@ Assume point is at the beginning of the babel call."
(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)))))))
+ (list 'inline-babel-call
+ (org-prog-plist
+ :call (match-string-no-properties 1)
+ :begin (match-beginning 0)
+ p (org-element--parse-paired-brackets ?\[)
+ :inside-header
+ (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)))
+ p (org-element--parse-paired-brackets ?\[)
+ :end-header
+ (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)))))))
(defun org-element-inline-babel-call-interpreter (inline-babel-call _)
"Interpret INLINE-BABEL-CALL object as Org syntax."
@@ -2969,22 +2801,18 @@ Assume point is at the beginning of the inline source block."
(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)))))))
+ (list 'inline-src-block
+ (org-prog-plist
+ :begin (match-beginning 0)
+ :language (match-string-no-properties 1)
+ p (org-element--parse-paired-brackets ?\[)
+ :parameters
+ (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")
+ :end (point)))))))
(defun org-element-inline-src-block-interpreter (inline-src-block _)
"Interpret INLINE-SRC-BLOCK object as Org syntax."
@@ -3010,18 +2838,12 @@ Assume point is at the first slash marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'italic
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'italic (list :begin (match-beginning 2)
+ :contents-begin (match-beginning 4)
+ :contents-end (match-end 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-italic-interpreter (_ contents)
"Interpret italic object as Org syntax.
@@ -3041,8 +2863,10 @@ and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the LaTeX fragment."
(catch 'no-object
(save-excursion
- (let* ((begin (point))
- (after-fragment
+ (list 'latex-frament
+ (org-prog-plist
+ :begin (point)
+ after-fragment
(cond
((not (eq ?$ (char-after)))
(pcase (char-after (1+ (point)))
@@ -3055,26 +2879,21 @@ Assume point is at the beginning of the LaTeX fragment."
(match-end 0)))))
((eq ?$ (char-after (1+ (point))))
(search-forward "$$" nil t 2))
- (t
- (and (not (eq ?$ (char-before)))
- (not (memq (char-after (1+ (point)))
- '(?\s ?\t ?\n ?, ?. ?\;)))
- (search-forward "$" nil t 2)
- (not (memq (char-before (match-beginning 0))
- '(?\s ?\t ?\n ?, ?.)))
- (looking-at-p
- "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)")
- (point)))))
- (post-blank
- (if (not after-fragment) (throw 'no-object nil)
- (goto-char after-fragment)
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'latex-fragment
- (list :value (buffer-substring-no-properties begin after-fragment)
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (t (and (not (eq ?$ (char-before)))
+ (not (memq (char-after (1+ (point)))
+ '(?\s ?\t ?\n ?, ?. ?\;)))
+ (search-forward "$" nil t 2)
+ (not (memq (char-before (match-beginning 0))
+ '(?\s ?\t ?\n ?, ?.)))
+ (looking-at-p
+ "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)")
+ (point))))
+ :post-blank (if (not after-fragment) (throw 'no-object nil)
+ (goto-char after-fragment)
+ (skip-chars-forward " \t"))
+ :end (point)
+ :value (buffer-substring-no-properties
+ begin after-fragment))))))
(defun org-element-latex-fragment-interpreter (latex-fragment _)
"Interpret LATEX-FRAGMENT object as Org syntax."
@@ -3115,123 +2934,115 @@ 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 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")
- (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. [[https://orgmode.org][homepage]]
- ((looking-at org-link-bracket-re)
- (setq format 'bracket)
- (setq contents-begin (match-beginning 2))
- (setq contents-end (match-end 2))
- (setq link-end (match-end 0))
- ;; RAW-LINK is the original link. Decode any encoding.
- ;; Expand any abbreviation in it.
- ;;
- ;; Also treat any newline character and associated
- ;; indentation as a single space character. This is not
- ;; compatible with RFC 3986, which requires to ignore
- ;; them altogether. However, doing so would require
- ;; users to encode spaces on the fly when writing links
- ;; (e.g., insert [[shell:ls%20*.org]] instead of
- ;; [[shell:ls *.org]], which defeats Org's focus on
- ;; simplicity.
- (setq raw-link (org-link-expand-abbrev
- (org-link-unescape
- (replace-regexp-in-string
- "[ \t]*\n[ \t]*" " "
- (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.
- (cond
- ;; File type.
- ((or (file-name-absolute-p raw-link)
- (string-match "\\`\\.\\.?/" raw-link))
- (setq type "file")
- (setq path raw-link))
- ;; 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))))
- ;; Code-ref type: PATH is the name of the reference.
- ((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.
- ((= (string-to-char raw-link) ?#)
- (setq type "custom-id")
- (setq path (substring raw-link 1)))
- ;; Fuzzy type: Internal link either matches a target, an
- ;; headline name or nothing. PATH is the target or
- ;; headline's name.
- (t
- (setq type "fuzzy")
- (setq path raw-link))))
- ;; Type 3: Plain link, e.g., https://orgmode.org
- ((looking-at org-link-plain-re)
- (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., <https://orgmode.org>. Unlike to
- ;; bracket links, follow RFC 3986 and remove any extra
- ;; whitespace in URI.
- ((looking-at org-link-angle-re)
- (setq format 'angle)
- (setq type (match-string-no-properties 1))
- (setq link-end (match-end 0))
- (setq raw-link
- (buffer-substring-no-properties
- (match-beginning 1) (match-end 2)))
- (setq path (replace-regexp-in-string
- "[ \t]*\n[ \t]*" "" (match-string-no-properties 2))))
- (t (throw 'no-object nil)))
- ;; In any case, deduce end point after trailing white space from
- ;; LINK-END variable.
- (save-excursion
- (setq post-blank
- (progn (goto-char link-end) (skip-chars-forward " \t")))
- (setq end (point)))
- ;; Special "file"-type link processing. Extract opening
- ;; application and search option, if any. Also normalize URI.
- (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
- (setq application (match-string 1 type))
- (setq type "file")
- (when (string-match "::\\(.*\\)\\'" path)
- (setq search-option (match-string 1 path))
- (setq path (replace-match "" nil nil path)))
- (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path)))
- ;; Translate link, if `org-link-translation-function' is set.
- (let ((trans (and (functionp org-link-translation-function)
- (funcall org-link-translation-function type path))))
- (when trans
- (setq type (car trans))
- (setq path (cdr trans))))
- (list 'link
- (list :type type
- :path path
- :format format
- :raw-link (or raw-link path)
- :application application
- :search-option search-option
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (list 'link
+ (org-prog-plist
+ :begin (point)
+ :end nil :contents-begin nil :contents-end nil
+ :link-end nil :post-blank nil :path nil :type nil :format nil
+ raw-link nil
+ :search-option nil :application nil
+ (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")
+ (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. [[https://orgmode.org][homepage]]
+ ((looking-at org-link-bracket-re)
+ (setq format 'bracket)
+ (setq contents-begin (match-beginning 2))
+ (setq contents-end (match-end 2))
+ (setq link-end (match-end 0))
+ ;; RAW-LINK is the original link. Decode any encoding.
+ ;; Expand any abbreviation in it.
+ ;;
+ ;; Also treat any newline character and associated
+ ;; indentation as a single space character. This is not
+ ;; compatible with RFC 3986, which requires to ignore
+ ;; them altogether. However, doing so would require
+ ;; users to encode spaces on the fly when writing links
+ ;; (e.g., insert [[shell:ls%20*.org]] instead of
+ ;; [[shell:ls *.org]], which defeats Org's focus on
+ ;; simplicity.
+ (setq raw-link (org-link-expand-abbrev
+ (org-link-unescape
+ (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" " "
+ (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.
+ (cond
+ ;; File type.
+ ((or (file-name-absolute-p raw-link)
+ (string-match "\\`\\.\\.?/" raw-link))
+ (setq type "file")
+ (setq path raw-link))
+ ;; 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))))
+ ;; Code-ref type: PATH is the name of the reference.
+ ((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.
+ ((= (string-to-char raw-link) ?#)
+ (setq type "custom-id")
+ (setq path (substring raw-link 1)))
+ ;; Fuzzy type: Internal link either matches a target, an
+ ;; headline name or nothing. PATH is the target or
+ ;; headline's name.
+ (t
+ (setq type "fuzzy")
+ (setq path raw-link))))
+ ;; Type 3: Plain link, e.g., https://orgmode.org
+ ((looking-at org-link-plain-re)
+ (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., <https://orgmode.org>. Unlike to
+ ;; bracket links, follow RFC 3986 and remove any extra
+ ;; whitespace in URI.
+ ((looking-at org-link-angle-re)
+ (setq format 'angle)
+ (setq type (match-string-no-properties 1))
+ (setq link-end (match-end 0))
+ (setq raw-link
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 2)))
+ (setq path (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" "" (match-string-no-properties 2))))
+ (t (throw 'no-object nil)))
+ ;; In any case, deduce end point after trailing white space from
+ ;; LINK-END variable.
+ (save-excursion
+ (setq post-blank
+ (progn (goto-char link-end) (skip-chars-forward " \t")))
+ (setq end (point)))
+ ;; Special "file" type link processing. Extract opening
+ ;; application and search option, if any. Also normalize URI.
+ (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
+ (setq application (match-string 1 type) type "file")
+ (when (string-match "::\\(.*\\)\\'" path)
+ (setq search-option (match-string 1 path))
+ (setq path (replace-match "" nil nil path)))
+ (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path)))
+ ;; Translate link, if `org-link-translation-function' is set.
+ (let ((trans (and (functionp org-link-translation-function)
+ (funcall org-link-translation-function type path))))
+ (when trans
+ (setq type (car trans))
+ (setq path (cdr trans))))
+ :raw-link (or raw-link path)))))
(defun org-element-link-interpreter (link contents)
"Interpret LINK object as Org syntax.
@@ -3285,24 +3096,18 @@ a plist with `:key', `:args', `:begin', `:end', `:value' and
Assume point is at the macro."
(save-excursion
(when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}")
- (let ((begin (point))
- (key (downcase (match-string-no-properties 1)))
- (value (match-string-no-properties 0))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (args (pcase (match-string-no-properties 3)
- (`nil nil)
- (a (org-macro-extract-arguments
- (replace-regexp-in-string
- "[ \t\r\n]+" " " (org-trim a)))))))
- (list 'macro
- (list :key key
- :value value
- :args args
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (list 'macro
+ (list :begin (point)
+ :key (downcase (match-string-no-properties 1))
+ :value (match-string-no-properties 0)
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point)
+ :args (pcase (match-string-no-properties 3)
+ (`nil nil)
+ (a (org-macro-extract-arguments
+ (replace-regexp-in-string
+ "[ \t\r\n]+" " " (org-trim a))))))))))
(defun org-element-macro-interpreter (macro _)
"Interpret MACRO object as Org syntax."
@@ -3326,20 +3131,14 @@ Otherwise, return nil.
Assume point is at the radio target."
(save-excursion
(when (looking-at org-radio-target-regexp)
- (let ((begin (point))
- (contents-begin (match-beginning 1))
- (contents-end (match-end 1))
- (value (match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'radio-target
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank
- :value value))))))
+ (list 'radio-target
+ (list :begin (point)
+ :contents-begin (match-beginning 1)
+ :contents-end (match-end 1)
+ :value (match-string-no-properties 1)
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-radio-target-interpreter (_ contents)
"Interpret target object as Org syntax.
@@ -3359,17 +3158,13 @@ When at a statistics cookie, return a list whose car is
Assume point is at the beginning of the statistics-cookie."
(save-excursion
(when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
- (let* ((begin (point))
- (value (buffer-substring-no-properties
- (match-beginning 0) (match-end 0)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'statistics-cookie
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank))))))
+ (list 'statistics-cookie
+ (list :begin (point)
+ :value (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0))
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-statistics-cookie-interpreter (statistics-cookie _)
"Interpret STATISTICS-COOKIE object as Org syntax."
@@ -3390,18 +3185,13 @@ Assume point is at the first plus sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'strike-through
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'strike-through
+ (list :begin (match-beginning 2)
+ :contents-begin (match-beginning 4)
+ :contents-end (match-end 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-strike-through-interpreter (_ contents)
"Interpret strike-through object as Org syntax.
@@ -3423,21 +3213,14 @@ Assume point is at the underscore."
(save-excursion
(unless (bolp) (backward-char))
(when (looking-at org-match-substring-regexp)
- (let ((bracketsp (match-beginning 4))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 4)
- (match-beginning 3)))
- (contents-end (or (match-end 4) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'subscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'subscript
+ (list :use-brackets-p (match-beginning 4)
+ :begin (match-beginning 2)
+ :contents-begin (or (match-beginning 4) (match-beginning 3))
+ :contents-end (or (match-end 4) (match-end 3))
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-subscript-interpreter (subscript contents)
"Interpret SUBSCRIPT object as Org syntax.
@@ -3461,21 +3244,14 @@ Assume point is at the caret."
(save-excursion
(unless (bolp) (backward-char))
(when (looking-at org-match-substring-regexp)
- (let ((bracketsp (match-beginning 4))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 4)
- (match-beginning 3)))
- (contents-end (or (match-end 4) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'superscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'superscript
+ (list :use-brackets-p (match-beginning 4)
+ :begin (match-beginning 2)
+ :contents-begin (or (match-beginning 4) (match-beginning 3))
+ :contents-end (or (match-end 4) (match-end 3))
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-superscript-interpreter (superscript contents)
"Interpret SUPERSCRIPT object as Org syntax.
@@ -3493,16 +3269,11 @@ Return a list whose car is `table-cell' and cdr is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end'
and `:post-blank' keywords."
(looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
- (let* ((begin (match-beginning 0))
- (end (match-end 0))
- (contents-begin (match-beginning 1))
- (contents-end (match-end 1)))
- (list 'table-cell
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank 0))))
+ (list 'table-cell (list :begin (match-beginning 0)
+ :end (match-end 0)
+ :contents-begin (match-beginning 1)
+ :contents-end (match-end 1)
+ :post-blank 0)))
(defun org-element-table-cell-interpreter (_ contents)
"Interpret table-cell element as Org syntax.
@@ -3522,16 +3293,11 @@ keywords. Otherwise, return nil.
Assume point is at the target."
(save-excursion
(when (looking-at org-target-regexp)
- (let ((begin (point))
- (value (match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'target
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank))))))
+ (list 'target (list :begin (point)
+ :value (match-string-no-properties 1)
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-target-interpreter (target _)
"Interpret TARGET object as Org syntax."
@@ -3563,91 +3329,76 @@ Otherwise, return nil.
Assume point is at the beginning of the timestamp."
(when (looking-at-p org-element--timestamp-regexp)
(save-excursion
- (let* ((begin (point))
- (activep (eq (char-after) ?<))
- (raw-value
- (progn
- (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
- (match-string-no-properties 0)))
- (date-start (match-string-no-properties 1))
- (date-end (match-string 3))
- (diaryp (match-beginning 2))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (time-range
- (and (not diaryp)
- (string-match
- "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
- date-start)
- (cons (string-to-number (match-string 2 date-start))
- (string-to-number (match-string 3 date-start)))))
- (type (cond (diaryp 'diary)
- ((and activep (or date-end time-range)) 'active-range)
- (activep 'active)
- ((or date-end time-range) 'inactive-range)
- (t 'inactive)))
- (repeater-props
- (and (not diaryp)
- (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
- raw-value)
- (list
- :repeater-type
- (let ((type (match-string 1 raw-value)))
- (cond ((equal "++" type) 'catch-up)
- ((equal ".+" type) 'restart)
- (t 'cumulate)))
- :repeater-value (string-to-number (match-string 2 raw-value))
- :repeater-unit
- (pcase (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
- (warning-props
- (and (not diaryp)
- (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
- (list
- :warning-type (if (match-string 1 raw-value) 'first 'all)
- :warning-value (string-to-number (match-string 2 raw-value))
- :warning-unit
- (pcase (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
- year-start month-start day-start hour-start minute-start year-end
- month-end day-end hour-end minute-end)
- ;; Parse date-start.
- (unless diaryp
- (let ((date (org-parse-time-string date-start t)))
- (setq year-start (nth 5 date)
- month-start (nth 4 date)
- day-start (nth 3 date)
- hour-start (nth 2 date)
- minute-start (nth 1 date))))
- ;; Compute date-end. It can be provided directly in time-stamp,
- ;; or extracted from time range. Otherwise, it defaults to the
- ;; same values as date-start.
- (unless diaryp
- (let ((date (and date-end (org-parse-time-string date-end t))))
- (setq year-end (or (nth 5 date) year-start)
- month-end (or (nth 4 date) month-start)
- day-end (or (nth 3 date) day-start)
- hour-end (or (nth 2 date) (car time-range) hour-start)
- minute-end (or (nth 1 date) (cdr time-range) minute-start))))
- (list 'timestamp
- (nconc (list :type type
- :raw-value raw-value
- :year-start year-start
- :month-start month-start
- :day-start day-start
- :hour-start hour-start
- :minute-start minute-start
- :year-end year-end
- :month-end month-end
- :day-end day-end
- :hour-end hour-end
- :minute-end minute-end
- :begin begin
- :end end
- :post-blank post-blank)
- repeater-props
- warning-props))))))
+ (org-let*-prog-plist
+ (plist
+ :begin (point)
+ activep (eq (char-after) ?<)
+ :raw-value
+ (progn
+ (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (match-string-no-properties 0))
+ date-start (match-string-no-properties 1)
+ date-end (match-string 3)
+ diaryp (match-beginning 2)
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point)
+ time-range
+ (and (not diaryp)
+ (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start))))
+ :type (cond (diaryp 'diary)
+ ((and activep (or date-end time-range)) 'active-range)
+ (activep 'active)
+ ((or date-end time-range) 'inactive-range)
+ (t 'inactive))
+ repeater-props
+ (and (not diaryp)
+ (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
+ raw-value)
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (t 'cumulate)))
+ :repeater-value (string-to-number (match-string 2 raw-value))
+ :repeater-unit
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))
+ warning-props
+ (and (not diaryp)
+ (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
+ (list
+ :warning-type (if (match-string 1 raw-value) 'first 'all)
+ :warning-value (string-to-number (match-string 2 raw-value))
+ :warning-unit
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))
+ :year-start nil :month-start nil :day-start nil :hour-start nil :minute-start nil
+ :year-end nil :month-end nil :day-end nil :hour-end nil :minute-end nil
+ ;; Parse date-start.
+ (unless diaryp
+ (let ((date (org-parse-time-string date-start t)))
+ (setq year-start (nth 5 date)
+ month-start (nth 4 date)
+ day-start (nth 3 date)
+ hour-start (nth 2 date)
+ minute-start (nth 1 date))))
+ ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; or extracted from time range. Otherwise, it defaults to the
+ ;; same values as date-start.
+ (unless diaryp
+ (let ((date (and date-end (org-parse-time-string date-end t))))
+ (setq year-end (or (nth 5 date) year-start)
+ month-end (or (nth 4 date) month-start)
+ day-end (or (nth 3 date) day-start)
+ hour-end (or (nth 2 date) (car time-range) hour-start)
+ minute-end (or (nth 1 date) (cdr time-range) minute-start)))))
+ (list 'timestamp (nconc plist repeater-props warning-props))))))
(defun org-element-timestamp-interpreter (timestamp _)
"Interpret TIMESTAMP object as Org syntax."
@@ -3758,18 +3509,12 @@ Assume point is at the first underscore marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'underline
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'underline (list :begin (match-beginning 2)
+ :contents-begin (match-beginning 4)
+ :contents-end (match-end 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-underline-interpreter (_ contents)
"Interpret underline object as Org syntax.
@@ -3790,16 +3535,11 @@ Assume point is at the first equal sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-verbatim-re)
- (let ((begin (match-beginning 2))
- (value (match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'verbatim
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (list 'verbatim (list :begin (match-beginning 2)
+ :value (match-string-no-properties 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-verbatim-interpreter (verbatim _)
"Interpret VERBATIM object as Org syntax."
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index f25efe07f..077601b6b 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -33,6 +33,8 @@
(require 'cl-lib)
(require 'format-spec)
+(eval-when-compile (require 'cl-macs))
+(require 'cl-seq) ; cl-reduce
(declare-function org-show-context "org" (&optional key))
(declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
@@ -49,6 +51,263 @@
symbols)
,@body))
+(when (version< emacs-version "28")
+ ;; Should be removed once Org drops support for Emacs 27 and older.
+ ;; `keyword' type is provided natively in `cl-macs' since 2020-07-06
+ (cl-deftype keyword () '(satisfies keywordp)))
+
+(eval-when-compile
+ (defun org-dekeyword (symbol)
+ ;; There is nothing org-specific about this definition. It better be moved.
+ "Given SYMBOL, return symbol with name as in SYMBOL but normalized: namely, without the leading colon, if it is present.
+
+Examples:
+
+ELISP> (org-dekeyword :x)
+x
+
+ELISP> (org-dekeyword 'x)
+x"
+ (cl-etypecase symbol
+ (keyword (intern (substring (symbol-name symbol) 1)))
+ (symbol symbol))))
+
+(eval-when-compile
+ (defun org-fold (f x seq)
+ "Reduce F over SEQ with obligatory initial value X."
+ ;; There is nothing org-specific about this definition. It better be moved.
+ (cl-reduce f seq :initial-value x)))
+
+(defmacro org-prog-plist (&rest bindings-and-compound-forms)
+ ;; There is nothing org-specific about this definition. It better be moved.
+ ;;
+ ;; TODO: maybe support positions, absolute or relative (or both):
+ ;; sometimes one wants pairs to be in plist in specific order
+ ;; since numbers self-evaluate and are useless as code,
+ ;;
+ ;; one could have e.g.
+ ;; (org-prog-plist
+ ;; :p a
+ ;; 0 :q b
+ ;; :r c
+ ;; 1 :s d)
+ ;; specify that q property should be plisted first, s property second,
+ ;;
+ ;; and e.g.
+ ;; (org-prog-plist
+ ;; :p a
+ ;; (0) :q b
+ ;; :r c
+ ;; (1) :s d)
+ ;; specify that s property should be plisted after q property.
+ ;;
+ ;; However, one could imagine some similar prog-ptree macro
+ ;; that arranges results at different depth, in which case
+ ;; (0), ((0)) and deeper specs should probably be reserved for level specs
+ "Construct a plist, imperatively (hence prog- prefix) and conveniently.
+
+Examples:
+
+Trivial plist:
+ELISP> (org-prog-plist
+ :x 1
+ :z 2)
+(:x 1 :z 2)
+
+Evaluate arbitrary compound forms between key-value pairs:
+ELISP> (macroexpand-1
+ `(org-prog-plist
+ :x 1
+ (message \"Building rest of plist\")
+ :z 2))
+(let* ((x 1))
+ (message \"Building rest of plist\")
+ (let* ((z 2))
+ (list :x x :z z)))
+
+Reference previous values when building subsequent ones:
+ELISP> (org-prog-plist
+ :x 1
+ :z (+ x 40 x))
+(:x 1 :z 42)
+
+Modify previous values when building subsequent ones:
+ELISP> (org-prog-plist
+ :x 1
+ :z (+ (cl-incf x) 40))
+(:x 2 :z 42)
+
+Bind temporary variables omitted from the resulting plist:
+ELISP> (macroexpand-1
+ `(org-prog-plist
+ :x 1
+ y 40
+ (incf y)
+ :z (+ x y)))
+(let* ((x 1)
+ (y 40))
+ (incf y)
+ (let* ((z (+ x y)))
+ (list :x x :z z)))
+
+Note: to reuse temporary variables, use `org-with-plist', `org-with-plists'."
+ (declare (indent 0))
+ (let ((headers (list (list 'progn))) bindings plist-form
+ (reading 'symbol-or-compound-form))
+ (cl-symbol-macrolet ((maybe-push-bindings-to-headers
+ (if bindings
+ (prog1 (push (list (nreverse bindings) 'let*)
+ headers)
+ (setf bindings nil))
+ headers))
+ (setf-form-in-current-binding
+ (setf (cadar bindings) it
+ reading 'symbol-or-compound-form)))
+ (cl-flet ((cleanup (form) (if (and (consp (cadar form))
+ (eq 'let* (caadar form)))
+ (cadar form)
+ (car form))))
+ (dolist (it bindings-and-compound-forms
+ (cleanup
+ (org-fold (lambda (form header)
+ (dolist (e header (list form))
+ (push e form)))
+ (list (cons 'list (nreverse plist-form)))
+ maybe-push-bindings-to-headers)))
+ (cl-ecase reading
+ (keyword-form (push (org-dekeyword (car plist-form)) plist-form)
+ setf-form-in-current-binding)
+ (variable-form setf-form-in-current-binding)
+ (symbol-or-compound-form
+ (cl-etypecase it
+ (keyword (if (cl-loop for (_value key) on plist-form by #'cddr
+ do (when (eq it key) (cl-return t)))
+ (setf reading 'repeated-keyword-form)
+ (push it plist-form)
+ (setf reading 'keyword-form))
+ (push (list (org-dekeyword it) nil) bindings))
+ (symbol (push (list it nil) bindings)
+ (setf reading 'variable-form))
+ ;; it might be better to write compound-form instead of cons
+ ;; however, lack of namespaces means it'd be org-compound-form
+ ;; which we deemed obnoxious
+ ;; anyway, conses here are meant to be compound forms
+ (cons maybe-push-bindings-to-headers
+ (push it (car headers))
+ (setf reading 'symbol-or-compound-form))))
+ (repeated-keyword-form setf-form-in-current-binding)))))))
+
+(defmacro org-let*-prog-plists (plist-specs &rest body)
+ ;; Lots of code from org-prog-plist is reused verbatim.
+ ;; The point of org-let*-prog-plists is
+ ;; to be able to reuse temporary variables used during plist construction.
+ ;; We thus do not expand org-with-plists forms into org-prog-plist forms
+ ;; which discard those variables, but rather produce the code manually.
+ ;; It might be suboptimal but it works. Duplication twice is not that bad.
+ ;; TODO: consider other names
+ ;; - org-prog-plists-let*
+ ;; - org-with-prog-plists
+ "Construct plists in PLIST-SPECS as in `org-prog-plist'; bind them to variables. All intermediate variables from PLIST-SPECS, including temporary ones, are available in BODY.
+
+PLIST-SPECS is a binding spec of the form
+((VAR-1 . BINDINGS-AND-COMPOUND-FORMS-1)
+ (VAR-2 . BINDINGS-AND-COMPOUND-FORMS-2)
+ ...
+ (VAR-n . BINDINGS-AND-COMPOUND-FORMS-n))
+
+where VAR-i is bound to plist specified by BINDINGS-AND-COMPOUND-FORMS-i, right after it is constructed.
+
+Examples:
+
+Construct multiple plists imperatively, reuse temporary bindings:
+ELISP> (macroexpand-1
+ `(org-with-plists ((plist1 :x 1
+ y 40
+ (incf y)
+ :z (incf y))
+ (plist2 :x y))
+ (list plist1 y plist2)))
+(let* ((x 1)
+ (y 40))
+ (incf y)
+ (let* ((z (incf y))
+ (plist1 (list :x x :z z))
+ (x y)
+ (plist2 (list :x x)))
+ (list plist1 y plist2)))
+
+Once plist is constructed, its places are lost; values are still available:
+ELISP> (macroexpand-1
+ `(org-with-plists ((plist1 :x 1)
+ (plist2 (incf x)
+ :z (+ x 40)))
+ (list plist1 x plist2)))
+(let* ((x 1)
+ (plist1 (list :x x)))
+ (incf x)
+ (let* ((z (+ x 40))
+ (plist2 (list :z z)))
+ (list plist1 x plist2)))
+
+See Also: `org-prog-plist'"
+ (declare (indent 1))
+ (let ((headers (list (list 'progn))) bindings plist-form
+ (reading 'symbol-or-compound-form))
+ (cl-symbol-macrolet ((maybe-push-bindings-to-headers
+ (if bindings
+ (prog1 (push (list (nreverse bindings) 'let*)
+ headers)
+ (setf bindings nil))
+ headers))
+ (setf-form-in-current-binding
+ (setf (cadar bindings) it
+ reading 'symbol-or-compound-form)))
+ (cl-flet ((cleanup (form) (if (and (consp (cadar form))
+ (eq 'let* (caadar form)))
+ (cadar form)
+ (car form))))
+ (dolist (plist-spec plist-specs
+ (cleanup
+ (org-fold (lambda (form header)
+ (dolist (e header (list form))
+ (push e form)))
+ body
+ maybe-push-bindings-to-headers)))
+ (setf plist-form nil)
+ (dolist (it (cdr plist-spec)
+ (let ((it (cons 'list (nreverse plist-form))))
+ (push (list (car plist-spec) nil) bindings)
+ setf-form-in-current-binding))
+ (cl-ecase reading
+ (keyword-form (push (org-dekeyword (car plist-form)) plist-form)
+ setf-form-in-current-binding)
+ (variable-form setf-form-in-current-binding)
+ (symbol-or-compound-form
+ (cl-etypecase it
+ (keyword (if (cl-loop for (_value key) on plist-form by #'cddr
+ do (when (eq it key) (cl-return t)))
+ (setf reading 'repeated-keyword-form)
+ (push it plist-form)
+ (setf reading 'keyword-form))
+ (push (list (org-dekeyword it) nil) bindings))
+ (symbol (push (list it nil) bindings)
+ (setf reading 'variable-form))
+ ;; it might be better to write compound-form instead of cons
+ ;; however, lack of namespaces means it'd be org-compound-form
+ ;; which we deemed obnoxious
+ ;; anyway, conses here are meant to be compound forms
+ (cons maybe-push-bindings-to-headers
+ (push it (car headers))
+ (setf reading 'symbol-or-compound-form))))
+ (repeated-keyword-form setf-form-in-current-binding))))))))
+
+(defmacro org-let*-prog-plist (plist-spec &rest body)
+ "Like `org-let*-prog-plists' but only supports a a single plist binding.
+
+Provided solely to reduce sexp depth when desired."
+ (declare (indent 1))
+ `(org-let*-prog-plists (,plist-spec) ,@body))
+
;; Use `with-silent-modifications' to ignore cosmetic changes and
;; `org-unmodified' to ignore real text modifications.
(defmacro org-unmodified (&rest body)
--
2.26.2
^ permalink raw reply related [flat|nested] 5+ messages in thread* Re: [PATCH] org-element: Hide parsers boilerplate into plist-creating macros
2020-09-08 17:19 [PATCH] org-element: Hide parsers boilerplate into plist-creating macros akater
@ 2020-09-09 8:46 ` Bastien
2020-09-09 13:59 ` akater
2020-09-09 16:11 ` Nicolas Goaziou
0 siblings, 2 replies; 5+ messages in thread
From: Bastien @ 2020-09-09 8:46 UTC (permalink / raw)
To: akater; +Cc: emacs-orgmode
Hi Akater,
akater <nuclearspace@gmail.com> writes:
> We replace some repetetive code with macro calls org-prog-plist and
> org-let*-prog-plist.
IIUC this is a refactoring, it does not add or remove functionalities?
I'll let Nicolas decide on this, of course.
--
Bastien
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH] org-element: Hide parsers boilerplate into plist-creating macros
2020-09-09 8:46 ` Bastien
@ 2020-09-09 13:59 ` akater
2020-09-09 14:37 ` Bastien
2020-09-09 16:11 ` Nicolas Goaziou
1 sibling, 1 reply; 5+ messages in thread
From: akater @ 2020-09-09 13:59 UTC (permalink / raw)
To: Bastien; +Cc: emacs-orgmode
[-- Attachment #1.1: Type: text/plain, Size: 196 bytes --]
Bastien <bzg@gnu.org> writes:
> IIUC this is a refactoring, it does not add or remove functionalities?
Yes, just a refactoring.
A typo crept into comments and help pages, so here's an update.
[-- Attachment #1.2: signature.asc --]
[-- Type: application/pgp-signature, Size: 800 bytes --]
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-element boilerplate removal, with typo fixed --]
[-- Type: text/x-diff, Size: 123832 bytes --]
From 0636f032b3c7e60221c28aeea91cce58376561dd Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Thu, 16 Apr 2020 02:25:59 +0000
Subject: [PATCH] org-element: Hide parsers boilerplate into plist-creating
macros
* lisp/org-element.el (org-prog-plist, org-let*-prog-plists) (org-let*-prog-plist): New macros. Build plists without boilerplate.
(org-fold, org-dekeyword): New functions. Dependencies for the above.
* lisp/org-element.el (org-element-center-block-parser)
(org-element-drawer-parser, org-element-dynamic-block-parser)
(org-element-footnote-definition-parser)
(org-element-plain-list-parser, org-element-property-drawer-parser)
(org-element-quote-block-parser, org-element-section-parser)
(org-element-special-block-parser, org-element-babel-call-parser)
(org-element-clock-parser, org-element-comment-parser)
(org-element-comment-block-parser, org-element-diary-sexp-parser)
(org-element-example-block-parser, org-element-export-block-parser)
(org-element-fixed-width-parser, org-element-horizontal-rule-parser)
(org-element-keyword-parser, org-element-latex-environment-parser)
(org-element-node-property-parser, org-element-paragraph-parser)
(org-element-planning-parser, org-element-src-block-parser)
(org-element-table-parser, org-element-table-row-parser)
(org-element-verse-block-parser, org-element-entity-parser)
(org-element-footnote-reference-parser, org-element-inline-babel-call-parser)
(org-element-inline-src-block-parser, org-element-latex-fragment-parser)
(org-element-link-parser): Use org-prog-plist to build plist
(org-element-headline-parser, org-element-inlinetask-parser)
(org-element-item-parser, org-element-timestamp-parser): Use
org-let*-prog-plist to build plist
(org-element-radio-target-parser, org-element-statistics-cookie-parser) (org-element-subscript-parser, org-element-superscript-parser) (org-element-table-cell-parser, org-element-target-parser) (org-element-underline-parser, org-element-verbatim-parser): Use
just #'list to build plist
(org-element-comment-block-parser): Fix a typo in docstring.
---
lisp/org-element.el | 2584 +++++++++++++++++++------------------------
lisp/org-macs.el | 259 +++++
2 files changed, 1421 insertions(+), 1422 deletions(-)
diff --git a/lisp/org-element.el b/lisp/org-element.el
index a693cb68d..e40f881b9 100644
--- a/lisp/org-element.el
+++ b/lisp/org-element.el
@@ -691,29 +691,26 @@ Assume point is at the beginning of the block."
(re-search-forward "^[ \t]*#\\+END_CENTER[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((block-end-line (match-beginning 0)))
- (let* ((begin (car affiliated))
- (post-affiliated (point))
+ (list 'center-block
+ (nconc
+ (org-prog-plist
+ block-end-line (match-beginning 0)
+ :begin (car affiliated)
+ :post-affiliated (point)
;; Empty blocks have no contents.
- (contents-begin (progn (forward-line)
+ :contents-begin (progn (forward-line)
(and (< (point) block-end-line)
- (point))))
- (contents-end (and contents-begin block-end-line))
- (pos-before-blank (progn (goto-char block-end-line)
- (forward-line)
- (point)))
- (end (save-excursion
+ (point)))
+ :contents-end (and contents-begin block-end-line)
+ pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point))
+ :end (save-excursion
(skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'center-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (if (eobp) (point)
+ (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end))
+ (cdr affiliated))))))
(defun org-element-center-block-interpreter (_ contents)
"Interpret a center-block element as Org syntax.
@@ -740,32 +737,28 @@ Assume point is at beginning of drawer."
(if (not (save-excursion (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
;; Incomplete drawer: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (save-excursion
- (let* ((drawer-end-line (match-beginning 0))
- (name (progn (looking-at org-drawer-regexp)
- (match-string-no-properties 1)))
- (begin (car affiliated))
- (post-affiliated (point))
- ;; Empty drawers have no contents.
- (contents-begin (progn (forward-line)
- (and (< (point) drawer-end-line)
- (point))))
- (contents-end (and contents-begin drawer-end-line))
- (pos-before-blank (progn (goto-char drawer-end-line)
- (forward-line)
+ (list
+ 'drawer
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ drawer-end-line (match-beginning 0)
+ :drawer-name (progn (looking-at org-drawer-regexp)
+ (match-string-no-properties 1))
+ :begin (car affiliated)
+ :post-affiliated (point)
+ ;; Empty drawers have no contents.
+ :contents-begin (progn (forward-line)
+ (and (< (point) drawer-end-line)
(point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'drawer
- (nconc
- (list :begin begin
- :end end
- :drawer-name name
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ :contents-end (and contents-begin drawer-end-line)
+ pos-before-blank (progn (goto-char drawer-end-line)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))))
(defun org-element-drawer-interpreter (drawer contents)
"Interpret DRAWER element as Org syntax.
@@ -796,34 +789,28 @@ Assume point is at beginning of dynamic block."
(re-search-forward "^[ \t]*#\\+END:?[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((block-end-line (match-beginning 0)))
- (save-excursion
- (let* ((name (progn (looking-at org-dblock-start-re)
- (match-string-no-properties 1)))
- (arguments (match-string-no-properties 3))
- (begin (car affiliated))
- (post-affiliated (point))
+ (list 'dynamic-block
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ block-end-line (match-beginning 0)
+ :block-name (progn (looking-at org-dblock-start-re)
+ (match-string-no-properties 1))
+ :arguments (match-string-no-properties 3)
+ :begin (car affiliated)
+ :post-affiliated (point)
;; Empty blocks have no contents.
- (contents-begin (progn (forward-line)
+ :contents-begin (progn (forward-line)
(and (< (point) block-end-line)
- (point))))
- (contents-end (and contents-begin block-end-line))
- (pos-before-blank (progn (goto-char block-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'dynamic-block
- (nconc
- (list :begin begin
- :end end
- :block-name name
- :arguments arguments
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (point)))
+ :contents-end (and contents-begin block-end-line)
+ pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))))
(defun org-element-dynamic-block-interpreter (dynamic-block contents)
"Interpret DYNAMIC-BLOCK element as Org syntax.
@@ -857,54 +844,49 @@ a plist containing `:label', `:begin' `:end', `:contents-begin',
`:post-affiliated' keywords.
Assume point is at the beginning of the footnote definition."
- (save-excursion
- (let* ((label (progn (looking-at org-footnote-definition-re)
- (match-string-no-properties 1)))
- (begin (car affiliated))
- (post-affiliated (point))
- (end
- (save-excursion
- (end-of-line)
- (cond
- ((not
- (re-search-forward org-element--footnote-separator limit t))
- limit)
- ((eq ?\[ (char-after (match-beginning 0)))
- ;; At a new footnote definition, make sure we end
- ;; before any affiliated keyword above.
- (forward-line -1)
- (while (and (> (point) post-affiliated)
- (looking-at-p org-element--affiliated-re))
- (forward-line -1))
- (line-beginning-position 2))
- ((eq ?* (char-after (match-beginning 0))) (match-beginning 0))
- (t (skip-chars-forward " \r\t\n" limit)
- (if (= limit (point)) limit (line-beginning-position))))))
- (pre-blank 0)
- (contents-begin
- (progn (search-forward "]")
- (skip-chars-forward " \r\t\n" end)
- (cond ((= (point) end) nil)
- ((= (line-beginning-position) post-affiliated) (point))
- (t
- (setq pre-blank
- (count-lines (line-beginning-position) begin))
- (line-beginning-position)))))
- (contents-end
- (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- (list 'footnote-definition
- (nconc
- (list :label label
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end (and contents-begin contents-end)
- :pre-blank pre-blank
- :post-blank (count-lines contents-end end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list
+ 'footnote-definition
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :label (progn (looking-at org-footnote-definition-re)
+ (match-string-no-properties 1))
+ :begin (car affiliated)
+ :post-affiliated (point)
+ :end
+ (save-excursion
+ (end-of-line)
+ (cond
+ ((not
+ (re-search-forward org-element--footnote-separator limit t))
+ limit)
+ ((eq ?\[ (char-after (match-beginning 0)))
+ ;; At a new footnote definition, make sure we end
+ ;; before any affiliated keyword above.
+ (forward-line -1)
+ (while (and (> (point) post-affiliated)
+ (looking-at-p org-element--affiliated-re))
+ (forward-line -1))
+ (line-beginning-position 2))
+ ((eq ?* (char-after (match-beginning 0))) (match-beginning 0))
+ (t (skip-chars-forward " \r\t\n" limit)
+ (if (= limit (point)) limit (line-beginning-position)))))
+ :pre-blank 0
+ :contents-begin
+ (progn (search-forward "]")
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ((= (line-beginning-position) post-affiliated) (point))
+ (t
+ (setq pre-blank
+ (count-lines (line-beginning-position) begin))
+ (line-beginning-position))))
+ :contents-end (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ :contents-end (and contents-begin contents-end)
+ :post-blank (count-lines contents-end end)))
+ (cdr affiliated))))
(defun org-element-footnote-definition-interpreter (footnote-definition contents)
"Interpret FOOTNOTE-DEFINITION element as Org syntax.
@@ -983,72 +965,59 @@ parsed as a secondary string, but as a plain string instead.
Assume point is at beginning of the headline."
(save-excursion
- (let* ((begin (point))
- (level (prog1 (org-reduced-level (skip-chars-forward "*"))
- (skip-chars-forward " \t")))
- (todo (and org-todo-regexp
- (let (case-fold-search) (looking-at (concat org-todo-regexp " ")))
- (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (match-string 1))))
- (todo-type
- (and todo (if (member todo org-done-keywords) 'done 'todo)))
- (priority (and (looking-at "\\[#.\\][ \t]*")
- (progn (goto-char (match-end 0))
- (aref (match-string 0) 2))))
- (commentedp
- (and (let (case-fold-search) (looking-at org-comment-string))
- (goto-char (match-end 0))))
- (title-start (point))
- (tags (when (re-search-forward
- "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
- (line-end-position)
- 'move)
- (goto-char (match-beginning 0))
- (org-split-string (match-string 1) ":")))
- (title-end (point))
- (raw-value (org-trim
- (buffer-substring-no-properties title-start title-end)))
- (archivedp (member org-archive-tag tags))
- (footnote-section-p (and org-footnote-section
- (string= org-footnote-section raw-value)))
- (standard-props (org-element--get-node-properties))
- (time-props (org-element--get-time-properties))
- (end (min (save-excursion (org-end-of-subtree t t)) limit))
- (contents-begin (save-excursion
- (forward-line)
- (skip-chars-forward " \r\t\n" end)
- (and (/= (point) end) (line-beginning-position))))
- (contents-end (and contents-begin
- (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2)))))
+ (org-let*-prog-plist
+ (plist
+ :begin (point)
+ :level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t"))
+ todo (and org-todo-regexp
+ (let (case-fold-search)
+ (looking-at (concat org-todo-regexp " ")))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 1)))
+ :todo-type
+ (and todo (if (member todo org-done-keywords) 'done 'todo))
+ :priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2)))
+ :commentedp
+ (and (let (case-fold-search) (looking-at org-comment-string))
+ (goto-char (match-end 0)))
+ title-start (point)
+ :tags (when (re-search-forward
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":"))
+ title-end (point)
+ :raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end))
+ :archivedp (member org-archive-tag tags)
+ :footnote-section-p (and org-footnote-section
+ (string= org-footnote-section raw-value))
+ standard-props (org-element--get-node-properties)
+ time-props (org-element--get-time-properties)
+ :end (min (save-excursion (org-end-of-subtree t t)) limit)
+ :contents-begin (save-excursion
+ (forward-line)
+ (skip-chars-forward " \r\t\n" end)
+ (and (/= (point) end)
+ (line-beginning-position)))
+ :contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ :pre-blank (if (not contents-begin) 0
+ (1- (count-lines begin contents-begin)))
+ :todo-keyword todo
+ :post-blank (if contents-end
+ (count-lines contents-end end)
+ (1- (count-lines begin end)))
+ :post-affiliated begin)
(let ((headline
- (list 'headline
- (nconc
- (list :raw-value raw-value
- :begin begin
- :end end
- :pre-blank
- (if (not contents-begin) 0
- (1- (count-lines begin contents-begin)))
- :contents-begin contents-begin
- :contents-end contents-end
- :level level
- :priority priority
- :tags tags
- :todo-keyword todo
- :todo-type todo-type
- :post-blank
- (if contents-end
- (count-lines contents-end end)
- (1- (count-lines begin end)))
- :footnote-section-p footnote-section-p
- :archivedp archivedp
- :commentedp commentedp
- :post-affiliated begin)
- time-props
- standard-props))))
+ (list 'headline (nconc plist time-props standard-props))))
(org-element-put-property
headline :title
(if raw-secondary-p raw-value
@@ -1129,80 +1098,70 @@ string instead.
Assume point is at beginning of the inline task."
(save-excursion
- (let* ((begin (point))
- (level (prog1 (org-reduced-level (skip-chars-forward "*"))
- (skip-chars-forward " \t")))
- (todo (and org-todo-regexp
- (let (case-fold-search) (looking-at org-todo-regexp))
- (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")
- (match-string 0))))
- (todo-type (and todo
- (if (member todo org-done-keywords) 'done 'todo)))
- (priority (and (looking-at "\\[#.\\][ \t]*")
- (progn (goto-char (match-end 0))
- (aref (match-string 0) 2))))
- (title-start (point))
- (tags (when (re-search-forward
- "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
- (line-end-position)
- 'move)
- (goto-char (match-beginning 0))
- (org-split-string (match-string 1) ":")))
- (title-end (point))
- (raw-value (org-trim
- (buffer-substring-no-properties title-start title-end)))
- (task-end (save-excursion
- (end-of-line)
- (and (re-search-forward org-outline-regexp-bol limit t)
- (looking-at-p "[ \t]*END[ \t]*$")
- (line-beginning-position))))
- (standard-props (and task-end (org-element--get-node-properties)))
- (time-props (and task-end (org-element--get-time-properties)))
- (contents-begin (and task-end
- (< (point) task-end)
- (progn
- (forward-line)
- (skip-chars-forward " \t\n")
- (line-beginning-position))))
- (contents-end (and contents-begin task-end))
- (end (progn (when task-end (goto-char task-end))
- (forward-line)
- (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (inlinetask
- (list 'inlinetask
- (nconc
- (list :raw-value raw-value
- :begin begin
- :end end
- :pre-blank
- (if (not contents-begin) 0
- (1- (count-lines begin contents-begin)))
- :contents-begin contents-begin
- :contents-end contents-end
- :level level
- :priority priority
- :tags tags
- :todo-keyword todo
- :todo-type todo-type
- :post-blank (1- (count-lines (or task-end begin) end))
- :post-affiliated begin)
- time-props
- standard-props))))
- (org-element-put-property
- inlinetask :title
- (if raw-secondary-p raw-value
- (org-element--parse-objects
- (progn (goto-char title-start)
- (skip-chars-forward " \t")
- (point))
- (progn (goto-char title-end)
- (skip-chars-backward " \t")
- (point))
- nil
- (org-element-restriction 'inlinetask)
- inlinetask))))))
+ (org-let*-prog-plist
+ (plist
+ :begin (point)
+ :level (prog1 (org-reduced-level (skip-chars-forward "*"))
+ (skip-chars-forward " \t"))
+ :todo (and org-todo-regexp
+ (let (case-fold-search) (looking-at org-todo-regexp))
+ (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t")
+ (match-string 0)))
+ :todo-type (and todo
+ (if (member todo org-done-keywords) 'done 'todo))
+ :priority (and (looking-at "\\[#.\\][ \t]*")
+ (progn (goto-char (match-end 0))
+ (aref (match-string 0) 2)))
+ title-start (point)
+ :tags (when (re-search-forward
+ "[ \t]+\\(:[[:alnum:]_@#%:]+:\\)[ \t]*$"
+ (line-end-position)
+ 'move)
+ (goto-char (match-beginning 0))
+ (org-split-string (match-string 1) ":"))
+ title-end (point)
+ :raw-value (org-trim
+ (buffer-substring-no-properties title-start title-end))
+ :task-end (save-excursion
+ (end-of-line)
+ (and (re-search-forward org-outline-regexp-bol limit t)
+ (looking-at-p "[ \t]*END[ \t]*$")
+ (line-beginning-position)))
+ standard-props (and task-end
+ (org-element--get-node-properties))
+ time-props (and task-end (org-element--get-time-properties))
+ :contents-begin (and task-end
+ (< (point) task-end)
+ (progn
+ (forward-line)
+ (skip-chars-forward " \t\n")
+ (line-beginning-position)))
+ :contents-end (and contents-begin task-end)
+ :end (progn (when task-end (goto-char task-end))
+ (forward-line)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :pre-blank (if (not contents-begin) 0
+ (1- (count-lines begin contents-begin)))
+ :todo-keyword todo
+ :post-blank (1- (count-lines (or task-end begin) end))
+ :post-affiliated begin)
+ (let ((inlinetask
+ (list 'inlinetask (nconc plist time-props standard-props))))
+ (org-element-put-property
+ inlinetask :title
+ (if raw-secondary-p raw-value
+ (org-element--parse-objects
+ (progn (goto-char title-start)
+ (skip-chars-forward " \t")
+ (point))
+ (progn (goto-char title-end)
+ (skip-chars-backward " \t")
+ (point))
+ nil
+ (org-element-restriction 'inlinetask)
+ inlinetask)))))))
(defun org-element-inlinetask-interpreter (inlinetask contents)
"Interpret INLINETASK element as Org syntax.
@@ -1262,68 +1221,61 @@ Assume point is at the beginning of the item."
(save-excursion
(beginning-of-line)
(looking-at org-list-full-item-re)
- (let* ((begin (point))
- (bullet (match-string-no-properties 1))
- (checkbox (let ((box (match-string 3)))
- (cond ((equal "[ ]" box) 'off)
- ((equal "[X]" box) 'on)
- ((equal "[-]" box) 'trans))))
- (counter (let ((c (match-string 2)))
- (save-match-data
- (cond
- ((not c) nil)
- ((string-match "[A-Za-z]" c)
- (- (string-to-char (upcase (match-string 0 c)))
- 64))
- ((string-match "[0-9]+" c)
- (string-to-number (match-string 0 c)))))))
- (end (progn (goto-char (nth 6 (assq (point) struct)))
- (if (bolp) (point) (line-beginning-position 2))))
- (pre-blank 0)
- (contents-begin
- (progn
- (goto-char
- ;; Ignore tags in un-ordered lists: they are just
- ;; a part of item's body.
- (if (and (match-beginning 4)
- (save-match-data (string-match "[.)]" bullet)))
- (match-beginning 4)
- (match-end 0)))
- (skip-chars-forward " \r\t\n" end)
- (cond ((= (point) end) nil)
- ;; If first line isn't empty, contents really
- ;; start at the text after item's meta-data.
- ((= (line-beginning-position) begin) (point))
- (t
- (setq pre-blank
- (count-lines (line-beginning-position) begin))
- (line-beginning-position)))))
- (contents-end (and contents-begin
- (progn (goto-char end)
- (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- (item
- (list 'item
- (list :bullet bullet
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :checkbox checkbox
- :counter counter
- :structure struct
- :pre-blank pre-blank
- :post-blank (count-lines (or contents-end begin) end)
- :post-affiliated begin))))
- (org-element-put-property
- item :tag
- (let ((raw (org-list-get-tag begin struct)))
- (when raw
- (if raw-secondary-p raw
- (org-element--parse-objects
- (match-beginning 4) (match-end 4) nil
- (org-element-restriction 'item)
- item))))))))
+ (org-let*-prog-plist
+ (plist
+ :begin (point)
+ :bullet (match-string-no-properties 1)
+ :checkbox (let ((box (match-string 3)))
+ (cond ((equal "[ ]" box) 'off)
+ ((equal "[X]" box) 'on)
+ ((equal "[-]" box) 'trans)))
+ :counter (let ((c (match-string 2)))
+ (save-match-data
+ (cond
+ ((not c) nil)
+ ((string-match "[A-Za-z]" c)
+ (- (string-to-char (upcase (match-string 0 c)))
+ 64))
+ ((string-match "[0-9]+" c)
+ (string-to-number (match-string 0 c))))))
+ :end (progn (goto-char (nth 6 (assq (point) struct)))
+ (if (bolp) (point) (line-beginning-position 2)))
+ :pre-blank 0
+ :contents-begin
+ (progn
+ (goto-char
+ ;; Ignore tags in un-ordered lists: they are just
+ ;; a part of item's body.
+ (if (and (match-beginning 4)
+ (save-match-data (string-match "[.)]" bullet)))
+ (match-beginning 4)
+ (match-end 0)))
+ (skip-chars-forward " \r\t\n" end)
+ (cond ((= (point) end) nil)
+ ;; If first line isn't empty, contents really
+ ;; start at the text after item's meta-data.
+ ((= (line-beginning-position) begin) (point))
+ (t
+ (setq pre-blank
+ (count-lines (line-beginning-position) begin))
+ (line-beginning-position))))
+ :contents-end (and contents-begin
+ (progn (goto-char end)
+ (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2)))
+ :structure struct
+ :post-blank (count-lines (or contents-end begin) end)
+ :post-affiliated begin)
+ (let ((item (list 'item plist)))
+ (org-element-put-property
+ item :tag
+ (let ((raw (org-list-get-tag begin struct)))
+ (when raw
+ (if raw-secondary-p raw
+ (org-element--parse-objects
+ (match-beginning 4) (match-end 4) nil
+ (org-element-restriction 'item)
+ item)))))))))
(defun org-element-item-interpreter (item contents)
"Interpret ITEM element as Org syntax.
@@ -1463,35 +1415,30 @@ containing `:type', `:begin', `:end', `:contents-begin' and
`:post-affiliated' keywords.
Assume point is at the beginning of the list."
- (save-excursion
- (let* ((struct (or structure (org-element--list-struct limit)))
- (type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
- ((nth 5 (assq (point) struct)) 'descriptive)
- (t 'unordered)))
- (contents-begin (point))
- (begin (car affiliated))
- (contents-end (let* ((item (assq contents-begin struct))
- (ind (nth 1 item))
- (pos (nth 6 item)))
- (while (and (setq item (assq pos struct))
- (= (nth 1 item) ind))
- (setq pos (nth 6 item)))
- pos))
- (end (progn (goto-char contents-end)
- (skip-chars-forward " \r\t\n" limit)
- (if (= (point) limit) limit (line-beginning-position)))))
- ;; Return value.
- (list 'plain-list
- (nconc
- (list :type type
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :structure struct
- :post-blank (count-lines contents-end end)
- :post-affiliated contents-begin)
- (cdr affiliated))))))
+ (list 'plain-list
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ struct (or structure (org-element--list-struct limit))
+ :type (cond ((looking-at-p "[ \t]*[A-Za-z0-9]") 'ordered)
+ ((nth 5 (assq (point) struct)) 'descriptive)
+ (t 'unordered))
+ :contents-begin (point)
+ :begin (car affiliated)
+ :contents-end (let* ((item (assq contents-begin struct))
+ (ind (nth 1 item))
+ (pos (nth 6 item)))
+ (while (and (setq item (assq pos struct))
+ (= (nth 1 item) ind))
+ (setq pos (nth 6 item)))
+ pos)
+ :end (progn (goto-char contents-end)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (= (point) limit) limit (line-beginning-position)))
+ :structure struct
+ :post-blank (count-lines contents-end end)
+ :post-affiliated contents-begin))
+ (cdr affiliated))))
(defun org-element-plain-list-interpreter (_ contents)
"Interpret plain-list element as Org syntax.
@@ -1515,23 +1462,21 @@ containing `:begin', `:end', `:contents-begin', `:contents-end',
`:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the property drawer."
- (save-excursion
- (let ((case-fold-search t)
- (begin (point))
- (contents-begin (line-beginning-position 2)))
- (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)
- (let ((contents-end (and (> (match-beginning 0) contents-begin)
- (match-beginning 0)))
- (before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'property-drawer
- (list :begin begin
- :end end
- :contents-begin (and contents-end contents-begin)
- :contents-end contents-end
- :post-blank (count-lines before-blank end)
- :post-affiliated begin))))))
+ (list 'property-drawer
+ (save-excursion
+ (org-prog-plist
+ case-fold-search t
+ :begin (point)
+ contents-begin (line-beginning-position 2)
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)
+ :contents-end (and (> (match-beginning 0) contents-begin)
+ (match-beginning 0))
+ before-blank (progn (forward-line) (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :contents-begin (and contents-end contents-begin)
+ :post-blank (count-lines before-blank end)
+ :post-affiliated begin))))
(defun org-element-property-drawer-interpreter (_ contents)
"Interpret property-drawer element as Org syntax.
@@ -1559,29 +1504,25 @@ Assume point is at the beginning of the block."
(re-search-forward "^[ \t]*#\\+END_QUOTE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((block-end-line (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- ;; Empty blocks have no contents.
- (contents-begin (progn (forward-line)
- (and (< (point) block-end-line)
- (point))))
- (contents-end (and contents-begin block-end-line))
- (pos-before-blank (progn (goto-char block-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'quote-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'quote-block
+ (nconc
+ (let ((block-end-line (match-beginning 0)))
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ ;; Empty blocks have no contents.
+ :contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point)))
+ :contents-end (and contents-begin block-end-line)
+ pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end))))
+ (cdr affiliated))))))
(defun org-element-quote-block-interpreter (_ contents)
"Interpret quote-block element as Org syntax.
@@ -1597,21 +1538,21 @@ CONTENTS is the contents of the element."
Return a list whose CAR is `section' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `contents-end',
`:post-blank' and `:post-affiliated' keywords."
- (save-excursion
- ;; Beginning of section is the beginning of the first non-blank
- ;; line after previous headline.
- (let ((begin (point))
- (end (progn (org-with-limited-levels (outline-next-heading))
- (point)))
- (pos-before-blank (progn (skip-chars-backward " \r\t\n")
- (line-beginning-position 2))))
- (list 'section
- (list :begin begin
- :end end
- :contents-begin begin
- :contents-end pos-before-blank
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated begin)))))
+ (list 'section
+ (save-excursion
+ (org-prog-plist
+ ;; Beginning of section is the beginning of the first non-blank
+ ;; line after previous headline
+ :begin (point)
+ :end (progn
+ (org-with-limited-levels (outline-next-heading))
+ (point))
+ pos-before-blank (progn (skip-chars-backward " \r\t\n")
+ (line-beginning-position 2))
+ :contents-begin begin
+ :contents-end pos-before-blank
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated begin))))
(defun org-element-section-interpreter (_ contents)
"Interpret section element as Org syntax.
@@ -1644,29 +1585,25 @@ Assume point is at the beginning of the block."
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
(let ((block-end-line (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- ;; Empty blocks have no contents.
- (contents-begin (progn (forward-line)
- (and (< (point) block-end-line)
- (point))))
- (contents-end (and contents-begin block-end-line))
- (pos-before-blank (progn (goto-char block-end-line)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'special-block
- (nconc
- (list :type type
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'special-block
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :type type
+ :begin (car affiliated)
+ :post-affiliated (point)
+ ;; Empty blocks have no contents.
+ :contents-begin (progn (forward-line)
+ (and (< (point) block-end-line)
+ (point)))
+ :contents-end (and contents-begin block-end-line)
+ pos-before-blank (progn (goto-char block-end-line)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated)))))))
(defun org-element-special-block-interpreter (special-block contents)
"Interpret SPECIAL-BLOCK element as Org syntax.
@@ -1701,42 +1638,36 @@ Return a list whose car is `babel-call' and cdr is a plist
containing `:call', `:inside-header', `:arguments',
`:end-header', `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' as keywords."
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (before-blank (line-beginning-position 2))
- (value (progn (search-forward ":" before-blank t)
- (skip-chars-forward " \t")
- (org-trim
- (buffer-substring-no-properties
- (point) (line-end-position)))))
- (call
- (or (org-string-nw-p
- (buffer-substring-no-properties
- (point) (progn (skip-chars-forward "^[]()" before-blank)
- (point))))))
- (inside-header (org-element--parse-paired-brackets ?\[))
- (arguments (org-string-nw-p
- (org-element--parse-paired-brackets ?\()))
- (end-header
- (org-string-nw-p
- (org-trim
- (buffer-substring-no-properties (point) (line-end-position)))))
- (end (progn (forward-line)
- (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'babel-call
- (nconc
- (list :call call
- :inside-header inside-header
- :arguments arguments
- :end-header end-header
- :begin begin
- :end end
- :value value
- :post-blank (count-lines before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'babel-call
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ before-blank (line-beginning-position 2)
+ :value (progn (search-forward ":" before-blank t)
+ (skip-chars-forward " \t")
+ (org-trim
+ (buffer-substring-no-properties
+ (point) (line-end-position))))
+ :call
+ (or (org-string-nw-p
+ (buffer-substring-no-properties
+ (point) (progn (skip-chars-forward "^[]()" before-blank)
+ (point)))))
+ :inside-header (org-element--parse-paired-brackets ?\[)
+ :arguments (org-string-nw-p
+ (org-element--parse-paired-brackets ?\())
+ :end-header
+ (org-string-nw-p
+ (org-trim
+ (buffer-substring-no-properties (point) (line-end-position))))
+ :end (progn (forward-line)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point)
+ (line-beginning-position)))
+ :post-blank (count-lines before-blank end)))
+ (cdr affiliated))))
(defun org-element-babel-call-interpreter (babel-call _)
"Interpret BABEL-CALL element as Org syntax."
@@ -1759,31 +1690,26 @@ LIMIT bounds the search.
Return a list whose CAR is `clock' and CDR is a plist containing
`:status', `:value', `:time', `:begin', `:end', `:post-blank' and
`:post-affiliated' as keywords."
- (save-excursion
- (let* ((case-fold-search nil)
- (begin (point))
- (value (progn (search-forward "CLOCK:" (line-end-position) t)
- (skip-chars-forward " \t")
- (org-element-timestamp-parser)))
- (duration (and (search-forward " => " (line-end-position) t)
- (progn (skip-chars-forward " \t")
- (looking-at "\\(\\S-+\\)[ \t]*$"))
- (match-string-no-properties 1)))
- (status (if duration 'closed 'running))
- (post-blank (let ((before-blank (progn (forward-line) (point))))
- (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (unless (bolp) (end-of-line))
- (count-lines before-blank (point))))
- (end (point)))
- (list 'clock
- (list :status status
- :value value
- :duration duration
- :begin begin
- :end end
- :post-blank post-blank
- :post-affiliated begin)))))
+ (list 'clock
+ (save-excursion
+ (org-prog-plist
+ case-fold-search nil
+ :begin (point)
+ :value (progn (search-forward "CLOCK:" (line-end-position) t)
+ (skip-chars-forward " \t")
+ (org-element-timestamp-parser))
+ :duration (and (search-forward " => " (line-end-position) t)
+ (progn (skip-chars-forward " \t")
+ (looking-at "\\(\\S-+\\)[ \t]*$"))
+ (match-string-no-properties 1))
+ :status (if duration 'closed 'running)
+ :post-blank (let ((before-blank (progn (forward-line) (point))))
+ (skip-chars-forward " \r\t\n" limit)
+ (skip-chars-backward " \t")
+ (unless (bolp) (end-of-line))
+ (count-lines before-blank (point)))
+ :end (point)
+ :post-affiliated begin))))
(defun org-element-clock-interpreter (clock _)
"Interpret CLOCK element as Org syntax."
@@ -1810,13 +1736,15 @@ containing `:begin', `:end', `:value', `:post-blank',
`:post-affiliated' keywords.
Assume point is at comment beginning."
- (save-excursion
- (let* ((begin (point))
- (value (prog2 (looking-at "[ \t]*# ?")
- (buffer-substring-no-properties
- (match-end 0) (line-end-position))
- (forward-line)))
- (com-end
+ (list 'comment
+ (save-excursion
+ (org-prog-plist
+ :begin (point)
+ :value (prog2 (looking-at "[ \t]*# ?")
+ (buffer-substring-no-properties
+ (match-end 0) (line-end-position))
+ (forward-line))
+ com-end
;; Get comments ending.
(progn
(while (and (< (point) limit) (looking-at "[ \t]*#\\( \\|$\\)"))
@@ -1828,16 +1756,12 @@ Assume point is at comment beginning."
(buffer-substring-no-properties
(match-end 0) (line-end-position))))
(forward-line))
- (point)))
- (end (progn (goto-char com-end)
- (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'comment
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines com-end end)
- :post-affiliated begin)))))
+ (point))
+ :end (progn (goto-char com-end)
+ (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines com-end end)
+ :post-affiliated begin))))
(defun org-element-comment-interpreter (comment _)
"Interpret COMMENT element as Org syntax.
@@ -1848,7 +1772,7 @@ CONTENTS is nil."
;;;; Comment Block
(defun org-element-comment-block-parser (limit affiliated)
- "Parse an export block.
+ "Parse a comment block.
LIMIT bounds the search. AFFILIATED is a list of which CAR is
the buffer position at the beginning of the first affiliated
@@ -1865,26 +1789,23 @@ Assume point is at comment block beginning."
(re-search-forward "^[ \t]*#\\+END_COMMENT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (progn (forward-line) (point)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (value (buffer-substring-no-properties
- contents-begin contents-end)))
- (list 'comment-block
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'comment-block
+ (nconc
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (org-prog-plist
+ :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)
+ :post-blank (count-lines pos-before-blank end))))
+ (cdr affiliated))))))
(defun org-element-comment-block-interpreter (comment-block _)
"Interpret COMMENT-BLOCK element as Org syntax."
@@ -1907,22 +1828,19 @@ their value.
Return a list whose CAR is `diary-sexp' and CDR is a plist
containing `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' keywords."
- (save-excursion
- (let ((begin (car affiliated))
- (post-affiliated (point))
- (value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
- (match-string-no-properties 1)))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'diary-sexp
- (nconc
- (list :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'diary-sexp
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ :value (progn (looking-at "\\(%%(.*\\)[ \t]*$")
+ (match-string-no-properties 1))
+ pos-before-blank (progn (forward-line) (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))
(defun org-element-diary-sexp-interpreter (diary-sexp _)
"Interpret DIARY-SEXP as Org syntax."
@@ -1948,69 +1866,61 @@ containing `:begin', `:end', `:number-lines', `:preserve-indent',
(re-search-forward "^[ \t]*#\\+END_EXAMPLE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((switches
- (progn
- (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
- (match-string-no-properties 1)))
- ;; Switches analysis.
- (number-lines
- (and switches
- (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
- switches)
- (cons
- (if (equal (match-string 1 switches) "-")
- 'new
- 'continued)
- (if (not (match-end 2)) 0
- ;; Subtract 1 to give number of lines before
- ;; first line.
- (1- (string-to-number (match-string 2 switches)))))))
- (preserve-indent
- (and switches (string-match "-i\\>" switches)))
- ;; Should labels be retained in (or stripped from) example
- ;; blocks?
- (retain-labels
- (or (not switches)
- (not (string-match "-r\\>" switches))
- (and number-lines (string-match "-k\\>" switches))))
- ;; What should code-references use - labels or
- ;; line-numbers?
- (use-labels
- (or (not switches)
- (and retain-labels
- (not (string-match "-k\\>" switches)))))
- (label-fmt
- (and switches
- (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
- ;; Standard block parsing.
- (begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (line-beginning-position 2))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- contents-begin contents-end)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'example-block
- (nconc
- (list :begin begin
- :end end
- :value value
- :switches switches
- :number-lines number-lines
- :preserve-indent preserve-indent
- :retain-labels retain-labels
- :use-labels use-labels
- :label-fmt label-fmt
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'example-block
+ (nconc
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (org-prog-plist
+ :switches
+ (progn
+ (looking-at "^[ \t]*#\\+BEGIN_EXAMPLE\\(?: +\\(.*\\)\\)?")
+ (match-string-no-properties 1))
+ ;; Switches analysis.
+ :number-lines
+ (and switches
+ (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
+ switches)
+ (cons
+ (if (equal (match-string 1 switches) "-")
+ 'new
+ 'continued)
+ (if (not (match-end 2)) 0
+ ;; Subtract 1 to give number of lines before
+ ;; first line.
+ (1- (string-to-number (match-string 2 switches))))))
+ :preserve-indent
+ (and switches (string-match "-i\\>" switches))
+ ;; Should labels be retained in (or stripped from) example
+ ;; blocks?
+ :retain-labels
+ (or (not switches)
+ (not (string-match "-r\\>" switches))
+ (and number-lines (string-match "-k\\>" switches)))
+ ;; What should code-references use - labels or
+ ;; line-numbers?
+ :use-labels
+ (or (not switches)
+ (and retain-labels
+ (not (string-match "-k\\>" switches))))
+ :label-fmt
+ (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches))
+ ;; Standard block parsing.
+ :begin (car affiliated)
+ :post-affiliated (point)
+ contents-begin (line-beginning-position 2)
+ :value (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ contents-begin contents-end))
+ pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point)
+ (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end))))
+ (cdr affiliated))))))
(defun org-element-example-block-interpreter (example-block _)
"Interpret EXAMPLE-BLOCK element as Org syntax."
@@ -2053,33 +1963,30 @@ Assume point is at export-block beginning."
(re-search-forward "^[ \t]*#\\+END_EXPORT[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (save-excursion
- (let* ((contents-end (match-beginning 0))
- (backend
- (progn
- (looking-at
- "[ \t]*#\\+BEGIN_EXPORT\\(?:[ \t]+\\(\\S-+\\)\\)?[ \t]*$")
- (match-string-no-properties 1)))
- (begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (progn (forward-line) (point)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position))))
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties contents-begin
- contents-end))))
- (list 'export-block
- (nconc
- (list :type (and backend (upcase backend))
- :begin begin
- :end end
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))))
+ (list 'export-block
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ 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))
+ :type (and backend (upcase backend))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))))
(defun org-element-export-block-interpreter (export-block _)
"Interpret EXPORT-BLOCK element as Org syntax."
@@ -2103,28 +2010,25 @@ containing `:begin', `:end', `:value', `:post-blank' and
`:post-affiliated' keywords.
Assume point is at the beginning of the fixed-width area."
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (end-area
- (progn
- (while (and (< (point) limit)
- (looking-at "[ \t]*:\\( \\|$\\)"))
- (forward-line))
- (if (bolp) (line-end-position 0) (point))))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'fixed-width
- (nconc
- (list :begin begin
- :end end
- :value (replace-regexp-in-string
- "^[ \t]*: ?" ""
- (buffer-substring-no-properties post-affiliated
- end-area))
- :post-blank (count-lines end-area end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'fixed-width
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ end-area (progn
+ (while (and (< (point) limit)
+ (looking-at "[ \t]*:\\( \\|$\\)"))
+ (forward-line))
+ (if (bolp) (line-end-position 0) (point)))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :value (replace-regexp-in-string
+ "^[ \t]*: ?" ""
+ (buffer-substring-no-properties post-affiliated
+ end-area))
+ :post-blank (count-lines end-area end)))
+ (cdr affiliated))))
(defun org-element-fixed-width-interpreter (fixed-width _)
"Interpret FIXED-WIDTH element as Org syntax."
@@ -2145,19 +2049,16 @@ their value.
Return a list whose CAR is `horizontal-rule' and CDR is a plist
containing `:begin', `:end', `:post-blank' and `:post-affiliated'
keywords."
- (save-excursion
- (let ((begin (car affiliated))
- (post-affiliated (point))
- (post-hr (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'horizontal-rule
- (nconc
- (list :begin begin
- :end end
- :post-blank (count-lines post-hr end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'horizontal-rule
+ (nconc (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ post-hr (progn (forward-line) (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines post-hr end)))
+ (cdr affiliated))))
(defun org-element-horizontal-rule-interpreter (&rest _)
"Interpret HORIZONTAL-RULE element as Org syntax."
@@ -2177,28 +2078,24 @@ their value.
Return a list whose CAR is a normalized `keyword' (uppercase) and
CDR is a plist containing `:key', `:value', `:begin', `:end',
`:post-blank' and `:post-affiliated' keywords."
- (save-excursion
- ;; An orphaned affiliated keyword is considered as a regular
- ;; keyword. In this case AFFILIATED is nil, so we take care of
- ;; this corner case.
- (let ((begin (or (car affiliated) (point)))
- (post-affiliated (point))
- (key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):")
- (upcase (match-string-no-properties 1))))
- (value (org-trim (buffer-substring-no-properties
- (match-end 0) (point-at-eol))))
- (pos-before-blank (progn (forward-line) (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'keyword
- (nconc
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated))))))
+ (list 'keyword
+ (nconc
+ (save-excursion
+ ;; An orphaned affiliated keyword is considered as a regular
+ ;; keyword. In this case AFFILIATED is nil, so we take care of
+ ;; this corner case.
+ (org-prog-plist
+ :begin (or (car affiliated) (point))
+ :post-affiliated (point)
+ :key (progn (looking-at "[ \t]*#\\+\\(\\S-*\\):")
+ (upcase (match-string-no-properties 1)))
+ :value (org-trim (buffer-substring-no-properties
+ (match-end 0) (point-at-eol)))
+ pos-before-blank (progn (forward-line) (point))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))
(defun org-element-keyword-interpreter (keyword _)
"Interpret KEYWORD element as Org syntax."
@@ -2243,19 +2140,17 @@ Assume point is at the beginning of the latex environment."
limit t))
;; Incomplete latex environment: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let* ((code-end (progn (forward-line) (point)))
- (begin (car affiliated))
- (value (buffer-substring-no-properties code-begin code-end))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'latex-environment
- (nconc
- (list :begin begin
- :end end
- :value value
- :post-blank (count-lines code-end end)
- :post-affiliated code-begin)
- (cdr affiliated))))))))
+ (list 'latex-environment
+ (nconc
+ (org-prog-plist
+ code-end (progn (forward-line) (point))
+ :begin (car affiliated)
+ :value (buffer-substring-no-properties code-begin code-end)
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines code-end end)
+ :post-affiliated code-begin)
+ (cdr affiliated)))))))
(defun org-element-latex-environment-interpreter (latex-environment _)
"Interpret LATEX-ENVIRONMENT element as Org syntax."
@@ -2273,22 +2168,18 @@ Return a list whose CAR is `node-property' and CDR is a plist
containing `:key', `:value', `:begin', `:end', `:post-blank' and
`:post-affiliated' keywords."
(looking-at org-property-re)
- (let ((case-fold-search t)
- (begin (point))
- (key (match-string-no-properties 2))
- (value (match-string-no-properties 3))
- (end (save-excursion
- (end-of-line)
- (if (re-search-forward org-property-re limit t)
- (line-beginning-position)
- limit))))
- (list 'node-property
- (list :key key
- :value value
- :begin begin
- :end end
- :post-blank 0
- :post-affiliated begin))))
+ (list 'node-property
+ (org-prog-plist case-fold-search t
+ :begin (point)
+ :key (match-string-no-properties 2)
+ :value (match-string-no-properties 3)
+ :end (save-excursion
+ (end-of-line)
+ (if (re-search-forward org-property-re limit t)
+ (line-beginning-position)
+ limit))
+ :post-blank 0
+ :post-affiliated begin)))
(defun org-element-node-property-interpreter (node-property _)
"Interpret NODE-PROPERTY element as Org syntax."
@@ -2312,59 +2203,56 @@ containing `:begin', `:end', `:contents-begin' and
`:contents-end', `:post-blank' and `:post-affiliated' keywords.
Assume point is at the beginning of the paragraph."
- (save-excursion
- (let* ((begin (car affiliated))
- (contents-begin (point))
- (before-blank
- (let ((case-fold-search t))
- (end-of-line)
- ;; A matching `org-element-paragraph-separate' is not
- ;; necessarily the end of the paragraph. In particular,
- ;; drawers, blocks or LaTeX environments opening lines
- ;; must be closed. Moreover keywords with a secondary
- ;; value must belong to "dual keywords".
- (while (not
- (cond
- ((not (and (re-search-forward
- org-element-paragraph-separate limit 'move)
- (progn (beginning-of-line) t))))
- ((looking-at org-drawer-regexp)
- (save-excursion
- (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
- ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
- (save-excursion
- (re-search-forward
- (format "^[ \t]*#\\+END_%s[ \t]*$"
- (regexp-quote (match-string 1)))
- limit t)))
- ((looking-at org-element--latex-begin-environment)
- (save-excursion
- (re-search-forward
- (format org-element--latex-end-environment
- (regexp-quote (match-string 1)))
- limit t)))
- ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:")
- (member-ignore-case (match-string 1)
- org-element-dual-keywords))
- ;; Everything else is unambiguous.
- (t)))
- (end-of-line))
- (if (= (point) limit) limit
- (goto-char (line-beginning-position)))))
- (contents-end (save-excursion
- (skip-chars-backward " \r\t\n" contents-begin)
- (line-beginning-position 2)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'paragraph
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines before-blank end)
- :post-affiliated contents-begin)
- (cdr affiliated))))))
+ (list 'paragraph
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :contents-begin (point)
+ before-blank
+ (let ((case-fold-search t))
+ (end-of-line)
+ ;; A matching `org-element-paragraph-separate' is not
+ ;; necessarily the end of the paragraph. In particular,
+ ;; drawers, blocks or LaTeX environments opening lines
+ ;; must be closed. Moreover keywords with a secondary
+ ;; value must belong to "dual keywords".
+ (while (not
+ (cond
+ ((not (and (re-search-forward
+ org-element-paragraph-separate limit 'move)
+ (progn (beginning-of-line) t))))
+ ((looking-at org-drawer-regexp)
+ (save-excursion
+ (re-search-forward "^[ \t]*:END:[ \t]*$" limit t)))
+ ((looking-at "[ \t]*#\\+BEGIN_\\(\\S-+\\)")
+ (save-excursion
+ (re-search-forward
+ (format "^[ \t]*#\\+END_%s[ \t]*$"
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at org-element--latex-begin-environment)
+ (save-excursion
+ (re-search-forward
+ (format org-element--latex-end-environment
+ (regexp-quote (match-string 1)))
+ limit t)))
+ ((looking-at "[ \t]*#\\+\\(\\S-+\\)\\[.*\\]:")
+ (member-ignore-case (match-string 1)
+ org-element-dual-keywords))
+ ;; Everything else is unambiguous.
+ (t)))
+ (end-of-line))
+ (if (= (point) limit) limit
+ (goto-char (line-beginning-position))))
+ :contents-end (save-excursion
+ (skip-chars-backward " \r\t\n" contents-begin)
+ (line-beginning-position 2))
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ :post-blank (count-lines before-blank end)
+ :post-affiliated contents-begin))
+ (cdr affiliated))))
(defun org-element-paragraph-interpreter (_ contents)
"Interpret paragraph element as Org syntax.
@@ -2383,32 +2271,27 @@ Return a list whose CAR is `planning' and CDR is a plist
containing `:closed', `:deadline', `:scheduled', `:begin',
`:end', `:post-blank' and `:post-affiliated' keywords."
(save-excursion
- (let* ((case-fold-search nil)
- (begin (point))
- (post-blank (let ((before-blank (progn (forward-line) (point))))
- (skip-chars-forward " \r\t\n" limit)
- (skip-chars-backward " \t")
- (unless (bolp) (end-of-line))
- (count-lines before-blank (point))))
- (end (point))
- closed deadline scheduled)
- (goto-char begin)
- (while (re-search-forward org-keyword-time-not-clock-regexp end t)
- (goto-char (match-end 1))
- (skip-chars-forward " \t" end)
- (let ((keyword (match-string 1))
- (time (org-element-timestamp-parser)))
- (cond ((equal keyword org-closed-string) (setq closed time))
- ((equal keyword org-deadline-string) (setq deadline time))
- (t (setq scheduled time)))))
- (list 'planning
- (list :closed closed
- :deadline deadline
- :scheduled scheduled
- :begin begin
- :end end
- :post-blank post-blank
- :post-affiliated begin)))))
+ (list 'planning
+ (org-prog-plist
+ case-fold-search nil
+ :begin (point)
+ :post-blank (let ((before-blank (progn (forward-line) (point))))
+ (skip-chars-forward " \r\t\n" limit)
+ (skip-chars-backward " \t")
+ (unless (bolp) (end-of-line))
+ (count-lines before-blank (point)))
+ :end (point)
+ :closed nil :deadline nil :scheduled nil
+ (goto-char begin)
+ (while (re-search-forward org-keyword-time-not-clock-regexp end t)
+ (goto-char (match-end 1))
+ (skip-chars-forward " \t" end)
+ (let ((keyword (match-string 1))
+ (time (org-element-timestamp-parser)))
+ (cond ((equal keyword org-closed-string) (setq closed time))
+ ((equal keyword org-deadline-string) (setq deadline time))
+ (t (setq scheduled time)))))
+ :post-affiliated begin))))
(defun org-element-planning-interpreter (planning _)
"Interpret PLANNING element as Org syntax."
@@ -2452,82 +2335,75 @@ Assume point is at the beginning of the block."
limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- ;; Get language as a string.
- (language
- (progn
- (looking-at
- "^[ \t]*#\\+BEGIN_SRC\
+ (list 'src-block
+ (nconc
+ (let ((contents-end (match-beginning 0)))
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ ;; Get language as a string.
+ :language
+ (progn
+ (looking-at
+ "^[ \t]*#\\+BEGIN_SRC\
\\(?: +\\(\\S-+\\)\\)?\
\\(\\(?: +\\(?:-\\(?:l \".+\"\\|[ikr]\\)\\|[-+]n\\(?: *[0-9]+\\)?\\)\\)+\\)?\
\\(.*\\)[ \t]*$")
- (match-string-no-properties 1)))
- ;; Get switches.
- (switches (match-string-no-properties 2))
- ;; Get parameters.
- (parameters (match-string-no-properties 3))
- ;; Switches analysis.
- (number-lines
- (and switches
- (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
- switches)
- (cons
- (if (equal (match-string 1 switches) "-")
- 'new
- 'continued)
- (if (not (match-end 2)) 0
- ;; Subtract 1 to give number of lines before
- ;; first line.
- (1- (string-to-number (match-string 2 switches)))))))
- (preserve-indent (and switches
- (string-match "-i\\>" switches)))
- (label-fmt
- (and switches
- (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
- (match-string 1 switches)))
- ;; Should labels be retained in (or stripped from)
- ;; source blocks?
- (retain-labels
- (or (not switches)
- (not (string-match "-r\\>" switches))
- (and number-lines (string-match "-k\\>" switches))))
- ;; What should code-references use - labels or
- ;; line-numbers?
- (use-labels
- (or (not switches)
- (and retain-labels
- (not (string-match "-k\\>" switches)))))
- ;; Retrieve code.
- (value (org-unescape-code-in-string
- (buffer-substring-no-properties
- (line-beginning-position 2) contents-end)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- ;; Get position after ending blank lines.
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'src-block
- (nconc
- (list :language language
- :switches (and (org-string-nw-p switches)
- (org-trim switches))
- :parameters (and (org-string-nw-p parameters)
- (org-trim parameters))
- :begin begin
- :end end
- :number-lines number-lines
- :preserve-indent preserve-indent
- :retain-labels retain-labels
- :use-labels use-labels
- :label-fmt label-fmt
- :value value
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (match-string-no-properties 1))
+ ;; Get switches.
+ switches (match-string-no-properties 2)
+ ;; Get parameters.
+ parameters (match-string-no-properties 3)
+ ;; Switches analysis.
+ :number-lines
+ (and switches
+ (string-match "\\([-+]\\)n\\(?: *\\([0-9]+\\)\\)?\\>"
+ switches)
+ (cons
+ (if (equal (match-string 1 switches) "-")
+ 'new
+ 'continued)
+ (if (not (match-end 2)) 0
+ ;; Subtract 1 to give number of lines before
+ ;; first line.
+ (1- (string-to-number (match-string 2 switches))))))
+ :preserve-indent (and switches
+ (string-match "-i\\>" switches))
+ :label-fmt
+ (and switches
+ (string-match "-l +\"\\([^\"\n]+\\)\"" switches)
+ (match-string 1 switches))
+ ;; Should labels be retained in (or stripped from)
+ ;; source blocks?
+ :retain-labels
+ (or (not switches)
+ (not (string-match "-r\\>" switches))
+ (and number-lines (string-match "-k\\>" switches)))
+ ;; What should code-references use - labels or
+ ;; line-numbers?
+ :use-labels
+ (or (not switches)
+ (and retain-labels
+ (not (string-match "-k\\>" switches))))
+ ;; Retrieve code.
+ :value (org-unescape-code-in-string
+ (buffer-substring-no-properties
+ (line-beginning-position 2) contents-end))
+ pos-before-blank (progn (goto-char contents-end)
+ (forward-line)
+ (point))
+ ;; Get position after ending blank lines.
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point)
+ (line-beginning-position)))
+ ;; Update switches and parameters
+ :switches (and (org-string-nw-p switches)
+ (org-trim switches))
+ :parameters (and (org-string-nw-p parameters)
+ (org-trim parameters))
+ :post-blank (count-lines pos-before-blank end))))
+ (cdr affiliated))))))
(defun org-element-src-block-interpreter (src-block _)
"Interpret SRC-BLOCK element as Org syntax."
@@ -2570,42 +2446,37 @@ Return a list whose CAR is `table' and CDR is a plist containing
keywords.
Assume point is at the beginning of the table."
- (save-excursion
- (let* ((case-fold-search t)
- (table-begin (point))
- (type (if (looking-at "[ \t]*|") 'org 'table.el))
- (end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
- (if (eq type 'org) "" "+")))
- (begin (car affiliated))
- (table-end
- (if (re-search-forward end-re limit 'move)
- (goto-char (match-beginning 0))
- (point)))
- (tblfm (let (acc)
- (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
- (push (match-string-no-properties 1) acc)
- (forward-line))
- acc))
- (pos-before-blank (point))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'table
- (nconc
- (list :begin begin
- :end end
- :type type
- :tblfm tblfm
- ;; Only `org' tables have contents. `table.el' tables
- ;; use a `:value' property to store raw table as
- ;; a string.
- :contents-begin (and (eq type 'org) table-begin)
- :contents-end (and (eq type 'org) table-end)
- :value (and (eq type 'table.el)
- (buffer-substring-no-properties
- table-begin table-end))
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated table-begin)
- (cdr affiliated))))))
+ (list 'table
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ case-fold-search t
+ table-begin (point)
+ :type (if (looking-at "[ \t]*|") 'org 'table.el)
+ end-re (format "^[ \t]*\\($\\|[^| \t%s]\\)"
+ (if (eq type 'org) "" "+"))
+ :begin (car affiliated)
+ table-end (if (re-search-forward end-re limit 'move)
+ (goto-char (match-beginning 0))
+ (point))
+ :tblfm (let (acc)
+ (while (looking-at "[ \t]*#\\+TBLFM: +\\(.*\\)[ \t]*$")
+ (push (match-string-no-properties 1) acc)
+ (forward-line))
+ acc)
+ pos-before-blank (point)
+ :end (progn (skip-chars-forward " \r\t\n" limit)
+ (if (eobp) (point) (line-beginning-position)))
+ ;; Only `org' tables have contents. `table.el' tables
+ ;; use a `:value' property to store raw table as
+ ;; a string.
+ :contents-begin (and (eq type 'org) table-begin)
+ :contents-end (and (eq type 'org) table-end)
+ :value (and (eq type 'table.el)
+ (buffer-substring-no-properties table-begin table-end))
+ :post-blank (count-lines pos-before-blank end)
+ :post-affiliated table-begin))
+ (cdr affiliated))))
(defun org-element-table-interpreter (table contents)
"Interpret TABLE element as Org syntax.
@@ -2628,26 +2499,21 @@ CONTENTS is a string, if table's type is `org', or nil."
Return a list whose CAR is `table-row' and CDR is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end',
`:type', `:post-blank' and `:post-affiliated' keywords."
- (save-excursion
- (let* ((type (if (looking-at "^[ \t]*|-") 'rule 'standard))
- (begin (point))
- ;; A table rule has no contents. In that case, ensure
- ;; CONTENTS-BEGIN matches CONTENTS-END.
- (contents-begin (and (eq type 'standard) (search-forward "|")))
- (contents-end (and (eq type 'standard)
- (progn
- (end-of-line)
- (skip-chars-backward " \t")
- (point))))
- (end (line-beginning-position 2)))
- (list 'table-row
- (list :type type
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank 0
- :post-affiliated begin)))))
+ (list 'table-row
+ (save-excursion
+ (org-prog-plist
+ :type (if (looking-at "^[ \t]*|-") 'rule 'standard)
+ :begin (point)
+ ;; A table rule has no contents. In that case, ensure
+ ;; CONTENTS-BEGIN matches CONTENTS-END.
+ :contents-begin (and (eq type 'standard) (search-forward "|"))
+ :contents-end (and (eq type 'standard)
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ :end (line-beginning-position 2)
+ :post-blank 0
+ :post-affiliated begin))))
(defun org-element-table-row-interpreter (table-row contents)
"Interpret TABLE-ROW element as Org syntax.
@@ -2676,25 +2542,21 @@ Assume point is at beginning of the block."
(re-search-forward "^[ \t]*#\\+END_VERSE[ \t]*$" limit t)))
;; Incomplete block: parse it as a paragraph.
(org-element-paragraph-parser limit affiliated)
- (let ((contents-end (match-beginning 0)))
- (save-excursion
- (let* ((begin (car affiliated))
- (post-affiliated (point))
- (contents-begin (progn (forward-line) (point)))
- (pos-before-blank (progn (goto-char contents-end)
- (forward-line)
- (point)))
- (end (progn (skip-chars-forward " \r\t\n" limit)
- (if (eobp) (point) (line-beginning-position)))))
- (list 'verse-block
- (nconc
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank (count-lines pos-before-blank end)
- :post-affiliated post-affiliated)
- (cdr affiliated)))))))))
+ (list 'verse-block
+ (nconc
+ (save-excursion
+ (org-prog-plist
+ :begin (car affiliated)
+ :post-affiliated (point)
+ :contents-begin (progn (forward-line) (point))
+ :contents-end (match-beginning 0)
+ 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)))
+ :post-blank (count-lines pos-before-blank end)))
+ (cdr affiliated))))))
(defun org-element-verse-block-interpreter (_ contents)
"Interpret verse-block element as Org syntax.
@@ -2732,18 +2594,12 @@ Assume point is at the first star marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'bold
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'bold (list :begin (match-beginning 2)
+ :contents-begin (match-beginning 4)
+ :contents-end (match-end 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-bold-interpreter (_ contents)
"Interpret bold object as Org syntax.
@@ -2764,16 +2620,11 @@ Assume point is at the first tilde marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-verbatim-re)
- (let ((begin (match-beginning 2))
- (value (match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'code
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (list 'code (list :value (match-string-no-properties 4)
+ :begin (match-beginning 2)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-code-interpreter (code _)
"Interpret CODE object as Org syntax."
@@ -2793,27 +2644,25 @@ a plist with `:begin', `:end', `:latex', `:latex-math-p',
Assume point is at the beginning of the entity."
(catch 'no-object
(when (looking-at "\\\\\\(?:\\(?1:_ +\\)\\|\\(?1:there4\\|sup[123]\\|frac[13][24]\\|[a-zA-Z]+\\)\\(?2:$\\|{}\\|[^[:alpha:]]\\)\\)")
- (save-excursion
- (let* ((value (or (org-entity-get (match-string 1))
- (throw 'no-object nil)))
- (begin (match-beginning 0))
- (bracketsp (string= (match-string 2) "{}"))
- (post-blank (progn (goto-char (match-end 1))
- (when bracketsp (forward-char 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'entity
- (list :name (car value)
- :latex (nth 1 value)
- :latex-math-p (nth 2 value)
- :html (nth 3 value)
- :ascii (nth 4 value)
- :latin1 (nth 5 value)
- :utf-8 (nth 6 value)
- :begin begin
- :end end
- :use-brackets-p bracketsp
- :post-blank post-blank)))))))
+ (list 'entity
+ (save-excursion
+ (org-prog-plist
+ value (or (org-entity-get (match-string 1))
+ (throw 'no-object nil))
+ :begin (match-beginning 0)
+ bracketsp (string= (match-string 2) "{}")
+ :post-blank (progn (goto-char (match-end 1))
+ (when bracketsp (forward-char 2))
+ (skip-chars-forward " \t"))
+ :end (point)
+ :name (car value)
+ :latex (nth 1 value)
+ :latex-math-p (nth 2 value)
+ :html (nth 3 value)
+ :ascii (nth 4 value)
+ :latin1 (nth 5 value)
+ :utf-8 (nth 6 value)
+ :use-brackets-p bracketsp))))))
(defun org-element-entity-interpreter (entity _)
"Interpret ENTITY object as Org syntax."
@@ -2840,18 +2689,12 @@ Assume point is at the beginning of the snippet."
(save-match-data (goto-char (match-end 0))
(re-search-forward "@@" nil t)
(match-beginning 0))))
- (let* ((begin (match-beginning 0))
- (back-end (match-string-no-properties 1))
- (value (buffer-substring-no-properties
- (match-end 0) contents-end))
- (post-blank (skip-chars-forward " \t"))
- (end (point)))
- (list 'export-snippet
- (list :back-end back-end
- :value value
- :begin begin
- :end end
- :post-blank post-blank)))))))
+ (list 'export-snippet (list :begin (match-beginning 0)
+ :back-end (match-string-no-properties 1)
+ :value (buffer-substring-no-properties
+ (match-end 0) contents-end)
+ :post-blank (skip-chars-forward " \t")
+ :end (point)))))))
(defun org-element-export-snippet-interpreter (export-snippet _)
"Interpret EXPORT-SNIPPET object as Org syntax."
@@ -2873,23 +2716,19 @@ When at a footnote reference, return a list whose car is
(let ((closing (with-syntax-table org-element--pair-square-table
(ignore-errors (scan-lists (point) 1 0)))))
(when closing
- (save-excursion
- (let* ((begin (point))
- (label (match-string-no-properties 1))
- (inner-begin (match-end 0))
- (inner-end (1- closing))
- (type (if (match-end 2) 'inline 'standard))
- (post-blank (progn (goto-char closing)
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'footnote-reference
- (list :label label
- :type type
- :begin begin
- :end end
- :contents-begin (and (eq type 'inline) inner-begin)
- :contents-end (and (eq type 'inline) inner-end)
- :post-blank post-blank))))))))
+ (list 'footnote-reference
+ (save-excursion
+ (org-prog-plist
+ :label (match-string-no-properties 1)
+ :begin (point)
+ 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)
+ :contents-begin (and (eq type 'inline) inner-begin)
+ :contents-end (and (eq type 'inline) inner-end))))))))
(defun org-element-footnote-reference-interpreter (footnote-reference contents)
"Interpret FOOTNOTE-REFERENCE object as Org syntax.
@@ -2915,32 +2754,25 @@ Assume point is at the beginning of the babel call."
(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)))))))
+ (list 'inline-babel-call
+ (org-prog-plist
+ :call (match-string-no-properties 1)
+ :begin (match-beginning 0)
+ p (org-element--parse-paired-brackets ?\[)
+ :inside-header
+ (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)))
+ p (org-element--parse-paired-brackets ?\[)
+ :end-header
+ (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)))))))
(defun org-element-inline-babel-call-interpreter (inline-babel-call _)
"Interpret INLINE-BABEL-CALL object as Org syntax."
@@ -2969,22 +2801,18 @@ Assume point is at the beginning of the inline source block."
(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)))))))
+ (list 'inline-src-block
+ (org-prog-plist
+ :begin (match-beginning 0)
+ :language (match-string-no-properties 1)
+ p (org-element--parse-paired-brackets ?\[)
+ :parameters
+ (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")
+ :end (point)))))))
(defun org-element-inline-src-block-interpreter (inline-src-block _)
"Interpret INLINE-SRC-BLOCK object as Org syntax."
@@ -3010,18 +2838,12 @@ Assume point is at the first slash marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'italic
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'italic (list :begin (match-beginning 2)
+ :contents-begin (match-beginning 4)
+ :contents-end (match-end 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-italic-interpreter (_ contents)
"Interpret italic object as Org syntax.
@@ -3041,8 +2863,10 @@ and `:post-blank' as keywords. Otherwise, return nil.
Assume point is at the beginning of the LaTeX fragment."
(catch 'no-object
(save-excursion
- (let* ((begin (point))
- (after-fragment
+ (list 'latex-frament
+ (org-prog-plist
+ :begin (point)
+ after-fragment
(cond
((not (eq ?$ (char-after)))
(pcase (char-after (1+ (point)))
@@ -3055,26 +2879,21 @@ Assume point is at the beginning of the LaTeX fragment."
(match-end 0)))))
((eq ?$ (char-after (1+ (point))))
(search-forward "$$" nil t 2))
- (t
- (and (not (eq ?$ (char-before)))
- (not (memq (char-after (1+ (point)))
- '(?\s ?\t ?\n ?, ?. ?\;)))
- (search-forward "$" nil t 2)
- (not (memq (char-before (match-beginning 0))
- '(?\s ?\t ?\n ?, ?.)))
- (looking-at-p
- "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)")
- (point)))))
- (post-blank
- (if (not after-fragment) (throw 'no-object nil)
- (goto-char after-fragment)
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'latex-fragment
- (list :value (buffer-substring-no-properties begin after-fragment)
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (t (and (not (eq ?$ (char-before)))
+ (not (memq (char-after (1+ (point)))
+ '(?\s ?\t ?\n ?, ?. ?\;)))
+ (search-forward "$" nil t 2)
+ (not (memq (char-before (match-beginning 0))
+ '(?\s ?\t ?\n ?, ?.)))
+ (looking-at-p
+ "\\(\\s.\\|\\s-\\|\\s(\\|\\s)\\|\\s\"\\|'\\|$\\)")
+ (point))))
+ :post-blank (if (not after-fragment) (throw 'no-object nil)
+ (goto-char after-fragment)
+ (skip-chars-forward " \t"))
+ :end (point)
+ :value (buffer-substring-no-properties
+ begin after-fragment))))))
(defun org-element-latex-fragment-interpreter (latex-fragment _)
"Interpret LATEX-FRAGMENT object as Org syntax."
@@ -3115,123 +2934,115 @@ 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 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")
- (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. [[https://orgmode.org][homepage]]
- ((looking-at org-link-bracket-re)
- (setq format 'bracket)
- (setq contents-begin (match-beginning 2))
- (setq contents-end (match-end 2))
- (setq link-end (match-end 0))
- ;; RAW-LINK is the original link. Decode any encoding.
- ;; Expand any abbreviation in it.
- ;;
- ;; Also treat any newline character and associated
- ;; indentation as a single space character. This is not
- ;; compatible with RFC 3986, which requires to ignore
- ;; them altogether. However, doing so would require
- ;; users to encode spaces on the fly when writing links
- ;; (e.g., insert [[shell:ls%20*.org]] instead of
- ;; [[shell:ls *.org]], which defeats Org's focus on
- ;; simplicity.
- (setq raw-link (org-link-expand-abbrev
- (org-link-unescape
- (replace-regexp-in-string
- "[ \t]*\n[ \t]*" " "
- (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.
- (cond
- ;; File type.
- ((or (file-name-absolute-p raw-link)
- (string-match "\\`\\.\\.?/" raw-link))
- (setq type "file")
- (setq path raw-link))
- ;; 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))))
- ;; Code-ref type: PATH is the name of the reference.
- ((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.
- ((= (string-to-char raw-link) ?#)
- (setq type "custom-id")
- (setq path (substring raw-link 1)))
- ;; Fuzzy type: Internal link either matches a target, an
- ;; headline name or nothing. PATH is the target or
- ;; headline's name.
- (t
- (setq type "fuzzy")
- (setq path raw-link))))
- ;; Type 3: Plain link, e.g., https://orgmode.org
- ((looking-at org-link-plain-re)
- (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., <https://orgmode.org>. Unlike to
- ;; bracket links, follow RFC 3986 and remove any extra
- ;; whitespace in URI.
- ((looking-at org-link-angle-re)
- (setq format 'angle)
- (setq type (match-string-no-properties 1))
- (setq link-end (match-end 0))
- (setq raw-link
- (buffer-substring-no-properties
- (match-beginning 1) (match-end 2)))
- (setq path (replace-regexp-in-string
- "[ \t]*\n[ \t]*" "" (match-string-no-properties 2))))
- (t (throw 'no-object nil)))
- ;; In any case, deduce end point after trailing white space from
- ;; LINK-END variable.
- (save-excursion
- (setq post-blank
- (progn (goto-char link-end) (skip-chars-forward " \t")))
- (setq end (point)))
- ;; Special "file"-type link processing. Extract opening
- ;; application and search option, if any. Also normalize URI.
- (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
- (setq application (match-string 1 type))
- (setq type "file")
- (when (string-match "::\\(.*\\)\\'" path)
- (setq search-option (match-string 1 path))
- (setq path (replace-match "" nil nil path)))
- (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path)))
- ;; Translate link, if `org-link-translation-function' is set.
- (let ((trans (and (functionp org-link-translation-function)
- (funcall org-link-translation-function type path))))
- (when trans
- (setq type (car trans))
- (setq path (cdr trans))))
- (list 'link
- (list :type type
- :path path
- :format format
- :raw-link (or raw-link path)
- :application application
- :search-option search-option
- :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank)))))
+ (list 'link
+ (org-prog-plist
+ :begin (point)
+ :end nil :contents-begin nil :contents-end nil
+ :link-end nil :post-blank nil :path nil :type nil :format nil
+ raw-link nil
+ :search-option nil :application nil
+ (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")
+ (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. [[https://orgmode.org][homepage]]
+ ((looking-at org-link-bracket-re)
+ (setq format 'bracket)
+ (setq contents-begin (match-beginning 2))
+ (setq contents-end (match-end 2))
+ (setq link-end (match-end 0))
+ ;; RAW-LINK is the original link. Decode any encoding.
+ ;; Expand any abbreviation in it.
+ ;;
+ ;; Also treat any newline character and associated
+ ;; indentation as a single space character. This is not
+ ;; compatible with RFC 3986, which requires to ignore
+ ;; them altogether. However, doing so would require
+ ;; users to encode spaces on the fly when writing links
+ ;; (e.g., insert [[shell:ls%20*.org]] instead of
+ ;; [[shell:ls *.org]], which defeats Org's focus on
+ ;; simplicity.
+ (setq raw-link (org-link-expand-abbrev
+ (org-link-unescape
+ (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" " "
+ (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.
+ (cond
+ ;; File type.
+ ((or (file-name-absolute-p raw-link)
+ (string-match "\\`\\.\\.?/" raw-link))
+ (setq type "file")
+ (setq path raw-link))
+ ;; 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))))
+ ;; Code-ref type: PATH is the name of the reference.
+ ((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.
+ ((= (string-to-char raw-link) ?#)
+ (setq type "custom-id")
+ (setq path (substring raw-link 1)))
+ ;; Fuzzy type: Internal link either matches a target, an
+ ;; headline name or nothing. PATH is the target or
+ ;; headline's name.
+ (t
+ (setq type "fuzzy")
+ (setq path raw-link))))
+ ;; Type 3: Plain link, e.g., https://orgmode.org
+ ((looking-at org-link-plain-re)
+ (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., <https://orgmode.org>. Unlike to
+ ;; bracket links, follow RFC 3986 and remove any extra
+ ;; whitespace in URI.
+ ((looking-at org-link-angle-re)
+ (setq format 'angle)
+ (setq type (match-string-no-properties 1))
+ (setq link-end (match-end 0))
+ (setq raw-link
+ (buffer-substring-no-properties
+ (match-beginning 1) (match-end 2)))
+ (setq path (replace-regexp-in-string
+ "[ \t]*\n[ \t]*" "" (match-string-no-properties 2))))
+ (t (throw 'no-object nil)))
+ ;; In any case, deduce end point after trailing white space from
+ ;; LINK-END variable.
+ (save-excursion
+ (setq post-blank
+ (progn (goto-char link-end) (skip-chars-forward " \t")))
+ (setq end (point)))
+ ;; Special "file" type link processing. Extract opening
+ ;; application and search option, if any. Also normalize URI.
+ (when (string-match "\\`file\\(?:\\+\\(.+\\)\\)?\\'" type)
+ (setq application (match-string 1 type) type "file")
+ (when (string-match "::\\(.*\\)\\'" path)
+ (setq search-option (match-string 1 path))
+ (setq path (replace-match "" nil nil path)))
+ (setq path (replace-regexp-in-string "\\`///*\\(.:\\)?/" "\\1/" path)))
+ ;; Translate link, if `org-link-translation-function' is set.
+ (let ((trans (and (functionp org-link-translation-function)
+ (funcall org-link-translation-function type path))))
+ (when trans
+ (setq type (car trans))
+ (setq path (cdr trans))))
+ :raw-link (or raw-link path)))))
(defun org-element-link-interpreter (link contents)
"Interpret LINK object as Org syntax.
@@ -3285,24 +3096,18 @@ a plist with `:key', `:args', `:begin', `:end', `:value' and
Assume point is at the macro."
(save-excursion
(when (looking-at "{{{\\([a-zA-Z][-a-zA-Z0-9_]*\\)\\((\\([^\000]*?\\))\\)?}}}")
- (let ((begin (point))
- (key (downcase (match-string-no-properties 1)))
- (value (match-string-no-properties 0))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (args (pcase (match-string-no-properties 3)
- (`nil nil)
- (a (org-macro-extract-arguments
- (replace-regexp-in-string
- "[ \t\r\n]+" " " (org-trim a)))))))
- (list 'macro
- (list :key key
- :value value
- :args args
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (list 'macro
+ (list :begin (point)
+ :key (downcase (match-string-no-properties 1))
+ :value (match-string-no-properties 0)
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point)
+ :args (pcase (match-string-no-properties 3)
+ (`nil nil)
+ (a (org-macro-extract-arguments
+ (replace-regexp-in-string
+ "[ \t\r\n]+" " " (org-trim a))))))))))
(defun org-element-macro-interpreter (macro _)
"Interpret MACRO object as Org syntax."
@@ -3326,20 +3131,14 @@ Otherwise, return nil.
Assume point is at the radio target."
(save-excursion
(when (looking-at org-radio-target-regexp)
- (let ((begin (point))
- (contents-begin (match-beginning 1))
- (contents-end (match-end 1))
- (value (match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'radio-target
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank
- :value value))))))
+ (list 'radio-target
+ (list :begin (point)
+ :contents-begin (match-beginning 1)
+ :contents-end (match-end 1)
+ :value (match-string-no-properties 1)
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-radio-target-interpreter (_ contents)
"Interpret target object as Org syntax.
@@ -3359,17 +3158,13 @@ When at a statistics cookie, return a list whose car is
Assume point is at the beginning of the statistics-cookie."
(save-excursion
(when (looking-at "\\[[0-9]*\\(%\\|/[0-9]*\\)\\]")
- (let* ((begin (point))
- (value (buffer-substring-no-properties
- (match-beginning 0) (match-end 0)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'statistics-cookie
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank))))))
+ (list 'statistics-cookie
+ (list :begin (point)
+ :value (buffer-substring-no-properties
+ (match-beginning 0) (match-end 0))
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-statistics-cookie-interpreter (statistics-cookie _)
"Interpret STATISTICS-COOKIE object as Org syntax."
@@ -3390,18 +3185,13 @@ Assume point is at the first plus sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'strike-through
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'strike-through
+ (list :begin (match-beginning 2)
+ :contents-begin (match-beginning 4)
+ :contents-end (match-end 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-strike-through-interpreter (_ contents)
"Interpret strike-through object as Org syntax.
@@ -3423,21 +3213,14 @@ Assume point is at the underscore."
(save-excursion
(unless (bolp) (backward-char))
(when (looking-at org-match-substring-regexp)
- (let ((bracketsp (match-beginning 4))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 4)
- (match-beginning 3)))
- (contents-end (or (match-end 4) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'subscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'subscript
+ (list :use-brackets-p (match-beginning 4)
+ :begin (match-beginning 2)
+ :contents-begin (or (match-beginning 4) (match-beginning 3))
+ :contents-end (or (match-end 4) (match-end 3))
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-subscript-interpreter (subscript contents)
"Interpret SUBSCRIPT object as Org syntax.
@@ -3461,21 +3244,14 @@ Assume point is at the caret."
(save-excursion
(unless (bolp) (backward-char))
(when (looking-at org-match-substring-regexp)
- (let ((bracketsp (match-beginning 4))
- (begin (match-beginning 2))
- (contents-begin (or (match-beginning 4)
- (match-beginning 3)))
- (contents-end (or (match-end 4) (match-end 3)))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'superscript
- (list :begin begin
- :end end
- :use-brackets-p bracketsp
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'superscript
+ (list :use-brackets-p (match-beginning 4)
+ :begin (match-beginning 2)
+ :contents-begin (or (match-beginning 4) (match-beginning 3))
+ :contents-end (or (match-end 4) (match-end 3))
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-superscript-interpreter (superscript contents)
"Interpret SUPERSCRIPT object as Org syntax.
@@ -3493,16 +3269,11 @@ Return a list whose car is `table-cell' and cdr is a plist
containing `:begin', `:end', `:contents-begin', `:contents-end'
and `:post-blank' keywords."
(looking-at "[ \t]*\\(.*?\\)[ \t]*\\(?:|\\|$\\)")
- (let* ((begin (match-beginning 0))
- (end (match-end 0))
- (contents-begin (match-beginning 1))
- (contents-end (match-end 1)))
- (list 'table-cell
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank 0))))
+ (list 'table-cell (list :begin (match-beginning 0)
+ :end (match-end 0)
+ :contents-begin (match-beginning 1)
+ :contents-end (match-end 1)
+ :post-blank 0)))
(defun org-element-table-cell-interpreter (_ contents)
"Interpret table-cell element as Org syntax.
@@ -3522,16 +3293,11 @@ keywords. Otherwise, return nil.
Assume point is at the target."
(save-excursion
(when (looking-at org-target-regexp)
- (let ((begin (point))
- (value (match-string-no-properties 1))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'target
- (list :begin begin
- :end end
- :value value
- :post-blank post-blank))))))
+ (list 'target (list :begin (point)
+ :value (match-string-no-properties 1)
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-target-interpreter (target _)
"Interpret TARGET object as Org syntax."
@@ -3563,91 +3329,76 @@ Otherwise, return nil.
Assume point is at the beginning of the timestamp."
(when (looking-at-p org-element--timestamp-regexp)
(save-excursion
- (let* ((begin (point))
- (activep (eq (char-after) ?<))
- (raw-value
- (progn
- (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
- (match-string-no-properties 0)))
- (date-start (match-string-no-properties 1))
- (date-end (match-string 3))
- (diaryp (match-beginning 2))
- (post-blank (progn (goto-char (match-end 0))
- (skip-chars-forward " \t")))
- (end (point))
- (time-range
- (and (not diaryp)
- (string-match
- "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
- date-start)
- (cons (string-to-number (match-string 2 date-start))
- (string-to-number (match-string 3 date-start)))))
- (type (cond (diaryp 'diary)
- ((and activep (or date-end time-range)) 'active-range)
- (activep 'active)
- ((or date-end time-range) 'inactive-range)
- (t 'inactive)))
- (repeater-props
- (and (not diaryp)
- (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
- raw-value)
- (list
- :repeater-type
- (let ((type (match-string 1 raw-value)))
- (cond ((equal "++" type) 'catch-up)
- ((equal ".+" type) 'restart)
- (t 'cumulate)))
- :repeater-value (string-to-number (match-string 2 raw-value))
- :repeater-unit
- (pcase (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
- (warning-props
- (and (not diaryp)
- (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
- (list
- :warning-type (if (match-string 1 raw-value) 'first 'all)
- :warning-value (string-to-number (match-string 2 raw-value))
- :warning-unit
- (pcase (string-to-char (match-string 3 raw-value))
- (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year)))))
- year-start month-start day-start hour-start minute-start year-end
- month-end day-end hour-end minute-end)
- ;; Parse date-start.
- (unless diaryp
- (let ((date (org-parse-time-string date-start t)))
- (setq year-start (nth 5 date)
- month-start (nth 4 date)
- day-start (nth 3 date)
- hour-start (nth 2 date)
- minute-start (nth 1 date))))
- ;; Compute date-end. It can be provided directly in time-stamp,
- ;; or extracted from time range. Otherwise, it defaults to the
- ;; same values as date-start.
- (unless diaryp
- (let ((date (and date-end (org-parse-time-string date-end t))))
- (setq year-end (or (nth 5 date) year-start)
- month-end (or (nth 4 date) month-start)
- day-end (or (nth 3 date) day-start)
- hour-end (or (nth 2 date) (car time-range) hour-start)
- minute-end (or (nth 1 date) (cdr time-range) minute-start))))
- (list 'timestamp
- (nconc (list :type type
- :raw-value raw-value
- :year-start year-start
- :month-start month-start
- :day-start day-start
- :hour-start hour-start
- :minute-start minute-start
- :year-end year-end
- :month-end month-end
- :day-end day-end
- :hour-end hour-end
- :minute-end minute-end
- :begin begin
- :end end
- :post-blank post-blank)
- repeater-props
- warning-props))))))
+ (org-let*-prog-plist
+ (plist
+ :begin (point)
+ activep (eq (char-after) ?<)
+ :raw-value
+ (progn
+ (looking-at "\\([<[]\\(%%\\)?.*?\\)[]>]\\(?:--\\([<[].*?[]>]\\)\\)?")
+ (match-string-no-properties 0))
+ date-start (match-string-no-properties 1)
+ date-end (match-string 3)
+ diaryp (match-beginning 2)
+ :post-blank (progn (goto-char (match-end 0))
+ (skip-chars-forward " \t"))
+ :end (point)
+ time-range
+ (and (not diaryp)
+ (string-match
+ "[012]?[0-9]:[0-5][0-9]\\(-\\([012]?[0-9]\\):\\([0-5][0-9]\\)\\)"
+ date-start)
+ (cons (string-to-number (match-string 2 date-start))
+ (string-to-number (match-string 3 date-start))))
+ :type (cond (diaryp 'diary)
+ ((and activep (or date-end time-range)) 'active-range)
+ (activep 'active)
+ ((or date-end time-range) 'inactive-range)
+ (t 'inactive))
+ repeater-props
+ (and (not diaryp)
+ (string-match "\\([.+]?\\+\\)\\([0-9]+\\)\\([hdwmy]\\)"
+ raw-value)
+ (list
+ :repeater-type
+ (let ((type (match-string 1 raw-value)))
+ (cond ((equal "++" type) 'catch-up)
+ ((equal ".+" type) 'restart)
+ (t 'cumulate)))
+ :repeater-value (string-to-number (match-string 2 raw-value))
+ :repeater-unit
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))
+ warning-props
+ (and (not diaryp)
+ (string-match "\\(-\\)?-\\([0-9]+\\)\\([hdwmy]\\)" raw-value)
+ (list
+ :warning-type (if (match-string 1 raw-value) 'first 'all)
+ :warning-value (string-to-number (match-string 2 raw-value))
+ :warning-unit
+ (pcase (string-to-char (match-string 3 raw-value))
+ (?h 'hour) (?d 'day) (?w 'week) (?m 'month) (_ 'year))))
+ :year-start nil :month-start nil :day-start nil :hour-start nil :minute-start nil
+ :year-end nil :month-end nil :day-end nil :hour-end nil :minute-end nil
+ ;; Parse date-start.
+ (unless diaryp
+ (let ((date (org-parse-time-string date-start t)))
+ (setq year-start (nth 5 date)
+ month-start (nth 4 date)
+ day-start (nth 3 date)
+ hour-start (nth 2 date)
+ minute-start (nth 1 date))))
+ ;; Compute date-end. It can be provided directly in time-stamp,
+ ;; or extracted from time range. Otherwise, it defaults to the
+ ;; same values as date-start.
+ (unless diaryp
+ (let ((date (and date-end (org-parse-time-string date-end t))))
+ (setq year-end (or (nth 5 date) year-start)
+ month-end (or (nth 4 date) month-start)
+ day-end (or (nth 3 date) day-start)
+ hour-end (or (nth 2 date) (car time-range) hour-start)
+ minute-end (or (nth 1 date) (cdr time-range) minute-start)))))
+ (list 'timestamp (nconc plist repeater-props warning-props))))))
(defun org-element-timestamp-interpreter (timestamp _)
"Interpret TIMESTAMP object as Org syntax."
@@ -3758,18 +3509,12 @@ Assume point is at the first underscore marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-emph-re)
- (let ((begin (match-beginning 2))
- (contents-begin (match-beginning 4))
- (contents-end (match-end 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'underline
- (list :begin begin
- :end end
- :contents-begin contents-begin
- :contents-end contents-end
- :post-blank post-blank))))))
+ (list 'underline (list :begin (match-beginning 2)
+ :contents-begin (match-beginning 4)
+ :contents-end (match-end 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-underline-interpreter (_ contents)
"Interpret underline object as Org syntax.
@@ -3790,16 +3535,11 @@ Assume point is at the first equal sign marker."
(save-excursion
(unless (bolp) (backward-char 1))
(when (looking-at org-verbatim-re)
- (let ((begin (match-beginning 2))
- (value (match-string-no-properties 4))
- (post-blank (progn (goto-char (match-end 2))
- (skip-chars-forward " \t")))
- (end (point)))
- (list 'verbatim
- (list :value value
- :begin begin
- :end end
- :post-blank post-blank))))))
+ (list 'verbatim (list :begin (match-beginning 2)
+ :value (match-string-no-properties 4)
+ :post-blank (progn (goto-char (match-end 2))
+ (skip-chars-forward " \t"))
+ :end (point))))))
(defun org-element-verbatim-interpreter (verbatim _)
"Interpret VERBATIM object as Org syntax."
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index f25efe07f..8c43601eb 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -33,6 +33,8 @@
(require 'cl-lib)
(require 'format-spec)
+(eval-when-compile (require 'cl-macs))
+(require 'cl-seq) ; cl-reduce
(declare-function org-show-context "org" (&optional key))
(declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case))
@@ -49,6 +51,263 @@
symbols)
,@body))
+(when (version< emacs-version "28")
+ ;; Should be removed once Org drops support for Emacs 27 and older.
+ ;; `keyword' type is provided natively in `cl-macs' since 2020-07-06
+ (cl-deftype keyword () '(satisfies keywordp)))
+
+(eval-when-compile
+ (defun org-dekeyword (symbol)
+ ;; There is nothing org-specific about this definition. It better be moved.
+ "Given SYMBOL, return symbol with name as in SYMBOL but normalized: namely, without the leading colon, if it is present.
+
+Examples:
+
+ELISP> (org-dekeyword :x)
+x
+
+ELISP> (org-dekeyword 'x)
+x"
+ (cl-etypecase symbol
+ (keyword (intern (substring (symbol-name symbol) 1)))
+ (symbol symbol))))
+
+(eval-when-compile
+ (defun org-fold (f x seq)
+ "Reduce F over SEQ with obligatory initial value X."
+ ;; There is nothing org-specific about this definition. It better be moved.
+ (cl-reduce f seq :initial-value x)))
+
+(defmacro org-prog-plist (&rest bindings-and-compound-forms)
+ ;; There is nothing org-specific about this definition. It better be moved.
+ ;;
+ ;; TODO: maybe support positions, absolute or relative (or both):
+ ;; sometimes one wants pairs to be in plist in specific order
+ ;; since numbers self-evaluate and are useless as code,
+ ;;
+ ;; one could have e.g.
+ ;; (org-prog-plist
+ ;; :p a
+ ;; 0 :q b
+ ;; :r c
+ ;; 1 :s d)
+ ;; specify that q property should be plisted first, s property second,
+ ;;
+ ;; and e.g.
+ ;; (org-prog-plist
+ ;; :p a
+ ;; (0) :q b
+ ;; :r c
+ ;; (1) :s d)
+ ;; specify that s property should be plisted after q property.
+ ;;
+ ;; However, one could imagine some similar prog-ptree macro
+ ;; that arranges results at different depth, in which case
+ ;; (0), ((0)) and deeper specs should probably be reserved for level specs
+ "Construct a plist, imperatively (hence prog- prefix) and conveniently.
+
+Examples:
+
+Trivial plist:
+ELISP> (org-prog-plist
+ :x 1
+ :z 2)
+(:x 1 :z 2)
+
+Evaluate arbitrary compound forms between key-value pairs:
+ELISP> (macroexpand-1
+ `(org-prog-plist
+ :x 1
+ (message \"Building rest of plist\")
+ :z 2))
+(let* ((x 1))
+ (message \"Building rest of plist\")
+ (let* ((z 2))
+ (list :x x :z z)))
+
+Reference previous values when building subsequent ones:
+ELISP> (org-prog-plist
+ :x 1
+ :z (+ x 40 x))
+(:x 1 :z 42)
+
+Modify previous values when building subsequent ones:
+ELISP> (org-prog-plist
+ :x 1
+ :z (+ (cl-incf x) 40))
+(:x 2 :z 42)
+
+Bind temporary variables omitted from the resulting plist:
+ELISP> (macroexpand-1
+ `(org-prog-plist
+ :x 1
+ y 40
+ (incf y)
+ :z (+ x y)))
+(let* ((x 1)
+ (y 40))
+ (incf y)
+ (let* ((z (+ x y)))
+ (list :x x :z z)))
+
+Note: to reuse temporary variables, please employ `org-let*-prog-plist', `org-let*-prog-plists'."
+ (declare (indent 0))
+ (let ((headers (list (list 'progn))) bindings plist-form
+ (reading 'symbol-or-compound-form))
+ (cl-symbol-macrolet ((maybe-push-bindings-to-headers
+ (if bindings
+ (prog1 (push (list (nreverse bindings) 'let*)
+ headers)
+ (setf bindings nil))
+ headers))
+ (setf-form-in-current-binding
+ (setf (cadar bindings) it
+ reading 'symbol-or-compound-form)))
+ (cl-flet ((cleanup (form) (if (and (consp (cadar form))
+ (eq 'let* (caadar form)))
+ (cadar form)
+ (car form))))
+ (dolist (it bindings-and-compound-forms
+ (cleanup
+ (org-fold (lambda (form header)
+ (dolist (e header (list form))
+ (push e form)))
+ (list (cons 'list (nreverse plist-form)))
+ maybe-push-bindings-to-headers)))
+ (cl-ecase reading
+ (keyword-form (push (org-dekeyword (car plist-form)) plist-form)
+ setf-form-in-current-binding)
+ (variable-form setf-form-in-current-binding)
+ (symbol-or-compound-form
+ (cl-etypecase it
+ (keyword (if (cl-loop for (_value key) on plist-form by #'cddr
+ do (when (eq it key) (cl-return t)))
+ (setf reading 'repeated-keyword-form)
+ (push it plist-form)
+ (setf reading 'keyword-form))
+ (push (list (org-dekeyword it) nil) bindings))
+ (symbol (push (list it nil) bindings)
+ (setf reading 'variable-form))
+ ;; it might be better to write compound-form instead of cons
+ ;; however, lack of namespaces means it'd be org-compound-form
+ ;; which we deemed obnoxious
+ ;; anyway, conses here are meant to be compound forms
+ (cons maybe-push-bindings-to-headers
+ (push it (car headers))
+ (setf reading 'symbol-or-compound-form))))
+ (repeated-keyword-form setf-form-in-current-binding)))))))
+
+(defmacro org-let*-prog-plists (plist-specs &rest body)
+ ;; Lots of code from org-prog-plist is reused verbatim.
+ ;; The point of org-let*-prog-plists is
+ ;; to be able to reuse temporary variables used during plist construction.
+ ;; We thus do not expand org-let*-prog-plists forms into org-prog-plist forms
+ ;; which discard those variables, but rather produce the code manually.
+ ;; It might be suboptimal but it works. Duplication twice is not that bad.
+ ;; TODO: consider other names
+ ;; - org-prog-plists-let*
+ ;; - org-with-prog-plists
+ "Construct plists in PLIST-SPECS as in `org-prog-plist'; bind them to variables. All intermediate variables from PLIST-SPECS, including temporary ones, are available in BODY.
+
+PLIST-SPECS is a binding spec of the form
+((VAR-1 . BINDINGS-AND-COMPOUND-FORMS-1)
+ (VAR-2 . BINDINGS-AND-COMPOUND-FORMS-2)
+ ...
+ (VAR-n . BINDINGS-AND-COMPOUND-FORMS-n))
+
+where VAR-i is bound to plist specified by BINDINGS-AND-COMPOUND-FORMS-i, right after it is constructed.
+
+Examples:
+
+Construct multiple plists imperatively, reuse temporary bindings:
+ELISP> (macroexpand-1
+ `(org-let*-prog-plists ((plist1 :x 1
+ y 40
+ (incf y)
+ :z (incf y))
+ (plist2 :x y))
+ (list plist1 y plist2)))
+(let* ((x 1)
+ (y 40))
+ (incf y)
+ (let* ((z (incf y))
+ (plist1 (list :x x :z z))
+ (x y)
+ (plist2 (list :x x)))
+ (list plist1 y plist2)))
+
+Once plist is constructed, its places are lost; values are still available:
+ELISP> (macroexpand-1
+ `(org-let*-prog-plists ((plist1 :x 1)
+ (plist2 (incf x)
+ :z (+ x 40)))
+ (list plist1 x plist2)))
+(let* ((x 1)
+ (plist1 (list :x x)))
+ (incf x)
+ (let* ((z (+ x 40))
+ (plist2 (list :z z)))
+ (list plist1 x plist2)))
+
+See Also: `org-prog-plist'"
+ (declare (indent 1))
+ (let ((headers (list (list 'progn))) bindings plist-form
+ (reading 'symbol-or-compound-form))
+ (cl-symbol-macrolet ((maybe-push-bindings-to-headers
+ (if bindings
+ (prog1 (push (list (nreverse bindings) 'let*)
+ headers)
+ (setf bindings nil))
+ headers))
+ (setf-form-in-current-binding
+ (setf (cadar bindings) it
+ reading 'symbol-or-compound-form)))
+ (cl-flet ((cleanup (form) (if (and (consp (cadar form))
+ (eq 'let* (caadar form)))
+ (cadar form)
+ (car form))))
+ (dolist (plist-spec plist-specs
+ (cleanup
+ (org-fold (lambda (form header)
+ (dolist (e header (list form))
+ (push e form)))
+ body
+ maybe-push-bindings-to-headers)))
+ (setf plist-form nil)
+ (dolist (it (cdr plist-spec)
+ (let ((it (cons 'list (nreverse plist-form))))
+ (push (list (car plist-spec) nil) bindings)
+ setf-form-in-current-binding))
+ (cl-ecase reading
+ (keyword-form (push (org-dekeyword (car plist-form)) plist-form)
+ setf-form-in-current-binding)
+ (variable-form setf-form-in-current-binding)
+ (symbol-or-compound-form
+ (cl-etypecase it
+ (keyword (if (cl-loop for (_value key) on plist-form by #'cddr
+ do (when (eq it key) (cl-return t)))
+ (setf reading 'repeated-keyword-form)
+ (push it plist-form)
+ (setf reading 'keyword-form))
+ (push (list (org-dekeyword it) nil) bindings))
+ (symbol (push (list it nil) bindings)
+ (setf reading 'variable-form))
+ ;; it might be better to write compound-form instead of cons
+ ;; however, lack of namespaces means it'd be org-compound-form
+ ;; which we deemed obnoxious
+ ;; anyway, conses here are meant to be compound forms
+ (cons maybe-push-bindings-to-headers
+ (push it (car headers))
+ (setf reading 'symbol-or-compound-form))))
+ (repeated-keyword-form setf-form-in-current-binding))))))))
+
+(defmacro org-let*-prog-plist (plist-spec &rest body)
+ "Like `org-let*-prog-plists' but only supports a a single plist binding.
+
+Provided solely to reduce sexp depth when desired."
+ (declare (indent 1))
+ `(org-let*-prog-plists (,plist-spec) ,@body))
+
;; Use `with-silent-modifications' to ignore cosmetic changes and
;; `org-unmodified' to ignore real text modifications.
(defmacro org-unmodified (&rest body)
--
2.26.2
^ permalink raw reply related [flat|nested] 5+ messages in thread* Re: [PATCH] org-element: Hide parsers boilerplate into plist-creating macros
2020-09-09 8:46 ` Bastien
2020-09-09 13:59 ` akater
@ 2020-09-09 16:11 ` Nicolas Goaziou
1 sibling, 0 replies; 5+ messages in thread
From: Nicolas Goaziou @ 2020-09-09 16:11 UTC (permalink / raw)
To: Bastien; +Cc: emacs-orgmode, akater
Hello,
Bastien <bzg@gnu.org> writes:
> akater <nuclearspace@gmail.com> writes:
>
>> We replace some repetetive code with macro calls org-prog-plist and
>> org-let*-prog-plist.
>
> IIUC this is a refactoring, it does not add or remove functionalities?
>
> I'll let Nicolas decide on this, of course.
FWIW, I'm not convinced there's a significant advantage in doing this
refactoring. Arguably, the code is not more readable. It will not make
it faster either.
There is room for refactoring in Org (for the record, org-agenda.el has
not switched to lexical binding yet), but I don't think org-element.el
has bitrotten so much that it deserves some.
Regards,
--
Nicolas Goaziou
^ permalink raw reply [flat|nested] 5+ messages in thread
end of thread, other threads:[~2020-09-09 16:12 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-09-08 17:19 [PATCH] org-element: Hide parsers boilerplate into plist-creating macros akater
2020-09-09 8:46 ` Bastien
2020-09-09 13:59 ` akater
2020-09-09 14:37 ` Bastien
2020-09-09 16:11 ` Nicolas Goaziou
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).