mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-21 e75a20334813452c6912c090d70a0de2c805f94d
commit | author | age
76bbd0 1 ;;; org-macro.el --- Macro Replacement Code for Org  -*- lexical-binding: t; -*-
C 2
3 ;; Copyright (C) 2013-2018 Free Software Foundation, Inc.
4
5 ;; Author: Nicolas Goaziou <n.goaziou@gmail.com>
6 ;; Keywords: outlines, hypermedia, calendar, wp
7
8 ;; This file is part of GNU Emacs.
9
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 <https://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 ;; Argument in macros are separated with commas. Proper escaping rules
34 ;; are implemented in `org-macro-escape-arguments' and arguments can
35 ;; be extracted from a string with `org-macro-extract-arguments'.
36
37 ;; Along with macros defined through #+MACRO: keyword, default
38 ;; templates include the following hard-coded macros:
39 ;;   {{{time(format-string)}}},
40 ;;   {{{property(node-property)}}},
41 ;;   {{{input-file}}},
42 ;;   {{{modification-time(format-string)}}},
43 ;;   {{{n(counter,action}}}.
44
45 ;; Upon exporting, "ox.el" will also provide {{{author}}}, {{{date}}},
46 ;; {{{email}}} and {{{title}}} macros.
47
48 ;;; Code:
49 (require 'cl-lib)
50 (require 'org-macs)
51 (require 'org-compat)
52
53 (declare-function org-element-at-point "org-element" ())
54 (declare-function org-element-context "org-element" (&optional element))
55 (declare-function org-element-macro-parser "org-element" ())
56 (declare-function org-element-property "org-element" (property element))
57 (declare-function org-element-type "org-element" (element))
58 (declare-function org-file-contents "org" (file &optional noerror nocache))
59 (declare-function org-file-url-p "org" (file))
60 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
61 (declare-function org-mode "org" ())
62 (declare-function org-trim "org" (s &optional keep-lead))
63 (declare-function vc-backend "vc-hooks" (f))
64 (declare-function vc-call "vc-hooks" (fun file &rest args) t)
65 (declare-function vc-exec-after "vc-dispatcher" (code))
66
67 ;;; Variables
68
69 (defvar-local org-macro-templates nil
70   "Alist containing all macro templates in current buffer.
71 Associations are in the shape of (NAME . TEMPLATE) where NAME
72 stands for macro's name and template for its replacement value,
73 both as strings.  This is an internal variable.  Do not set it
74 directly, use instead:
75
76   #+MACRO: name template")
77
78 ;;; Functions
79
80 (defun org-macro--collect-macros ()
81   "Collect macro definitions in current buffer and setup files.
82 Return an alist containing all macro templates found."
83   (letrec ((collect-macros
84         (lambda (files templates)
85           ;; Return an alist of macro templates.  FILES is a list
86           ;; of setup files names read so far, used to avoid
87           ;; circular dependencies.  TEMPLATES is the alist
88           ;; collected so far.
89           (let ((case-fold-search t))
90         (org-with-wide-buffer
91          (goto-char (point-min))
92          (while (re-search-forward
93              "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)
94            (let ((element (org-element-at-point)))
95              (when (eq (org-element-type element) 'keyword)
96                (let ((val (org-element-property :value element)))
97              (if (equal (org-element-property :key element) "MACRO")
98                  ;; Install macro in TEMPLATES.
99                  (when (string-match
100                     "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)
101                    (let* ((name (match-string 1 val))
102                       (template (or (match-string 2 val) ""))
103                       (old-cell (assoc name templates)))
104                  (if old-cell (setcdr old-cell template)
105                    (push (cons name template) templates))))
106                ;; Enter setup file.
107                (let* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
108                   (uri-is-url (org-file-url-p uri))
109                   (uri (if uri-is-url
110                        uri
111                      (expand-file-name uri))))
112                  ;; Avoid circular dependencies.
113                  (unless (member uri files)
114                    (with-temp-buffer
115                  (unless uri-is-url
116                    (setq default-directory
117                      (file-name-directory uri)))
118                  (org-mode)
119                  (insert (org-file-contents uri 'noerror))
120                  (setq templates
121                        (funcall collect-macros (cons uri files)
122                         templates)))))))))))
123         templates))))
124     (funcall collect-macros nil nil)))
125
126 (defun org-macro-initialize-templates ()
127   "Collect macro templates defined in current buffer.
128 Templates are stored in buffer-local variable
129 `org-macro-templates'.  In addition to buffer-defined macros, the
130 function installs the following ones: \"property\",
131 \"time\". and, if the buffer is associated to a file,
132 \"input-file\" and \"modification-time\"."
133   (let* ((templates nil)
134      (update-templates
135       (lambda (cell)
136         (let ((old-template (assoc (car cell) templates)))
137           (if old-template (setcdr old-template (cdr cell))
138         (push cell templates))))))
139     ;; Install "property", "time" macros.
140     (mapc update-templates
141       (list (cons "property"
142               "(eval (save-excursion
143         (let ((l \"$2\"))
144           (when (org-string-nw-p l)
145             (condition-case _
146                 (let ((org-link-search-must-match-exact-headline t))
147                   (org-link-search l nil t))
148               (error
149                (error \"Macro property failed: cannot find location %s\"
150                       l)))))
151         (org-entry-get nil \"$1\" 'selective)))")
152         (cons "time" "(eval (format-time-string \"$1\"))")))
153     ;; Install "input-file", "modification-time" macros.
154     (let ((visited-file (buffer-file-name (buffer-base-buffer))))
155       (when (and visited-file (file-exists-p visited-file))
156     (mapc update-templates
157           (list (cons "input-file" (file-name-nondirectory visited-file))
158             (cons "modification-time"
159               (format "(eval (format-time-string \"$1\" (or (and (org-string-nw-p \"$2\") (org-macro--vc-modified-time %s)) '%s)))"
160                   (prin1-to-string visited-file)
161                   (prin1-to-string
162                    (nth 5 (file-attributes visited-file)))))))))
163     ;; Initialize and install "n" macro.
164     (org-macro--counter-initialize)
165     (funcall update-templates
166          (cons "n" "(eval (org-macro--counter-increment \"$1\" \"$2\"))"))
167     (setq org-macro-templates (nconc (org-macro--collect-macros) templates))))
168
169 (defun org-macro-expand (macro templates)
170   "Return expanded MACRO, as a string.
171 MACRO is an object, obtained, for example, with
172 `org-element-context'.  TEMPLATES is an alist of templates used
173 for expansion.  See `org-macro-templates' for a buffer-local
174 default value.  Return nil if no template was found."
175   (let ((template
176      ;; Macro names are case-insensitive.
177      (cdr (assoc-string (org-element-property :key macro) templates t))))
178     (when template
179       (let ((value (replace-regexp-in-string
180                     "\\$[0-9]+"
181                     (lambda (arg)
182                       (or (nth (1- (string-to-number (substring arg 1)))
183                                (org-element-property :args macro))
184                           ;; No argument: remove place-holder.
185                           ""))
186                     template nil 'literal)))
187         ;; VALUE starts with "(eval": it is a s-exp, `eval' it.
188         (when (string-match "\\`(eval\\>" value)
189           (setq value (eval (read value))))
190         ;; Return string.
191         (format "%s" (or value ""))))))
192
193 (defun org-macro-replace-all (templates &optional finalize keywords)
194   "Replace all macros in current buffer by their expansion.
195
196 TEMPLATES is an alist of templates used for expansion.  See
197 `org-macro-templates' for a buffer-local default value.
198
199 If optional arg FINALIZE is non-nil, raise an error if a macro is
200 found in the buffer with no definition in TEMPLATES.
201
202 Optional argument KEYWORDS, when non-nil is a list of keywords,
203 as strings, where macro expansion is allowed."
204   (org-with-wide-buffer
205    (goto-char (point-min))
206    (let ((properties-regexp (format "\\`EXPORT_%s\\+?\\'"
207                     (regexp-opt keywords)))
208      record)
209      (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t)
210        (unless (save-match-data (org-in-commented-heading-p))
211      (let* ((datum (save-match-data (org-element-context)))
212         (type (org-element-type datum))
213         (macro
214          (cond
215           ((eq type 'macro) datum)
216           ;; In parsed keywords and associated node
217           ;; properties, force macro recognition.
218           ((or (and (eq type 'keyword)
219                 (member (org-element-property :key datum) keywords))
220                (and (eq type 'node-property)
221                 (string-match-p properties-regexp
222                         (org-element-property :key datum))))
223            (save-excursion
224              (goto-char (match-beginning 0))
225              (org-element-macro-parser))))))
226        (when macro
227          (let* ((value (org-macro-expand macro templates))
228             (begin (org-element-property :begin macro))
229             (signature (list begin
230                      macro
231                      (org-element-property :args macro))))
232            ;; Avoid circular dependencies by checking if the same
233            ;; macro with the same arguments is expanded at the
234            ;; same position twice.
235            (cond ((member signature record)
236               (error "Circular macro expansion: %s"
237                  (org-element-property :key macro)))
238              (value
239               (push signature record)
240               (delete-region
241                begin
242                ;; Preserve white spaces after the macro.
243                (progn (goto-char (org-element-property :end macro))
244                   (skip-chars-backward " \t")
245                   (point)))
246               ;; Leave point before replacement in case of
247               ;; recursive expansions.
248               (save-excursion (insert value)))
249              (finalize
250               (error "Undefined Org macro: %s; aborting"
251                  (org-element-property :key macro))))))))))))
252
253 (defun org-macro-escape-arguments (&rest args)
254   "Build macro's arguments string from ARGS.
255 ARGS are strings.  Return value is a string with arguments
256 properly escaped and separated with commas.  This is the opposite
257 of `org-macro-extract-arguments'."
258   (let ((s ""))
259     (dolist (arg (reverse args) (substring s 1))
260       (setq s
261         (concat
262          ","
263          (replace-regexp-in-string
264           "\\(\\\\*\\),"
265           (lambda (m)
266         (concat (make-string (1+ (* 2 (length (match-string 1 m)))) ?\\)
267             ","))
268           ;; If a non-terminal argument ends on backslashes, make
269           ;; sure to also escape them as they will be followed by
270           ;; a comma.
271           (concat arg (and (not (equal s ""))
272                    (string-match "\\\\+\\'" arg)
273                    (match-string 0 arg)))
274           nil t)
275          s)))))
276
277 (defun org-macro-extract-arguments (s)
278   "Extract macro arguments from string S.
279 S is a string containing comma separated values properly escaped.
280 Return a list of arguments, as strings.  This is the opposite of
281 `org-macro-escape-arguments'."
282   ;; Do not use `org-split-string' since empty strings are
283   ;; meaningful here.
284   (split-string
285    (replace-regexp-in-string
286     "\\(\\\\*\\),"
287     (lambda (str)
288       (let ((len (length (match-string 1 str))))
289     (concat (make-string (/ len 2) ?\\)
290         (if (zerop (mod len 2)) "\000" ","))))
291     s nil t)
292    "\000"))
293
294
295 ;;; Helper functions and variables for internal macros
296
297 (defun org-macro--vc-modified-time (file)
298   (save-window-excursion
299     (when (vc-backend file)
300       (let ((buf (get-buffer-create " *org-vc*"))
301         (case-fold-search t)
302         date)
303     (unwind-protect
304         (progn
305           (vc-call print-log file buf nil nil 1)
306           (with-current-buffer buf
307         (vc-exec-after
308          (lambda ()
309            (goto-char (point-min))
310            (when (re-search-forward "Date:?[ \t]*" nil t)
311              (let ((time (parse-time-string
312                   (buffer-substring
313                    (point) (line-end-position)))))
314                (when (cl-some #'identity time)
315              (setq date (apply #'encode-time time))))))))
316           (let ((proc (get-buffer-process buf)))
317         (while (and proc (accept-process-output proc .5 nil t)))))
318       (kill-buffer buf))
319     date))))
320
321 (defvar org-macro--counter-table nil
322   "Hash table containing counter value per name.")
323
324 (defun org-macro--counter-initialize ()
325   "Initialize `org-macro--counter-table'."
326   (setq org-macro--counter-table (make-hash-table :test #'equal)))
327
328 (defun org-macro--counter-increment (name &optional action)
329   "Increment counter NAME.
330 NAME is a string identifying the counter.
331
332 When non-nil, optional argument ACTION is a string.
333
334 If the string is \"-\", keep the NAME counter at its current
335 value, i.e. do not increment.
336
337 If the string represents an integer, set the counter to this number.
338
339 Any other non-empty string resets the counter to 1."
340   (let ((name-trimmed (org-trim name))
341         (action-trimmed (when (org-string-nw-p action)
342                           (org-trim action))))
343     (puthash name-trimmed
344              (cond ((not (org-string-nw-p action-trimmed))
345                     (1+ (gethash name-trimmed org-macro--counter-table 0)))
346                    ((string= "-" action-trimmed)
347                     (gethash name-trimmed org-macro--counter-table 1))
348                    ((string-match-p "\\`[0-9]+\\'" action-trimmed)
349                     (string-to-number action-trimmed))
350                    (t 1))
351              org-macro--counter-table)))
352
353
354 (provide 'org-macro)
355 ;;; org-macro.el ends here