From: Stefan Monnier <monnier@iro.umontreal.ca>
To: emacs-orgmode@gnu.org
Subject: Improving org-macro.el
Date: Sun, 11 Apr 2021 13:17:54 -0400 [thread overview]
Message-ID: <jwvwnt9he8s.fsf-monnier+emacs@gnu.org> (raw)
In the course of trying to get the Org package to work with the (then)
new GNU ELPA scripts, I bumped into the org-macro.el monster (mostly
because it has changed incompatibly between Emacs-26 and Emacs-27,
IIRC).
In any case, the code struck me as quite inefficient since it
reparses the macro definition every time the macro is called.
I came up with the tentative patch below.
It seems to work on Org's own manual, but other than that I haven't gone
out of my way to test it.
It clearly changes the semantics of Org macros to some extent:
- It skips the call to `eval`, which caused a double evaluation.
This only makes a difference for those macros defined with
#+macro: <name> (eval (expression-which-does-not-return-a-string))
so I think this is a safe change.
- It also changes the behavior when $N appears elsewhere than an
"expression context". E.g.:
#+macro: <name> (eval (let (($1 foo)) (bar)))
or
#+macro: <name> (eval (mapconcat #'foo '($1 $2 $3) ""))
or
#+macro: <name> (eval (fun-with "code $1"))
I don't think it requires changes to the manual because the semantics
described in the manual is sufficiently incomplete that both the old and
the new semantics satisfy it.
WDYT?
Stefan
diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
index f914a33d61..1508a2f647 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -90,6 +90,17 @@ org-macro--set-template
previous one, unless VALUE is nil. TEMPLATES is the list of
templates. Return the updated list."
(let ((old-definition (assoc name templates)))
+ (when (and value (string-match-p "\\`(eval\\>" value))
+ ;; Pre-process the evaluation form for faster macro expansion.
+ (let* ((args (org-macro--makeargs value))
+ (body (condition-case nil
+ ;; `value' is of the form "(eval ...)" but we don't want
+ ;; this to mean to pass the result to `eval' (which
+ ;; would cause double evaluation), so we strip the
+ ;; `eval' away with `cadr'.
+ (cadr (read value))
+ (error (debug)))))
+ (setq value (eval (macroexpand-all `(lambda ,args ,body)) t))))
(cond ((and value old-definition) (setcdr old-definition value))
(old-definition)
(t (push (cons name (or value "")) templates))))
@@ -138,21 +149,33 @@ org-macro-initialize-templates
(list
`("input-file" . ,(file-name-nondirectory visited-file))
`("modification-time" .
- ,(format "(eval
-\(format-time-string $1
- (or (and (org-string-nw-p $2)
- (org-macro--vc-modified-time %s))
- '%s)))"
- (prin1-to-string visited-file)
- (prin1-to-string
- (file-attribute-modification-time
- (file-attributes visited-file))))))))
+ ,(let ((modtime (file-attribute-modification-time
+ (file-attributes visited-file))))
+ (lambda (arg1 arg2 &rest _)
+ (format-time-string
+ arg1
+ (or (and (org-string-nw-p arg2)
+ (org-macro--vc-modified-time visited-file))
+ modtime))))))))
;; Install generic macros.
(list
- '("n" . "(eval (org-macro--counter-increment $1 $2))")
- '("keyword" . "(eval (org-macro--find-keyword-value $1))")
- '("time" . "(eval (format-time-string $1))")
- '("property" . "(eval (org-macro--get-property $1 $2))")))))
+ `("n" . org-macro--counter-increment)
+ `("keyword" . ,(lambda (name)
+ (org-macro--find-keyword-value name)))
+ `("time" . ,(lambda (format) (format-time-string format)))
+ `("property" . org-macro--get-property)))))
+
+(defun org-macro--makeargs (template)
+ "Compute the formal arglist to use for TEMPLATE."
+ (let ((max 0) (i 0))
+ (while (string-match "\\$\\([0-9]+\\)" template i)
+ (setq i (match-end 0))
+ (setq max (max max (string-to-number (match-string 1 template)))))
+ (let ((args '(&rest _)))
+ (while (> i 0)
+ (push (intern (format "$%d" i)) args)
+ (setq i (1- i)))
+ (cons '&optional args))))
(defun org-macro-expand (macro templates)
"Return expanded MACRO, as a string.
@@ -164,21 +187,17 @@ org-macro-expand
;; Macro names are case-insensitive.
(cdr (assoc-string (org-element-property :key macro) templates t))))
(when template
- (let* ((eval? (string-match-p "\\`(eval\\>" template))
- (value
- (replace-regexp-in-string
- "\\$[0-9]+"
- (lambda (m)
- (let ((arg (or (nth (1- (string-to-number (substring m 1)))
- (org-element-property :args macro))
- ;; No argument: remove place-holder.
- "")))
- ;; `eval' implies arguments are strings.
- (if eval? (format "%S" arg) arg)))
- template nil 'literal)))
- (when eval?
- (setq value (eval (condition-case nil (read value)
- (error (debug))))))
+ (let* ((value
+ (if (functionp template)
+ (apply template (org-element-property :args macro))
+ (replace-regexp-in-string
+ "\\$[0-9]+"
+ (lambda (m)
+ (or (nth (1- (string-to-number (substring m 1)))
+ (org-element-property :args macro))
+ ;; No argument: remove place-holder.
+ ""))
+ template nil 'literal))))
;; Force return value to be a string.
(format "%s" (or value ""))))))
next reply other threads:[~2021-04-11 17:18 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2021-04-11 17:17 Stefan Monnier [this message]
2021-04-16 14:47 ` Improving org-macro.el Nicolas Goaziou
2021-04-16 16:22 ` Stefan Monnier
2021-04-16 22:06 ` Stefan Monnier
2021-04-17 9:48 ` 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=jwvwnt9he8s.fsf-monnier+emacs@gnu.org \
--to=monnier@iro.umontreal.ca \
--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).