Update Org to 9.3

1 files changed, 173 insertions, 107 deletions

diff --git a/lisp/org/org-macro.el b/lisp/org/org-macro.el
index a151e1e8469..c928ea732c2 100644
--- a/lisp/org/org-macro.el
+++ b/lisp/org/org-macro.el
@@ -52,18 +52,24 @@
 
 (declare-function org-element-at-point "org-element" ())
 (declare-function org-element-context "org-element" (&optional element))
+(declare-function org-element-copy "org-element" (datum))
 (declare-function org-element-macro-parser "org-element" ())
+(declare-function org-element-parse-secondary-string "org-element" (string restriction &optional parent))
 (declare-function org-element-property "org-element" (property element))
+(declare-function org-element-restriction "org-element" (element))
 (declare-function org-element-type "org-element" (element))
+(declare-function org-entry-get "org" (pom property &optional inherit literal-nil))
 (declare-function org-file-contents "org" (file &optional noerror nocache))
 (declare-function org-file-url-p "org" (file))
 (declare-function org-in-commented-heading-p "org" (&optional no-inheritance))
+(declare-function org-link-search "ol" (s &optional avoid-pos stealth))
 (declare-function org-mode "org" ())
-(declare-function org-trim "org" (s &optional keep-lead))
 (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 org-link-search-must-match-exact-headline)
+
 ;;; Variables
 
 (defvar-local org-macro-templates nil
@@ -77,95 +83,100 @@ directly, use instead:
 
 ;;; Functions
 
-(defun org-macro--collect-macros ()
+(defun org-macro--set-template (name value templates)
+  "Set template for the macro NAME.
+VALUE is the template of the macro.  The new value override the
+previous one, unless VALUE is nil.  TEMPLATES is the list of
+templates.  Return the updated list."
+  (when value
+    (let ((old-definition (assoc name templates)))
+      (if old-definition
+	  (setcdr old-definition value)
+	(push (cons name value) templates))))
+  templates)
+
+(defun org-macro--collect-macros (&optional files templates)
   "Collect macro definitions in current buffer and setup files.
-Return an alist containing all macro templates found."
-  (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* ((uri (org-unbracket-string "\"" "\"" (org-trim val)))
-				  (uri-is-url (org-file-url-p uri))
-				  (uri (if uri-is-url
-					   uri
-					 (expand-file-name uri))))
-			     ;; Avoid circular dependencies.
-			     (unless (member uri files)
-			       (with-temp-buffer
-				 (unless uri-is-url
-				   (setq default-directory
-					 (file-name-directory uri)))
-				 (org-mode)
-				 (insert (org-file-contents uri 'noerror))
-				 (setq templates
-				       (funcall collect-macros (cons uri files)
-						templates)))))))))))
-		templates))))
-    (funcall collect-macros nil nil)))
+Return an alist containing all macro templates found.
+
+FILES is a list of setup files names read so far, used to avoid
+circular dependencies.  TEMPLATES is the alist collected so far.
+The two arguments are used in recursive calls."
+  (let ((case-fold-search t))
+    (org-with-point-at 1
+      (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 "MACRO" (org-element-property :key element))
+		  ;; Install macro in TEMPLATES.
+		  (when (string-match "^\\(\\S-+\\)[ \t]*" val)
+		    (let ((name (match-string 1 val))
+			  (value (substring val (match-end 0))))
+		      (setq templates
+			    (org-macro--set-template name value templates))))
+		;; Enter setup file.
+		(let* ((uri (org-strip-quotes val))
+		       (uri-is-url (org-file-url-p uri))
+		       (uri (if uri-is-url
+				uri
+			      (expand-file-name uri))))
+		  ;; Avoid circular dependencies.
+		  (unless (member uri files)
+		    (with-temp-buffer
+		      (unless uri-is-url
+			(setq default-directory (file-name-directory uri)))
+		      (org-mode)
+		      (insert (org-file-contents uri 'noerror))
+		      (setq templates
+			    (org-macro--collect-macros
+			     (cons uri files) templates)))))))))))
+    (let ((macros `(("author" . ,(org-macro--find-keyword-value "AUTHOR"))
+		    ("email" . ,(org-macro--find-keyword-value "EMAIL"))
+		    ("title" . ,(org-macro--find-keyword-value "TITLE" t))
+		    ("date" . ,(org-macro--find-date)))))
+      (pcase-dolist (`(,name . ,value) macros)
+	(setq templates (org-macro--set-template name value templates))))
+    templates))
 
 (defun org-macro-initialize-templates ()
   "Collect macro templates defined in current buffer.
+
 Templates are stored in buffer-local variable
-`org-macro-templates'.  In addition to buffer-defined macros, the
-function installs the following ones: \"property\",
-\"time\". and, if the buffer is associated to a file,
-\"input-file\" and \"modification-time\"."
-  (let* ((templates nil)
-	 (update-templates
-	  (lambda (cell)
-	    (let ((old-template (assoc (car cell) templates)))
-	      (if old-template (setcdr old-template (cdr cell))
-		(push cell templates))))))
-    ;; Install "property", "time" macros.
-    (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)))")
-		(cons "time" "(eval (format-time-string \"$1\"))")))
-    ;; Install "input-file", "modification-time" macros.
-    (let ((visited-file (buffer-file-name (buffer-base-buffer))))
-      (when (and visited-file (file-exists-p visited-file))
-	(mapc update-templates
-	      (list (cons "input-file" (file-name-nondirectory visited-file))
-		    (cons "modification-time"
-			  (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)
-				  (prin1-to-string
-				   (file-attribute-modification-time
-				    (file-attributes visited-file)))))))))
-    ;; Initialize and install "n" macro.
-    (org-macro--counter-initialize)
-    (funcall update-templates
-	     (cons "n" "(eval (org-macro--counter-increment \"$1\" \"$2\"))"))
-    (setq org-macro-templates (nconc (org-macro--collect-macros) templates))))
+`org-macro-templates'.
+
+In addition to buffer-defined macros, the function installs the
+following ones: \"n\", \"author\", \"email\", \"keyword\",
+\"time\", \"property\", and, if the buffer is associated to
+a file, \"input-file\" and \"modification-time\"."
+  (require 'org-element)
+  (org-macro--counter-initialize)	;for "n" macro
+  (setq org-macro-templates
+	(nconc
+	 ;; Install user-defined macros.
+	 (org-macro--collect-macros)
+	 ;; Install file-specific macros.
+	 (let ((visited-file (buffer-file-name (buffer-base-buffer))))
+	   (and visited-file
+		(file-exists-p visited-file)
+		(list
+		 `("input-file" . ,(file-name-nondirectory visited-file))
+		 `("modification-time" .
+		   ,(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)
+			    (prin1-to-string
+			     (file-attribute-modification-time
+			      (file-attributes visited-file))))))))
+	 ;; Install generic macros.
+	 (list
+	  '("n" . "(eval (org-macro--counter-increment $1 $2))")
+	  '("keyword" . "(eval (org-macro--find-keyword-value $1))")
+	  '("time" . "(eval (format-time-string $1))")
+	  '("property" . "(eval (org-macro--get-property $1 $2))")))))
 
 (defun org-macro-expand (macro templates)
   "Return expanded MACRO, as a string.
@@ -177,31 +188,35 @@ default value.  Return nil if no template was found."
 	 ;; Macro names are case-insensitive.
 	 (cdr (assoc-string (org-element-property :key macro) templates t))))
     (when template
-      (let ((value (replace-regexp-in-string
-                    "\\$[0-9]+"
-                    (lambda (arg)
-                      (or (nth (1- (string-to-number (substring arg 1)))
-                               (org-element-property :args macro))
-                          ;; No argument: remove place-holder.
-                          ""))
-                    template nil 'literal)))
-        ;; VALUE starts with "(eval": it is a s-exp, `eval' it.
-        (when (string-match "\\`(eval\\>" value)
-          (setq value (eval (read value))))
-        ;; Return string.
+      (let* ((eval? (string-match-p "\\`(eval\\>" template))
+	     (value
+	      (replace-regexp-in-string
+	       "\\$[0-9]+"
+	       (lambda (m)
+		 (let ((arg (or (nth (1- (string-to-number (substring m 1)))
+				     (org-element-property :args macro))
+				;; No argument: remove place-holder.
+				"")))
+		   ;; `eval' implies arguments are strings.
+		   (if eval? (format "%S" arg) arg)))
+	       template nil 'literal)))
+        (when eval?
+          (setq value (eval (condition-case nil (read value)
+			      (error (debug))))))
+        ;; Force return value to be a string.
         (format "%s" (or value ""))))))
 
-(defun org-macro-replace-all (templates &optional finalize keywords)
+(defun org-macro-replace-all (templates &optional keywords)
   "Replace all macros in current buffer by their expansion.
 
 TEMPLATES is an alist of templates used for expansion.  See
 `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."
+as strings, where macro expansion is allowed.
+
+Return an error if a macro in the buffer cannot be associated to
+a definition in TEMPLATES."
   (org-with-wide-buffer
    (goto-char (point-min))
    (let ((properties-regexp (format "\\`EXPORT_%s\\+?\\'"
@@ -225,7 +240,8 @@ as strings, where macro expansion is allowed."
 		     (goto-char (match-beginning 0))
 		     (org-element-macro-parser))))))
 	   (when macro
-	     (let* ((value (org-macro-expand macro templates))
+	     (let* ((key (org-element-property :key macro))
+		    (value (org-macro-expand macro templates))
 		    (begin (org-element-property :begin macro))
 		    (signature (list begin
 				     macro
@@ -234,8 +250,7 @@ as strings, where macro expansion is allowed."
 	       ;; 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)))
+		      (error "Circular macro expansion: %s" key))
 		     (value
 		      (push signature record)
 		      (delete-region
@@ -247,7 +262,11 @@ as strings, where macro expansion is allowed."
 		      ;; Leave point before replacement in case of
 		      ;; recursive expansions.
 		      (save-excursion (insert value)))
-		     (finalize
+		     ;; Special "results" macro: if it is not defined,
+		     ;; simply leave it as-is.  It will be expanded in
+		     ;; a second phase.
+		     ((equal key "results"))
+		     (t
 		      (error "Undefined Org macro: %s; aborting"
 			     (org-element-property :key macro))))))))))))
 
@@ -295,6 +314,53 @@ Return a list of arguments, as strings.  This is the opposite of
 
 ;;; Helper functions and variables for internal macros
 
+(defun org-macro--get-property (property location)
+  "Find PROPERTY's value at LOCATION.
+PROPERTY is a string.  LOCATION is a search string, as expected
+by `org-link-search', or the empty string."
+  (save-excursion
+    (when (org-string-nw-p location)
+      (condition-case _
+	  (let ((org-link-search-must-match-exact-headline t))
+	    (org-link-search location nil t))
+        (error
+	 (error "Macro property failed: cannot find location %s" location))))
+    (org-entry-get nil property 'selective)))
+
+(defun org-macro--find-keyword-value (name &optional collect)
+  "Find value for keyword NAME in current buffer.
+Return value associated to the keywords named after NAME, as
+a string, or nil.  When optional argument COLLECT is non-nil,
+concatenate values, separated with a space, from various keywords
+in the buffer."
+  (org-with-point-at 1
+    (let ((regexp (format "^[ \t]*#\\+%s:" (regexp-quote name)))
+	  (case-fold-search t)
+	  (result nil))
+      (catch :exit
+	(while (re-search-forward regexp nil t)
+	  (let ((element (org-element-at-point)))
+	    (when (eq 'keyword (org-element-type element))
+	      (let ((value (org-element-property :value element)))
+		(if (not collect) (throw :exit value)
+		  (setq result (concat result " " value)))))))
+	(and result (org-trim result))))))
+
+(defun org-macro--find-date ()
+  "Find value for DATE in current buffer.
+Return value as a string."
+  (let* ((value (org-macro--find-keyword-value "DATE"))
+	 (date (org-element-parse-secondary-string
+		value (org-element-restriction 'keyword))))
+    (if (and (consp date)
+	     (not (cdr date))
+	     (eq 'timestamp (org-element-type (car date))))
+	(format "(eval (if (org-string-nw-p $1) %s %S))"
+		(format "(org-timestamp-format '%S $1)"
+			(org-element-copy (car date)))
+		value)
+      value)))
+
 (defun org-macro--vc-modified-time (file)
   (save-window-excursion
     (when (vc-backend file)
@@ -313,7 +379,7 @@ Return a list of arguments, as strings.  This is the opposite of
 				  (buffer-substring
 				   (point) (line-end-position)))))
 		       (when (cl-some #'identity time)
-			 (setq date (encode-time 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))