emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
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 ""))))))
 



             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 ` 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).