Commit | Line | Data |
---|---|---|
271672fa BG |
1 | ;;; org-macro.el --- Macro Replacement Code for Org Mode |
2 | ||
3 | ;; Copyright (C) 2013 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Nicolas Goaziou <n.goaziou@gmail.com> | |
6 | ;; Keywords: outlines, hypermedia, calendar, wp | |
7 | ||
439d6b1c GM |
8 | ;; This file is part of GNU Emacs. |
9 | ||
271672fa BG |
10 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation, either version 3 of the License, or | |
13 | ;; (at your option) any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;; Macros are expanded with `org-macro-replace-all', which relies | |
26 | ;; internally on `org-macro-expand'. | |
27 | ||
28 | ;; Default templates for expansion are stored in the buffer-local | |
29 | ;; variable `org-macro-templates'. This variable is updated by | |
30 | ;; `org-macro-initialize-templates', which recursively calls | |
31 | ;; `org-macro--collect-macros' in order to read setup files. | |
32 | ||
33 | ;; Along with macros defined through #+MACRO: keyword, default | |
34 | ;; templates include the following hard-coded macros: | |
35 | ;; {{{time(format-string)}}}, {{{property(node-property)}}}, | |
36 | ;; {{{input-file}}} and {{{modification-time(format-string)}}}. | |
37 | ||
38 | ;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}}, | |
39 | ;; {{{email}}} and {{{title}}} macros. | |
40 | ||
41 | ;;; Code: | |
42 | (require 'org-macs) | |
43 | ||
44 | (declare-function org-element-at-point "org-element" (&optional keep-trail)) | |
45 | (declare-function org-element-context "org-element" (&optional element)) | |
46 | (declare-function org-element-property "org-element" (property element)) | |
47 | (declare-function org-element-type "org-element" (element)) | |
48 | (declare-function org-remove-double-quotes "org" (s)) | |
49 | (declare-function org-mode "org" ()) | |
50 | (declare-function org-file-contents "org" (file &optional noerror)) | |
51 | (declare-function org-with-wide-buffer "org-macs" (&rest body)) | |
52 | ||
53 | ;;; Variables | |
54 | ||
55 | (defvar org-macro-templates nil | |
56 | "Alist containing all macro templates in current buffer. | |
57 | Associations are in the shape of (NAME . TEMPLATE) where NAME | |
58 | stands for macro's name and template for its replacement value, | |
59 | both as strings. This is an internal variable. Do not set it | |
60 | directly, use instead: | |
61 | ||
62 | #+MACRO: name template") | |
63 | (make-variable-buffer-local 'org-macro-templates) | |
64 | ||
65 | ||
66 | ;;; Functions | |
67 | ||
68 | (defun org-macro--collect-macros () | |
69 | "Collect macro definitions in current buffer and setup files. | |
70 | Return an alist containing all macro templates found." | |
71 | (let* (collect-macros ; For byte-compiler. | |
72 | (collect-macros | |
73 | (lambda (files templates) | |
74 | ;; Return an alist of macro templates. FILES is a list of | |
75 | ;; setup files names read so far, used to avoid circular | |
76 | ;; dependencies. TEMPLATES is the alist collected so far. | |
77 | (let ((case-fold-search t)) | |
78 | (org-with-wide-buffer | |
79 | (goto-char (point-min)) | |
80 | (while (re-search-forward | |
81 | "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t) | |
82 | (let ((element (org-element-at-point))) | |
83 | (when (eq (org-element-type element) 'keyword) | |
84 | (let ((val (org-element-property :value element))) | |
85 | (if (equal (org-element-property :key element) "MACRO") | |
86 | ;; Install macro in TEMPLATES. | |
87 | (when (string-match | |
88 | "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val) | |
89 | (let* ((name (match-string 1 val)) | |
90 | (template (or (match-string 2 val) "")) | |
91 | (old-cell (assoc name templates))) | |
92 | (if old-cell (setcdr old-cell template) | |
93 | (push (cons name template) templates)))) | |
94 | ;; Enter setup file. | |
95 | (let ((file (expand-file-name | |
96 | (org-remove-double-quotes val)))) | |
97 | (unless (member file files) | |
98 | (with-temp-buffer | |
99 | (org-mode) | |
100 | (insert (org-file-contents file 'noerror)) | |
101 | (setq templates | |
102 | (funcall collect-macros (cons file files) | |
103 | templates))))))))))) | |
104 | templates)))) | |
105 | (funcall collect-macros nil nil))) | |
106 | ||
107 | (defun org-macro-initialize-templates () | |
108 | "Collect macro templates defined in current buffer. | |
109 | Templates are stored in buffer-local variable | |
110 | `org-macro-templates'. In addition to buffer-defined macros, the | |
111 | function installs the following ones: \"property\", | |
112 | \"time\". and, if the buffer is associated to a file, | |
113 | \"input-file\" and \"modification-time\"." | |
114 | (let* ((templates (org-macro--collect-macros)) | |
115 | (update-templates | |
116 | (lambda (cell) | |
117 | (let ((old-template (assoc (car cell) templates))) | |
118 | (if old-template (setcdr old-template (cdr cell)) | |
119 | (push cell templates)))))) | |
120 | ;; Install hard-coded macros. | |
121 | (mapc (lambda (cell) (funcall update-templates cell)) | |
122 | (list (cons "property" "(eval (org-entry-get nil \"$1\" 'selective))") | |
123 | (cons "time" "(eval (format-time-string \"$1\"))"))) | |
124 | (let ((visited-file (buffer-file-name (buffer-base-buffer)))) | |
125 | (when (and visited-file (file-exists-p visited-file)) | |
126 | (mapc (lambda (cell) (funcall update-templates cell)) | |
127 | (list (cons "input-file" (file-name-nondirectory visited-file)) | |
128 | (cons "modification-time" | |
129 | (format "(eval (format-time-string \"$1\" '%s))" | |
130 | (prin1-to-string | |
131 | (nth 5 (file-attributes visited-file))))))))) | |
132 | (setq org-macro-templates templates))) | |
133 | ||
134 | (defun org-macro-expand (macro templates) | |
135 | "Return expanded MACRO, as a string. | |
136 | MACRO is an object, obtained, for example, with | |
137 | `org-element-context'. TEMPLATES is an alist of templates used | |
138 | for expansion. See `org-macro-templates' for a buffer-local | |
139 | default value. Return nil if no template was found." | |
140 | (let ((template | |
141 | ;; Macro names are case-insensitive. | |
142 | (cdr (assoc-string (org-element-property :key macro) templates t)))) | |
143 | (when template | |
144 | (let ((value (replace-regexp-in-string | |
145 | "\\$[0-9]+" | |
146 | (lambda (arg) | |
147 | (or (nth (1- (string-to-number (substring arg 1))) | |
148 | (org-element-property :args macro)) | |
149 | ;; No argument: remove place-holder. | |
150 | "")) | |
151 | template nil 'literal))) | |
152 | ;; VALUE starts with "(eval": it is a s-exp, `eval' it. | |
153 | (when (string-match "\\`(eval\\>" value) | |
154 | (setq value (eval (read value)))) | |
155 | ;; Return string. | |
156 | (format "%s" (or value "")))))) | |
157 | ||
158 | (defun org-macro-replace-all (templates) | |
159 | "Replace all macros in current buffer by their expansion. | |
160 | TEMPLATES is an alist of templates used for expansion. See | |
161 | `org-macro-templates' for a buffer-local default value." | |
162 | (save-excursion | |
163 | (goto-char (point-min)) | |
164 | (let (record) | |
165 | (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) | |
166 | (let ((object (org-element-context))) | |
167 | (when (eq (org-element-type object) 'macro) | |
168 | (let* ((value (org-macro-expand object templates)) | |
169 | (begin (org-element-property :begin object)) | |
170 | (signature (list begin | |
171 | object | |
172 | (org-element-property :args object)))) | |
173 | ;; Avoid circular dependencies by checking if the same | |
174 | ;; macro with the same arguments is expanded at the same | |
175 | ;; position twice. | |
176 | (if (member signature record) | |
177 | (error "Circular macro expansion: %s" | |
178 | (org-element-property :key object)) | |
179 | (when value | |
180 | (push signature record) | |
181 | (delete-region | |
182 | begin | |
183 | ;; Preserve white spaces after the macro. | |
184 | (progn (goto-char (org-element-property :end object)) | |
185 | (skip-chars-backward " \t") | |
186 | (point))) | |
187 | ;; Leave point before replacement in case of recursive | |
188 | ;; expansions. | |
189 | (save-excursion (insert value))))))))))) | |
190 | ||
191 | ||
192 | (provide 'org-macro) | |
193 | ;;; org-macro.el ends here |