path: root/init.el

;;; init.el --- minimal single-file Org workflow -*- lexical-binding: t; -*-

;;; Code:

(require 'abbrev)
(require 'org)
(require 'org-element)
(require 'seq)
(require 'subr-x)

(defvar org-agenda-mode-map)
(declare-function org-agenda-tree-to-indirect-buffer "org-agenda" (&optional arg))

;; --------------------------------------------------
;; Core paths
;; --------------------------------------------------

(setq org-directory (expand-file-name "~/org"))
(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
         (or load-file-name user-init-file default-directory))))

(defun ss-validate-org-layout ()
  "Warn once at startup when required Org workflow paths are missing."
  (let ((missing-paths nil))
    (unless (file-directory-p org-directory)
      (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
       (format
        "Missing required Org workflow paths: %s. Org workflow features may not work as expected."
        (mapconcat #'identity (nreverse missing-paths) ", "))
       :warning))))

(add-hook 'emacs-startup-hook #'ss-validate-org-layout)

;; --------------------------------------------------
;; Startup: agenda as modal view
;; --------------------------------------------------

(setq initial-buffer-choice
      (lambda ()
        (if (file-exists-p org-default-notes-file)
            (progn
              (require 'org-agenda)
              (org-agenda nil "h")
              (current-buffer))
          (get-buffer-create "*scratch*"))))

;; --------------------------------------------------
;; Package bootstrap
;; --------------------------------------------------

(require 'package)

(setq package-archives
      '(("gnu"    . "https://elpa.gnu.org/packages/")
        ("nongnu" . "https://elpa.nongnu.org/nongnu/")
        ("melpa"  . "https://melpa.org/packages/")))

(package-initialize)

(dolist (pkg '(vertico marginalia orderless consult corfu modus-themes olivetti))
  (unless (package-installed-p pkg)
    (unless package-archive-contents
      (package-refresh-contents))
    (package-install pkg)))

(require 'use-package)
(setq use-package-always-ensure t)

(use-package git-auto-commit-mode
  :pin melpa
  :commands (git-auto-commit-mode)
  :init
  (setq gac-shell-and
        (if (string-match-p "fish\\'" shell-file-name)
            " ; and "
          " && ")))

;; --------------------------------------------------
;; UI
;; --------------------------------------------------

(setq inhibit-startup-message t
      inhibit-startup-screen t
  auto-save-default nil
  backup-inhibited t
  compilation-ask-about-save nil
  echo-keystrokes 0.1
  enable-recursive-minibuffers t
  gc-cons-threshold (* 128 1024 1024)
  gc-cons-percentage 0.1
  mouse-wheel-follow-mouse t
  mouse-wheel-progressive-speed nil
  mouse-wheel-scroll-amount '(1 ((shift) . 1))
  process-adaptive-read-buffering nil
  read-process-output-max (* 4 1024 1024)
  ring-bell-function #'ignore
  scroll-conservatively 101
  scroll-margin 2
  scroll-preserve-screen-position t
  scroll-step 1
  require-final-newline t)

(which-key-mode)

(column-number-mode 1)
(show-paren-mode 1)
(global-auto-revert-mode 1)
(delete-selection-mode 1)
(defalias 'yes-or-no-p 'y-or-n-p)

(setq-default abbrev-mode t
      fill-column 80
      indent-tabs-mode nil
      indicate-empty-lines t
      sentence-end-double-space nil
      tab-width 2)

(when (file-readable-p abbrev-file-name)
  (quietly-read-abbrev-file))

(when (display-graphic-p)
  (tool-bar-mode -1)
  (scroll-bar-mode -1)
  ;; Reapply the startup frame font to the selected GUI frame.
  (let ((font (alist-get 'font default-frame-alist)))
    (when font
      (set-face-attribute 'default t :font font))))

(use-package modus-themes
  :config
  (load-theme 'modus-vivendi t))

(use-package olivetti
  :bind (("C-c z" . olivetti-mode))
  :config
  (setq olivetti-body-width 100))

;; --------------------------------------------------
;; Completion
;; --------------------------------------------------

(use-package vertico
  :init (vertico-mode 1))

(use-package marginalia
  :init (marginalia-mode 1))

(use-package orderless
  :init
  (setq completion-styles '(orderless basic)))

(use-package corfu
  :init
  (setq corfu-auto nil
        corfu-cycle t)
  (global-corfu-mode 1))

(use-package consult
  :bind (("C-s" . consult-line)
         ("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 "l") #'ss-crm-insert-org-link)
    (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-org-link ()
  "Insert an Org link to a CRM card."
  (interactive)
  (let* ((entry (or (ss-crm-select-entry "Insert person link: ")
                    (user-error "No person selected")))
         (name (ss-crm-entry-get entry :name)))
    (insert (org-link-make-string
             (format "file:%s::*%s"
                     (file-name-nondirectory ss-crm-file)
                     name)
             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))
    (let ((abbrevs-changed abbrevs-changed))
      (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 'visual-line-mode)
  (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
;; --------------------------------------------------

(use-package org
  :ensure nil
  :bind (("C-c c" . org-capture)
         ("C-c a" . org-agenda)
         ("C-c r" . org-refile))
  :init
  (setq org-agenda-files
        (list org-default-notes-file)
        org-agenda-custom-commands
        '(("h" "Home"
           ((agenda ""
                    ((org-agenda-overriding-header ":: THIS WEEK ::")))
            (todo "TODO"
                  ((org-agenda-overriding-header ":: TASKS ::")))
            (todo "CLARIFY"
                  ((org-agenda-overriding-header ":: OPEN QUESTIONS ::")))
            (tags "CATEGORY=\"inbox\"+LEVEL<3"
                  ((org-agenda-overriding-header ":: REFILE ::"))))))
        org-agenda-window-setup 'only-window
        org-startup-folded 'overview
        org-cycle-hide-drawer-startup t

        org-log-done 'time
        org-log-into-drawer "LOGBOOK"
        org-drawers '("PROPERTIES" "LOGBOOK")

        org-todo-keywords
        '((sequence "TODO(t)" "IN-PROGRESS(i@/!)" "WAIT(w@/!)" "|" "DONE(d@)" "OBE(o@)")
          (sequence "CLARIFY(c@)" "WAIT(w@/!)" "|" "ANSWERED(a@)"))

        org-todo-keyword-faces
        '(
          ("TODO" . (:foreground "GoldenRod" :weight bold))
          ("CLARIFY" . (:foreground "DeepPink" :weight bold))
          ("IN-PROGRESS" . (:foreground "Cyan" :weight bold))
          ("WAIT" . (:foreground "Red" :weight bold))
          ("DONE" . (:foreground "LimeGreen" :weight bold))
          ("ANSWERED" . (:foreground "LimeGreen" :weight bold)))

        org-use-speed-commands t
        org-refile-use-outline-path 'file
        org-outline-path-complete-in-steps nil
        org-refile-targets '((org-agenda-files :maxlevel . 2))
        org-id-link-to-org-use-id nil
        org-special-ctrl-a/e t
        org-insert-heading-respect-content t
        org-return-follows-link t
        org-hide-emphasis-markers t)

  :config
  ;; Keep capture modal in the current window.
  (add-to-list 'display-buffer-alist
           '("\\*Org Capture\\*" (display-buffer-reuse-window display-buffer-same-window)))

  (with-eval-after-load 'org-agenda
    (define-key org-agenda-mode-map (kbd "TAB")
                #'org-agenda-tree-to-indirect-buffer)
    (define-key org-agenda-mode-map (kbd "<tab>")
                #'org-agenda-tree-to-indirect-buffer))

  (add-hook 'org-capture-mode-hook
            (lambda () (delete-other-windows))))

;; --------------------------------------------------
;; Capture templates
;; --------------------------------------------------

(setq org-capture-templates
      `(("i" "Inbox" entry
         (file+headline ,org-default-notes-file "Inbox")
         "* %?\n:PROPERTIES:\n:CAPTURED: %U\n:END:\n%a\n")

        ("b" "Bookmark" entry
         (file+headline ,org-default-notes-file "Bookmarks")
         "* %?\n")

        ("t" "Task" entry
         (file+headline ,org-default-notes-file "Tasks")
         "* TODO %?\n:PROPERTIES:\n:CAPTURED: %U\n:END:\n%a\n")

        ("q" "Question" entry
         (file+headline ,org-default-notes-file "Questions")
         "* CLARIFY %?\n:PROPERTIES:\n:CAPTURED: %U\n:END:\n%a\n")

        ("m" "Meeting" entry
         (file+headline ,org-default-notes-file "Meetings")
         "* <%<%Y-%m-%d %a %H:%M>> %?\n")))

;; Load Custom state last so Customize values can override defaults above.
(load custom-file t)

(provide 'init)