+;;; org-macro.el --- Macro Replacement Code for Org -*- lexical-binding: t; -*-

+;; Argument in macros are separated with commas. Proper escaping rules

+;; are implemented in `org-macro-escape-arguments' and arguments can

+;; be extracted from a string with `org-macro-extract-arguments'.

+

+(require 'cl-lib)

+(require 'org-compat)

+(declare-function org-element-at-point "org-element" ())

+(declare-function org-element-macro-parser "org-element" ())

+(declare-function org-in-commented-heading-p "org" (&optional no-inheritance))

+(declare-function org-mode "org" ())

+(declare-function vc-backend "vc-hooks" (f))

+(declare-function vc-call "vc-hooks" (fun file &rest args) t)

+(declare-function vc-exec-after "vc-dispatcher" (code))

+(defvar-local org-macro-templates nil

+ (letrec ((collect-macros

+ (lambda (files templates)

+ ;; Return an alist of macro templates. FILES is a list

+ ;; of setup files names read so far, used to avoid

+ ;; circular dependencies. TEMPLATES is the alist

+ ;; collected so far.

+ (let ((case-fold-search t))

+ (org-with-wide-buffer

+ (goto-char (point-min))

+ (while (re-search-forward

+ "^[ \t]*#\\+\\(MACRO\\|SETUPFILE\\):" nil t)

+ (let ((element (org-element-at-point)))

+ (when (eq (org-element-type element) 'keyword)

+ (let ((val (org-element-property :value element)))

+ (if (equal (org-element-property :key element) "MACRO")

+ ;; Install macro in TEMPLATES.

+ (when (string-match

+ "^\\(.*?\\)\\(?:\\s-+\\(.*\\)\\)?\\s-*$" val)

+ (let* ((name (match-string 1 val))

+ (template (or (match-string 2 val) ""))

+ (old-cell (assoc name templates)))

+ (if old-cell (setcdr old-cell template)

+ (push (cons name template) templates))))

+ ;; Enter setup file.

+ (let ((file (expand-file-name

+ (org-unbracket-string "\"" "\"" val))))

+ (unless (member file files)

+ (with-temp-buffer

+ (setq default-directory

+ (file-name-directory file))

+ (org-mode)

+ (insert (org-file-contents file 'noerror))

+ (setq templates

+ (funcall collect-macros (cons file files)

+ templates)))))))))))

+ templates))))

+ (mapc update-templates

+ (list (cons "property"

+ "(eval (save-excursion

+ (let ((l \"$2\"))

+ (when (org-string-nw-p l)

+ (condition-case _

+ (let ((org-link-search-must-match-exact-headline t))

+ (org-link-search l nil t))

+ (error

+ (error \"Macro property failed: cannot find location %s\"

+ l)))))

+ (org-entry-get nil \"$1\" 'selective)))")

+ (mapc update-templates

+ (format "(eval (format-time-string \"$1\" (or (and (org-string-nw-p \"$2\") (org-macro--vc-modified-time %s)) '%s)))"

+ (prin1-to-string visited-file)

+(defun org-macro-replace-all (templates &optional finalize keywords)

+

+`org-macro-templates' for a buffer-local default value.

+

+If optional arg FINALIZE is non-nil, raise an error if a macro is

+found in the buffer with no definition in TEMPLATES.

+

+Optional argument KEYWORDS, when non-nil is a list of keywords,

+as strings, where macro expansion is allowed."

+ (let ((properties-regexp

+ (format "\\`EXPORT_%s\\+?\\'" (regexp-opt keywords)))

+ record)

+ (unless (save-match-data (org-in-commented-heading-p))

+ (let* ((datum (save-match-data (org-element-context)))

+ (type (org-element-type datum))

+ (macro

+ (cond

+ ((eq type 'macro) datum)

+ ;; In parsed keywords and associated node

+ ;; properties, force macro recognition.

+ ((or (and (eq type 'keyword)

+ (member (org-element-property :key datum)

+ keywords))

+ (and (eq type 'node-property)

+ (string-match-p properties-regexp

+ (org-element-property :key

+ datum))))

+ (save-excursion

+ (goto-char (match-beginning 0))

+ (org-element-macro-parser))))))

+ (when macro

+ (let* ((value (org-macro-expand macro templates))

+ (begin (org-element-property :begin macro))

+ (signature (list begin

+ macro

+ (org-element-property :args macro))))

+ ;; Avoid circular dependencies by checking if the same

+ ;; macro with the same arguments is expanded at the

+ ;; same position twice.

+ (cond ((member signature record)

+ (error "Circular macro expansion: %s"

+ (org-element-property :key macro)))

+ (value

+ (push signature record)

+ (delete-region

+ begin

+ ;; Preserve white spaces after the macro.

+ (progn (goto-char (org-element-property :end macro))

+ (skip-chars-backward " \t")

+ (point)))

+ ;; Leave point before replacement in case of

+ ;; recursive expansions.

+ (save-excursion (insert value)))

+ (finalize

+ (error "Undefined Org macro: %s; aborting"

+ (org-element-property :key macro))))))))))))

+

+(defun org-macro-escape-arguments (&rest args)

+ "Build macro's arguments string from ARGS.

+ARGS are strings. Return value is a string with arguments

+properly escaped and separated with commas. This is the opposite

+of `org-macro-extract-arguments'."

+ (let ((s ""))

+ (dolist (arg (reverse args) (substring s 1))

+ (setq s

+ (concat

+ ","

+ (replace-regexp-in-string

+ "\\(\\\\*\\),"

+ (lambda (m)

+ (concat (make-string (1+ (* 2 (length (match-string 1 m)))) ?\\)

+ ","))

+ ;; If a non-terminal argument ends on backslashes, make

+ ;; sure to also escape them as they will be followed by

+ ;; a comma.

+ (concat arg (and (not (equal s ""))

+ (string-match "\\\\+\\'" arg)

+ (match-string 0 arg)))

+ nil t)

+ s)))))

+

+(defun org-macro-extract-arguments (s)

+ "Extract macro arguments from string S.

+S is a string containing comma separated values properly escaped.

+Return a list of arguments, as strings. This is the opposite of

+`org-macro-escape-arguments'."

+ ;; Do not use `org-split-string' since empty strings are

+ ;; meaningful here.

+ (split-string

+ (replace-regexp-in-string

+ "\\(\\\\*\\),"

+ (lambda (str)

+ (let ((len (length (match-string 1 str))))

+ (concat (make-string (/ len 2) ?\\)

+ (if (zerop (mod len 2)) "\000" ","))))

+ s nil t)

+ "\000"))

+

+(defun org-macro--vc-modified-time (file)

+ (save-window-excursion

+ (when (vc-backend file)

+ (let ((buf (get-buffer-create " *org-vc*"))

+ (case-fold-search t)

+ date)

+ (unwind-protect

+ (progn

+ (vc-call print-log file buf nil nil 1)

+ (with-current-buffer buf

+ (vc-exec-after

+ (lambda ()

+ (goto-char (point-min))

+ (when (re-search-forward "Date:?[ \t]*" nil t)

+ (let ((time (parse-time-string

+ (buffer-substring

+ (point) (line-end-position)))))

+ (when (cl-some #'identity time)

+ (setq date (apply #'encode-time time))))))))

+ (let ((proc (get-buffer-process buf)))

+ (while (and proc (accept-process-output proc .5 nil t)))))

+ (kill-buffer buf))

+ date))))