lisp/org-macro.el

   1 ;;; org-macro.el --- Macro Replacement Code for Org  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2013-2017 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 <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 ;; 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 (org-macro--collect-macros))
 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 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   (save-excursion
 205     (goto-char (point-min))
 206     (let ((properties-regexp
 207            (format "\\`EXPORT_%s\\+?\\'" (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)
 220                                      keywords))
 221                         (and (eq type 'node-property)
 222                              (string-match-p properties-regexp
 223                                              (org-element-property :key
 224                                                                    datum))))
 225                     (save-excursion
 226                       (goto-char (match-beginning 0))
 227                       (org-element-macro-parser))))))
 228             (when macro
 229               (let* ((value (org-macro-expand macro templates))
 230                      (begin (org-element-property :begin macro))
 231                      (signature (list begin
 232                                       macro
 233                                       (org-element-property :args macro))))
 234                 ;; Avoid circular dependencies by checking if the same
 235                 ;; macro with the same arguments is expanded at the
 236                 ;; same position twice.
 237                 (cond ((member signature record)
 238                        (error "Circular macro expansion: %s"
 239                               (org-element-property :key macro)))
 240                       (value
 241                        (push signature record)
 242                        (delete-region
 243                         begin
 244                         ;; Preserve white spaces after the macro.
 245                         (progn (goto-char (org-element-property :end macro))
 246                                (skip-chars-backward " \t")
 247                                (point)))
 248                        ;; Leave point before replacement in case of
 249                        ;; recursive expansions.
 250                        (save-excursion (insert value)))
 251                       (finalize
 252                        (error "Undefined Org macro: %s; aborting"
 253                               (org-element-property :key macro))))))))))))
 254
 255 (defun org-macro-escape-arguments (&rest args)
 256   "Build macro's arguments string from ARGS.
 257 ARGS are strings.  Return value is a string with arguments
 258 properly escaped and separated with commas.  This is the opposite
 259 of `org-macro-extract-arguments'."
 260   (let ((s ""))
 261     (dolist (arg (reverse args) (substring s 1))
 262       (setq s
 263             (concat
 264              ","
 265              (replace-regexp-in-string
 266               "\\(\\\\*\\),"
 267               (lambda (m)
 268                 (concat (make-string (1+ (* 2 (length (match-string 1 m)))) ?\\)
 269                         ","))
 270               ;; If a non-terminal argument ends on backslashes, make
 271               ;; sure to also escape them as they will be followed by
 272               ;; a comma.
 273               (concat arg (and (not (equal s ""))
 274                                (string-match "\\\\+\\'" arg)
 275                                (match-string 0 arg)))
 276               nil t)
 277              s)))))
 278
 279 (defun org-macro-extract-arguments (s)
 280   "Extract macro arguments from string S.
 281 S is a string containing comma separated values properly escaped.
 282 Return a list of arguments, as strings.  This is the opposite of
 283 `org-macro-escape-arguments'."
 284   ;; Do not use `org-split-string' since empty strings are
 285   ;; meaningful here.
 286   (split-string
 287    (replace-regexp-in-string
 288     "\\(\\\\*\\),"
 289     (lambda (str)
 290       (let ((len (length (match-string 1 str))))
 291         (concat (make-string (/ len 2) ?\\)
 292                 (if (zerop (mod len 2)) "\000" ","))))
 293     s nil t)
 294    "\000"))
 295
 296 \f
 297 ;;; Helper functions and variables for internal macros
 298
 299 (defun org-macro--vc-modified-time (file)
 300   (save-window-excursion
 301     (when (vc-backend file)
 302       (let ((buf (get-buffer-create " *org-vc*"))
 303             (case-fold-search t)
 304             date)
 305         (unwind-protect
 306             (progn
 307               (vc-call print-log file buf nil nil 1)
 308               (with-current-buffer buf
 309                 (vc-exec-after
 310                  (lambda ()
 311                    (goto-char (point-min))
 312                    (when (re-search-forward "Date:?[ \t]*" nil t)
 313                      (let ((time (parse-time-string
 314                                   (buffer-substring
 315                                    (point) (line-end-position)))))
 316                        (when (cl-some #'identity time)
 317                          (setq date (apply #'encode-time time))))))))
 318               (let ((proc (get-buffer-process buf)))
 319                 (while (and proc (accept-process-output proc .5 nil t)))))
 320           (kill-buffer buf))
 321         date))))
 322
 323 (defvar org-macro--counter-table nil
 324   "Hash table containing counter value per name.")
 325
 326 (defun org-macro--counter-initialize ()
 327   "Initialize `org-macro--counter-table'."
 328   (setq org-macro--counter-table (make-hash-table :test #'equal)))
 329
 330 (defun org-macro--counter-increment (name &optional action)
 331   "Increment counter NAME.
 332 NAME is a string identifying the counter.
 333
 334 When non-nil, optional argument ACTION is a string.
 335
 336 If the string is \"-\", keep the NAME counter at its current
 337 value, i.e. do not increment.
 338
 339 If the string represents an integer, set the counter to this number.
 340
 341 Any other non-empty string resets the counter to 1."
 342   (let ((name-trimmed (org-trim name))
 343         (action-trimmed (when (org-string-nw-p action)
 344                           (org-trim action))))
 345     (puthash name-trimmed
 346              (cond ((not (org-string-nw-p action-trimmed))
 347                     (1+ (gethash name-trimmed org-macro--counter-table 0)))
 348                    ((string= "-" action-trimmed)
 349                     (gethash name-trimmed org-macro--counter-table 1))
 350                    ((string-match-p "\\`[0-9]+\\'" action-trimmed)
 351                     (string-to-number action-trimmed))
 352                    (t 1))
 353              org-macro--counter-table)))
 354
 355
 356 (provide 'org-macro)
 357 ;;; org-macro.el ends here