Browse Source

Merge branch 'maint'

Nicolas Goaziou 6 months ago
parent
commit
9bbae3ce8f
2 changed files with 85 additions and 93 deletions
  1. 84 71
      lisp/org-macro.el
  2. 1 22
      testing/lisp/test-org-macro.el

+ 84 - 71
lisp/org-macro.el

@@ -83,51 +83,61 @@ 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-strip-quotes (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.
@@ -161,27 +171,12 @@ a file, \"input-file\" and \"modification-time\"."
 			    (prin1-to-string
 			     (file-attribute-modification-time
 			      (file-attributes visited-file))))))))
-	 ;; Install built-in macros.
+	 ;; Install generic macros.
 	 (list
 	  '("n" . "(eval (org-macro--counter-increment $1 $2))")
-	  `("author" . ,(org-macro--find-keyword-value "AUTHOR"))
-	  `("email" . ,(org-macro--find-keyword-value "EMAIL"))
 	  '("keyword" . "(eval (org-macro--find-keyword-value $1))")
 	  '("time" . "(eval (format-time-string $1))")
-	  `("title" . ,(org-macro--find-keyword-value "TITLE"))
-	  '("property" . "(eval (org-macro--get-property $1 $2))")
-	  `("date" .
-	    ,(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)))))))
+	  '("property" . "(eval (org-macro--get-property $1 $2))")))))
 
 (defun org-macro-expand (macro templates)
   "Return expanded MACRO, as a string.
@@ -332,21 +327,39 @@ by `org-link-search', or the empty string."
 	 (error "Macro property failed: cannot find location %s" location))))
     (org-entry-get nil property 'selective)))
 
-(defun org-macro--find-keyword-value (name)
+(defun org-macro--find-keyword-value (name &optional collect)
   "Find value for keyword NAME in current buffer.
-KEYWORD is a string.  Return value associated to the keywords
-named after NAME, as a string, or nil."
+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))
-      (while (re-search-forward regexp nil t)
-	(let ((element (org-element-at-point)))
-	  (when (eq 'keyword (org-element-type element))
-	    (setq result (concat result
-				 " "
-				 (org-element-property :value element))))))
-      (and result (org-trim result)))))
+      (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

+ 1 - 22
testing/lisp/test-org-macro.el

@@ -103,18 +103,7 @@
         "#+MACRO: macro expansion\n* COMMENT H1\n** H2\n<point>{{{macro}}}"
       (org-macro-initialize-templates)
       (org-macro-replace-all org-macro-templates)
-      (org-with-wide-buffer (buffer-string)))))
-  ;; User-defined macros take precedence over built-in macros.
-  (should
-   (equal
-    "foo"
-    (org-test-with-temp-text
-        "#+MACRO: title foo\n#+TITLE: bar\n<point>{{{title}}}"
-      (org-macro-initialize-templates)
-      (org-macro-replace-all org-macro-templates)
-      (goto-char (point-max))
-      (buffer-substring-no-properties (line-beginning-position)
-				      (line-end-position))))))
+      (org-with-wide-buffer (buffer-string))))))
 
 (ert-deftest test-org-macro/property ()
   "Test {{{property}}} macro."
@@ -312,16 +301,6 @@
 	"#+keyword: value\n<point>{{{keyword(KEYWORD)}}}"
       (org-macro-initialize-templates)
       (org-macro-replace-all org-macro-templates)
-      (buffer-substring-no-properties
-       (line-beginning-position) (point-max)))))
-  ;; Replace macro with keyword's value.
-  (should
-   (equal
-    "value value2"
-    (org-test-with-temp-text
-	"#+keyword: value\n#+keyword: value2\n<point>{{{keyword(KEYWORD)}}}"
-      (org-macro-initialize-templates)
-      (org-macro-replace-all org-macro-templates)
       (buffer-substring-no-properties
        (line-beginning-position) (point-max))))))