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