org-macro.el 16 KB

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