diff options
| author | Szymon Szukalski <szymon@szymonszukalski.com> | 2026-04-13 10:12:26 +1000 |
|---|---|---|
| committer | Szymon Szukalski <szymon@szymonszukalski.com> | 2026-04-13 10:12:26 +1000 |
| commit | 281ca77b74eefa81578d9195ef78cd46a832d8c9 (patch) | |
| tree | 81749e1d141401a69fc4dee558c44c13285da641 | |
| parent | fea9aacb598d488a79a508906b72cdf7f3b6fe87 (diff) | |
Reintroduce CRM workflow in init.el
| -rw-r--r-- | README.org | 40 | ||||
| -rw-r--r-- | Workflow.org | 74 | ||||
| -rw-r--r-- | init.el | 773 |
3 files changed, 882 insertions, 5 deletions
@@ -32,6 +32,7 @@ The steady-state GC threshold is restored in =init.el=. - package bootstrap - UI defaults - completion +- CRM - Org configuration - capture templates @@ -87,8 +88,8 @@ The minibuffer completion setup is simple and modern: ** Org Workflow -The Org setup assumes a personal notes layout rooted at =~/org=, with the main workflow file at =~/org/obtf.org=. -At startup, the configuration validates those two required paths once and shows a soft warning if either is missing. +The Org setup assumes a personal notes layout rooted at =~/org=, with the main workflow file at =~/org/optus.org= and the CRM file at =~/org/crm.org=. +At startup, the configuration validates those required paths once and shows a soft warning if any are missing. Emacs still starts normally, but Org workflow features may not work as expected until the layout is in place. The workflow itself is organized around headings in that single notes file. @@ -104,9 +105,40 @@ Key behaviors include: - internal heading links instead of ID-based links - heading-respecting insertion and movement behavior +** CRM Workflow + +The CRM lives in =~/org/crm.org= as a flat list of level-1 person cards. +The implementation stays in =init.el= and restores the previous practical workflow without reintroducing the old multi-file layout. + +Restored capabilities include: + +- opening the CRM in overview mode +- finding and narrowing to an existing card +- adding a new card with field-aware prompts +- alias-aware minibuffer completion that inserts canonical names +- Marginalia annotations in person selection prompts +- CRM completion-at-point in text and Org writing buffers +- CRM-backed abbrevs in writing buffers, refreshed when the CRM changes +- grouped CRM reports by role, team, manager, relationship, engagement, supplier, and location + +The CRM card property model is: + +- =ABBREV= +- =ALIASES= +- =ROLE= +- =TEAM= +- =MANAGER= +- =RELATIONSHIP= +- =ENGAGEMENT= +- =SUPPLIER= +- =LOCATION= +- =CURRENT_FOCUS= + +New cards always use that property set in the drawer. + ** Capture Templates -The capture system stays low-friction and writes into named headings in the default notes file at =~/org/obtf.org=. +The capture system stays low-friction and writes into named headings in the default notes file at =~/org/optus.org=. Available templates: @@ -146,4 +178,4 @@ Custom-generated state loaded at the end of =init.el= so Customize values overri ** =Workflow.org= -Human-facing documentation for the workflows and keybindings enabled by this configuration. +Human-facing documentation for the workflows, CRM commands, and keybindings enabled by this configuration. diff --git a/Workflow.org b/Workflow.org index 25405b3..c4b2901 100644 --- a/Workflow.org +++ b/Workflow.org @@ -30,6 +30,14 @@ When an Org buffer opens: - drawers are hidden at startup - standard Org speed commands are enabled +** Required Files + +The main work note is =~/org/optus.org=. +The people CRM is =~/org/crm.org=. + +Startup validates =~/org=, =~/org/optus.org=, and =~/org/crm.org=. +If any of them are missing, Emacs still starts, but the workflow warns clearly so the missing file can be fixed deliberately. + * Home Agenda The Home agenda command key is =h= inside =org-agenda= custom commands. @@ -87,6 +95,67 @@ Use this for raw notes that still need sorting or refiling. - content: scheduled =TODO= - metadata: =CAPTURED= property +All capture templates target headings in =~/org/optus.org=. + +* CRM Workflow + +The CRM is a single Org file at =~/org/crm.org=. +Each person is stored as a level-1 heading with this property model: + +#+begin_src org +:PROPERTIES: +:ABBREV: +:ALIASES: +:ROLE: +:TEAM: +:MANAGER: +:RELATIONSHIP: +:ENGAGEMENT: +:SUPPLIER: +:LOCATION: +:CURRENT_FOCUS: +:END: +#+end_src + +The configured relationship completions are: + +- =Peer= +- =Direct Report= +- =Internal Stakeholder= +- =External Stakeholder= +- =Vendor= + +Role, team, relationship, engagement, supplier, and location prompts offer known values with completion. +Relationship also allows new freeform values when needed. +Manager completion is restricted to existing CRM names. + +** CRM Commands + +- =C-c p o= opens =~/org/crm.org= in overview mode +- =C-c p f= finds a person and narrows to that card +- =C-c p a= adds a new CRM card +- =C-c p i= inserts a canonical person name +- =C-c p s= inserts a compact person summary + +Reports are available through these commands: + +- =M-x ss-crm-report-by-role= +- =M-x ss-crm-report-by-team= +- =M-x ss-crm-report-by-manager= +- =M-x ss-crm-report-by-relationship= +- =M-x ss-crm-report-by-engagement= +- =M-x ss-crm-report-by-supplier= +- =M-x ss-crm-report-by-location= + +** CRM Completion + +CRM completion works in text and Org writing buffers through both abbrevs and completion-at-point. + +- CAPF inserts canonical names +- aliases help find the right person +- Marginalia annotations show compact CRM summaries in minibuffer selection +- CRM abbrevs are rebuilt from the current CRM data, and stale CRM abbrevs are cleared before reinstalling them + * Refile Workflow The configuration is built around using Org refile rather than custom routing. @@ -114,6 +183,11 @@ The intended loop is: | =C-c c= | =org-capture= | Open capture | | =C-c a= | =org-agenda= | Open agenda | | =C-c r= | =org-refile= | Refile current entry | +| =C-c p o= | =ss-crm-open= | Open CRM in overview mode | +| =C-c p f= | =ss-crm-find= | Find and focus a CRM card | +| =C-c p a= | =ss-crm-add= | Add a CRM card | +| =C-c p i= | =ss-crm-insert-name= | Insert a canonical CRM name | +| =C-c p s= | =ss-crm-insert-summary= | Insert a compact CRM summary | | =C-c z= | =olivetti-mode= | Toggle focused writing layout | ** Common Org Commands @@ -2,12 +2,20 @@ ;;; Code: +(require 'abbrev) +(require 'org) +(require 'org-element) +(require 'seq) +(require 'subr-x) + ;; -------------------------------------------------- ;; Core paths ;; -------------------------------------------------- (setq org-directory (expand-file-name "~/org")) -(setq org-default-notes-file (expand-file-name "obtf.org" org-directory)) +(setq org-default-notes-file (expand-file-name "optus.org" org-directory)) +(defconst ss-crm-file (expand-file-name "crm.org" org-directory) + "Root CRM file for people cards.") (setq custom-file (expand-file-name "custom.el" (file-name-directory @@ -20,6 +28,8 @@ (push org-directory missing-paths)) (unless (file-exists-p org-default-notes-file) (push org-default-notes-file missing-paths)) + (unless (file-exists-p ss-crm-file) + (push ss-crm-file missing-paths)) (when missing-paths (display-warning 'ss-org @@ -150,6 +160,767 @@ ("C-c o" . consult-outline))) ;; -------------------------------------------------- +;; CRM +;; -------------------------------------------------- + +(defconst ss-crm-relationship-options + '("Peer" + "Direct Report" + "Internal Stakeholder" + "External Stakeholder" + "Vendor") + "Built-in relationship values for CRM cards.") + +(defconst ss-crm-engagement-options + '("Perm" "SOW" "SOW Fixed Outcome" "NCS India") + "Built-in engagement values for CRM cards.") + +(defconst ss-crm-role-options + '("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") + "Built-in role values for CRM cards.") + +(defconst ss-crm-supplier-options + '("Accenture Song" + "INFOSYS TECHNOLOGIES LIMITED" + "MAKK Integrations Pty Ltd" + "NCSI Technologies India Private Limited" + "TECH MAHINDRA LTD") + "Built-in supplier values for CRM cards.") + +(defvar ss-crm--cache nil + "Cached CRM entries.") + +(defvar ss-crm--cache-mtime nil + "Modification time of the cached CRM file.") + +(defvar ss-crm-prefix-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "o") #'ss-crm-open) + (define-key map (kbd "f") #'ss-crm-find) + (define-key map (kbd "a") #'ss-crm-add) + (define-key map (kbd "i") #'ss-crm-insert-name) + (define-key map (kbd "s") #'ss-crm-insert-summary) + map) + "Keymap for CRM commands.") + +(keymap-global-set "C-c p" ss-crm-prefix-map) + +(defun ss-crm-file-available-p () + "Return non-nil when the CRM file exists." + (file-exists-p ss-crm-file)) + +(defun ss-crm-require-file () + "Return `ss-crm-file', signaling when it does not exist." + (unless (ss-crm-file-available-p) + (user-error "CRM file does not exist: %s" ss-crm-file)) + ss-crm-file) + +(defun ss-crm-source-buffer-p () + "Return non-nil when the current buffer visits `ss-crm-file'." + (and buffer-file-name + (string= (expand-file-name buffer-file-name) + (expand-file-name ss-crm-file)))) + +(defun ss-crm-entry-get (entry property) + "Return PROPERTY from ENTRY." + (plist-get entry property)) + +(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 comma-separated VALUE into trimmed strings." + (when (and value (not (string-empty-p value))) + (seq-filter + (lambda (item) + (not (string-empty-p item))) + (mapcar #'string-trim (split-string value "," t))))) + +(defun ss-crm-property-line (property value) + "Return an Org property line for PROPERTY and VALUE." + (format ":%s:%s\n" + property + (if (and value (not (string-empty-p value))) + (concat " " value) + ""))) + +(defun ss-crm-parse-entry-at-point (headline) + "Return the CRM card 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") + :relationship (org-entry-get nil "RELATIONSHIP") + :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 cards from `ss-crm-file'." + (with-temp-buffer + (insert-file-contents (ss-crm-require-file)) + (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-get left :name) + (ss-crm-entry-get right :name))))))) + +(defun ss-crm-entries () + "Return cached CRM cards, refreshing when the file changes." + (when (ss-crm-file-available-p) + (let* ((attributes (file-attributes ss-crm-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-entry-by-name (name) + "Return the CRM card whose canonical name is NAME." + (seq-find + (lambda (entry) + (string= name (ss-crm-entry-get entry :name))) + (ss-crm-entries))) + +(defun ss-crm-search-keys (entry) + "Return canonical and alias search keys for ENTRY." + (cons (ss-crm-entry-get entry :name) + (ss-crm-entry-get entry :aliases))) + +(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 names 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-summary (entry) + "Return a compact summary string for ENTRY." + (string-join + (seq-filter + (lambda (value) + (and value (not (string-empty-p value)))) + (list (ss-crm-entry-get entry :role) + (ss-crm-entry-get entry :team) + (ss-crm-entry-get entry :relationship) + (ss-crm-entry-get entry :engagement) + (ss-crm-entry-get entry :current-focus))) + " | ")) + +(defun ss-crm-display (entry) + "Return a compact display string for ENTRY." + (let ((summary (ss-crm-summary entry))) + (if (string-empty-p summary) + (ss-crm-entry-get entry :name) + (format "%s %s" (ss-crm-entry-get entry :name) summary)))) + +(defun ss-crm-completion-table (string pred action) + "Complete canonical CRM names while matching aliases via STRING." + (if (eq action 'metadata) + '(metadata (category . ss-crm-person)) + (complete-with-action + action + (mapcar + (lambda (entry) + (ss-crm-entry-get entry :name)) + (ss-crm-matching-entries string)) + string + pred))) + +(defun ss-crm-marginalia-annotator (candidate) + "Return a Marginalia annotation for CRM CANDIDATE." + (when-let ((entry (ss-crm-entry-by-name candidate))) + (concat " " (ss-crm-summary entry)))) + +(with-eval-after-load 'marginalia + (when (boundp 'marginalia-annotator-registry) + (add-to-list 'marginalia-annotator-registry + '(ss-crm-person ss-crm-marginalia-annotator nil nil)))) + +(defun ss-crm-select-entry (&optional prompt) + "Select a CRM card using PROMPT." + (let ((completion-extra-properties + '(:annotation-function ss-crm-marginalia-annotator))) + (when-let ((name (completing-read (or prompt "Person: ") + #'ss-crm-completion-table + nil + t))) + (ss-crm-entry-by-name name)))) + +(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-known-property-values (property) + "Return sorted unique non-empty values for PROPERTY from CRM cards." + (seq-sort + #'string< + (delete-dups + (seq-filter + (lambda (value) + (and (stringp value) + (not (string-empty-p (string-trim value))))) + (mapcar + (lambda (entry) + (ss-crm-entry-get entry property)) + (ss-crm-entries)))))) + +(defun ss-crm-known-person-names () + "Return sorted canonical CRM names." + (seq-sort + #'string< + (delete-dups + (seq-filter + (lambda (name) + (and (stringp name) + (not (string-empty-p (string-trim name))))) + (mapcar + (lambda (entry) + (ss-crm-entry-get entry :name)) + (ss-crm-entries)))))) + +(defun ss-crm-lookup-values (property &optional seeded) + "Return sorted unique PROPERTY values 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 PROMPT from CHOICES using options in PLIST." + (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-read-role () + "Read a CRM role." + (ss-crm-read-choice "Role: " + (ss-crm-lookup-values :role ss-crm-role-options) + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-team () + "Read a CRM team." + (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 from existing CRM names." + (ss-crm-read-choice "Manager: " + (ss-crm-known-person-names) + :allow-blank t + :require-match t)) + +(defun ss-crm-read-relationship () + "Read a CRM relationship value." + (ss-crm-read-choice "Relationship: " + (ss-crm-lookup-values :relationship + ss-crm-relationship-options) + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-engagement () + "Read a CRM engagement." + (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." + (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." + (ss-crm-read-choice "Location: " + (ss-crm-lookup-values :location) + :allow-blank t + :allow-new t)) + +(defun ss-crm-reload () + "Clear cached CRM data and refresh prose buffers." + (interactive) + (setq ss-crm--cache nil + ss-crm--cache-mtime nil) + (ss-crm-refresh-buffers) + (message "Reloaded CRM")) + +(defun ss-crm-open-entry (entry) + "Open `ss-crm-file' and narrow to ENTRY." + (find-file (ss-crm-require-file)) + (widen) + (let ((position (org-find-exact-headline-in-buffer + (ss-crm-entry-get entry :name)))) + (unless position + (user-error "No CRM card for %s" (ss-crm-entry-get entry :name))) + (goto-char position)) + (org-narrow-to-subtree) + (org-fold-show-subtree) + (org-fold-show-entry) + (goto-char (point-min))) + +(defun ss-crm-open () + "Open `ss-crm-file' in overview mode." + (interactive) + (find-file (ss-crm-require-file)) + (widen) + (goto-char (point-min)) + (org-overview) + (org-cycle-hide-drawers 'all)) + +(defun ss-crm-find () + "Select a CRM card and open it." + (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 CRM name at point." + (interactive) + (let ((entry (or (ss-crm-select-entry "Insert person name: ") + (user-error "No person selected")))) + (insert (ss-crm-entry-get entry :name)))) + +(defun ss-crm-insert-summary () + "Insert a compact CRM 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-add () + "Add a new CRM 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) + (relationship nil) + (engagement nil) + (supplier nil) + (location nil) + (current-focus nil)) + (when (ss-crm-entry-by-name name) + (user-error "A CRM card for %s already exists" name)) + (setq abbrev (ss-crm-read-string "Abbrev: " (ss-crm-default-abbrev name)) + aliases (ss-crm-read-string "Aliases (comma-separated, optional): ") + role (ss-crm-read-role) + team (ss-crm-read-team) + manager (ss-crm-read-manager) + relationship (ss-crm-read-relationship) + engagement (ss-crm-read-engagement) + supplier (ss-crm-read-supplier) + location (ss-crm-read-location) + current-focus (ss-crm-read-string "Current focus: ")) + (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 "RELATIONSHIP" relationship) + (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 CRM abbrevs from the current local abbrev 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 CRM abbrevs into the current prose buffer." + (when (and (not (ss-crm-source-buffer-p)) + (ss-crm-file-available-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-get entry :name)) + (abbrev (ss-crm-entry-get entry :abbrev)) + (abbrev-name + (if (and abbrev (not (string-empty-p abbrev))) + abbrev + (ss-crm-default-abbrev name)))) + (define-abbrev local-abbrev-table abbrev-name name) + (when-let ((symbol (abbrev-symbol abbrev-name local-abbrev-table))) + (abbrev-put symbol :ss/crm t)))))) + +(defun ss-crm-refresh-buffers () + "Refresh CRM abbrevs in text and Org buffers." + (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 a CRM completion-at-point source." + (when (ss-crm-file-available-p) + (let ((end (point))) + (save-excursion + (skip-syntax-backward "w_") + (let ((beg (point))) + (when (< beg end) + (list beg end #'ss-crm-completion-table + :exclusive 'no + :annotation-function #'ss-crm-marginalia-annotator + :company-docsig + (lambda (candidate) + (when-let ((entry (ss-crm-entry-by-name candidate))) + (ss-crm-summary entry)))))))))) + +(defun ss-crm-enable-capf () + "Install `ss-crm-capf' once in writing 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-track-buffer () + "Refresh CRM caches when `ss-crm-file' is saved." + (when (ss-crm-source-buffer-p) + (add-hook 'after-save-hook #'ss-crm-reload nil t))) + +(defun ss-crm-overview-buffer () + "Reset the CRM buffer to overview when visiting it directly." + (when (ss-crm-source-buffer-p) + (widen) + (goto-char (point-min)) + (org-overview) + (org-cycle-hide-drawers 'all))) + +(defun ss-crm-report-buffer (title property) + "Render a CRM report titled TITLE grouped by PROPERTY." + (let ((groups + (seq-group-by + (lambda (entry) + (let ((value (ss-crm-entry-get entry property))) + (if (string-empty-p (or value "")) + "(none)" + value))) + (ss-crm-entries)))) + (setq groups + (sort groups + (lambda (left right) + (string< (car left) (car right))))) + (with-current-buffer (get-buffer-create "*CRM 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-get left :name) + (ss-crm-entry-get right :name))))) + (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 CRM cards grouped by role." + (interactive) + (ss-crm-report-buffer "CRM by role" :role)) + +(defun ss-crm-report-by-team () + "Show CRM cards grouped by team." + (interactive) + (ss-crm-report-buffer "CRM by team" :team)) + +(defun ss-crm-report-by-manager () + "Show CRM cards grouped by manager." + (interactive) + (ss-crm-report-buffer "CRM by manager" :manager)) + +(defun ss-crm-report-by-relationship () + "Show CRM cards grouped by relationship." + (interactive) + (ss-crm-report-buffer "CRM by relationship" :relationship)) + +(defun ss-crm-report-by-engagement () + "Show CRM cards grouped by engagement." + (interactive) + (ss-crm-report-buffer "CRM by engagement" :engagement)) + +(defun ss-crm-report-by-supplier () + "Show CRM cards grouped by supplier." + (interactive) + (ss-crm-report-buffer "CRM by supplier" :supplier)) + +(defun ss-crm-report-by-location () + "Show CRM cards grouped by location." + (interactive) + (ss-crm-report-buffer "CRM by location" :location)) + +(dolist (hook '(text-mode-hook org-mode-hook)) + (add-hook hook #'ss-crm-enable-capf) + (add-hook hook #'ss-crm-install-abbrevs)) + +(add-hook 'find-file-hook #'ss-crm-track-buffer) +(add-hook 'find-file-hook #'ss-crm-overview-buffer) + +;; -------------------------------------------------- ;; Org ;; -------------------------------------------------- |
