lisp/org-macro.el

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