summaryrefslogtreecommitdiff
path: root/lisp
diff options
context:
space:
mode:
authorSzymon Szukalski <szymon@szymonszukalski.com>2026-04-09 10:53:27 +1000
committerSzymon Szukalski <szymon@szymonszukalski.com>2026-04-09 10:53:27 +1000
commitbc75732b9d37b77945a977ee9f7892cf6efc79c3 (patch)
tree4d9273ccc12c29eccc44fdc12372bea047414353 /lisp
parent12a5b1464bb919ba23f2aa6c22d44de81e382151 (diff)
Refactor Emacs config into modules
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ss-agenda.el40
-rw-r--r--lisp/ss-capture.el175
-rw-r--r--lisp/ss-core.el147
-rw-r--r--lisp/ss-crm.el559
-rw-r--r--lisp/ss-denote.el49
-rw-r--r--lisp/ss-gptel.el21
-rw-r--r--lisp/ss-keys.el55
-rw-r--r--lisp/ss-org.el57
-rw-r--r--lisp/ss-ui.el135
9 files changed, 1238 insertions, 0 deletions
diff --git a/lisp/ss-agenda.el b/lisp/ss-agenda.el
new file mode 100644
index 0000000..a89a52e
--- /dev/null
+++ b/lisp/ss-agenda.el
@@ -0,0 +1,40 @@
+;;; ss-agenda.el --- Agenda configuration -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Agenda discovery and agenda commands.
+
+;;; Code:
+
+(require 'ss-core)
+(require 'ss-org)
+
+(defun ss-refresh-org-agenda-files (&rest _)
+ "Refresh `org-agenda-files' from the journal and PARA directories.
+Ignore any arguments passed by advice wrappers."
+ (require 'org-agenda)
+ (setq org-agenda-files
+ (sort
+ (delete-dups
+ (append
+ (list (ss-require-existing-file ss-journal-file))
+ (apply #'append
+ (mapcar (lambda (directory)
+ (directory-files-recursively
+ (ss-require-existing-directory directory)
+ "\\.org\\'"))
+ ss-org-agenda-directories))))
+ #'string<)))
+
+(defun ss-open-agenda ()
+ "Refresh agenda files and invoke `org-agenda'."
+ (interactive)
+ (call-interactively #'org-agenda))
+
+(defun ss-agenda-setup ()
+ "Initialize agenda behavior."
+ (advice-add 'org-agenda :before #'ss-refresh-org-agenda-files))
+
+(provide 'ss-agenda)
+
+;;; ss-agenda.el ends here
diff --git a/lisp/ss-capture.el b/lisp/ss-capture.el
new file mode 100644
index 0000000..f930716
--- /dev/null
+++ b/lisp/ss-capture.el
@@ -0,0 +1,175 @@
+;;; ss-capture.el --- Capture configuration -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Journal capture helpers and capture templates.
+
+;;; Code:
+
+(require 'calendar)
+(require 'org)
+(require 'org-capture)
+(require 'ss-core)
+(require 'ss-org)
+
+(defun ss-journal-capture-time ()
+ "Return the effective timestamp for the current journal capture."
+ (or org-overriding-default-time
+ (org-capture-get :default-time)
+ (current-time)))
+
+(defun ss-journal-calendar-date (&optional time)
+ "Return TIME as a Gregorian date list for datetree helpers."
+ (calendar-gregorian-from-absolute
+ (time-to-days (or time (current-time)))))
+
+(defun ss-journal-year-heading (&optional time)
+ "Return the journal year heading text for TIME."
+ (format-time-string "%Y" (or time (current-time))))
+
+(defun ss-journal-day-heading (&optional time)
+ "Return the journal day heading text for TIME."
+ (format-time-string "%Y-%m-%d %A" (or time (current-time))))
+
+(defun ss-journal-find-or-create-heading (level heading)
+ "Move to HEADING at LEVEL, creating it when missing."
+ (goto-char (point-min))
+ (if (re-search-forward
+ (format "^%s %s$"
+ (make-string level ?*)
+ (regexp-quote heading))
+ nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert (make-string level ?*) " " heading "\n")
+ (forward-line -1))
+ (org-back-to-heading t))
+
+(defun ss-journal-goto-date (&optional time create)
+ "Move to TIME's journal date heading.
+When CREATE is non-nil, create the datetree entry when missing."
+ (goto-char (point-min))
+ (if create
+ (let ((year-heading (ss-journal-year-heading time))
+ (day-heading (ss-journal-day-heading time)))
+ (ss-journal-find-or-create-heading 1 year-heading)
+ (save-restriction
+ (org-narrow-to-subtree)
+ (ss-journal-find-or-create-heading 2 day-heading))
+ t)
+ (when (re-search-forward
+ (format "^\\*\\* %s$"
+ (regexp-quote
+ (ss-journal-day-heading (or time (current-time)))))
+ nil t)
+ (goto-char (match-beginning 0))
+ t)))
+
+(defun ss-journal-ensure-day-sections ()
+ "Ensure the standard section headings exist under the current journal day."
+ (org-back-to-heading t)
+ (let ((section-level (1+ (org-outline-level))))
+ (save-excursion
+ (save-restriction
+ (org-narrow-to-subtree)
+ (dolist (section ss-journal-section-headings)
+ (goto-char (point-min))
+ (unless (org-find-exact-headline-in-buffer section)
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (insert (make-string section-level ?*) " " section "\n")))))))
+
+(defun ss-journal-goto-section (section &optional time)
+ "Move to SECTION beneath TIME's journal date, creating structure as needed."
+ (unless (member section ss-journal-section-headings)
+ (user-error "Unknown journal section: %s" section))
+ (ss-journal-goto-date time 'create)
+ (ss-journal-ensure-day-sections)
+ (let ((section-level (1+ (org-outline-level)))
+ position)
+ (save-restriction
+ (org-narrow-to-subtree)
+ (goto-char (point-min))
+ (when (re-search-forward
+ (format "^%s %s$"
+ (make-string section-level ?*)
+ (regexp-quote section))
+ nil t)
+ (setq position (match-beginning 0))))
+ (unless position
+ (user-error "Journal section not found: %s" section))
+ (goto-char position)
+ (org-back-to-heading t)))
+
+(defun ss-journal-capture-target (section)
+ "Select SECTION under today's journal datetree entry for capture."
+ (set-buffer (find-file-noselect (ss-require-existing-file ss-journal-file)))
+ (widen)
+ (ss-journal-goto-section section (ss-journal-capture-time)))
+
+(defun ss-capture--denote-templates ()
+ "Return Denote-backed capture templates when Denote is enabled."
+ (when (ss-feature-enabled-p 'denote)
+ `(("n" "Denote")
+ ("nn" "Generic" plain
+ (file denote-last-path)
+ (function
+ (lambda ()
+ (denote-org-capture-with-prompts :title :keywords :subdirectory)))
+ :no-save t
+ :immediate-finish nil
+ :kill-buffer t
+ :jump-to-captured t)
+ ("np" "Project" plain
+ (file denote-last-path)
+ (function
+ (lambda ()
+ (ss-denote-capture-in-directory
+ ss-org-projects-directory '("project") :title :keywords :subdirectory)))
+ :no-save t
+ :immediate-finish nil
+ :kill-buffer t
+ :jump-to-captured t)
+ ("na" "Area" plain
+ (file denote-last-path)
+ (function
+ (lambda ()
+ (ss-denote-capture-in-directory
+ ss-org-areas-directory nil :title :keywords :subdirectory)))
+ :no-save t
+ :immediate-finish nil
+ :kill-buffer t
+ :jump-to-captured t)
+ ("nr" "Resource" plain
+ (file denote-last-path)
+ (function
+ (lambda ()
+ (ss-denote-capture-in-directory
+ ss-org-resources-directory nil :title :keywords :subdirectory)))
+ :no-save t
+ :immediate-finish nil
+ :kill-buffer t
+ :jump-to-captured t))))
+
+(defun ss-capture-setup ()
+ "Initialize capture templates."
+ (setq org-capture-templates
+ (append
+ '(("j" "Journal")
+ ("jt" "Task" entry
+ (function (lambda () (ss-journal-capture-target "Tasks")))
+ "* TODO %?")
+ ("jn" "Note" entry
+ (function (lambda () (ss-journal-capture-target "Notes")))
+ "* %?")
+ ("jm" "Meeting" entry
+ (function (lambda () (ss-journal-capture-target "Meetings")))
+ "* <%<%Y-%m-%d %H:%M>> %?"))
+ (ss-capture--denote-templates))))
+
+(provide 'ss-capture)
+
+;;; ss-capture.el ends here
diff --git a/lisp/ss-core.el b/lisp/ss-core.el
new file mode 100644
index 0000000..3be0711
--- /dev/null
+++ b/lisp/ss-core.el
@@ -0,0 +1,147 @@
+;;; ss-core.el --- Shared core setup -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Shared startup helpers, package bootstrap, paths, and editor defaults.
+
+;;; Code:
+
+(require 'subr-x)
+
+(defconst ss-minimum-emacs-version "27.1"
+ "Minimum supported Emacs version.")
+
+(defconst ss-warning-emacs-version "28.1"
+ "Version threshold for compatibility warnings.")
+
+(defconst ss-spell-check-support-enabled nil)
+(defconst ss-is-windows (memq system-type '(windows-nt ms-dos cygwin)))
+(defconst ss-is-linux (eq system-type 'gnu/linux))
+(defconst ss-is-mac (eq system-type 'darwin))
+
+(defconst ss-org-directory (expand-file-name "~/org/")
+ "Root directory for Org files.")
+
+(defconst ss-journal-file (expand-file-name "journal.org" ss-org-directory)
+ "Single-file work journal for operational capture.")
+
+(defconst ss-org-projects-directory (expand-file-name "projects/" ss-org-directory)
+ "Directory for project notes.")
+
+(defconst ss-org-areas-directory (expand-file-name "areas/" ss-org-directory)
+ "Directory for area notes.")
+
+(defconst ss-org-resources-directory (expand-file-name "resources/" ss-org-directory)
+ "Directory for resource notes.")
+
+(defconst ss-org-archives-directory (expand-file-name "archives/" ss-org-directory)
+ "Directory for archived notes.")
+
+(defconst ss-moc-file (expand-file-name "moc.org" ss-org-directory)
+ "Central MOC note.")
+
+(defconst ss-crm-file (expand-file-name "areas/people/people.org" ss-org-directory)
+ "Single source of truth for the people CRM.")
+
+(defconst ss-journal-section-headings
+ '("Tasks" "Notes" "Meetings")
+ "Per-day section headings maintained under each journal datetree entry.")
+
+(defconst ss-org-agenda-directories
+ (list ss-org-projects-directory
+ ss-org-areas-directory
+ ss-org-resources-directory)
+ "Directories whose Org files feed the agenda.")
+
+(defun ss-feature-enabled-p (feature)
+ "Return non-nil when FEATURE is enabled in `ss-enabled-features'."
+ (memq feature ss-enabled-features))
+
+(defun ss-require-existing-directory (directory)
+ "Return DIRECTORY, signaling when it does not exist."
+ (unless (file-directory-p directory)
+ (user-error "Directory does not exist: %s" directory))
+ directory)
+
+(defun ss-require-existing-file (file)
+ "Return FILE, signaling when it does not exist."
+ (unless (file-exists-p file)
+ (user-error "File does not exist: %s" file))
+ file)
+
+(defun ss-enable-prose-abbrev-mode ()
+ "Enable abbrev mode in prose buffers.
+We keep this mode-local so code buffers stay on their own completion rules."
+ (abbrev-mode 1))
+
+(defun ss-core-setup ()
+ "Initialize shared core behavior."
+ (let ((minver ss-minimum-emacs-version))
+ (when (version< emacs-version minver)
+ (error "Your Emacs is too old -- this config requires v%s or higher" minver)))
+ (when (version< emacs-version ss-warning-emacs-version)
+ (message
+ (concat
+ "Your Emacs is old, and some functionality in this config will be "
+ "disabled. Please upgrade if possible.")))
+
+ ;; Keep custom-set-variables out of the main config.
+ (setq custom-file (expand-file-name "custom.el" user-emacs-directory))
+
+ (require 'package)
+ (setq package-archives
+ (append '(("melpa" . "https://melpa.org/packages/"))
+ package-archives)
+ package-archive-priorities '(("gnu" . 10)
+ ("nongnu" . 8)
+ ("melpa" . 5))
+ package-install-upgrade-built-in t
+ use-package-always-ensure nil)
+ (package-initialize)
+ (require 'use-package)
+ (require 'abbrev)
+
+ (set-language-environment "UTF-8")
+ (set-default-coding-systems 'utf-8)
+ (prefer-coding-system 'utf-8)
+
+ (setq abbrev-file-name (expand-file-name "abbrev_defs" user-emacs-directory)
+ save-abbrevs 'silently)
+ (when (file-exists-p abbrev-file-name)
+ (quietly-read-abbrev-file abbrev-file-name))
+
+ (dolist (hook '(text-mode-hook org-mode-hook))
+ (add-hook hook #'ss-enable-prose-abbrev-mode))
+
+ (setq auto-save-default nil
+ backup-inhibited t
+ echo-keystrokes 0.1
+ compilation-ask-about-save nil
+ mouse-wheel-scroll-amount '(1 ((shift) . 1))
+ mouse-wheel-progressive-speed nil
+ mouse-wheel-follow-mouse t
+ scroll-step 1
+ scroll-conservatively 101
+ enable-recursive-minibuffers t
+ gc-cons-threshold (* 128 1024 1024)
+ read-process-output-max (* 4 1024 1024)
+ process-adaptive-read-buffering nil)
+
+ (fset 'yes-or-no-p 'y-or-n-p)
+ (global-auto-revert-mode 1)
+ (delete-selection-mode 1)
+
+ (setq-default indent-tabs-mode nil
+ fill-column 80
+ tab-width 2
+ indicate-empty-lines t
+ sentence-end-double-space nil))
+
+(defun ss-core-load-custom-file ()
+ "Load `custom-file' when it exists."
+ (when (file-exists-p custom-file)
+ (load custom-file nil 'nomessage)))
+
+(provide 'ss-core)
+
+;;; ss-core.el ends here
diff --git a/lisp/ss-crm.el b/lisp/ss-crm.el
new file mode 100644
index 0000000..c9b8c16
--- /dev/null
+++ b/lisp/ss-crm.el
@@ -0,0 +1,559 @@
+;;; ss-crm.el --- People CRM -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; People CRM parsing, lookup, completion, insertion, and reporting.
+
+;;; Code:
+
+(require 'abbrev)
+(require 'org)
+(require 'org-element)
+(require 'seq)
+(require 'ss-core)
+(require 'subr-x)
+(require 'marginalia nil t)
+
+(defconst ss-crm-engagement-options
+ '("Perm" "SOW" "SOW Fixed Outcome" "NCS India")
+ "Canonical engagement values for people cards.")
+
+(defconst ss-crm-supplier-options
+ '("Accenture Song"
+ "INFOSYS TECHNOLOGIES LIMITED"
+ "MAKK Integrations Pty Ltd"
+ "NCSI Technologies India Private Limited"
+ "TECH MAHINDRA LTD")
+ "Canonical supplier values for people cards.")
+
+(defvar ss-crm--cache nil
+ "Cached CRM entries loaded from `ss-crm-file'.")
+
+(defvar ss-crm--cache-mtime nil
+ "Modification time of the cached CRM entries.")
+
+(defun ss-crm--entry-name (entry)
+ "Return the canonical name in ENTRY."
+ (plist-get entry :name))
+
+(defun ss-crm--entry-abbrev (entry)
+ "Return the abbrev trigger in ENTRY."
+ (plist-get entry :abbrev))
+
+(defun ss-crm--entry-aliases (entry)
+ "Return alias variants in ENTRY."
+ (plist-get entry :aliases))
+
+(defun ss-crm--entry-role (entry)
+ "Return the role in ENTRY."
+ (plist-get entry :role))
+
+(defun ss-crm--entry-team (entry)
+ "Return the team in ENTRY."
+ (plist-get entry :team))
+
+(defun ss-crm--entry-manager (entry)
+ "Return the manager in ENTRY."
+ (plist-get entry :manager))
+
+(defun ss-crm--entry-engagement (entry)
+ "Return the engagement in ENTRY."
+ (plist-get entry :engagement))
+
+(defun ss-crm--entry-supplier (entry)
+ "Return the supplier in ENTRY."
+ (plist-get entry :supplier))
+
+(defun ss-crm--entry-location (entry)
+ "Return the location in ENTRY."
+ (plist-get entry :location))
+
+(defun ss-crm--entry-current-focus (entry)
+ "Return the current focus in ENTRY."
+ (plist-get entry :current-focus))
+
+(defun ss-crm-default-abbrev (name)
+ "Suggest a short abbrev trigger for NAME."
+ (let* ((parts (split-string (string-trim name) "[[:space:]]+" t))
+ (first (downcase (substring (car parts) 0 (min 2 (length (car parts))))))
+ (last (downcase (substring (car (last parts)) 0 1))))
+ (if (> (length parts) 1)
+ (concat ";" first last)
+ (concat ";" first))))
+
+(defun ss-crm--split-values (value)
+ "Split VALUE on commas and trim each item."
+ (when (and value (not (string-empty-p value)))
+ (seq-filter
+ (lambda (string)
+ (not (string-empty-p string)))
+ (mapcar #'string-trim (split-string value "," t)))))
+
+(defun ss-crm--summary (entry)
+ "Return the compact one-line summary for ENTRY."
+ (string-join
+ (seq-filter
+ (lambda (string)
+ (and string (not (string-empty-p string))))
+ (list (ss-crm--entry-role entry)
+ (ss-crm--entry-team entry)
+ (ss-crm--entry-engagement entry)
+ (ss-crm--entry-current-focus entry)))
+ " | "))
+
+(defun ss-crm--display (entry)
+ "Return the compact display string for ENTRY."
+ (let ((summary (ss-crm--summary entry)))
+ (if (string-empty-p summary)
+ (ss-crm--entry-name entry)
+ (format "%s %s" (ss-crm--entry-name entry) summary))))
+
+(defun ss-crm--property-line (key value)
+ "Return an Org property line for KEY and VALUE."
+ (if (and value (not (string-empty-p value)))
+ (format ":%s: %s\n" key value)
+ ""))
+
+(defun ss-crm--require-file ()
+ "Return `ss-crm-file', signaling when it is unavailable."
+ (ss-require-existing-file ss-crm-file))
+
+(defun ss-crm--parse-entry-at-point (headline)
+ "Return the CRM entry described by HEADLINE at point."
+ (list :name (org-element-property :raw-value headline)
+ :abbrev (org-entry-get nil "ABBREV")
+ :aliases (ss-crm--split-values (org-entry-get nil "ALIASES"))
+ :role (org-entry-get nil "ROLE")
+ :team (org-entry-get nil "TEAM")
+ :manager (org-entry-get nil "MANAGER")
+ :engagement (org-entry-get nil "ENGAGEMENT")
+ :supplier (org-entry-get nil "SUPPLIER")
+ :location (org-entry-get nil "LOCATION")
+ :current-focus (org-entry-get nil "CURRENT_FOCUS")))
+
+(defun ss-crm--parse-entries ()
+ "Parse top-level CRM entries from `ss-crm-file'."
+ (with-temp-buffer
+ (insert-file-contents (ss-crm--require-file))
+ ;; Parse cards without running user hooks; otherwise the CRM's own Org
+ ;; hooks recurse back into this parser.
+ (delay-mode-hooks
+ (org-mode))
+ (let ((ast (org-element-parse-buffer))
+ cards)
+ (org-element-map ast 'headline
+ (lambda (headline)
+ (when (= 1 (org-element-property :level headline))
+ (goto-char (org-element-property :begin headline))
+ (push (ss-crm--parse-entry-at-point headline) cards))))
+ (sort cards
+ (lambda (left right)
+ (string< (ss-crm--entry-name left)
+ (ss-crm--entry-name right)))))))
+
+(defun ss-crm-entries ()
+ "Return top-level people cards from `ss-crm-file'."
+ (let* ((file (ss-crm--require-file))
+ (attributes (file-attributes file))
+ (mtime (file-attribute-modification-time attributes)))
+ (unless (and ss-crm--cache
+ (equal mtime ss-crm--cache-mtime))
+ (setq ss-crm--cache (ss-crm--parse-entries)
+ ss-crm--cache-mtime mtime))
+ ss-crm--cache))
+
+(defun ss-crm-reload ()
+ "Reload the people cache and refresh prose buffers."
+ (interactive)
+ (setq ss-crm--cache nil
+ ss-crm--cache-mtime nil)
+ (ss-crm-refresh-buffers)
+ (message "Reloaded people CRM"))
+
+(defun ss-crm--entry-by-name (name)
+ "Return the people entry matching canonical NAME."
+ (seq-find
+ (lambda (entry)
+ (string= name (ss-crm--entry-name entry)))
+ (ss-crm-entries)))
+
+(defun ss-crm--search-keys (entry)
+ "Return canonical and alias search keys for ENTRY."
+ (cons (ss-crm--entry-name entry)
+ (ss-crm--entry-aliases entry)))
+
+(defun ss-crm--match-p (query entry)
+ "Return non-nil when QUERY matches ENTRY name or aliases."
+ (let* ((parts (split-string (downcase (string-trim query)) "[[:space:]]+" t))
+ (keys (mapcar #'downcase (ss-crm--search-keys entry))))
+ (seq-every-p
+ (lambda (part)
+ (seq-some
+ (lambda (key)
+ (string-match-p (regexp-quote part) key))
+ keys))
+ parts)))
+
+(defun ss-crm--matching-entries (query)
+ "Return entries whose canonical name or aliases match QUERY."
+ (let ((entries (ss-crm-entries)))
+ (if (string-empty-p (string-trim query))
+ entries
+ (seq-filter
+ (lambda (entry)
+ (ss-crm--match-p query entry))
+ entries))))
+
+(defun ss-crm--completion-table (string pred action)
+ "Complete canonical people names while matching aliases via STRING."
+ (if (eq action 'metadata)
+ '(metadata (category . ss-person))
+ (complete-with-action
+ action
+ (mapcar #'ss-crm--entry-name (ss-crm--matching-entries string))
+ string
+ pred)))
+
+(defun ss-crm-marginalia-annotator (candidate)
+ "Return a Marginalia annotation for person CANDIDATE."
+ (when-let ((entry (ss-crm--entry-by-name candidate)))
+ (concat " " (ss-crm--summary entry))))
+
+(defun ss-crm-select-entry (&optional prompt)
+ "Select a person entry using PROMPT."
+ (let ((completion-extra-properties
+ '(:annotation-function ss-crm-marginalia-annotator)))
+ (ss-crm--entry-by-name
+ (completing-read (or prompt "Person: ")
+ #'ss-crm--completion-table
+ nil
+ t))))
+
+(defun ss-crm-overview ()
+ "Open `ss-crm-file' in overview mode, widening first when needed."
+ (interactive)
+ (unless (and buffer-file-name
+ (string= (file-truename buffer-file-name)
+ (file-truename ss-crm-file)))
+ (find-file (ss-crm--require-file)))
+ (widen)
+ (goto-char (point-min))
+ (org-overview)
+ (org-cycle-hide-drawers 'all))
+
+(defun ss-crm-open ()
+ "Open the people CRM by delegating to `ss-crm-overview'."
+ (interactive)
+ (ss-crm-overview))
+
+(defun ss-crm--track-buffer ()
+ "Refresh CRM caches when `ss-crm-file' is saved."
+ (when (and buffer-file-name
+ (string= (file-truename buffer-file-name)
+ (file-truename ss-crm-file)))
+ (add-hook 'after-save-hook #'ss-crm-reload nil t)))
+
+(defun ss-crm--source-buffer-p ()
+ "Return non-nil when the current buffer visits `ss-crm-file'."
+ (and buffer-file-name
+ (string= (file-truename buffer-file-name)
+ (file-truename ss-crm-file))))
+
+(defun ss-crm--open-entry (entry)
+ "Open the people CRM file, then narrow to ENTRY for card view."
+ (find-file (ss-crm--require-file))
+ (widen)
+ (let ((position (org-find-exact-headline-in-buffer
+ (ss-crm--entry-name entry))))
+ (unless position
+ (user-error "No people card for %s" (ss-crm--entry-name entry)))
+ (goto-char position))
+ (org-narrow-to-subtree)
+ (org-fold-show-subtree)
+ (org-fold-show-entry)
+ (goto-char (point-min)))
+
+(defun ss-crm-find ()
+ "Find a person and open that card."
+ (interactive)
+ (ss-crm--open-entry
+ (or (ss-crm-select-entry "Find person: ")
+ (user-error "No person selected"))))
+
+(defun ss-crm-insert-name ()
+ "Insert a canonical person name at point."
+ (interactive)
+ (let ((entry (or (ss-crm-select-entry "Insert person name: ")
+ (user-error "No person selected"))))
+ (insert (ss-crm--entry-name entry))))
+
+(defun ss-crm-insert-summary ()
+ "Insert a compact person summary at point."
+ (interactive)
+ (let ((entry (or (ss-crm-select-entry "Insert person summary: ")
+ (user-error "No person selected"))))
+ (insert (ss-crm--display entry))))
+
+(defun ss-crm--report-buffer (title group-fn)
+ "Render a grouped CRM report titled TITLE using GROUP-FN."
+ (let* ((entries (ss-crm-entries))
+ (groups
+ (seq-group-by
+ (lambda (entry)
+ (let ((value (funcall group-fn entry)))
+ (if (string-empty-p (or value ""))
+ "(none)"
+ value)))
+ entries)))
+ (setq groups
+ (sort groups
+ (lambda (left right)
+ (string< (car left) (car right)))))
+ (with-current-buffer (get-buffer-create "*People Report*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (org-mode)
+ (insert "#+title: " title "\n\n")
+ (dolist (group groups)
+ (insert "* " (car group) "\n")
+ (dolist (entry (sort (copy-sequence (cdr group))
+ (lambda (left right)
+ (string< (ss-crm--entry-name left)
+ (ss-crm--entry-name right)))))
+ (insert "- " (ss-crm--display entry) "\n")))
+ (goto-char (point-min))
+ (read-only-mode 1)
+ (view-mode 1))
+ (pop-to-buffer (current-buffer)))))
+
+(defun ss-crm-report-by-team ()
+ "Show people grouped by team."
+ (interactive)
+ (ss-crm--report-buffer "People by team" #'ss-crm--entry-team))
+
+(defun ss-crm-report-by-manager ()
+ "Show people grouped by manager."
+ (interactive)
+ (ss-crm--report-buffer "People by manager" #'ss-crm--entry-manager))
+
+(defun ss-crm-report-by-engagement ()
+ "Show people grouped by engagement."
+ (interactive)
+ (ss-crm--report-buffer "People by engagement" #'ss-crm--entry-engagement))
+
+(defun ss-crm-report-by-supplier ()
+ "Show non-empty suppliers grouped by supplier."
+ (interactive)
+ (let* ((entries
+ (seq-filter
+ (lambda (entry)
+ (not (string-empty-p (or (ss-crm--entry-supplier entry) ""))))
+ (ss-crm-entries)))
+ (groups (seq-group-by #'ss-crm--entry-supplier entries)))
+ (setq groups
+ (sort groups
+ (lambda (left right)
+ (string< (car left) (car right)))))
+ (with-current-buffer (get-buffer-create "*People Report*")
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (org-mode)
+ (insert "#+title: People by supplier\n\n")
+ (dolist (group groups)
+ (insert "* " (car group) "\n")
+ (dolist (entry (sort (copy-sequence (cdr group))
+ (lambda (left right)
+ (string< (ss-crm--entry-name left)
+ (ss-crm--entry-name right)))))
+ (insert "- " (ss-crm--display entry) "\n")))
+ (goto-char (point-min))
+ (read-only-mode 1)
+ (view-mode 1))
+ (pop-to-buffer (current-buffer)))))
+
+(defun ss-crm-report-by-role ()
+ "Show people grouped by role."
+ (interactive)
+ (ss-crm--report-buffer "People by role" #'ss-crm--entry-role))
+
+(defun ss-crm-report-by-location ()
+ "Show people grouped by location."
+ (interactive)
+ (ss-crm--report-buffer "People by location" #'ss-crm--entry-location))
+
+(defun ss-crm-read-string (prompt &optional default)
+ "Read PROMPT and trim the result."
+ (string-trim (read-string prompt nil nil default)))
+
+(defun ss-crm-read-required-string (prompt &optional default)
+ "Read PROMPT and require a non-empty result."
+ (let ((value (ss-crm-read-string prompt default)))
+ (if (string-empty-p value)
+ (user-error "%s is required" (string-remove-suffix ": " prompt))
+ 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."
+ (let ((values (delete-dups (mapcar extractor (ss-crm-entries)))))
+ (seq-sort
+ #'string<
+ (seq-filter
+ (lambda (value)
+ (or include-empty
+ (not (string-empty-p (or value "")))))
+ values))))
+
+(defun ss-crm-add ()
+ "Add a new compact person card to `ss-crm-file'."
+ (interactive)
+ (let ((name (ss-crm-read-required-string "Full name: "))
+ (abbrev nil)
+ (aliases nil)
+ (role nil)
+ (team nil)
+ (manager nil)
+ (engagement nil)
+ (supplier nil)
+ (location nil)
+ (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)
+ 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)
+ (setq abbrev (ss-crm-default-abbrev name)))
+ (find-file (ss-crm--require-file))
+ (widen)
+ (goto-char (point-max))
+ (unless (bolp)
+ (insert "\n"))
+ (unless (looking-back "\n\n" nil)
+ (insert "\n"))
+ (insert "* " name "\n"
+ ":PROPERTIES:\n"
+ (ss-crm--property-line "ABBREV" abbrev)
+ (ss-crm--property-line "ALIASES" aliases)
+ (ss-crm--property-line "ROLE" role)
+ (ss-crm--property-line "TEAM" team)
+ (ss-crm--property-line "MANAGER" manager)
+ (ss-crm--property-line "ENGAGEMENT" engagement)
+ (ss-crm--property-line "SUPPLIER" supplier)
+ (ss-crm--property-line "LOCATION" location)
+ (ss-crm--property-line "CURRENT_FOCUS" current-focus)
+ ":END:\n\n"
+ "** Context\n\n"
+ "** TODOs\n")
+ (save-buffer)
+ (ss-crm-reload)
+ (ss-crm--open-entry (ss-crm--entry-by-name name))))
+
+(defun ss-crm--clear-installed-abbrevs ()
+ "Remove people-specific abbrevs from the current local table."
+ (mapatoms
+ (lambda (symbol)
+ (when (abbrev-get symbol :ss/crm)
+ (define-abbrev local-abbrev-table (symbol-name symbol) nil)))
+ local-abbrev-table))
+
+(defun ss-crm-install-abbrevs ()
+ "Install people abbrevs into the current buffer."
+ (unless (ss-crm--source-buffer-p)
+ (setq-local local-abbrev-table (copy-abbrev-table local-abbrev-table))
+ (ss-crm--clear-installed-abbrevs)
+ (dolist (entry (ss-crm-entries))
+ (let* ((name (ss-crm--entry-name entry))
+ (abbrev (ss-crm--entry-abbrev entry))
+ (abbrev-name
+ (if (or (null abbrev) (string-empty-p abbrev))
+ (ss-crm-default-abbrev name)
+ abbrev)))
+ (define-abbrev local-abbrev-table abbrev-name name)
+ (when-let ((abbrev-symbol
+ (abbrev-symbol abbrev-name local-abbrev-table)))
+ (abbrev-put abbrev-symbol :ss/crm t))))))
+
+(defun ss-crm-refresh-buffers ()
+ "Refresh people abbrevs in every prose buffer."
+ (dolist (buffer (buffer-list))
+ (with-current-buffer buffer
+ (when (and (bound-and-true-p abbrev-mode)
+ (derived-mode-p 'text-mode 'org-mode))
+ (ss-crm-install-abbrevs)))))
+
+(defun ss-crm-capf ()
+ "Return canonical people completions at a word boundary."
+ (let ((end (point)))
+ (save-excursion
+ (skip-syntax-backward "w_")
+ (let ((beg (point)))
+ (when (< beg end)
+ (let ((annotation
+ (lambda (candidate)
+ (when-let ((entry (ss-crm--entry-by-name candidate)))
+ (concat " " (ss-crm--summary entry)))))
+ (docsig
+ (lambda (candidate)
+ (when-let ((entry (ss-crm--entry-by-name candidate)))
+ (ss-crm--summary entry)))))
+ (list beg end #'ss-crm--completion-table
+ :exclusive 'no
+ :annotation-function annotation
+ :company-docsig docsig)))))))
+
+(defun ss-enable-people-capf ()
+ "Add `ss-crm-capf' once in prose buffers."
+ (unless (or (ss-crm--source-buffer-p)
+ (memq #'ss-crm-capf completion-at-point-functions))
+ (add-hook 'completion-at-point-functions #'ss-crm-capf nil t)))
+
+(defun ss-crm--maybe-overview-buffer ()
+ "Reset the people CRM buffer to overview when visiting it directly."
+ (when (and buffer-file-name
+ (string= (file-truename buffer-file-name)
+ (file-truename ss-crm-file)))
+ (widen)
+ (goto-char (point-min))
+ (org-overview)
+ (org-cycle-hide-drawers 'all)))
+
+(defun ss-crm-setup ()
+ "Initialize CRM hooks and helpers."
+ (dolist (hook '(text-mode-hook org-mode-hook))
+ (add-hook hook #'ss-enable-people-capf)
+ (add-hook hook #'ss-crm-install-abbrevs))
+ (add-hook 'find-file-hook #'ss-crm--track-buffer)
+ (add-hook 'find-file-hook #'ss-crm--maybe-overview-buffer))
+
+(provide 'ss-crm)
+
+;;; ss-crm.el ends here
diff --git a/lisp/ss-denote.el b/lisp/ss-denote.el
new file mode 100644
index 0000000..65b9b53
--- /dev/null
+++ b/lisp/ss-denote.el
@@ -0,0 +1,49 @@
+;;; ss-denote.el --- Denote configuration -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Durable note creation and Denote integration.
+
+;;; Code:
+
+(require 'ss-core)
+
+(declare-function denote-keywords-prompt "denote")
+(declare-function denote-org-capture "denote")
+(declare-function denote-org-capture-with-prompts "denote")
+
+(defun ss-denote-capture-in-directory (directory &optional keywords &rest prompts)
+ "Start a Denote Org capture in DIRECTORY with KEYWORDS and PROMPTS.
+If PROMPTS is empty, rely on `denote-prompts'."
+ (let* ((prompt-for-keywords (memq :keywords prompts))
+ (directory (ss-require-existing-directory directory))
+ (denote-directory directory)
+ (denote-use-directory (unless (memq :subdirectory prompts) directory))
+ (denote-use-keywords
+ (if prompt-for-keywords
+ (delete-dups (append keywords (denote-keywords-prompt)))
+ keywords)))
+ (if prompts
+ (denote-org-capture-with-prompts
+ (memq :title prompts)
+ nil
+ (memq :subdirectory prompts)
+ (memq :date prompts)
+ (memq :template prompts))
+ (denote-org-capture))))
+
+(defun ss-denote-setup ()
+ "Initialize Denote."
+ (use-package denote
+ :ensure t
+ :after org
+ :config
+ (setq denote-directory ss-org-directory
+ denote-known-keywords '("project")
+ denote-prompts '(title keywords)
+ denote-org-capture-specifiers "%?")
+ (denote-rename-buffer-mode 1)))
+
+(provide 'ss-denote)
+
+;;; ss-denote.el ends here
diff --git a/lisp/ss-gptel.el b/lisp/ss-gptel.el
new file mode 100644
index 0000000..bef5ce7
--- /dev/null
+++ b/lisp/ss-gptel.el
@@ -0,0 +1,21 @@
+;;; ss-gptel.el --- GPTel integration -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Experimental gptel setup using the GitHub Copilot backend.
+
+;;; Code:
+
+(require 'ss-core)
+
+(defun ss-gptel-setup ()
+ "Initialize gptel."
+ (if (require 'gptel nil t)
+ (setq gptel-default-mode 'org-mode
+ gptel-model 'gpt-4o
+ gptel-backend (gptel-make-gh-copilot "Copilot"))
+ (message "Skipping gptel setup because the package is unavailable.")))
+
+(provide 'ss-gptel)
+
+;;; ss-gptel.el ends here
diff --git a/lisp/ss-keys.el b/lisp/ss-keys.el
new file mode 100644
index 0000000..fe45572
--- /dev/null
+++ b/lisp/ss-keys.el
@@ -0,0 +1,55 @@
+;;; ss-keys.el --- Global keybindings -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Centralized global keybindings for enabled features.
+
+;;; Code:
+
+(require 'ss-core)
+
+(defun ss-keys-setup ()
+ "Install global keybindings for enabled features."
+ (when (ss-feature-enabled-p 'agenda)
+ (global-set-key (kbd "C-c a") #'ss-open-agenda))
+
+ (when (ss-feature-enabled-p 'capture)
+ (global-set-key (kbd "C-c c") #'org-capture))
+
+ (when (and (ss-feature-enabled-p 'denote)
+ (fboundp 'denote-open-or-create)
+ (fboundp 'denote-link))
+ (global-set-key (kbd "C-c n n") #'denote-open-or-create)
+ (global-set-key (kbd "C-c n l") #'denote-link))
+
+ (when (ss-feature-enabled-p 'org)
+ (global-set-key (kbd "C-c n M") #'ss-open-moc)
+ (global-set-key (kbd "C-c n d") #'ss-open-journal))
+
+ (when (ss-feature-enabled-p 'crm)
+ (global-set-key (kbd "C-c n E") #'ss-crm-report-by-engagement)
+ (global-set-key (kbd "C-c n f") #'ss-crm-find)
+ (global-set-key (kbd "C-c n i") #'ss-crm-insert-name)
+ (global-set-key (kbd "C-c n I") #'ss-crm-insert-summary)
+ (global-set-key (kbd "C-c n L") #'ss-crm-report-by-location)
+ (global-set-key (kbd "C-c n o") #'ss-crm-overview)
+ (global-set-key (kbd "C-c n O") #'ss-crm-report-by-role)
+ (global-set-key (kbd "C-c n p") #'ss-crm-open)
+ (global-set-key (kbd "C-c n P") #'ss-crm-add)
+ (global-set-key (kbd "C-c n R") #'ss-crm-report-by-manager)
+ (global-set-key (kbd "C-c n S") #'ss-crm-report-by-supplier)
+ (global-set-key (kbd "C-c n T") #'ss-crm-report-by-team))
+
+ (when (and (ss-feature-enabled-p 'gptel)
+ (fboundp 'gptel)
+ (fboundp 'gptel-send)
+ (fboundp 'gptel-rewrite)
+ (fboundp 'gptel-add))
+ (global-set-key (kbd "C-c n g") #'gptel)
+ (global-set-key (kbd "C-c n s") #'gptel-send)
+ (global-set-key (kbd "C-c n r") #'gptel-rewrite)
+ (global-set-key (kbd "C-c n a") #'gptel-add)))
+
+(provide 'ss-keys)
+
+;;; ss-keys.el ends here
diff --git a/lisp/ss-org.el b/lisp/ss-org.el
new file mode 100644
index 0000000..30956e9
--- /dev/null
+++ b/lisp/ss-org.el
@@ -0,0 +1,57 @@
+;;; ss-org.el --- Base Org configuration -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Shared Org setup and note-opening helpers.
+
+;;; Code:
+
+(require 'ss-core)
+
+(defun ss-open-journal ()
+ "Open `ss-journal-file', moving 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)
+ (goto-char (point-max)))))
+
+(defun ss-open-moc ()
+ "Open the central MOC note."
+ (interactive)
+ (find-file (ss-require-existing-file ss-moc-file)))
+
+(defun ss-org-setup ()
+ "Initialize base Org configuration."
+ (use-package org
+ :ensure nil
+ :config
+ (setq org-directory ss-org-directory
+ org-hide-emphasis-markers t
+ org-agenda-search-headline-for-time t)
+ (add-hook 'org-mode-hook
+ (lambda ()
+ (setq-local org-hide-emphasis-markers t)
+ (font-lock-flush)
+ (font-lock-ensure))))
+
+ (use-package git-auto-commit-mode
+ :ensure t
+ :pin melpa
+ :commands (git-auto-commit-mode)
+ :init
+ (setq gac-shell-and
+ (if (string-match-p "fish\\'" shell-file-name)
+ " ; and "
+ " && ")))
+
+ (add-hook 'emacs-startup-hook
+ (lambda ()
+ (find-file (ss-require-existing-file ss-moc-file)))))
+
+(provide 'ss-org)
+
+;;; ss-org.el ends here
diff --git a/lisp/ss-ui.el b/lisp/ss-ui.el
new file mode 100644
index 0000000..79f2a0d
--- /dev/null
+++ b/lisp/ss-ui.el
@@ -0,0 +1,135 @@
+;;; ss-ui.el --- Interface configuration -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Theme, frame, completion, and interface setup.
+
+;;; Code:
+
+(require 'ss-core)
+
+(defun ss-ui--configure-frames ()
+ "Apply GUI and terminal frame behavior."
+ (when (display-graphic-p)
+ (set-frame-size (selected-frame) 140 42)
+ (menu-bar-mode -1)
+ (tool-bar-mode -1)
+ (scroll-bar-mode -1)
+ (tooltip-mode -1)
+ (set-face-attribute
+ 'default nil
+ :family "JetBrains Mono" :height 140 :weight 'medium)
+ (set-face-attribute
+ 'fixed-pitch nil
+ :family "JetBrains Mono" :weight 'medium)
+ (set-face-attribute
+ 'fixed-pitch-serif nil
+ :family "JetBrains Mono" :weight 'medium))
+
+ (unless (display-graphic-p)
+ ;; Terminal menu bar removal stays on startup hook to avoid tty regressions.
+ (add-hook 'emacs-startup-hook (lambda () (menu-bar-mode -1)))))
+
+(defun ss-ui--setup-modeline ()
+ "Configure the modeline."
+ (use-package time
+ :ensure nil
+ :config
+ (setq display-time-24hr-format t
+ display-time-day-and-date t
+ display-time-default-load-average nil
+ calendar-latitude -37.7667
+ calendar-longitude 145.0
+ calendar-location-name "Melbourne, VIC")
+ (display-time-mode 1))
+
+ ;; Keep the theme's faces, but make the right edge alignment dynamic.
+ (setq-default mode-line-format
+ (list
+ " "
+ "%e"
+ mode-line-front-space
+ mode-line-mule-info
+ mode-line-client
+ mode-line-modified
+ mode-line-remote
+ mode-line-frame-identification
+ mode-line-buffer-identification
+ " "
+ mode-line-position
+ '(vc-mode vc-mode)
+ " "
+ mode-line-modes
+ '(:eval (propertize
+ " "
+ 'display
+ `((space :align-to
+ (- right
+ ,(+ 2 (string-width
+ (format-mode-line mode-line-misc-info))))))))
+ mode-line-misc-info
+ " "
+ mode-line-end-spaces)))
+
+(defun ss-ui--setup-completion ()
+ "Configure minibuffer and in-buffer completion."
+ (use-package vertico
+ :ensure t
+ :pin melpa
+ :init
+ (vertico-mode 1))
+
+ (use-package orderless
+ :ensure t
+ :pin melpa
+ :custom
+ (completion-styles '(orderless basic))
+ (completion-category-defaults nil)
+ (completion-category-overrides '((file (styles basic partial-completion)))))
+
+ (use-package marginalia
+ :ensure t
+ :pin melpa
+ :after vertico
+ :init
+ (marginalia-mode 1))
+
+ (use-package corfu
+ :ensure t
+ :pin gnu
+ :init
+ (global-corfu-mode 1)))
+
+(defun ss-ui-setup ()
+ "Initialize interface and completion behavior."
+ (setq inhibit-startup-message t
+ inhibit-startup-screen t
+ ring-bell-function 'ignore)
+
+ (ss-ui--configure-frames)
+
+ (use-package modus-themes
+ :ensure nil
+ :no-require t
+ :config
+ (load-theme 'modus-vivendi t))
+
+ (use-package dired
+ :ensure nil
+ :custom
+ (dired-use-ls-dired nil))
+
+ (line-number-mode 1)
+ (column-number-mode 1)
+ (show-paren-mode 1)
+
+ (setq-default indicate-empty-lines nil)
+ (setq-default indicate-buffer-boundaries nil)
+ (setq-default fringe-indicator-alist nil)
+
+ (ss-ui--setup-modeline)
+ (ss-ui--setup-completion))
+
+(provide 'ss-ui)
+
+;;; ss-ui.el ends here