lisp/org-macro.el

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