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 ""))))))