macro: Improve speed for `eval' macros

* lisp/org-macro.el (org-macro--makeargs): New function.
(org-macro--set-templates): New function.
(org-macro--set-template): Remove function.
(org-macro-initialize-templates): Add optional argument to
signature. Add macro definitions as functions.
(org-macro-expand): Allow functions as macro definitions.
(org-macro--counter-increment): Handle nil argument.
* lisp/ox.el (org-export-as): Apply signature change for
`org-initialize-templates'.

The main difference with the previous behaviour is that missing
arguments are now treated as nil instead of the empty string.

See <http://lists.gnu.org/r/emacs-orgmode/2021-04/msg00219.html>.

lisp/org-macro.el

@@ -84,42 +84,66 @@ directly, use instead:
 
 ;;; Functions
 
-(defun org-macro--set-template (name value templates)
+(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 (> max 0)
+        (push (intern (format "$%d" max)) args)
+        (setq max (1- max)))
+      (cons '&optional args))))
+
+(defun org-macro--set-templates (templates)
   "Set template for the macro NAME.
 VALUE is the template of the macro.  The new value override the
-previous one, unless VALUE is nil.  TEMPLATES is the list of
-templates.  Return the updated list."
-  (let ((old-definition (assoc name templates)))
-    (cond ((and value old-definition) (setcdr old-definition value))
-	  (old-definition)
-	  (t (push (cons name (or value "")) templates))))
-  templates)
+previous one, unless VALUE is nil.  Return the updated list."
+  (let ((new-templates nil))
+    (pcase-dolist (`(,name . ,value) templates)
+      (let ((old-definition (assoc name new-templates)))
+        (when (and (stringp 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
+                     (user-error "Invalid definition for macro %S" name)))))
+	    (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 "")) new-templates)))))
+    new-templates))
 
 (defun org-macro--collect-macros ()
   "Collect macro definitions in current buffer and setup files.
 Return an alist containing all macro templates found."
-  (let ((templates nil))
+  (let ((templates
+         `(("author" . ,(org-macro--find-keyword-value "AUTHOR"))
+	   ("email" . ,(org-macro--find-keyword-value "EMAIL"))
+	   ("title" . ,(org-macro--find-keyword-value "TITLE" t))
+	   ("date" . ,(org-macro--find-date)))))
     (pcase (org-collect-keywords '("MACRO"))
       (`(("MACRO" . ,values))
        (dolist (value values)
 	 (when (string-match "^\\(\\S-+\\)[ \t]*" value)
 	   (let ((name (match-string 1 value))
 		 (definition (substring value (match-end 0))))
-	     (setq templates
-		   (org-macro--set-template name definition templates)))))))
-    (let ((macros `(("author" . ,(org-macro--find-keyword-value "AUTHOR"))
-		    ("email" . ,(org-macro--find-keyword-value "EMAIL"))
-		    ("title" . ,(org-macro--find-keyword-value "TITLE" t))
-		    ("date" . ,(org-macro--find-date)))))
-      (pcase-dolist (`(,name . ,value) macros)
-	(setq templates (org-macro--set-template name value templates))))
+             (push (cons name definition) templates))))))
     templates))
 
-(defun org-macro-initialize-templates ()
+(defun org-macro-initialize-templates (&optional default)
   "Collect macro templates defined in current buffer.
 
-Templates are stored in buffer-local variable
-`org-macro-templates'.
+DEFAULT is a list of globally available templates.
+
+Templates are stored in buffer-local variable `org-macro-templates'.
 
 In addition to buffer-defined macros, the function installs the
 following ones: \"n\", \"author\", \"email\", \"keyword\",
@@ -129,8 +153,9 @@ a file, \"input-file\" and \"modification-time\"."
   (org-macro--counter-initialize)	;for "n" macro
   (setq org-macro-templates
 	(nconc
-	 ;; Install user-defined macros.
-	 (org-macro--collect-macros)
+	 ;; Install user-defined macros.  Local macros have higher
+         ;; precedence than global ones.
+         (org-macro--set-templates (append default (org-macro--collect-macros)))
 	 ;; Install file-specific macros.
 	 (let ((visited-file (buffer-file-name (buffer-base-buffer))))
 	   (and visited-file
@@ -138,21 +163,23 @@ a file, \"input-file\" and \"modification-time\"."
 		(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))")))))
+	 '(("keyword" . (lambda (arg1 &rest _)
+                          (org-macro--find-keyword-value arg1)))
+	   ("n" . (lambda (&optional arg1 arg2 &rest _)
+                    (org-macro--counter-increment arg1 arg2)))
+           ("property" . (lambda (arg1 &optional arg2 &rest _)
+                           (org-macro--get-property arg1 arg2)))
+	   ("time" . (lambda (arg1 &rest _)
+                       (format-time-string arg1)))))))
 
 (defun org-macro-expand (macro templates)
   "Return expanded MACRO, as a string.
@@ -164,21 +191,17 @@ default value.  Return nil if no template was found."
 	 ;; 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 ""))))))
 
@@ -380,7 +403,7 @@ value, i.e. do not increment.
 If the string represents an integer, set the counter to this number.
 
 Any other non-empty string resets the counter to 1."
-  (let ((name-trimmed (org-trim name))
+  (let ((name-trimmed (if (stringp name) (org-trim name) ""))
         (action-trimmed (when (org-string-nw-p action)
                           (org-trim action))))
     (puthash name-trimmed

lisp/ox.el

@@ -2949,10 +2949,8 @@ Return code as a string."
 			     (org-export-backend-name backend))
 	 (org-export-expand-include-keyword)
 	 (org-export--delete-comment-trees)
-	 (org-macro-initialize-templates)
-	 (org-macro-replace-all (append org-macro-templates
-					org-export-global-macros)
-				parsed-keywords)
+	 (org-macro-initialize-templates org-export-global-macros)
+	 (org-macro-replace-all org-macro-templates parsed-keywords)
 	 ;; Refresh buffer properties and radio targets after previous
 	 ;; potentially invasive changes.
 	 (org-set-regexps-and-options)