From: akater <nuclearspace@gmail.com>
To: Bastien <bzg@gnu.org>
Cc: emacs-orgmode@gnu.org
Subject: Re: [PATCH] org-element: Hide parsers boilerplate into plist-creating macros
Date: Wed, 09 Sep 2020 13:59:20 +0000 [thread overview]
Message-ID: <87eenb6og7.fsf@gmail.com> (raw)
In-Reply-To: <87r1rbl4ll.fsf@gnu.org>
[-- 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
next prev parent reply other threads:[~2020-09-09 14:14 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
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 [this message]
2020-09-09 14:37 ` Bastien
2020-09-09 16:11 ` Nicolas Goaziou
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.orgmode.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87eenb6og7.fsf@gmail.com \
--to=nuclearspace@gmail.com \
--cc=bzg@gnu.org \
--cc=emacs-orgmode@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).