diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2021-04-11 13:17:54 -0400 |
---|---|---|
committer | Nicolas Goaziou <mail@nicolasgoaziou.fr> | 2021-04-16 16:37:22 +0200 |
commit | 8abdbbee395f284f2262a89187d662eaf40080b1 (patch) | |
tree | 370033b5e1a40cf5e30dd59e53b006df2fda0a77 | |
parent | 4941444f45adebeab61259625fa69275acee03f0 (diff) | |
download | org-mode-8abdbbee395f284f2262a89187d662eaf40080b1.tar.gz |
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>.
-rw-r--r-- | lisp/org-macro.el | 127 | ||||
-rw-r--r-- | lisp/ox.el | 6 |
2 files changed, 77 insertions, 56 deletions
diff --git a/lisp/org-macro.el b/lisp/org-macro.el index f914a33..0f1dfa2 100644 --- a/lisp/org-macro.el +++ b/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 @@ -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) |