| 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 | |
