I've updated my tests with `org-test-at-time' and updated the commit
message to fit within default column of 70.
From 25c0252c8532e498e3fce103dd44a81441d8a51a Mon Sep 17 00:00:00 2001
From: Nafiz Islam <nafiz.islam1...@gmail.com>
Date: Tue, 21 May 2024 16:24:26 -0400
Subject: [PATCH] function and symbol for headline and olp for
org-capture-templates
* doc/org-manual.org: Add template formats for the function and symbol
variant.
* etc/ORG-NEWS: Announce the updated options.
* lisp/org-capture.el (org-capture-templates): Update customization
type for `file+headline', `file+olp' and `file+olp+datetree' targets,
and update docstring.
(org-capture-expand-headline): Define `org-capture-expand-headline'.
(org-capture-expand-olp): Define `org-capture-expand-olp'.
(org-capture-set-target-location): Use `org-capture-expand-headline'
to expand headline, and use `org-capture-expand-olp' to expand outline
path.
* testing/lisp/test-org-capture.el (test-org-capture/entry): Add tests
for at most three different kinds of target for `file+headline',
`file+olp', and `file+olp+datetree'.
(test-org-capture/org-capture-expand-olp): Add tests for
`org-capture-expand-olp'.
---
doc/org-manual.org | 12 +++
etc/ORG-NEWS | 6 ++
lisp/org-capture.el | 67 +++++++++++---
testing/lisp/test-org-capture.el | 148 ++++++++++++++++++++++++++++++-
4 files changed, 219 insertions(+), 14 deletions(-)
diff --git a/doc/org-manual.org b/doc/org-manual.org
index 3973764f9..c4bcffdc3 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -8052,10 +8052,18 @@ Now lets look at the elements of a template definition. Each entry in
- =(file+headline "filename" "node headline")= ::
+ - =(file+headline "filename" function-returning-headline)= ::
+
+ - =(file+headline "filename" symbol-containing-headline)= ::
+
Fast configuration if the target heading is unique in the file.
- =(file+olp "filename" "Level 1 heading" "Level 2" ...)= ::
+ - =(file+olp "filename" function-returning-outline-path)= ::
+
+ - =(file+olp "filename" symbol-containing-outline-path)= ::
+
For non-unique headings, the full path is safer.
- =(file+regexp "filename" "regexp to find location")= ::
@@ -8064,6 +8072,10 @@ Now lets look at the elements of a template definition. Each entry in
- =(file+olp+datetree "filename" [ "Level 1 heading" ...])= ::
+ - =(file+olp+datetree "filename" function-returning-outline-path)= ::
+
+ - =(file+olp+datetree "filename" symbol-containing-outline-path)= ::
+
This target[fn:30] creates a heading in a date tree[fn:31] for
today's date. If the optional outline path is given, the tree
will be built under the node it is pointing to, instead of at top
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index ec28f77d8..aa45809c8 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -661,6 +661,12 @@ Users who do not want variable expansion can set
This new hook runs when a note has been stored.
+*** New customization options for ~org-capture-templates~
+
+The variable ~org-capture-templates~ accepts a target specification
+for headline (~file+headline~) and olp (~file+olp~ and
+~file+olp+datetree~) as function and symbol.
+
*** New option controlling how Org mode sorts things ~org-sort-function~
Sorting of agenda items, tables, menus, headlines, etc can now be
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 786b81771..1711e5b79 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -201,15 +201,21 @@ target Specification of where the captured item should be placed.
File as child of this entry, or in the body of the entry
(file+headline \"path/to/file\" \"node headline\")
+ (file+headline \"path/to/file\" function-returning-headline)
+ (file+headline \"path/to/file\" symbol-containing-headline)
Fast configuration if the target heading is unique in the file
(file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
+ (file+olp \"path/to/file\" function-returning-outline-path)
+ (file+olp \"path/to/file\" symbol-containing-outline-path)
For non-unique headings, the full outline path is safer
(file+regexp \"path/to/file\" \"regexp to find location\")
File to the entry matching regexp
(file+olp+datetree \"path/to/file\" \"Level 1 heading\" ...)
+ (file+olp+datetree \"path/to/file\" function-returning-outline-path)
+ (file+olp+datetree \"path/to/file\" symbol-containing-outline-path)
Will create a heading in a date tree for today's date.
If no heading is given, the tree will be on top level.
To prompt for date instead of using TODAY, use the
@@ -411,7 +417,12 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
(file :tag "Literal")
(function :tag "Function")
(variable :tag "Variable")
- (sexp :tag "Form"))))
+ (sexp :tag "Form")))
+ (olp-variants '(choice :tag "Outline path"
+ (repeat :tag "Outline path" :inline t
+ (string :tag "Headline"))
+ (function :tag "Function")
+ (variable :tag "Variable"))))
`(repeat
(choice :value ("" "" entry (file "~/org/notes.org") "")
(list :tag "Multikey description"
@@ -436,12 +447,14 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
(list :tag "File & Headline"
(const :format "" file+headline)
,file-variants
- (string :tag " Headline"))
+ (choice :tag "Headline"
+ (string :tag "Headline")
+ (function :tag "Function")
+ (variable :tag "Variable")))
(list :tag "File & Outline path"
(const :format "" file+olp)
,file-variants
- (repeat :tag "Outline path" :inline t
- (string :tag "Headline")))
+ ,olp-variants)
(list :tag "File & Regexp"
(const :format "" file+regexp)
,file-variants
@@ -449,8 +462,7 @@ you can escape ambiguous cases with a backward slash, e.g., \\%i."
(list :tag "File [ & Outline path ] & Date tree"
(const :format "" file+olp+datetree)
,file-variants
- (option (repeat :tag "Outline path" :inline t
- (string :tag "Headline"))))
+ ,olp-variants)
(list :tag "File & function"
(const :format "" file+function)
,file-variants
@@ -1013,7 +1025,7 @@ Store them in the capture property list."
(org-capture-put-target-region-and-position)
(goto-char position))
(_ (error "Cannot find target ID \"%s\"" id))))
- (`(file+headline ,path ,(and headline (pred stringp)))
+ (`(file+headline ,path ,headline)
(set-buffer (org-capture-target-buffer path))
;; Org expects the target file to be in Org mode, otherwise
;; it throws an error. However, the default notes files
@@ -1027,6 +1039,7 @@ Store them in the capture property list."
(org-capture-put-target-region-and-position)
(widen)
(goto-char (point-min))
+ (setq headline (org-capture-expand-headline headline))
(if (re-search-forward (format org-complex-heading-regexp-format
(regexp-quote headline))
nil t)
@@ -1036,8 +1049,9 @@ Store them in the capture property list."
(insert "* " headline "\n")
(forward-line -1)))
(`(file+olp ,path . ,(and outline-path (guard outline-path)))
- (let ((m (org-find-olp (cons (org-capture-expand-file path)
- outline-path))))
+ (let* ((expanded-file-path (org-capture-expand-file path))
+ (m (org-find-olp (cons expanded-file-path
+ (apply #'org-capture-expand-olp expanded-file-path outline-path)))))
(set-buffer (marker-buffer m))
(org-capture-put-target-region-and-position)
(widen)
@@ -1058,8 +1072,9 @@ Store them in the capture property list."
(and (derived-mode-p 'org-mode) (org-at-heading-p)))))
(`(file+olp+datetree ,path . ,outline-path)
(let ((m (if outline-path
- (org-find-olp (cons (org-capture-expand-file path)
- outline-path))
+ (let ((expanded-file-path (org-capture-expand-file path)))
+ (org-find-olp (cons expanded-file-path
+ (apply #'org-capture-expand-olp expanded-file-path outline-path))))
(set-buffer (org-capture-target-buffer path))
(point-marker))))
(set-buffer (marker-buffer m))
@@ -1144,6 +1159,36 @@ Store them in the capture property list."
(org-decrypt-entry)
(and (org-back-to-heading t) (point))))))))
+(defun org-capture-expand-headline (headline)
+ "Expand functions, symbols and headline names for HEADLINE.
+When HEADLINE is a function, call it. When it is a variable,
+return its value. When it is a string, return it. In any other
+case, signal an error."
+ (let* ((final-headline (cond ((stringp headline) headline)
+ ((functionp headline) (funcall headline))
+ ((and (symbolp headline) (boundp headline))
+ (symbol-value headline))
+ (t nil))))
+ (or final-headline
+ (error "Invalid headline: %S" headline))))
+
+(defun org-capture-expand-olp (file &rest olp)
+ "Expand functions, symbols and outline paths for OLP.
+When OLP is a function, call it with no arguments while
+the current buffer is the FILE-visiting buffer. When it
+is a variable, return its value. When it is a list of
+string, return it. In any other case, signal an error."
+ (let* ((first (car olp))
+ (final-olp (cond ((not (memq nil (mapcar #'stringp olp))) olp)
+ ((and (not (cdr olp)) (functionp first))
+ (with-current-buffer (find-file-noselect file)
+ (funcall first)))
+ ((and (not (cdr olp)) (symbolp first) (boundp first))
+ (symbol-value first))
+ (t nil))))
+ (or final-olp
+ (error "Invalid outline path: %S" olp))))
+
(defun org-capture-expand-file (file)
"Expand functions, symbols and file names for FILE.
When FILE is a function, call it. When it is a form, evaluate
diff --git a/testing/lisp/test-org-capture.el b/testing/lisp/test-org-capture.el
index f97d08bce..1ad2825c3 100644
--- a/testing/lisp/test-org-capture.el
+++ b/testing/lisp/test-org-capture.el
@@ -214,15 +214,130 @@
;; Do not break next headline.
(should
(equal
- "* A\n** H1 Capture text\n* B\n"
- (org-test-with-temp-text-in-file "* A\n* B\n"
+ "* A\n* B\n** H1 Capture text\n* C\n"
+ (org-test-with-temp-text-in-file "* A\n* B\n* C\n"
(let* ((file (buffer-file-name))
(org-capture-templates
- `(("t" "Todo" entry (file+headline ,file "A") "** H1 %?"))))
+ `(("t" "Todo" entry (file+headline ,file "B") "** H1 %?"))))
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n* B\n** H1 Capture text\n* C\n"
+ (org-test-with-temp-text-in-file "* A\n* B\n* C\n"
+ (let* ((file (buffer-file-name))
+ (org-capture-templates
+ `(("t"
+ "Todo"
+ entry
+ (file+headline ,file (lambda ()
+ (should (equal ,file (buffer-file-name)))
+ "B"))
+ "** H1 %?"))))
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n* B\n** H1 Capture text\n* C\n"
+ (org-test-with-temp-text-in-file "* A\n* B\n* C\n"
+ (dlet ((test-org-capture/entry/headline))
+ (let* ((file (buffer-file-name))
+ (org-capture-templates
+ `(("t" "Todo" entry (file+headline ,file test-org-capture/entry/headline) "** H1 %?"))))
+ (setq test-org-capture/entry/headline "B")
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize)))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n** B\n*** H1 Capture text\n** C\n"
+ (org-test-with-temp-text-in-file "* A\n** B\n** C\n"
+ (let* ((file (buffer-file-name))
+ (org-capture-templates
+ `(("t" "Todo" entry (file+olp ,file "A" "B") "* H1 %?"))))
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n** B\n*** H1 Capture text\n** C\n"
+ (org-test-with-temp-text-in-file "* A\n** B\n** C\n"
+ (let* ((file (buffer-file-name))
+ (org-capture-templates
+ `(("t"
+ "Todo"
+ entry
+ (file+olp ,file (lambda ()
+ (should (equal ,file (buffer-file-name)))
+ '("A" "B")))
+ "* H1 %?"))))
(org-capture nil "t")
(insert "Capture text")
(org-capture-finalize))
(buffer-string))))
+ (should
+ (equal
+ "* A\n** B\n*** H1 Capture text\n** C\n"
+ (org-test-with-temp-text-in-file "* A\n** B\n** C\n"
+ (dlet ((test-org-capture/entry/file+olp))
+ (let* ((file (buffer-file-name))
+ (org-capture-templates
+ `(("t" "Todo" entry (file+olp ,file test-org-capture/entry/file+olp) "* H1 %?"))))
+ (setq test-org-capture/entry/file+olp '("A" "B"))
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize)))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n** B\n*** 1969\n**** 1969-12 December\n***** 1969-12-31 Wednesday\n****** H1 Capture text\n** C\n"
+ (org-test-with-temp-text-in-file "* A\n** B\n** C\n"
+ (let* ((file (buffer-file-name))
+ (org-capture-templates
+ `(("t" "Todo" entry (file+olp+datetree ,file "A" "B") "* H1 %?"))))
+ (org-test-at-time 0
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize)))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n** B\n*** 1969\n**** 1969-12 December\n***** 1969-12-31 Wednesday\n****** H1 Capture text\n** C\n"
+ (org-test-with-temp-text-in-file "* A\n** B\n** C\n"
+ (let* ((file (buffer-file-name))
+ (org-capture-templates
+ `(("t"
+ "Todo"
+ entry
+ (file+olp+datetree ,file (lambda ()
+ (should (equal ,file (buffer-file-name)))
+ '("A" "B")))
+ "* H1 %?"))))
+ (org-test-at-time 0
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize)))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n** B\n*** 1969\n**** 1969-12 December\n***** 1969-12-31 Wednesday\n****** H1 Capture text\n** C\n"
+ (org-test-with-temp-text-in-file "* A\n** B\n** C\n"
+ (dlet ((test-org-capture/entry/file+olp+datetree))
+ (let* ((file (buffer-file-name))
+ (org-capture-templates
+ `(("t" "Todo" entry (file+olp+datetree ,file test-org-capture/entry/file+olp+datetree) "* H1 %?"))))
+ (setq test-org-capture/entry/file+olp+datetree '("A" "B"))
+ (org-test-at-time 0
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize))))
+ (buffer-string))))
;; Correctly save position of inserted entry.
(should
(equal
@@ -843,5 +958,32 @@ before\nglobal-before\nafter\nglobal-after"
(org-capture nil "t")
(buffer-string))))))
+(ert-deftest test-org-capture/org-capture-expand-olp ()
+ "Test org-capture-expand-olp."
+ ;; org-capture-expand-olp accepts inlined outline path
+ (should
+ (equal
+ '("A" "B" "C")
+ (let ((file (make-temp-file "org-test")))
+ (unwind-protect
+ (org-capture-expand-olp file "A" "B" "C")
+ (delete-file file)))))
+ ;; The current buffer during the funcall of the lambda is the temporary test file
+ (should
+ (let ((file (make-temp-file "org-test")))
+ (equal
+ file
+ (unwind-protect
+ (org-capture-expand-olp file (lambda () (buffer-file-name)))
+ (delete-file file)))))
+ ;; org-capture-expand-olp rejects outline path that is not inlined
+ (should-error
+ (equal
+ '("A" "B" "C")
+ (let ((file (make-temp-file "org-test")))
+ (unwind-protect
+ (org-capture-expand-olp file '("A" "B" "C"))
+ (delete-file file))))))
+
(provide 'test-org-capture)
;;; test-org-capture.el ends here
--
2.44.1
