Improve CRM and journal workflows

2 files changed, 167 insertions, 0 deletions

diff --git a/tests/ss-capture-tests.el b/tests/ss-capture-tests.el
new file mode 100644
index 0000000..4ea4ff6
--- /dev/null
+++ b/tests/ss-capture-tests.el
@@ -0,0 +1,75 @@
+;;; ss-capture-tests.el --- Tests for ss-capture -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Focused ERT coverage for journal capture structure helpers.
+
+;;; Code:
+
+(add-to-list 'load-path (expand-file-name "../lisp" (file-name-directory load-file-name)))
+
+(require 'cl-lib)
+(require 'ert)
+(require 'ss-capture)
+(require 'ss-org)
+
+(ert-deftest ss-journal-ensure-day-sections-adds-all-standard-sections ()
+  (with-temp-buffer
+    (org-mode)
+    (insert "#+title: Journal\n"
+            "#+startup: overview\n\n"
+            "* 2026\n"
+            "** 2026-04-08 Wednesday\n"
+            "*** Tasks\n"
+            "**** TODO Existing\n\n"
+            "** 2026-04-09 Thursday\n")
+    (goto-char (point-min))
+    (re-search-forward "^\\*\\* 2026-04-09 Thursday$")
+    (goto-char (match-beginning 0))
+    (ss-journal-ensure-day-sections)
+    (should (string-match-p
+             (regexp-quote
+              "** 2026-04-09 Thursday\n*** Tasks\n*** Notes\n*** Meetings\n")
+             (buffer-string)))))
+
+(ert-deftest ss-open-journal-narrows-to-today-when-entry-exists ()
+  (let* ((file (make-temp-file "ss-journal" nil ".org"))
+         (ss-journal-file file))
+    (unwind-protect
+        (progn
+          (with-temp-file file
+            (insert "#+title: Journal\n"
+                    "* 2026\n"
+                    "** 2026-04-09 Thursday\n"
+                    "*** Notes\n"))
+          (let ((org-overriding-default-time (encode-time 0 0 12 9 4 2026)))
+            (ss-open-journal)
+            (should (buffer-narrowed-p))
+            (should (equal (org-get-outline-path t)
+                           '("2026" "2026-04-09 Thursday")))
+            (should (looking-at-p "^\\*\\* 2026-04-09 Thursday$"))))
+      (when (buffer-live-p (current-buffer))
+        (kill-buffer (current-buffer)))
+      (when (file-exists-p file)
+        (delete-file file)))))
+
+(ert-deftest ss-open-journal-keeps-end-fallback-when-today-missing ()
+  (let* ((file (make-temp-file "ss-journal" nil ".org"))
+         (ss-journal-file file))
+    (unwind-protect
+        (progn
+          (with-temp-file file
+            (insert "#+title: Journal\n"
+                    "* 2026\n"
+                    "** 2026-04-08 Wednesday\n"
+                    "*** Notes\n"))
+          (let ((org-overriding-default-time (encode-time 0 0 12 9 4 2026)))
+            (ss-open-journal)
+            (should-not (buffer-narrowed-p))
+            (should (eobp))))
+      (when (buffer-live-p (current-buffer))
+        (kill-buffer (current-buffer)))
+      (when (file-exists-p file)
+        (delete-file file)))))
+
+;;; ss-capture-tests.el ends here
diff --git a/tests/ss-crm-tests.el b/tests/ss-crm-tests.el
new file mode 100644
index 0000000..bc88ee4
--- /dev/null
+++ b/tests/ss-crm-tests.el
@@ -0,0 +1,92 @@
+;;; ss-crm-tests.el --- Tests for ss-crm -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Focused ERT coverage for CRM lookup and prompt helpers.
+
+;;; Code:
+
+(add-to-list 'load-path (expand-file-name "../lisp" (file-name-directory load-file-name)))
+
+(require 'ert)
+(require 'cl-lib)
+(require 'ss-crm)
+
+(ert-deftest ss-crm-known-property-values-sorts-and-deduplicates ()
+  (cl-letf (((symbol-function 'ss-crm-entries)
+             (lambda ()
+               (list (list :role "Engineer")
+                     (list :role " engineer ")
+                     (list :role "Architect")
+                     (list :role "")
+                     (list :role nil)))))
+    (should (equal (ss-crm-known-property-values "ROLE")
+                   '(" engineer " "Architect" "Engineer")))))
+
+(ert-deftest ss-crm-known-person-names-returns-sorted-top-level-names ()
+  (cl-letf (((symbol-function 'ss-crm-entries)
+             (lambda ()
+               (list (list :name "Zoe")
+                     (list :name "Alice")
+                     (list :name "Bob")))))
+    (should (equal (ss-crm-known-person-names)
+                   '("Alice" "Bob" "Zoe")))))
+
+(ert-deftest ss-crm-lookup-values-merges-seeded-and-derived-values ()
+  (cl-letf (((symbol-function 'ss-crm-known-property-values)
+             (lambda (_property)
+               '("Team B" "Team A"))))
+    (should (equal (ss-crm-lookup-values "TEAM" '("Team A" "Team C"))
+                   '("Team A" "Team B" "Team C")))))
+
+(ert-deftest ss-crm-read-choice-returns-nil-for-none-selection ()
+  (cl-letf (((symbol-function 'completing-read)
+             (lambda (&rest _args)
+               "[none]")))
+    (should-not (ss-crm-read-choice "Role: " '("Engineer")
+                                    :allow-blank t
+                                    :allow-new t))))
+
+(ert-deftest ss-crm-read-choice-warns-on-new-case-insensitive-duplicate ()
+  (let (warning)
+    (cl-letf (((symbol-function 'completing-read)
+               (lambda (&rest _args)
+                 "sydney"))
+              ((symbol-function 'yes-or-no-p)
+               (lambda (&rest _args)
+                 t))
+              ((symbol-function 'display-warning)
+               (lambda (_type message &rest _args)
+                 (setq warning message))))
+      (should (equal (ss-crm-read-choice "Location: " '("Sydney")
+                                         :allow-blank t
+                                         :allow-new t)
+                     "sydney"))
+      (should (string-match-p "Sydney" warning)))))
+
+(ert-deftest ss-crm-read-choice-does-not-warn-for-existing-selection ()
+  (let (warning)
+    (cl-letf (((symbol-function 'completing-read)
+               (lambda (&rest _args)
+                 "Sydney"))
+              ((symbol-function 'display-warning)
+               (lambda (_type message &rest _args)
+                 (setq warning message))))
+      (should (equal (ss-crm-read-choice "Location: " '("Sydney" "sydney")
+                                         :allow-blank t
+                                         :allow-new t
+                                         :require-match t)
+                     "Sydney"))
+      (should-not warning))))
+
+(ert-deftest ss-crm-read-manager-uses-known-person-names ()
+  (cl-letf (((symbol-function 'ss-crm-known-person-names)
+             (lambda ()
+               '("Alice" "Bob")))
+            ((symbol-function 'ss-crm-read-choice)
+             (lambda (_prompt choices &rest _plist)
+               choices)))
+    (should (equal (ss-crm-read-manager)
+                   '("Alice" "Bob")))))
+
+;;; ss-crm-tests.el ends here