Improving org-macro.el

[Stefan Monnier]

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