diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | README.md | 2 | ||||
| -rw-r--r-- | docs/plans/2026-04-09-crm-property-completion-implementation.md | 144 | ||||
| -rw-r--r-- | docs/plans/2026-04-09-journal-open-narrowing-implementation.md | 85 | ||||
| -rw-r--r-- | lisp/ss-capture.el | 7 | ||||
| -rw-r--r-- | lisp/ss-crm.el | 314 | ||||
| -rw-r--r-- | lisp/ss-org.el | 5 | ||||
| -rw-r--r-- | tests/ss-capture-tests.el | 75 | ||||
| -rw-r--r-- | tests/ss-crm-tests.el | 92 |
9 files changed, 694 insertions, 32 deletions
@@ -14,3 +14,5 @@ !/docs/ !/docs/plans/ !/docs/plans/** +!/tests/ +!/tests/** @@ -175,7 +175,7 @@ The main bindings are: - `C-c n n` to open or create a Denote note - `C-c n l` to insert a Denote link - `C-c n M` to open the MOC -- `C-c n d` to open `~/org/journal.org` +- `C-c n d` to open `~/org/journal.org`, narrowed to today when present - `C-c n p` to open the people CRM - `C-c n P` to add a new person card - `C-c n f` to find a person card diff --git a/docs/plans/2026-04-09-crm-property-completion-implementation.md b/docs/plans/2026-04-09-crm-property-completion-implementation.md new file mode 100644 index 0000000..88b3d01 --- /dev/null +++ b/docs/plans/2026-04-09-crm-property-completion-implementation.md @@ -0,0 +1,144 @@ +# CRM Property Completion Implementation Plan + +> **For Claude:** REQUIRED SUB-SKILL: Use superpowers:executing-plans to implement this plan task-by-task. + +**Goal:** Add data-driven CRM property completion and inline value creation to `ss-crm-add` without introducing a second source of truth. + +**Architecture:** Extend `lisp/ss-crm.el` with small lookup helpers that build on the existing parsed CRM entry cache, plus a single generic choice reader that handles blank selection, optional freeform values, confirmation, and advisory duplicate warnings. Keep seeded vocabularies in code, wire field-specific readers into `ss-crm-add`, and verify with focused ERT coverage plus batch startup loading. + +**Tech Stack:** Emacs Lisp, Org, ERT, batch Emacs verification + +--- + +### Task 1: Add failing CRM helper tests + +**Files:** +- Create: `tests/ss-crm-tests.el` +- Modify: `lisp/ss-crm.el` + +**Step 1: Write the failing test** + +```elisp +(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 nil))))) + (should (equal (ss-crm-known-property-values "ROLE") + '("Architect" "Engineer" " engineer "))))) +``` + +**Step 2: Run test to verify it fails** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-crm-tests.el -f ert-run-tests-batch-and-exit` +Expected: FAIL because the new CRM helper functions do not exist yet. + +**Step 3: Write minimal implementation** + +```elisp +(defun ss-crm-known-property-values (property) + ...) +``` + +**Step 4: Run test to verify it passes** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-crm-tests.el -f ert-run-tests-batch-and-exit` +Expected: PASS for the helper coverage. + +**Step 5: Commit** + +```bash +git add tests/ss-crm-tests.el lisp/ss-crm.el +git commit -m "Add CRM property completion helpers" +``` + +### Task 2: Add completion-reader tests and implement prompt behavior + +**Files:** +- Modify: `tests/ss-crm-tests.el` +- Modify: `lisp/ss-crm.el` + +**Step 1: Write the failing test** + +```elisp +(ert-deftest ss-crm-read-choice-warns-on-new-case-insensitive-duplicate () + (let (warning) + (cl-letf (((symbol-function 'completing-read) (lambda (&rest _) "sydney")) + ((symbol-function 'yes-or-no-p) (lambda (&rest _) t)) + ((symbol-function 'display-warning) + (lambda (_type message &rest _) (setq warning message)))) + (should (equal (ss-crm-read-choice "Location: " '("Sydney") + :allow-blank t + :allow-new t) + "sydney")) + (should (string-match-p "Sydney" warning)))) +``` + +**Step 2: Run test to verify it fails** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-crm-tests.el -f ert-run-tests-batch-and-exit` +Expected: FAIL because `ss-crm-read-choice` does not support the new behavior yet. + +**Step 3: Write minimal implementation** + +```elisp +(defun ss-crm-read-choice (prompt choices &rest plist) + ...) +``` + +**Step 4: Run test to verify it passes** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-crm-tests.el -f ert-run-tests-batch-and-exit` +Expected: PASS for blank selection, existing completion, and new-value confirmation coverage. + +**Step 5: Commit** + +```bash +git add tests/ss-crm-tests.el lisp/ss-crm.el +git commit -m "Add CRM completion prompts" +``` + +### Task 3: Integrate field readers into `ss-crm-add` and verify startup + +**Files:** +- Modify: `lisp/ss-crm.el` +- Review: `README.md` + +**Step 1: Write the failing test** + +```elisp +(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"))))) +``` + +**Step 2: Run test to verify it fails** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-crm-tests.el -f ert-run-tests-batch-and-exit` +Expected: FAIL until the field readers are wired up. + +**Step 3: Write minimal implementation** + +```elisp +(defun ss-crm-read-manager () + (ss-crm-read-choice "Manager: " (ss-crm-known-person-names) + :allow-blank t + :require-match t)) +``` + +**Step 4: Run test to verify it passes** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-crm-tests.el -f ert-run-tests-batch-and-exit` +Expected: PASS, then run `emacs --batch -Q --load ./init.el` to confirm startup remains healthy. + +**Step 5: Commit** + +```bash +git add tests/ss-crm-tests.el lisp/ss-crm.el README.md +git commit -m "Guide CRM add-person property entry" +``` diff --git a/docs/plans/2026-04-09-journal-open-narrowing-implementation.md b/docs/plans/2026-04-09-journal-open-narrowing-implementation.md new file mode 100644 index 0000000..59a80de --- /dev/null +++ b/docs/plans/2026-04-09-journal-open-narrowing-implementation.md @@ -0,0 +1,85 @@ +# Journal Open Narrowing Implementation Plan + +> **For Claude:** REQUIRED SUB-SKILL: Use superpowers:executing-plans to implement this plan task-by-task. + +**Goal:** Make `ss-open-journal` narrow to today's subtree when today's journal entry exists, while preserving the current fallback when it does not. + +**Architecture:** Add focused ERT coverage for the journal-open helper in `tests/`, then update `lisp/ss-org.el` so it widens first, reuses the existing `ss-journal-goto-date` lookup, and narrows only on the successful path. Keep the missing-entry case unchanged by leaving point at the end of the journal buffer without creating new headings. + +**Tech Stack:** Emacs Lisp, ERT, batch Emacs verification + +--- + +### Task 1: Add failing journal-open test + +**Files:** +- Modify: `tests/ss-capture-tests.el` +- Modify: `lisp/ss-org.el` + +**Step 1: Write the failing test** + +```elisp +(ert-deftest ss-open-journal-narrows-to-today-when-entry-exists () + ...) +``` + +**Step 2: Run test to verify it fails** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-capture-tests.el -f ert-run-tests-batch-and-exit` +Expected: FAIL because `ss-open-journal` currently widens and jumps, but does not narrow. + +**Step 3: Write minimal implementation** + +```elisp +(when (ss-journal-goto-date) + (org-narrow-to-subtree)) +``` + +**Step 4: Run test to verify it passes** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-capture-tests.el -f ert-run-tests-batch-and-exit` +Expected: PASS, with the fallback case still leaving the buffer widened at end of file. + +**Step 5: Commit** + +```bash +git add tests/ss-capture-tests.el lisp/ss-org.el +git commit -m "Narrow journal open to today" +``` + +### Task 2: Run regression verification + +**Files:** +- Review: `README.md` +- Verify: `lisp/ss-org.el` + +**Step 1: Write the failing test** + +```elisp +(ert-deftest ss-open-journal-falls-back-to-end-when-today-missing () + ...) +``` + +**Step 2: Run test to verify it fails** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-capture-tests.el -f ert-run-tests-batch-and-exit` +Expected: FAIL until the fallback remains explicitly covered. + +**Step 3: Write minimal implementation** + +```elisp +(unless (ss-journal-goto-date) + (goto-char (point-max))) +``` + +**Step 4: Run test to verify it passes** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-capture-tests.el -l tests/ss-crm-tests.el -f ert-run-tests-batch-and-exit` +Expected: PASS, then run `emacs --batch -Q --load ./init.el` to confirm startup remains healthy. + +**Step 5: Commit** + +```bash +git add tests/ss-capture-tests.el lisp/ss-org.el README.md +git commit -m "Preserve journal open fallback" +``` diff --git a/lisp/ss-capture.el b/lisp/ss-capture.el index f930716..0489888 100644 --- a/lisp/ss-capture.el +++ b/lisp/ss-capture.el @@ -76,7 +76,12 @@ When CREATE is non-nil, create the datetree entry when missing." (org-narrow-to-subtree) (dolist (section ss-journal-section-headings) (goto-char (point-min)) - (unless (org-find-exact-headline-in-buffer section) + (forward-line 1) + (unless (re-search-forward + (format "^%s %s$" + (make-string section-level ?*) + (regexp-quote section)) + nil t) (goto-char (point-max)) (unless (bolp) (insert "\n")) diff --git a/lisp/ss-crm.el b/lisp/ss-crm.el index c9b8c16..62dc3e3 100644 --- a/lisp/ss-crm.el +++ b/lisp/ss-crm.el @@ -18,6 +18,155 @@ '("Perm" "SOW" "SOW Fixed Outcome" "NCS India") "Canonical engagement values for people cards.") +(defconst ss-crm-seeded-roles + '("Account Manager" + "AD Platform Manager" + "AD, Billing & Catalogue, Engineering" + "AD, Frontend Engineering" + "AD, IT Core & MarTech" + "AD, Mobile Engineering" + "AD, Platform Engineering" + "AD, Portfolio Delivery Products and API Management" + "AD, Portfolio Mgmt. Customer Engagement" + "AD, Quality Engineering" + "AD, Tech Product Owner" + "AD, Technical Delivery" + "AD, Technical Platform Management" + "AD, Technical Platform Manager, API" + "AD, Technical Platform Manager, Catalog" + "AD, Technical Platform Manager, Order and Quote" + "AD, Technical Product Management" + "Agile Scrum Master" + "Analyst Programmer - Senior" + "Android Developer" + "Android Developer - Senior" + "Application Development Lead" + "Architect" + "Associate Engineer" + "Associate Engineer" + "Associate Engineer, Frontend" + "Associate Engineer, Platform Engineering" + "Associate Software Engineer" + "Billing Executive" + "Business Analyst" + "Business Analyst - Senior" + "Business Development Manager" + "Business Intelligence Analyst" + "Business Program Manager" + "Cloud Engineer" + "Consultant" + "CRM Developer" + "Data Analyst" + "Data Analyst - Senior" + "Delivery Lead" + "Delivery Manager" + "Demand Lead" + "Deployment Manager" + "Development Manager" + "DevOps Engineer" + "DevOps Engineer - Senior" + "Digital Delivery Manager" + "Director Customer Engagement" + "Director Sales Technology" + "Director, Billing and Charging" + "Director, Delivery Portfolio Billing and Charging" + "Director, Digital Engineering" + "Director, Portfolio Mgmt." + "Director, SF Comms Technical Platform" + "Director, SSF Core & Commerce" + "Engineer" + "Engineer - Junior" + "Engineer - Senior" + "Engineer, Platform Engineering" + "Engineer, Salesforce" + "Engineering Manager" + "Engineering Manager, Mobile" + "Engineering Manager, Platform Engineering" + "Executive Assistant" + "Integration Lead" + "Integration Solution Designer" + "Integration Technical Specialist" + "iOS Developer" + "iOS Developer - Senior" + "IT Business Partner" + "Lead Consultant" + "Lead Developer" + "Manager, Release Engineer" + "Manager, Release Train Engineer" + "Mobile API Developer" + "Optus Tech Graduate" + "Portfolio Manager" + "Process Analyst - Senior" + "Product Manager" + "Product Solution Designer" + "Program Analyst" + "Program Director" + "Program Manager" + "Project Architect" + "Project Coordinator" + "Project Manager" + "Quality Assurance Analyst" + "Quality Engineering Professional" + "Release Coordinator" + "Release Manager" + "Salesforce Administrator" + "Salesforce Developer (Heroku, Lightning, etc)" + "Salesforce Marketing Cloud Architect" + "Salesforce Operations Manager" + "Scrum Master" + "SD, Engineering Capability" + "SD, Marketing Technology" + "SD, Technical Products" + "Senior Business Analyst" + "Senior Delivery Manager" + "Senior Delivery Manger" + "Senior Digital Technical Producer" + "Senior E2E Business Analyst Lead" + "Senior Engineer" + "Senior Engineer, API Engineering" + "Senior Engineer, Billing & Catalogue" + "Senior Engineer, Platform Engineering" + "Senior Engineer, Salesforce" + "Senior Front End Developer" + "Senior Integration Solution Designer" + "Senior Quality Engineering Professional" + "Senior Salesforce Administrator" + "Senior Salesforce Consultant" + "Senior Salesforce Functional Consultant" + "Senior Salesforce Operations Lead" + "Senior Software Developer" + "Senior Software Engineer" + "Senior Software Engineer, Frontend" + "Senior Software Engineer, Mobile" + "Senior Solution Designer" + "Snr Dir, Delivery & Platform Manager" + "Snr Director, Portfolio Mgmt. & Delivery" + "Software Developer" + "Software Developer - Junior" + "Software Developer - Senior" + "Software Engineer" + "Software Engineer, Frontend" + "Software Engineer, Mobile" + "Solution Architect" + "Solution Designer" + "Solution Designer - Senior" + "Staff Engineer" + "Support Analyst" + "System Analyst" + "System Engineer" + "Technical Lead" + "Technical Platform Manager" + "Technical Platform Manager, Billing and Charging" + "Technical Product Manager" + "Technical Project Manager - Senior" + "Technical Specialist - Senior" + "Technology Delivery Analyst" + "Test Analyst" + "Test Lead" + "Test Manager" + "VP, EB IT") + "Seeded role values derived from the historic roles CSV.") + (defconst ss-crm-supplier-options '("Accenture Song" "INFOSYS TECHNOLOGIES LIMITED" @@ -392,6 +541,93 @@ (user-error "%s is required" (string-remove-suffix ": " prompt)) value))) +(defun ss-crm-known-property-values (property) + "Return sorted unique non-empty values for PROPERTY from CRM entries." + (let ((key (intern (concat ":" (downcase property))))) + (seq-sort + #'string< + (delete-dups + (seq-filter + (lambda (value) + (and (stringp value) + (not (string-empty-p (string-trim value))))) + (mapcar + (lambda (entry) + (plist-get entry key)) + (ss-crm-entries))))))) + +(defun ss-crm-known-person-names () + "Return sorted top-level person names from CRM entries." + (seq-sort + #'string< + (delete-dups + (seq-filter + (lambda (name) + (and (stringp name) + (not (string-empty-p (string-trim name))))) + (mapcar #'ss-crm--entry-name (ss-crm-entries)))))) + +(defun ss-crm-lookup-values (property &optional seeded) + "Return sorted unique values for PROPERTY merged with SEEDED values." + (seq-sort + #'string< + (delete-dups + (seq-filter + (lambda (value) + (and (stringp value) + (not (string-empty-p (string-trim value))))) + (append seeded + (ss-crm-known-property-values property)))))) + +(defun ss-crm--read-choice-warning (prompt similar) + "Warn that PROMPT value is similar to existing SIMILAR." + (display-warning + 'ss-crm + (format "%sA similar existing value already exists: %s" + prompt + similar) + :warning)) + +(defun ss-crm-read-choice (prompt choices &rest plist) + "Read a value for PROMPT from CHOICES using options in PLIST. +Supported keywords are :allow-blank, :allow-new, and :require-match." + (let* ((allow-blank (plist-get plist :allow-blank)) + (allow-new (plist-get plist :allow-new)) + (require-match (plist-get plist :require-match)) + (blank-choice "[none]") + (collection (if allow-blank + (cons blank-choice choices) + choices)) + (completion-require-match (if allow-new nil require-match))) + (catch 'done + (while t + (let* ((value (completing-read prompt collection nil completion-require-match)) + (existing + (seq-find + (lambda (choice) + (string= value choice)) + choices))) + (cond + ((or (string-empty-p value) + (and allow-blank + (string= value blank-choice))) + (throw 'done nil)) + (existing + (throw 'done existing)) + ((not allow-new) + (user-error "Please choose an existing value")) + (t + (when-let ((similar + (seq-find + (lambda (choice) + (and (not (string= value choice)) + (string-equal (downcase value) + (downcase choice)))) + choices))) + (ss-crm--read-choice-warning prompt similar)) + (when (yes-or-no-p (format "Create new value `%s'? " value)) + (throw 'done value))))))))) + (defun ss-crm--completion-values (extractor &optional include-empty) "Return sorted unique values using EXTRACTOR. When INCLUDE-EMPTY is non-nil, keep empty values." @@ -404,6 +640,50 @@ When INCLUDE-EMPTY is non-nil, keep empty values." (not (string-empty-p (or value ""))))) values)))) +(defun ss-crm-read-role () + "Read a CRM role using seeded and known role values." + (ss-crm-read-choice "Role: " + (ss-crm-lookup-values "ROLE" ss-crm-seeded-roles) + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-team () + "Read a CRM team using known team values." + (ss-crm-read-choice "Team: " + (ss-crm-lookup-values "TEAM") + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-manager () + "Read a CRM manager using known person names." + (ss-crm-read-choice "Manager: " + (ss-crm-known-person-names) + :allow-blank t + :require-match t)) + +(defun ss-crm-read-engagement () + "Read a CRM engagement using seeded and known engagement values." + (ss-crm-read-choice "Engagement: " + (ss-crm-lookup-values "ENGAGEMENT" + ss-crm-engagement-options) + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-supplier () + "Read a CRM supplier using seeded and known supplier values." + (ss-crm-read-choice "Supplier: " + (ss-crm-lookup-values "SUPPLIER" + ss-crm-supplier-options) + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-location () + "Read a CRM location using known location values." + (ss-crm-read-choice "Location: " + (ss-crm-lookup-values "LOCATION") + :allow-blank t + :allow-new t)) + (defun ss-crm-add () "Add a new compact person card to `ss-crm-file'." (interactive) @@ -419,35 +699,13 @@ When INCLUDE-EMPTY is non-nil, keep empty values." (current-focus nil)) (setq abbrev (ss-crm-read-string "Abbrev: " (ss-crm-default-abbrev name)) aliases (ss-crm-read-string "Aliases (comma-separated, optional): ") - role (completing-read "Role: " - (ss-crm--completion-values #'ss-crm--entry-role) - nil nil) - team (completing-read "Team: " - (ss-crm--completion-values #'ss-crm--entry-team) - nil nil) - manager (completing-read "Manager: " - (mapcar #'ss-crm--entry-name (ss-crm-entries)) - nil nil) - engagement (completing-read "Engagement: " - ss-crm-engagement-options nil t) - supplier (completing-read "Supplier: " - ss-crm-supplier-options nil t) - location (completing-read "Location: " - (ss-crm--completion-values #'ss-crm--entry-location) - nil nil) + role (ss-crm-read-role) + team (ss-crm-read-team) + manager (ss-crm-read-manager) + engagement (ss-crm-read-engagement) + supplier (ss-crm-read-supplier) + location (ss-crm-read-location) current-focus (ss-crm-read-required-string "Current focus: ")) - (setq role (if (string-empty-p role) - (ss-crm-read-required-string "Role: ") - role)) - (setq team (if (string-empty-p team) - (ss-crm-read-required-string "Team: ") - team)) - (setq manager (if (string-empty-p manager) - (ss-crm-read-required-string "Manager: ") - manager)) - (setq location (if (string-empty-p location) - (ss-crm-read-required-string "Location: ") - location)) (when (ss-crm--entry-by-name name) (user-error "A person card for %s already exists" name)) (when (string-empty-p abbrev) diff --git a/lisp/ss-org.el b/lisp/ss-org.el index 30956e9..7df4d75 100644 --- a/lisp/ss-org.el +++ b/lisp/ss-org.el @@ -9,14 +9,15 @@ (require 'ss-core) (defun ss-open-journal () - "Open `ss-journal-file', moving to today's entry when it exists." + "Open `ss-journal-file', narrowing to today's entry when it exists." (interactive) (find-file (ss-require-existing-file ss-journal-file)) (widen) (unless (fboundp 'ss-journal-goto-date) (goto-char (point-max))) (when (fboundp 'ss-journal-goto-date) - (unless (ss-journal-goto-date) + (if (ss-journal-goto-date) + (org-narrow-to-subtree) (goto-char (point-max))))) (defun ss-open-moc () 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 |