From bc1de480d7002a7fb02509901e2bc10f01b25060 Mon Sep 17 00:00:00 2001 From: Nafiz Islam 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 format for the function and symbol variant * etc/ORG-NEWS: announce the updated options * lisp/org-capture.el (org-capture-templates): update customization type for headline, olp and olp+datetree targets, and update docstring * lisp/org-capture.el (org-capture-expand-headline): define `org-capture-expand-headline' * lisp/org-capture.el (org-capture-expand-olp): define `org-capture-expand-olp' * lisp/org-capture.el (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' * testing/lisp/test-org-capture.el (test-org-capture/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 | 130 ++++++++++++++++++++++++++++++- 4 files changed, 201 insertions(+), 14 deletions(-) diff --git a/doc/org-manual.org b/doc/org-manual.org index 170eea506..fd23a6cf6 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -8041,10 +8041,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")= :: @@ -8053,6 +8061,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 27712dd9a..82debb393 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -569,6 +569,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+old~ 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 6603b5e01..5d0c39b85 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 @@ -409,7 +415,13 @@ 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") + (sexp :tag "Form")))) `(repeat (choice :value ("" "" entry (file "~/org/notes.org") "") (list :tag "Multikey description" @@ -434,12 +446,15 @@ 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") + (sexp :tag "Form"))) (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 @@ -447,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 @@ -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,34 @@ 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, return `nil'." + (let* ((final-headline (cond ((stringp headline) headline) + ((functionp headline) (funcall headline)) + ((and (symbolp headline) (boundp headline)) + (symbol-value headline)) + (t nil)))) + final-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 ((or (not first) (stringp first)) 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 (error "Invalid outline path: %S" olp))))) + final-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 0ed44c6af..ceb6fd7e8 100644 --- a/testing/lisp/test-org-capture.el +++ b/testing/lisp/test-org-capture.el @@ -214,15 +214,112 @@ ;; 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 () "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 test-org-capture/entry/headline) "** H1 %?")))) + (setq test-org-capture/entry/headline "B") + (org-capture nil "t") + (insert "Capture text") + (org-capture-finalize) + (makunbound 'test-org-capture/entry/headline)) + (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 () '("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 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) + (makunbound 'test-org-capture/entry/file+olp)) + (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-overriding-default-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 () '("A" "B"))) "* H1 %?"))) + (org-overriding-default-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 test-org-capture/entry/file+olp+datetree) "* H1 %?"))) + (org-overriding-default-time 0)) + (setq test-org-capture/entry/file+olp+datetree '("A" "B")) + (org-capture nil "t") + (insert "Capture text") + (org-capture-finalize) + (makunbound 'test-org-capture/entry/file+olp+datetree)) + (buffer-string)))) ;; Correctly save position of inserted entry. (should (equal @@ -809,5 +906,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