path: root/lisp/ss-crm.el

;;; 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-seeded-roles
  '("Account Manager"
    "AD Platform Manager"
    "AD, Billing & Catalogue, Engineering"
    "AD, Frontend Engineering"
    "AD, IT Core & MarTech"
    "AD, Mobile Engineering"
    "AD, Platform Engineering"
    "AD, Portfolio Delivery Products and API Management"
    "AD, Portfolio Mgmt. Customer Engagement"
    "AD, Quality Engineering"
    "AD, Tech Product Owner"
    "AD, Technical Delivery"
    "AD, Technical Platform Management"
    "AD, Technical Platform Manager, API"
    "AD, Technical Platform Manager, Catalog"
    "AD, Technical Platform Manager, Order and Quote"
    "AD, Technical Product Management"
    "Agile Scrum Master"
    "Analyst Programmer - Senior"
    "Android Developer"
    "Android Developer - Senior"
    "Application Development Lead"
    "Architect"
    "Associate  Engineer"
    "Associate Engineer"
    "Associate Engineer, Frontend"
    "Associate Engineer, Platform Engineering"
    "Associate Software Engineer"
    "Billing Executive"
    "Business Analyst"
    "Business Analyst - Senior"
    "Business Development Manager"
    "Business Intelligence Analyst"
    "Business Program Manager"
    "Cloud Engineer"
    "Consultant"
    "CRM Developer"
    "Data Analyst"
    "Data Analyst - Senior"
    "Delivery Lead"
    "Delivery Manager"
    "Demand Lead"
    "Deployment Manager"
    "Development Manager"
    "DevOps Engineer"
    "DevOps Engineer - Senior"
    "Digital Delivery Manager"
    "Director Customer Engagement"
    "Director Sales Technology"
    "Director, Billing and Charging"
    "Director, Delivery Portfolio Billing and Charging"
    "Director, Digital Engineering"
    "Director, Portfolio Mgmt."
    "Director, SF Comms Technical Platform"
    "Director, SSF Core & Commerce"
    "Engineer"
    "Engineer - Junior"
    "Engineer - Senior"
    "Engineer, Platform Engineering"
    "Engineer, Salesforce"
    "Engineering Manager"
    "Engineering Manager, Mobile"
    "Engineering Manager, Platform Engineering"
    "Executive Assistant"
    "Integration Lead"
    "Integration Solution Designer"
    "Integration Technical Specialist"
    "iOS Developer"
    "iOS Developer - Senior"
    "IT Business Partner"
    "Lead Consultant"
    "Lead Developer"
    "Manager, Release Engineer"
    "Manager, Release Train Engineer"
    "Mobile API Developer"
    "Optus Tech Graduate"
    "Portfolio Manager"
    "Process Analyst - Senior"
    "Product Manager"
    "Product Solution Designer"
    "Program Analyst"
    "Program Director"
    "Program Manager"
    "Project Architect"
    "Project Coordinator"
    "Project Manager"
    "Quality Assurance Analyst"
    "Quality Engineering Professional"
    "Release Coordinator"
    "Release Manager"
    "Salesforce Administrator"
    "Salesforce Developer (Heroku, Lightning, etc)"
    "Salesforce Marketing Cloud Architect"
    "Salesforce Operations Manager"
    "Scrum Master"
    "SD, Engineering Capability"
    "SD, Marketing Technology"
    "SD, Technical Products"
    "Senior Business Analyst"
    "Senior Delivery Manager"
    "Senior Delivery Manger"
    "Senior Digital Technical Producer"
    "Senior E2E Business Analyst Lead"
    "Senior Engineer"
    "Senior Engineer, API Engineering"
    "Senior Engineer, Billing & Catalogue"
    "Senior Engineer, Platform Engineering"
    "Senior Engineer, Salesforce"
    "Senior Front End Developer"
    "Senior Integration Solution Designer"
    "Senior Quality Engineering Professional"
    "Senior Salesforce Administrator"
    "Senior Salesforce Consultant"
    "Senior Salesforce Functional Consultant"
    "Senior Salesforce Operations Lead"
    "Senior Software Developer"
    "Senior Software Engineer"
    "Senior Software Engineer, Frontend"
    "Senior Software Engineer, Mobile"
    "Senior Solution Designer"
    "Snr Dir, Delivery & Platform Manager"
    "Snr Director, Portfolio Mgmt. & Delivery"
    "Software Developer"
    "Software Developer - Junior"
    "Software Developer - Senior"
    "Software Engineer"
    "Software Engineer, Frontend"
    "Software Engineer, Mobile"
    "Solution Architect"
    "Solution Designer"
    "Solution Designer - Senior"
    "Staff Engineer"
    "Support Analyst"
    "System Analyst"
    "System Engineer"
    "Technical Lead"
    "Technical Platform Manager"
    "Technical Platform Manager, Billing and Charging"
    "Technical Product Manager"
    "Technical Project Manager - Senior"
    "Technical Specialist - Senior"
    "Technology Delivery Analyst"
    "Test Analyst"
    "Test Lead"
    "Test Manager"
    "VP, EB IT")
  "Seeded role values derived from the historic roles CSV.")

(defconst ss-crm-supplier-options
  '("Accenture Song"
    "INFOSYS TECHNOLOGIES LIMITED"
    "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-known-property-values (property)
  "Return sorted unique non-empty values for PROPERTY from CRM entries."
  (let ((key (intern (concat ":" (downcase property)))))
    (seq-sort
     #'string<
     (delete-dups
      (seq-filter
       (lambda (value)
         (and (stringp value)
              (not (string-empty-p (string-trim value)))))
       (mapcar
        (lambda (entry)
          (plist-get entry key))
        (ss-crm-entries)))))))

(defun ss-crm-known-person-names ()
  "Return sorted top-level person names from CRM entries."
  (seq-sort
   #'string<
   (delete-dups
    (seq-filter
     (lambda (name)
       (and (stringp name)
            (not (string-empty-p (string-trim name)))))
     (mapcar #'ss-crm--entry-name (ss-crm-entries))))))

(defun ss-crm-lookup-values (property &optional seeded)
  "Return sorted unique values for PROPERTY merged with SEEDED values."
  (seq-sort
   #'string<
   (delete-dups
    (seq-filter
     (lambda (value)
       (and (stringp value)
            (not (string-empty-p (string-trim value)))))
     (append seeded
             (ss-crm-known-property-values property))))))

(defun ss-crm--read-choice-warning (prompt similar)
  "Warn that PROMPT value is similar to existing SIMILAR."
  (display-warning
   'ss-crm
   (format "%sA similar existing value already exists: %s"
           prompt
           similar)
   :warning))

(defun ss-crm-read-choice (prompt choices &rest plist)
  "Read a value for PROMPT from CHOICES using options in PLIST.
Supported keywords are :allow-blank, :allow-new, and :require-match."
  (let* ((allow-blank (plist-get plist :allow-blank))
         (allow-new (plist-get plist :allow-new))
         (require-match (plist-get plist :require-match))
         (blank-choice "[none]")
         (collection (if allow-blank
                         (cons blank-choice choices)
                       choices))
         (completion-require-match (if allow-new nil require-match)))
    (catch 'done
      (while t
        (let* ((value (completing-read prompt collection nil completion-require-match))
               (existing
                (seq-find
                 (lambda (choice)
                   (string= value choice))
                 choices)))
          (cond
           ((or (string-empty-p value)
                (and allow-blank
                     (string= value blank-choice)))
            (throw 'done nil))
           (existing
            (throw 'done existing))
           ((not allow-new)
            (user-error "Please choose an existing value"))
           (t
            (when-let ((similar
                        (seq-find
                         (lambda (choice)
                           (and (not (string= value choice))
                                (string-equal (downcase value)
                                              (downcase choice))))
                         choices)))
              (ss-crm--read-choice-warning prompt similar))
            (when (yes-or-no-p (format "Create new value `%s'? " value))
              (throw 'done value)))))))))

(defun ss-crm--completion-values (extractor &optional include-empty)
  "Return sorted unique values using EXTRACTOR.
When INCLUDE-EMPTY is non-nil, keep empty values."
  (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-read-role ()
  "Read a CRM role using seeded and known role values."
  (ss-crm-read-choice "Role: "
                      (ss-crm-lookup-values "ROLE" ss-crm-seeded-roles)
                      :allow-blank t
                      :allow-new t))

(defun ss-crm-read-team ()
  "Read a CRM team using known team values."
  (ss-crm-read-choice "Team: "
                      (ss-crm-lookup-values "TEAM")
                      :allow-blank t
                      :allow-new t))

(defun ss-crm-read-manager ()
  "Read a CRM manager using known person names."
  (ss-crm-read-choice "Manager: "
                      (ss-crm-known-person-names)
                      :allow-blank t
                      :require-match t))

(defun ss-crm-read-engagement ()
  "Read a CRM engagement using seeded and known engagement values."
  (ss-crm-read-choice "Engagement: "
                      (ss-crm-lookup-values "ENGAGEMENT"
                                            ss-crm-engagement-options)
                      :allow-blank t
                      :allow-new t))

(defun ss-crm-read-supplier ()
  "Read a CRM supplier using seeded and known supplier values."
  (ss-crm-read-choice "Supplier: "
                      (ss-crm-lookup-values "SUPPLIER"
                                            ss-crm-supplier-options)
                      :allow-blank t
                      :allow-new t))

(defun ss-crm-read-location ()
  "Read a CRM location using known location values."
  (ss-crm-read-choice "Location: "
                      (ss-crm-lookup-values "LOCATION")
                      :allow-blank t
                      :allow-new t))

(defun ss-crm-add ()
  "Add a new compact person card to `ss-crm-file'."
  (interactive)
  (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 (ss-crm-read-role)
          team (ss-crm-read-team)
          manager (ss-crm-read-manager)
          engagement (ss-crm-read-engagement)
          supplier (ss-crm-read-supplier)
          location (ss-crm-read-location)
          current-focus (ss-crm-read-required-string "Current focus: "))
    (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