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'.
This commit is contained in:
Nafiz Islam 2024-05-21 16:24:26 -04:00 committed by Ihor Radchenko
parent 102181e030
commit 5265153fc5
No known key found for this signature in database
GPG Key ID: 6470762A7DA11D8B
4 changed files with 223 additions and 14 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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