diff options
| -rw-r--r-- | modules/org-capture-config.el | 89 | ||||
| -rw-r--r-- | tests/test-org-capture-config-project-target.el | 174 |
2 files changed, 262 insertions, 1 deletions
diff --git a/modules/org-capture-config.el b/modules/org-capture-config.el index 43b42b5e..4987eee8 100644 --- a/modules/org-capture-config.el +++ b/modules/org-capture-config.el @@ -42,6 +42,8 @@ (declare-function org-get-heading "org") (declare-function org-parse-time-string "org") (declare-function pdf-view-active-region-text "pdf-view") +(declare-function projectile-project-root "projectile" (&optional dir)) +(defvar inbox-file) (defvar cj/org-capture--file-headline-target-cache (make-hash-table :test #'equal) "Cache Org capture file+headline target markers by expanded file and headline.") @@ -132,6 +134,88 @@ re-scanning large target files after the first successful lookup." (advice-add 'org-capture-set-target-location :around #'cj/org-capture--set-target-location-advice)) +;; ----------------------- Project-Aware Capture Target ------------------------ +;; C-c c t (Task) and C-c c b (Bug) file into the current projectile project's +;; todo.org under its "... Open Work" heading. Outside a project they fall back +;; to the global inbox; in a project with no todo.org they fall back to the +;; inbox with a warning (they never create a project's todo.org). + +(defconst cj/--org-open-work-heading-regexp + "^\\*[ \t]+.*Open Work\\(?:[ \t]+:[^\n]*:\\)?[ \t]*$" + "Regexp matching a top-level \"... Open Work\" Org heading line.") + +(defun cj/--org-capture-project-name (root) + "Return a display project name for ROOT directory, or nil. +The basename of ROOT with a single leading dot stripped and the first +letter upcased: \"~/.emacs.d/\" -> \"Emacs.d\", \"~/code/duet/\" -> \"Duet\"." + (when (and (stringp root) (not (string-empty-p root))) + (let* ((base (file-name-nondirectory (directory-file-name root))) + (clean (if (and (> (length base) 1) (eq ?. (aref base 0))) + (substring base 1) + base))) + (and (not (string-empty-p clean)) + (concat (upcase (substring clean 0 1)) (substring clean 1)))))) + +(defun cj/--org-capture-project-target (root inbox) + "Pure capture-target decision for project-aware capture. +ROOT is the projectile project root (or nil); INBOX is the global inbox +file path. Return a plist (:file F :open-work BOOL :project NAME :warn MSG): +- ROOT with a todo.org -> F is that todo.org, :open-work t. +- ROOT without a todo.org -> F is INBOX, :open-work nil, :warn names the project. +- ROOT nil -> F is INBOX, :open-work nil, :warn nil." + (if (and (stringp root) (not (string-empty-p root))) + (let ((todo (expand-file-name "todo.org" root)) + (name (cj/--org-capture-project-name root))) + (if (file-exists-p todo) + (list :file todo :open-work t :project name :warn nil) + (list :file inbox :open-work nil :project name + :warn (format "No todo.org in project \"%s\"; captured to the inbox instead" + name)))) + (list :file inbox :open-work nil :project nil :warn nil))) + +(defun cj/--org-capture-goto-open-work (project-name) + "Move point to a top-level \"... Open Work\" heading in the current buffer. +Create \"* PROJECT-NAME Open Work\" at end of buffer when none exists. +Leave point at the start of the heading line." + (goto-char (point-min)) + (if (re-search-forward cj/--org-open-work-heading-regexp nil t) + (forward-line 0) + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert (format "* %s Open Work\n" project-name)) + (forward-line -1))) + +(defun cj/--org-capture-goto-exact-headline (headline) + "Move point to the top-level HEADLINE in the current buffer. +Create \"* HEADLINE\" at end of buffer when absent. Leave point at the +start of the heading line." + (goto-char (point-min)) + (if (re-search-forward (format org-complex-heading-regexp-format + (regexp-quote headline)) + nil t) + (forward-line 0) + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert "* " headline "\n") + (forward-line -1))) + +(defun cj/--org-capture-project-location () + "Org-capture `function' target for project-aware Task/Bug capture. +File into the current projectile project's todo.org under its \"... Open +Work\" heading, else the global inbox (`inbox-file') under \"Inbox\"." + (let* ((root (and (fboundp 'projectile-project-root) + (ignore-errors (projectile-project-root)))) + (plan (cj/--org-capture-project-target root inbox-file))) + (when (plist-get plan :warn) + (message "%s" (plist-get plan :warn))) + (set-buffer (org-capture-target-buffer (plist-get plan :file))) + (unless (derived-mode-p 'org-mode) (org-mode)) + (org-capture-put-target-region-and-position) + (widen) + (if (plist-get plan :open-work) + (cj/--org-capture-goto-open-work (plist-get plan :project)) + (cj/--org-capture-goto-exact-headline "Inbox")))) + ;; --------------------------- Org-Capture Templates --------------------------- ;; you can bring up the org capture menu with C-c c @@ -201,9 +285,12 @@ Intended to be called within an org capture template." ;; ORG-CAPTURE TEMPLATES (setq org-protocol-default-template-key "L") (setq org-capture-templates - '(("t" "Task" entry (file+headline inbox-file "Inbox") + '(("t" "Task" entry (function cj/--org-capture-project-location) "* TODO %?" :prepend t) + ("b" "Bug" entry (function cj/--org-capture-project-location) + "* TODO [#C] %?" :prepend t) + ("e" "Event" entry (file+headline schedule-file "Scheduled Events") "* %?%:description SCHEDULED: %^t%(cj/org-capture-event-content) diff --git a/tests/test-org-capture-config-project-target.el b/tests/test-org-capture-config-project-target.el new file mode 100644 index 00000000..c9091c91 --- /dev/null +++ b/tests/test-org-capture-config-project-target.el @@ -0,0 +1,174 @@ +;;; test-org-capture-config-project-target.el --- Project-aware capture tests -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the project-aware capture target shared by C-c c t (Task) and +;; C-c c b (Bug): the pure project-name and target-decision helpers, the +;; find-or-create "Open Work" / "Inbox" heading helpers, the function-target +;; wiring, and the two template registrations. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'org) +(require 'org-capture) +(require 'user-constants) +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-capture-config) + +;;; cj/--org-capture-project-name + +(ert-deftest test-org-capture-project-name-normal () + "Normal: basename, first letter upcased; trailing slash ignored." + (should (equal (cj/--org-capture-project-name "/home/cj/code/duet/") "Duet")) + (should (equal (cj/--org-capture-project-name "/home/cj/code/duet") "Duet"))) + +(ert-deftest test-org-capture-project-name-strips-leading-dot () + "Boundary: a single leading dot is stripped before upcasing." + (should (equal (cj/--org-capture-project-name "/home/cj/.emacs.d/") "Emacs.d"))) + +(ert-deftest test-org-capture-project-name-nil-and-empty () + "Error: nil or empty root yields nil." + (should-not (cj/--org-capture-project-name nil)) + (should-not (cj/--org-capture-project-name ""))) + +;;; cj/--org-capture-project-target + +(ert-deftest test-org-capture-target-project-with-todo () + "Normal: a projectile root whose todo.org exists targets that file's Open Work." + (let ((root (make-temp-file "captest-" t))) + (unwind-protect + (progn + (with-temp-file (expand-file-name "todo.org" root) + (insert "* X Open Work\n")) + (let ((plan (cj/--org-capture-project-target root "/tmp/inbox.org"))) + (should (string= (plist-get plan :file) + (expand-file-name "todo.org" root))) + (should (plist-get plan :open-work)) + (should-not (plist-get plan :warn)))) + (delete-directory root t)))) + +(ert-deftest test-org-capture-target-project-without-todo () + "Boundary: a projectile root with no todo.org falls back to inbox and warns." + (let ((root (make-temp-file "captest-" t))) + (unwind-protect + (let ((plan (cj/--org-capture-project-target root "/tmp/inbox.org"))) + (should (string= (plist-get plan :file) "/tmp/inbox.org")) + (should-not (plist-get plan :open-work)) + (should (stringp (plist-get plan :warn))) + (should (string-match-p (regexp-quote (cj/--org-capture-project-name root)) + (plist-get plan :warn)))) + (delete-directory root t)))) + +(ert-deftest test-org-capture-target-no-project () + "Boundary: nil root targets the inbox with no warning." + (let ((plan (cj/--org-capture-project-target nil "/tmp/inbox.org"))) + (should (string= (plist-get plan :file) "/tmp/inbox.org")) + (should-not (plist-get plan :open-work)) + (should-not (plist-get plan :warn)))) + +;;; cj/--org-capture-goto-open-work + +(ert-deftest test-org-capture-goto-open-work-finds-existing () + "Normal: an existing top-level \"... Open Work\" heading is reused, not duplicated." + (with-temp-buffer + (org-mode) + (insert "* Emacs Open Work\n** TODO a\n* Emacs Resolved\n") + (cj/--org-capture-goto-open-work "Ignored") + (should (string= (org-get-heading t t t t) "Emacs Open Work")) + (should-not (string-match-p "Ignored" (buffer-string))))) + +(ert-deftest test-org-capture-goto-open-work-matches-tagged-heading () + "Boundary: a tagged \"... Open Work\" heading still matches and is not duplicated." + (with-temp-buffer + (org-mode) + (insert "* Foo Open Work :stuff:\n") + (cj/--org-capture-goto-open-work "Bar") + (should (string-match-p "Open Work" (org-get-heading t t t t))) + (should-not (string-match-p "Bar Open Work" (buffer-string))))) + +(ert-deftest test-org-capture-goto-open-work-creates-when-absent () + "Boundary: with no Open Work heading, create \"* NAME Open Work\" at end." + (with-temp-buffer + (org-mode) + (insert "* Something Else\n") + (cj/--org-capture-goto-open-work "Duet") + (should (string-match-p "^\\* Duet Open Work$" (buffer-string))) + (should (string= (org-get-heading t t t t) "Duet Open Work")))) + +;;; cj/--org-capture-goto-exact-headline + +(ert-deftest test-org-capture-goto-exact-headline-finds () + "Normal: an existing Inbox heading is found." + (with-temp-buffer + (org-mode) + (insert "* Inbox\n** TODO x\n") + (cj/--org-capture-goto-exact-headline "Inbox") + (should (string= (org-get-heading t t t t) "Inbox")))) + +(ert-deftest test-org-capture-goto-exact-headline-creates () + "Boundary: a missing Inbox heading is created at end of buffer." + (with-temp-buffer + (org-mode) + (insert "* Other\n") + (cj/--org-capture-goto-exact-headline "Inbox") + (should (string-match-p "^\\* Inbox$" (buffer-string))))) + +;;; cj/--org-capture-project-location (function-target wiring) + +(ert-deftest test-org-capture-location-files-into-project-open-work () + "Integration: in a project with a todo.org, the location function visits that +file and lands point on its Open Work heading." + (let* ((root (make-temp-file "captest-" t)) + (todo (expand-file-name "todo.org" root)) + (org-capture-plist nil) + visited) + (unwind-protect + (progn + (with-temp-file todo (insert "* Captest Open Work\n** TODO old\n")) + (cl-letf (((symbol-function 'projectile-project-root) + (lambda (&optional _d) root))) + (cj/--org-capture-project-location) + (setq visited (current-buffer)) + (should (string= (buffer-file-name) todo)) + (should (string-match-p "Open Work" (org-get-heading t t t t))))) + (when (buffer-live-p visited) (kill-buffer visited)) + (delete-directory root t)))) + +(ert-deftest test-org-capture-location-falls-back-to-inbox-without-project () + "Integration: with no project, the location function visits the inbox file +under its Inbox heading." + (let* ((inbox (make-temp-file "captest-inbox-" nil ".org" "* Inbox\n")) + (inbox-file inbox) + (org-capture-plist nil) + visited) + (unwind-protect + (cl-letf (((symbol-function 'projectile-project-root) + (lambda (&optional _d) nil))) + (cj/--org-capture-project-location) + (setq visited (current-buffer)) + (should (string= (buffer-file-name) inbox)) + (should (string= (org-get-heading t t t t) "Inbox"))) + (when (buffer-live-p visited) (kill-buffer visited)) + (delete-file inbox)))) + +;;; templates + +(ert-deftest test-org-capture-task-template-is-project-aware () + "Normal: the Task template (t) targets the project-aware function." + (let ((entry (assoc "t" org-capture-templates))) + (should entry) + (should (equal (nth 3 entry) + '(function cj/--org-capture-project-location))))) + +(ert-deftest test-org-capture-bug-template-registered () + "Normal: the Bug template (b) exists, targets the project-aware function, and +defaults to the [#C] priority." + (let ((entry (assoc "b" org-capture-templates))) + (should entry) + (should (equal (nth 3 entry) + '(function cj/--org-capture-project-location))) + (should (string-match-p "\\[#C\\]" (nth 4 entry))))) + +(provide 'test-org-capture-config-project-target) +;;; test-org-capture-config-project-target.el ends here |