branch: externals/org
commit 5265153fc5ed52c3fa8c203d87276ef7c8cef058
Author: Nafiz Islam <nafiz.islam1...@gmail.com>
Commit: Ihor Radchenko <yanta...@posteo.net>
org-capture-templates: Allow headline/olp target to be function or symbol
* doc/org-manual.org: Add target spec format for function and symbol
for headline and olp.
* etc/ORG-NEWS: Announce the updated options for
`org-capture-templates'.
* 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 a new function that computes
headline string from target spec.
(org-capture-expand-olp): Define a new function that computes olp list
from target spec.
(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 | 69 +++++++++++++++---
testing/lisp/test-org-capture.el | 150 ++++++++++++++++++++++++++++++++++++++-
4 files changed, 223 insertions(+), 14 deletions(-)
diff --git a/doc/org-manual.org b/doc/org-manual.org
index 3973764f90..96c90eaab0 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-string)= ::
+
+ - =(file+headline "filename" symbol-containing-string)= ::
+
Fast configuration if the target heading is unique in the file.
- =(file+olp "filename" "Level 1 heading" "Level 2" ...)= ::
+ - =(file+olp "filename" function-returning-list-of-strings)= ::
+
+ - =(file+olp "filename" symbol-containing-list-of-strings)= ::
+
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-list-of-strings)= ::
+
+ - =(file+olp+datetree "filename" symbol-containing-list-of-strings)= ::
+
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 e2cacb4012..c4e11bcb0a 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -43,6 +43,12 @@ or newer.
# adding new customizations, or changing the interpretation of the
# existing customizations.
+*** Allow headline/olp target in ~org-capture-templates~ to be a
function/variable
+
+The variable ~org-capture-templates~ accepts a target specification as
+function or symbol for headline (~file+headline~) and olp (~file+olp~
+and ~file+olp+datetree~).
+
*** New =%\*N= placeholder in ~org-capture-templates~
The new placeholder is like =%\N=, gives access not only to the
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 98a43b0962..486304df22 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -201,15 +201,23 @@ 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-string)
+ (file+headline \"path/to/file\" symbol-containing-string)
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-list-of-strings)
+ (file+olp \"path/to/file\" symbol-containing-list-of-strings)
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-list-of-strings)
+ (file+olp+datetree
+ \"path/to/file\" symbol-containing-list-of-strings)
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
@@ -410,7 +418,12 @@ you can escape ambiguous cases with a backward slash,
e.g., \\%i."
(let ((file-variants '(choice :tag "Filename "
(file :tag "Literal")
(function :tag "Function")
- (variable :tag "Variable"))))
+ (variable :tag "Variable")))
+ (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"
@@ -435,12 +448,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
@@ -448,8 +463,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
@@ -1012,7 +1026,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
@@ -1026,6 +1040,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)
@@ -1035,8 +1050,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)
@@ -1057,8 +1073,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))
@@ -1143,6 +1160,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 "org-capture: Invalid headline target: %S" headline))))
+
+(defun org-capture-expand-olp (file &rest olp)
+ "Expand functions, symbols and outline paths in FILE 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 "org-capture: Invalid outline path target: %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 f97d08bcea..a42e619453 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*** 2024\n**** 2024-06 June\n***** 2024-06-16 Sunday\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 "2024-06-16"
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize)))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n** B\n*** 2024\n**** 2024-06 June\n***** 2024-06-16 Sunday\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 "2024-06-16"
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize)))
+ (buffer-string))))
+ (should
+ (equal
+ "* A\n** B\n*** 2024\n**** 2024-06 June\n***** 2024-06-16 Sunday\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 "2024-06-16"
+ (org-capture nil "t")
+ (insert "Capture text")
+ (org-capture-finalize))))
+ (buffer-string))))
;; Correctly save position of inserted entry.
(should
(equal
@@ -843,5 +958,34 @@ 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
