From b26bbcb1049e0ab07923308f583228028c100f15 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 and olp target, 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' * testing/lisp/test-org-capture.el (test-org-capture/org-capture-expand-olp-not-inlined-strings): add failing test 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 | 128 +++++++++++++++++++++++++++++++ 4 files changed, 202 insertions(+), 11 deletions(-) diff --git a/doc/org-manual.org b/doc/org-manual.org index 920114f70..e62acf0d9 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -8030,10 +8030,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")= :: @@ -8042,6 +8050,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 071e8a3fb..a586647e0 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -740,6 +740,12 @@ any more. Run ~org-ctags-enable~ to setup hooks and advices: 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 9d8f855ef..d465738ca 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..602a3564a 100644 --- a/testing/lisp/test-org-capture.el +++ b/testing/lisp/test-org-capture.el @@ -223,6 +223,103 @@ (insert "Capture text") (org-capture-finalize)) (buffer-string)))) + (should + (equal + "* A\n** H1 Capture text\n* B\n" + (org-test-with-temp-text-in-file "* A\n* B\n" + (let* ((file (buffer-file-name)) + (org-capture-templates + `(("t" "Todo" entry (file+headline ,file (lambda () "A")) "** H1 %?")))) + (org-capture nil "t") + (insert "Capture text") + (org-capture-finalize)) + (buffer-string)))) + (should + (equal + "* A\n** H1 Capture text\n* B\n" + (org-test-with-temp-text-in-file "* A\n* B\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 "A") + (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* B\n** B\n" + (org-test-with-temp-text-in-file "* A\n** B\n** C\n* B\n** B" + (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* B\n** B\n" + (org-test-with-temp-text-in-file "* A\n** B\n** C\n* B\n** B" + (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* B\n** B\n" + (org-test-with-temp-text-in-file "* A\n** B\n** C\n* B\n** B" + (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* B\n** B\n" + (org-test-with-temp-text-in-file "* A\n** B\n** C\n* B\n** B" + (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* B\n** B\n" + (org-test-with-temp-text-in-file "* A\n** B\n** C\n* B\n** B" + (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* B\n** B\n" + (org-test-with-temp-text-in-file "* A\n** B\n** C\n* B\n** B" + (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,36 @@ 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 (current-buffer)))) + (delete-file file)))))) + +(ert-deftest test-org-capture/org-capture-expand-olp-not-inlined-strings () + "Test org-capture-expand-olp when incorrect olp argument is passed." + :expected-result :failed + ;; org-capture-expand-olp rejects not 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)))))) + (provide 'test-org-capture) ;;; test-org-capture.el ends here -- 2.42.0