org-macro.el (17300B)
1 ;;; org-macro.el --- Macro Replacement Code for Org -*- lexical-binding: t; -*- 2 3 ;; Copyright (C) 2013-2023 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 50 (require 'org-macs) 51 (org-assert-version) 52 53 (require 'cl-lib) 54 (require 'org-macs) 55 (require 'org-compat) 56 57 (declare-function org-collect-keywords "org" (keywords &optional unique directory)) 58 (declare-function org-element-at-point "org-element" (&optional pom cached-only)) 59 (declare-function org-element-context "org-element" (&optional element)) 60 (declare-function org-element-copy "org-element" (datum)) 61 (declare-function org-element-macro-parser "org-element" ()) 62 (declare-function org-element-keyword-parser "org-element" (limit affiliated)) 63 (declare-function org-element-put-property "org-element" (element property value)) 64 (declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent)) 65 (declare-function org-element-property "org-element" (property element)) 66 (declare-function org-element-restriction "org-element" (element)) 67 (declare-function org-element-type "org-element" (element)) 68 (declare-function org-entry-get "org" (pom property &optional inherit literal-nil)) 69 (declare-function org-file-contents "org" (file &optional noerror nocache)) 70 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance element)) 71 (declare-function org-link-search "ol" (s &optional avoid-pos stealth)) 72 (declare-function org-mode "org" ()) 73 (declare-function vc-backend "vc-hooks" (f)) 74 (declare-function vc-call "vc-hooks" (fun file &rest args) t) 75 (declare-function vc-exec-after "vc-dispatcher" (code &optional success)) 76 77 (defvar org-link-search-must-match-exact-headline) 78 79 ;;; Variables 80 81 (defvar-local org-macro-templates nil 82 "Alist containing all macro templates in current buffer. 83 Associations are in the shape of (NAME . TEMPLATE) where NAME 84 stands for macro's name and template for its replacement value, 85 both as strings. This is an internal variable. Do not set it 86 directly, use instead: 87 88 #+MACRO: name template") 89 90 ;;; Functions 91 92 (defun org-macro--makeargs (template) 93 "Compute the formal arglist to use for TEMPLATE." 94 (let ((max 0) (i 0)) 95 (while (string-match "\\$\\([0-9]+\\)" template i) 96 (setq i (match-end 0)) 97 (setq max (max max (string-to-number (match-string 1 template))))) 98 (let ((args '(&rest _))) 99 (if (< max 1) args ;Avoid `&optional &rest', refused by Emacs-26! 100 (while (> max 0) 101 (push (intern (format "$%d" max)) args) 102 (setq max (1- max))) 103 (cons '&optional args))))) 104 105 (defun org-macro--set-templates (templates) 106 "Set template for the macro NAME. 107 VALUE is the template of the macro. The new value override the 108 previous one, unless VALUE is nil. Return the updated list." 109 (let ((new-templates nil)) 110 (pcase-dolist (`(,name . ,value) templates) 111 (let ((old-definition (assoc name new-templates))) 112 (when (and (stringp value) (string-match-p "\\`(eval\\>" value)) 113 ;; Pre-process the evaluation form for faster macro expansion. 114 (let* ((args (org-macro--makeargs value)) 115 (body 116 (condition-case nil 117 ;; `value' is of the form "(eval ...)" but we 118 ;; don't want this to mean to pass the result to 119 ;; `eval' (which would cause double evaluation), 120 ;; so we strip the `eval' away with `cadr'. 121 (cadr (read value)) 122 (error 123 (user-error "Invalid definition for macro %S" name))))) 124 (setq value (eval (macroexpand-all `(lambda ,args ,body)) t)))) 125 (cond ((and value old-definition) (setcdr old-definition value)) 126 (old-definition) 127 (t (push (cons name (or value "")) new-templates))))) 128 new-templates)) 129 130 (defun org-macro--collect-macros () 131 "Collect macro definitions in current buffer and setup files. 132 Return an alist containing all macro templates found." 133 (let ((templates 134 `(("author" . ,(org-macro--find-keyword-value "AUTHOR" t)) 135 ("email" . ,(org-macro--find-keyword-value "EMAIL")) 136 ("title" . ,(org-macro--find-keyword-value "TITLE" t)) 137 ("date" . ,(org-macro--find-date))))) 138 (pcase (org-collect-keywords '("MACRO")) 139 (`(("MACRO" . ,values)) 140 (dolist (value values) 141 (when (string-match "^\\(\\S-+\\)[ \t]*" value) 142 (let ((name (match-string 1 value)) 143 (definition (substring value (match-end 0)))) 144 (push (cons name definition) templates)))))) 145 templates)) 146 147 (defun org-macro-initialize-templates (&optional default) 148 "Collect macro templates defined in current buffer. 149 150 DEFAULT is a list of globally available templates. 151 152 Templates are stored in buffer-local variable `org-macro-templates'. 153 154 In addition to buffer-defined macros, the function installs the 155 following ones: \"n\", \"author\", \"email\", \"keyword\", 156 \"time\", \"property\", and, if the buffer is associated to 157 a file, \"input-file\" and \"modification-time\"." 158 (require 'org-element) 159 (org-macro--counter-initialize) ;for "n" macro 160 (setq org-macro-templates 161 (nconc 162 ;; Install user-defined macros. Local macros have higher 163 ;; precedence than global ones. 164 (org-macro--set-templates (append default (org-macro--collect-macros))) 165 ;; Install file-specific macros. 166 (let ((visited-file (buffer-file-name (buffer-base-buffer)))) 167 (and visited-file 168 (file-exists-p visited-file) 169 (list 170 `("input-file" . ,(file-name-nondirectory visited-file)) 171 `("modification-time" . 172 ,(let ((modtime (file-attribute-modification-time 173 (file-attributes visited-file)))) 174 (lambda (arg1 &optional arg2 &rest _) 175 (format-time-string 176 arg1 177 (or (and (org-string-nw-p arg2) 178 (org-macro--vc-modified-time visited-file)) 179 modtime)))))))) 180 ;; Install generic macros. 181 '(("keyword" . (lambda (arg1 &rest _) 182 (org-macro--find-keyword-value arg1 t))) 183 ("n" . (lambda (&optional arg1 arg2 &rest _) 184 (org-macro--counter-increment arg1 arg2))) 185 ("property" . (lambda (arg1 &optional arg2 &rest _) 186 (org-macro--get-property arg1 arg2))) 187 ("time" . (lambda (arg1 &rest _) 188 (format-time-string arg1))))))) 189 190 (defun org-macro-expand (macro templates) 191 "Return expanded MACRO, as a string. 192 MACRO is an object, obtained, for example, with 193 `org-element-context'. TEMPLATES is an alist of templates used 194 for expansion. See `org-macro-templates' for a buffer-local 195 default value. Return nil if no template was found." 196 (let ((template 197 ;; Macro names are case-insensitive. 198 (cdr (assoc-string (org-element-property :key macro) templates t)))) 199 (when template 200 (let* ((value 201 (if (functionp template) 202 (apply template (org-element-property :args macro)) 203 (replace-regexp-in-string 204 "\\$[0-9]+" 205 (lambda (m) 206 (or (nth (1- (string-to-number (substring m 1))) 207 (org-element-property :args macro)) 208 ;; No argument: remove place-holder. 209 "")) 210 template nil 'literal)))) 211 ;; Force return value to be a string. 212 (format "%s" (or value "")))))) 213 214 (defun org-macro-replace-all (templates &optional keywords) 215 "Replace all macros in current buffer by their expansion. 216 217 TEMPLATES is an alist of templates used for expansion. See 218 `org-macro-templates' for a buffer-local default value. 219 220 Optional argument KEYWORDS, when non-nil is a list of keywords, 221 as strings, where macro expansion is allowed. 222 223 Return an error if a macro in the buffer cannot be associated to 224 a definition in TEMPLATES." 225 (org-with-wide-buffer 226 (goto-char (point-min)) 227 (let ((properties-regexp (format "\\`EXPORT_%s\\+?\\'" 228 (regexp-opt keywords))) 229 record) 230 (while (re-search-forward "{{{[-A-Za-z0-9_]" nil t) 231 (unless (save-match-data (org-in-commented-heading-p)) 232 (let* ((datum (save-match-data (org-element-context))) 233 (type (org-element-type datum)) 234 (macro 235 (cond 236 ((eq type 'macro) datum) 237 ;; In parsed keywords and associated node 238 ;; properties, force macro recognition. 239 ((or (and (eq type 'keyword) 240 (member (org-element-property :key datum) keywords)) 241 (and (eq type 'node-property) 242 (string-match-p properties-regexp 243 (org-element-property :key datum)))) 244 (save-excursion 245 (goto-char (match-beginning 0)) 246 (org-element-macro-parser)))))) 247 (when macro 248 ;; `:parent' property might change as we modify buffer. 249 ;; We do not care about it when checking for circular 250 ;; dependencies. So, setting `:parent' to nil making sure 251 ;; that actual macro element (if org-element-cache is 252 ;; active) is unchanged. 253 (setq macro (cl-copy-list macro)) 254 (org-element-put-property macro :parent nil) 255 (let* ((key (org-element-property :key macro)) 256 (value (org-macro-expand macro templates)) 257 (begin (org-element-property :begin macro)) 258 (signature (list begin 259 macro 260 (org-element-property :args macro)))) 261 ;; Avoid circular dependencies by checking if the same 262 ;; macro with the same arguments is expanded at the 263 ;; same position twice. 264 (cond ((member signature record) 265 (error "Circular macro expansion: %s" key)) 266 (value 267 (push signature record) 268 (delete-region 269 begin 270 ;; Preserve white spaces after the macro. 271 (progn (goto-char (org-element-property :end macro)) 272 (skip-chars-backward " \t") 273 (point))) 274 ;; Leave point before replacement in case of 275 ;; recursive expansions. 276 (save-excursion (insert value))) 277 ;; Special "results" macro: if it is not defined, 278 ;; simply leave it as-is. It will be expanded in 279 ;; a second phase. 280 ((equal key "results")) 281 (t 282 (error "Undefined Org macro: %s; aborting" 283 (org-element-property :key macro)))))))))))) 284 285 (defun org-macro-escape-arguments (&rest args) 286 "Build macro's arguments string from ARGS. 287 ARGS are strings. Return value is a string with arguments 288 properly escaped and separated with commas. This is the opposite 289 of `org-macro-extract-arguments'." 290 (let ((s "")) 291 (dolist (arg (reverse args) (substring s 1)) 292 (setq s 293 (concat 294 "," 295 (replace-regexp-in-string 296 "\\(\\\\*\\)," 297 (lambda (m) 298 (concat (make-string (1+ (* 2 (length (match-string 1 m)))) ?\\) 299 ",")) 300 ;; If a non-terminal argument ends on backslashes, make 301 ;; sure to also escape them as they will be followed by 302 ;; a comma. 303 (concat arg (and (not (equal s "")) 304 (string-match "\\\\+\\'" arg) 305 (match-string 0 arg))) 306 nil t) 307 s))))) 308 309 (defun org-macro-extract-arguments (s) 310 "Extract macro arguments from string S. 311 S is a string containing comma separated values properly escaped. 312 Return a list of arguments, as strings. This is the opposite of 313 `org-macro-escape-arguments'." 314 ;; Do not use `org-split-string' since empty strings are 315 ;; meaningful here. 316 (split-string 317 (replace-regexp-in-string 318 "\\(\\\\*\\)," 319 (lambda (str) 320 (let ((len (length (match-string 1 str)))) 321 (concat (make-string (/ len 2) ?\\) 322 (if (zerop (mod len 2)) "\000" ",")))) 323 s nil t) 324 "\000")) 325 326 327 ;;; Helper functions and variables for internal macros 328 329 (defun org-macro--get-property (property location) 330 "Find PROPERTY's value at LOCATION. 331 PROPERTY is a string. LOCATION is a search string, as expected 332 by `org-link-search', or the empty string." 333 (save-excursion 334 (when (org-string-nw-p location) 335 (condition-case _ 336 (let ((org-link-search-must-match-exact-headline t)) 337 (org-link-search location nil t)) 338 (error 339 (error "Macro property failed: cannot find location %s" location)))) 340 (org-entry-get nil property 'selective))) 341 342 (defun org-macro--find-keyword-value (name &optional collect) 343 "Find value for keyword NAME in current buffer. 344 Return value associated to the keywords named after NAME, as 345 a string, or nil. When optional argument COLLECT is non-nil, 346 concatenate values, separated with a space, from various keywords 347 in the buffer." 348 (org-with-point-at 1 349 (let ((regexp (format "^[ \t]*#\\+%s:" (regexp-quote name))) 350 (case-fold-search t) 351 (result nil)) 352 (catch :exit 353 (while (re-search-forward regexp nil t) 354 (let ((element (org-with-point-at (match-beginning 0) (org-element-keyword-parser (line-end-position) (list (match-beginning 0)))))) 355 (when (eq 'keyword (org-element-type element)) 356 (let ((value (org-element-property :value element))) 357 (if (not collect) (throw :exit value) 358 (setq result (concat result " " value))))))) 359 (and result (org-trim result)))))) 360 361 (defun org-macro--find-date () 362 "Find value for DATE in current buffer. 363 Return value as a string." 364 (let* ((value (org-macro--find-keyword-value "DATE")) 365 (date (org-element-parse-secondary-string 366 value (org-element-restriction 'keyword)))) 367 (if (and (consp date) 368 (not (cdr date)) 369 (eq 'timestamp (org-element-type (car date)))) 370 (format "(eval (if (org-string-nw-p $1) %s %S))" 371 (format "(org-format-timestamp '%S $1)" 372 (org-element-copy (car date))) 373 value) 374 value))) 375 376 (defun org-macro--vc-modified-time (file) 377 (require 'vc) ; Not everything we need is autoloaded. 378 (save-window-excursion 379 (when (vc-backend file) 380 (let ((buf (get-buffer-create " *org-vc*")) 381 (case-fold-search t) 382 date) 383 (unwind-protect 384 (progn 385 (vc-call print-log (list file) buf nil nil 1) 386 (with-current-buffer buf 387 (vc-exec-after 388 (lambda () 389 (goto-char (point-min)) 390 (when (re-search-forward "Date:?[ \t]*" nil t) 391 (let ((time (parse-time-string 392 (buffer-substring 393 (point) (line-end-position))))) 394 (when (cl-some #'identity time) 395 (setq date (org-encode-time time)))))))) 396 (let ((proc (get-buffer-process buf))) 397 (while (and proc (accept-process-output proc .5 nil t))))) 398 (kill-buffer buf)) 399 date)))) 400 401 (defvar org-macro--counter-table nil 402 "Hash table containing counter value per name.") 403 404 (defun org-macro--counter-initialize () 405 "Initialize `org-macro--counter-table'." 406 (setq org-macro--counter-table (make-hash-table :test #'equal))) 407 408 (defun org-macro--counter-increment (name &optional action) 409 "Increment counter NAME. 410 NAME is a string identifying the counter. 411 412 When non-nil, optional argument ACTION is a string. 413 414 If the string is \"-\", keep the NAME counter at its current 415 value, i.e. do not increment. 416 417 If the string represents an integer, set the counter to this number. 418 419 Any other non-empty string resets the counter to 1." 420 (let ((name-trimmed (if (stringp name) (org-trim name) "")) 421 (action-trimmed (when (org-string-nw-p action) 422 (org-trim action)))) 423 (puthash name-trimmed 424 (cond ((not (org-string-nw-p action-trimmed)) 425 (1+ (gethash name-trimmed org-macro--counter-table 0))) 426 ((string= "-" action-trimmed) 427 (gethash name-trimmed org-macro--counter-table 1)) 428 ((string-match-p "\\`[0-9]+\\'" action-trimmed) 429 (string-to-number action-trimmed)) 430 (t 1)) 431 org-macro--counter-table))) 432 433 (provide 'org-macro) 434 435 ;;; org-macro.el ends here