From 48da6a46e0b9ccb090b38500b69620ef0945a979 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Sat, 16 Feb 2013 14:03:59 +0100 Subject: [PATCH] Move macro expansion code into its own library * lisp/org-macro.el: New file. * lisp/org.el: Remove macro code. * lisp/ox.el: Require new library * testing/lisp/test-org-macro.el: New file. * testing/lisp/test-org.el: Remove macro test. --- lisp/org-macro.el | 180 +++++++++++++++++++++++++++++++++++++++++ lisp/org.el | 131 +----------------------------- lisp/ox.el | 1 + testing/lisp/test-org-macro.el | 80 ++++++++++++++++++ testing/lisp/test-org.el | 46 ----------- 5 files changed, 262 insertions(+), 176 deletions(-) create mode 100644 lisp/org-macro.el create mode 100644 testing/lisp/test-org-macro.el diff --git a/lisp/org-macro.el b/lisp/org-macro.el new file mode 100644 index 000000000..1ac8b87d0 --- /dev/null +++ b/lisp/org-macro.el @@ -0,0 +1,180 @@ +;;; org-macro.el --- Macro Replacement Code for Org Mode + +;; Copyright (C) 2013 Free Software Foundation, Inc. + +;; Author: Nicolas Goaziou +;; Keywords: outlines, hypermedia, calendar, wp + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Macros are expanded with `org-macro-replace-all', which relies +;; internally on `org-macro-expand'. + +;; Default templates for expansion are stored in the buffer-local +;; variable `org-macro-templates'. This variable is updated by +;; `org-macro-initialize-templates', which recursively calls +;; `org-macro--collect-macros' in order to read setup files. + +;; Along with macros defined through #+MACRO: keyword, default +;; templates include the following hard-coded macros: +;; {{{time(format-string)}}}, {{{property(node-property)}}}, +;; {{{input-file}}} and {{{modification-time(format-string)}}}. + +;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, +;; {{{email}}} and {{{title}}} macros. + +;;; Code: + +(declare-function org-element-at-point "org-element" (&optional keep-trail)) +(declare-function org-element-context "org-element" (&optional element)) +(declare-function org-element-property "org-element" (property element)) +(declare-function org-element-type "org-element" (element)) + + +;;; Variables + +(defvar org-macro-templates nil + "Alist containing all macro templates in current buffer. +Associations are in the shape of (NAME . TEMPLATE) where NAME +stands for macro's name and template for its replacement value, +both as strings. This is an internal variable. Do not set it +directly, use instead: + + #+MACRO: name template") +(make-variable-buffer-local 'org-macro-templates) + + +;;; Functions + +(defun org-macro--collect-macros (files) + "Collect macro definitions in current buffer and setup files. +FILES is a list of setup files names read so far, used to avoid +circular dependencies. Return an alist containing all macro +templates found." + (let ((case-fold-search t) templates) + ;; Install buffer-local macros. Also enter SETUPFILE keywords. + (org-with-wide-buffer + (goto-char (point-min)) + (while (re-search-forward "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((val (org-element-property :value element))) + (if (equal (org-element-property :key element) "SETUPFILE") + ;; Enter setup file. + (let ((file (expand-file-name (org-remove-double-quotes val)))) + (unless (member file files) + (with-temp-buffer + (org-mode) + (insert (org-file-contents file 'noerror)) + (setq templates + (org-macro--collect-macros (cons file files)))))) + ;; Install macro in TEMPLATES. + (when (string-match "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) + (let* ((name (match-string 1 val)) + (template (or (match-string 2 val) "")) + (old-cell (assoc name templates))) + (if old-cell (setcdr old-cell template) + (push (cons name template) templates)))))))))) + ;; Return value. + templates)) + +(defun org-macro-initialize-templates () + "Collect macro templates defined in current buffer. +Templates are stored in buffer-local variable +`org-macro-templates'. In addition to buffer-defined macros, the +function installs the following ones: \"property\", +\"time\". and, if the buffer is associated to a file, +\"input-file\" and \"modification-time\"." + (let* ((templates (org-macro--collect-macros nil)) + (update-templates + (lambda (cell) + (let ((old-template (assoc (car cell) templates))) + (if old-template (setcdr old-template (cdr cell)) + (push cell templates)))))) + ;; Install hard-coded macros. + (mapc (lambda (cell) (funcall update-templates cell)) + (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))") + (cons "time" "(eval (format-time-string \"$1\"))"))) + (let ((visited-file (buffer-file-name (buffer-base-buffer)))) + (when (and visited-file (file-exists-p visited-file)) + (mapc (lambda (cell) (funcall update-templates cell)) + (list (cons "input-file" (file-name-nondirectory visited-file)) + (cons "modification-time" + (format "(eval (format-time-string \"$1\" '%s))" + (prin1-to-string + (nth 5 (file-attributes visited-file))))))))) + (setq org-macro-templates templates))) + +(defun org-macro-expand (macro templates) + "Return expanded MACRO, as a string. +MACRO is an object, obtained, for example, with +`org-element-context'. TEMPLATES is an alist of templates used +for expansion. See `org-macro-templates' for a buffer-local +default value. Return nil if no template was found." + (let ((template + ;; Macro names are case-insensitive. + (cdr (assoc-string (org-element-property :key macro) templates t)))) + (when template + (let ((value (replace-regexp-in-string + "\\$[0-9]+" + (lambda (arg) + (or (nth (1- (string-to-number (substring arg 1))) + (org-element-property :args macro)) + ;; No argument: remove place-holder. + "")) + template))) + ;; VALUE starts with "(eval": it is a s-exp, `eval' it. + (when (string-match "\\`(eval\\>" value) + (setq value (eval (read value)))) + ;; Return string. + (format "%s" (or value "")))))) + +(defun org-macro-replace-all (templates) + "Replace all macros in current buffer by their expansion. +TEMPLATES is an alist of templates used for expansion. See +`org-macro-templates' for a buffer-local default value." + (save-excursion + (goto-char (point-min)) + (let (record) + (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) + (let ((object (org-element-context))) + (when (eq (org-element-type object) 'macro) + (let* ((value (org-macro-expand object templates)) + (begin (org-element-property :begin object)) + (signature (list begin + object + (org-element-property :args object)))) + ;; Avoid circular dependencies by checking if the same + ;; macro with the same arguments is expanded at the same + ;; position twice. + (if (member signature record) + (error "Circular macro expansion: %s" + (org-element-property :key object)) + (when value + (push signature record) + (delete-region + begin + ;; Preserve white spaces after the macro. + (progn (goto-char (org-element-property :end object)) + (skip-chars-backward " \t") + (point))) + ;; Leave point before replacement in case of recursive + ;; expansions. + (save-excursion (insert value))))))))))) + + +(provide 'org-macro) +;;; org-macro.el ends here diff --git a/lisp/org.el b/lisp/org.el index dc7e78b29..91763d3c2 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -5115,6 +5115,7 @@ This variable is set by `org-before-change-function'. (require 'org-pcomplete) (require 'org-src) (require 'org-footnote) +(require 'org-macro) ;; babel (require 'ob) @@ -21351,136 +21352,6 @@ hierarchy of headlines by UP levels before marking the subtree." (org-mark-element))) -;;; Macros - -;; Macros are expanded with `org-macro-replace-all', which relies -;; internally on `org-macro-expand'. - -;; Default templates for expansion are stored in the buffer-local -;; variable `org-macro-templates'. This variable is updated by -;; `org-macro-initialize-templates'. - -;; Along with macros defined through #+MACRO: keyword, default -;; templates include the following hard-coded macros: -;; {{{time(format-string)}}}, {{{property(node-property)}}}, -;; {{{input-file}}} and {{{modification-time(format-string)}}}. - -;; During export, {{{author}}}, {{{date}}}, {{{email}}} and -;; {{{title}}} will also be provided. - - -(defvar org-macro-templates nil - "Alist containing all macro templates in current buffer. -Associations are in the shape of (NAME . TEMPLATE) where NAME -stands for macro's name and template for its replacement value, -both as strings. This is an internal variable. Do not set it -directly, use instead: - - #+MACRO: name template") -(make-variable-buffer-local 'org-macro-templates) - -(defun org-macro-expand (macro templates) - "Return expanded MACRO, as a string. -MACRO is an object, obtained, for example, with -`org-element-context'. TEMPLATES is an alist of templates used -for expansion. See `org-macro-templates' for a buffer-local -default value. Return nil if no template was found." - (let ((template - ;; Macro names are case-insensitive. - (cdr (assoc-string (org-element-property :key macro) templates t)))) - (when template - (let ((value (replace-regexp-in-string - "\\$[0-9]+" - (lambda (arg) - (or (nth (1- (string-to-number (substring arg 1))) - (org-element-property :args macro)) - ;; No argument provided: remove - ;; place-holder. - "")) - template))) - ;; VALUE starts with "(eval": it is a s-exp, `eval' it. - (when (string-match "\\`(eval\\>" value) - (setq value (eval (read value)))) - ;; Return string. - (format "%s" (or value "")))))) - -(defun org-macro-replace-all (templates) - "Replace all macros in current buffer by their expansion. -TEMPLATES is an alist of templates used for expansion. See -`org-macro-templates' for a buffer-local default value." - (save-excursion - (goto-char (point-min)) - (let (record) - (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) - (let ((object (org-element-context))) - (when (eq (org-element-type object) 'macro) - (let* ((value (org-macro-expand object templates)) - (begin (org-element-property :begin object)) - (signature (list begin - object - (org-element-property :args object)))) - ;; Avoid circular dependencies by checking if the same - ;; macro with the same arguments is expanded at the same - ;; position twice. - (if (member signature record) - (error "Circular macro expansion: %s" - (org-element-property :key object)) - (when value - (push signature record) - (delete-region - begin - ;; Preserve white spaces after the macro. - (progn (goto-char (org-element-property :end object)) - (skip-chars-backward " \t") - (point))) - ;; Leave point before replacement in case of recursive - ;; expansions. - (save-excursion (insert value))))))))))) - -(defun org-macro-initialize-templates () - "Collect macro templates defined in current buffer. -Templates are stored in buffer-local variable -`org-macro-templates'. In addition to buffer-defined macros, the -function installs the following ones: \"property\", -\"time\". and, if the buffer is associated to a file, -\"input-file\" and \"modification-time\"." - (let ((case-fold-search t) - (set-template - (lambda (cell) - ;; Add CELL to `org-macro-templates' if there's no - ;; association matching its name already. Otherwise, - ;; replace old association with the new one in that - ;; variable. - (let ((old-template (assoc (car cell) org-macro-templates))) - (if old-template (setcdr old-template (cdr cell)) - (push cell org-macro-templates)))))) - ;; Install buffer-local macros. - (org-with-wide-buffer - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+MACRO:" nil t) - (let ((element (org-element-at-point))) - (when (eq (org-element-type element) 'keyword) - (let ((value (org-element-property :value element))) - (when (string-match "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" value) - (funcall set-template - (cons (match-string 1 value) - (or (match-string 2 value) ""))))))))) - ;; Install hard-coded macros. - (mapc (lambda (cell) (funcall set-template cell)) - (list - (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))") - (cons "time" "(eval (format-time-string \"$1\"))"))) - (let ((visited-file (buffer-file-name (buffer-base-buffer)))) - (when (and visited-file (file-exists-p visited-file)) - (mapc (lambda (cell) (funcall set-template cell)) - (list - (cons "input-file" (file-name-nondirectory visited-file)) - (cons "modification-time" - (format "(eval (format-time-string \"$1\" '%s))" - (prin1-to-string - (nth 5 (file-attributes visited-file))))))))))) - - ;;; Indentation (defun org-indent-line () diff --git a/lisp/ox.el b/lisp/ox.el index 81f93cc2c..eafcd4045 100644 --- a/lisp/ox.el +++ b/lisp/ox.el @@ -78,6 +78,7 @@ (eval-when-compile (require 'cl)) (require 'org-element) +(require 'org-macro) (require 'ob-exp) (declare-function org-publish "ox-publish" (project &optional force async)) diff --git a/testing/lisp/test-org-macro.el b/testing/lisp/test-org-macro.el new file mode 100644 index 000000000..75265e41a --- /dev/null +++ b/testing/lisp/test-org-macro.el @@ -0,0 +1,80 @@ +;;; test-org-macro.el --- Tests for org-macro.el + +;; Copyright (C) 2013 Nicolas Goaziou + +;; Author: Nicolas Goaziou + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + + +;;; Macros + +(ert-deftest test-org/macro-replace-all () + "Test `org-macro-replace-all' specifications." + ;; Standard test. + (should + (equal + "#+MACRO: A B\n1 B 3" + (org-test-with-temp-text "#+MACRO: A B\n1 {{{A}}} 3" + (progn (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates) + (buffer-string))))) + ;; Macro with arguments. + (should + (equal + "#+MACRO: macro $1 $2\nsome text" + (org-test-with-temp-text "#+MACRO: macro $1 $2\n{{{macro(some,text)}}}" + (progn (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates) + (buffer-string))))) + ;; Macro with "eval". + (should + (equal + "#+MACRO: add (eval (+ $1 $2))\n3" + (org-test-with-temp-text "#+MACRO: add (eval (+ $1 $2))\n{{{add(1,2)}}}" + (progn (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates) + (buffer-string))))) + ;; Nested macros. + (should + (equal + "#+MACRO: in inner\n#+MACRO: out {{{in}}} outer\ninner outer" + (org-test-with-temp-text + "#+MACRO: in inner\n#+MACRO: out {{{in}}} outer\n{{{out}}}" + (progn (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates) + (buffer-string))))) + ;; Error out when macro expansion is circular. + (should-error + (org-test-with-temp-text + "#+MACRO: mac1 {{{mac2}}}\n#+MACRO: mac2 {{{mac1}}}\n{{{mac1}}}" + (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates))) + ;; Macros in setup file. + (should + (string-match + "success\\'" + (org-test-with-temp-text + (format + "#+SETUPFILE: \"%sexamples/macro-templates.org\"\n{{{included-macro}}}" + org-test-dir) + (org-macro-initialize-templates) + (org-macro-replace-all org-macro-templates) + (buffer-string))))) + + +(provide 'test-org-macro) +;;; test-org-macro.el ends here diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index dac5fd264..324ebc310 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -398,52 +398,6 @@ http://article.gmane.org/gmane.emacs.orgmode/21459/" -;;; Macros - -(ert-deftest test-org/macro-replace-all () - "Test `org-macro-replace-all' specifications." - ;; Standard test. - (should - (equal - "#+MACRO: A B\n1 B 3" - (org-test-with-temp-text "#+MACRO: A B\n1 {{{A}}} 3" - (progn (org-macro-initialize-templates) - (org-macro-replace-all org-macro-templates) - (buffer-string))))) - ;; Macro with arguments. - (should - (equal - "#+MACRO: macro $1 $2\nsome text" - (org-test-with-temp-text "#+MACRO: macro $1 $2\n{{{macro(some,text)}}}" - (progn (org-macro-initialize-templates) - (org-macro-replace-all org-macro-templates) - (buffer-string))))) - ;; Macro with "eval". - (should - (equal - "#+MACRO: add (eval (+ $1 $2))\n3" - (org-test-with-temp-text "#+MACRO: add (eval (+ $1 $2))\n{{{add(1,2)}}}" - (progn (org-macro-initialize-templates) - (org-macro-replace-all org-macro-templates) - (buffer-string))))) - ;; Nested macros. - (should - (equal - "#+MACRO: in inner\n#+MACRO: out {{{in}}} outer\ninner outer" - (org-test-with-temp-text - "#+MACRO: in inner\n#+MACRO: out {{{in}}} outer\n{{{out}}}" - (progn (org-macro-initialize-templates) - (org-macro-replace-all org-macro-templates) - (buffer-string))))) - ;; Error out when macro expansion is circular. - (should-error - (org-test-with-temp-text - "#+MACRO: mac1 {{{mac2}}}\n#+MACRO: mac2 {{{mac1}}}\n{{{mac1}}}" - (org-macro-initialize-templates) - (org-macro-replace-all org-macro-templates)))) - - - ;;; Node Properties (ert-deftest test-org/accumulated-properties-in-drawers () -- 2.11.4.GIT