diff options
| author | Szymon Szukalski <szymon@szymonszukalski.com> | 2026-04-09 10:53:27 +1000 |
|---|---|---|
| committer | Szymon Szukalski <szymon@szymonszukalski.com> | 2026-04-09 10:53:27 +1000 |
| commit | bc75732b9d37b77945a977ee9f7892cf6efc79c3 (patch) | |
| tree | 4d9273ccc12c29eccc44fdc12372bea047414353 /lisp | |
| parent | 12a5b1464bb919ba23f2aa6c22d44de81e382151 (diff) | |
Refactor Emacs config into modules
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ss-agenda.el | 40 | ||||
| -rw-r--r-- | lisp/ss-capture.el | 175 | ||||
| -rw-r--r-- | lisp/ss-core.el | 147 | ||||
| -rw-r--r-- | lisp/ss-crm.el | 559 | ||||
| -rw-r--r-- | lisp/ss-denote.el | 49 | ||||
| -rw-r--r-- | lisp/ss-gptel.el | 21 | ||||
| -rw-r--r-- | lisp/ss-keys.el | 55 | ||||
| -rw-r--r-- | lisp/ss-org.el | 57 | ||||
| -rw-r--r-- | lisp/ss-ui.el | 135 |
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 |
