diff options
Diffstat (limited to 'config.org')
| -rw-r--r-- | config.org | 816 |
1 files changed, 356 insertions, 460 deletions
@@ -279,309 +279,284 @@ annotations. * Name shortcuts -The name workflow uses fixed abbrev shortcuts for deterministic one-shot -expansions and a structured people roster for searchable metadata. Abbrev -mutates the buffer immediately, while Corfu-backed CAPF completion only -proposes candidates and annotations. The roster file holds the name, role, -engagement, and other lookup fields used by manager-facing searches and -reports. +The people workflow is a lightweight rolodex backed by a single =~/org/people.org= +file. Each top-level heading is a compact card with properties for lookup, +completion, reports, and abbrevs. Abbrev remains the fast path for names you +type all the time, while CAPF plus Corfu remains the discovery path. The +machine-facing layer only reads heading text and properties; the =Context= and +=TODOs= sections stay human-facing notes. #+begin_src emacs-lisp - (defconst ss/name-dictionary-file - (expand-file-name "name-dictionary.el" user-emacs-directory) - "Persistent source of truth for name abbrevs and CAPF candidates.") - - (defvar ss/name-dictionary-entries nil - "Persistent name entries used by abbrev and CAPF.") - - (when (file-exists-p ss/name-dictionary-file) - (load ss/name-dictionary-file nil t)) - (require 'seq) (require 'subr-x) + (require 'marginalia nil t) - (defun ss/name-dictionary--entry-name (entry) - "Return the canonical name in ENTRY." - (plist-get entry :name)) - - (defun ss/name-dictionary--entry-abbrev (entry) - "Return the abbrev trigger in ENTRY." - (plist-get entry :abbrev)) - - (defun ss/name-dictionary--entry-aliases (entry) - "Return alias candidates in ENTRY." - (plist-get entry :aliases)) - - (defun ss/name-dictionary-default-abbrev (name) - "Suggest a short 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)))) + (defconst ss/people-file + (expand-file-name "people.org" "~/org/") + "Single source of truth for the lightweight people rolodex.") - (defun ss/name-dictionary-read-aliases (prompt) - "Read PROMPT and return a cleaned alias list." - (let ((aliases (mapcar #'string-trim (split-string (read-string prompt) "," t)))) - (seq-filter (lambda (string) (not (string-empty-p string))) aliases))) + (defconst ss/people-engagement-values + '("permanent" "contractor" "other") + "Allowed engagement values for people cards.") - (defvar ss/people-roster--cache nil - "Cached roster entries loaded from `ss/people-roster-file'.") + (defconst ss/people-relationship-values + '("direct-report" "stakeholder" "peer" "skip" "other") + "Allowed relationship values for people cards.") - (defvar ss/people-roster--cache-mtime nil - "Modification time of the cached roster entries.") + (defvar ss/people--cache nil + "Cached rolodex entries loaded from `ss/people-file'.") - (defun ss/people-roster--org-property-line (key value) - "Return an Org property line for KEY and VALUE, or the empty string." - (if (and value (not (string-empty-p value))) - (format ":%s: %s\n" key value) - "")) + (defvar ss/people--cache-mtime nil + "Modification time of the cached rolodex entries.") - (defun ss/people-roster--entry-name (entry) + (defun ss/people--entry-name (entry) "Return the canonical name in ENTRY." (plist-get entry :name)) - (defun ss/people-roster--entry-abbrev (entry) + (defun ss/people--entry-abbrev (entry) "Return the abbrev trigger in ENTRY." (plist-get entry :abbrev)) - (defun ss/people-roster--entry-aliases (entry) + (defun ss/people--entry-aliases (entry) "Return alias variants in ENTRY." (plist-get entry :aliases)) - (defun ss/people-roster--entry-role (entry) + (defun ss/people--entry-role (entry) "Return the role in ENTRY." (plist-get entry :role)) - (defun ss/people-roster--entry-engagement (entry) - "Return the engagement type in ENTRY." - (plist-get entry :engagement)) + (defun ss/people--entry-location (entry) + "Return the location in ENTRY." + (plist-get entry :location)) - (defun ss/people-roster--entry-team (entry) - "Return the team in ENTRY." - (plist-get entry :team)) + (defun ss/people--entry-engagement (entry) + "Return the engagement in ENTRY." + (plist-get entry :engagement)) - (defun ss/people-roster--entry-employee-time (entry) - "Return the raw employee time in ENTRY." - (plist-get entry :employee-time)) + (defun ss/people--entry-relationship (entry) + "Return the relationship in ENTRY." + (plist-get entry :relationship)) - (defun ss/people-roster--entry-manager (entry) - "Return the manager in ENTRY." - (plist-get entry :manager)) + (defun ss/people--entry-current-focus (entry) + "Return the current focus in ENTRY." + (plist-get entry :current-focus)) - (defun ss/people-roster--entry-email (entry) - "Return the email address in ENTRY." - (plist-get entry :email)) + (defun ss/people--entry-team (entry) + "Return the team in ENTRY." + (plist-get entry :team)) - (defun ss/people-roster--entry-location (entry) - "Return the location in ENTRY." - (plist-get entry :location)) + (defun ss/people-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/people-roster--split-values (value) - "Split VALUE on commas or semicolons and trim each item." + (defun ss/people--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))))) + (mapcar #'string-trim (split-string value "," t))))) - (defun ss/people-roster--entry-summary (entry) - "Return a one-line summary for ENTRY." + (defun ss/people--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/people-roster--entry-role entry) - (ss/people-roster--entry-engagement entry) - (ss/people-roster--entry-team entry) - (ss/people-roster--entry-manager entry))) + (list (ss/people--entry-role entry) + (ss/people--entry-location entry) + (ss/people--entry-engagement entry) + (ss/people--entry-current-focus entry))) " | ")) - (defun ss/people-roster-entry-display (entry) - "Return a searchable display string for ENTRY." - (let ((name (ss/people-roster--entry-name entry)) - (summary (ss/people-roster--entry-summary entry))) + (defun ss/people--display (entry) + "Return the compact display string for ENTRY." + (let ((summary (ss/people--summary entry))) (if (string-empty-p summary) - name - (format "%s | %s" name summary)))) + (ss/people--entry-name entry) + (format "%s %s" (ss/people--entry-name entry) summary)))) + + (defun ss/people--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/people-roster--entry-by-name (name) - "Return the roster entry matching NAME or one of its aliases." + (defun ss/people--ensure-file () + "Create `ss/people-file' when it is missing." + (make-directory (file-name-directory ss/people-file) t) + (unless (file-exists-p ss/people-file) + (with-temp-file ss/people-file + (insert "#+title: People\n\n"))) + ss/people-file) + + (defun ss/people-entries () + "Return top-level people cards from `ss/people-file'." + (let* ((file (ss/people--ensure-file)) + (attributes (file-attributes file)) + (mtime (file-attribute-modification-time attributes))) + (unless (and ss/people--cache + (equal mtime ss/people--cache-mtime)) + (setq ss/people--cache + (with-temp-buffer + (insert-file-contents file) + (org-mode) + (goto-char (point-min)) + (let (entries) + (org-element-map (org-element-parse-buffer) 'headline + (lambda (headline) + (when (= 1 (org-element-property :level headline)) + (goto-char (org-element-property :begin headline)) + (push (list :name (org-element-property :raw-value headline) + :abbrev (org-entry-get nil "ABBREV") + :aliases (ss/people--split-values + (org-entry-get nil "ALIASES")) + :role (org-entry-get nil "ROLE") + :location (org-entry-get nil "LOCATION") + :engagement (org-entry-get nil "ENGAGEMENT") + :relationship (org-entry-get nil "RELATIONSHIP") + :current-focus (org-entry-get nil "CURRENT_FOCUS") + :team (org-entry-get nil "TEAM")) + entries)))) + (sort entries + (lambda (left right) + (string< (ss/people--entry-name left) + (ss/people--entry-name right))))) + ss/people--cache-mtime mtime)) + ss/people--cache)) + + (defun ss/people-reload () + "Reload the people cache and refresh prose buffers." + (interactive) + (setq ss/people--cache nil + ss/people--cache-mtime nil) + (ss/people-refresh-buffers) + (message "Reloaded people rolodex")) + + (defun ss/people--entry-by-name (name) + "Return the people entry matching canonical NAME." (seq-find (lambda (entry) - (or (string= name (ss/people-roster--entry-name entry)) - (member name (ss/people-roster--entry-aliases entry)))) - (ss/people-roster-entries))) - - (defun ss/people-roster--ensure-file () - "Create the roster file when it is missing." - (make-directory (file-name-directory ss/people-roster-file) t) - (unless (file-exists-p ss/people-roster-file) - (with-temp-file ss/people-roster-file - (insert "#+title: People roster\n\n"))) - ss/people-roster-file) - - (defun ss/people-roster-entries () - "Return the structured roster entries from `ss/people-roster-file'." - (let* ((attributes (and (file-exists-p ss/people-roster-file) - (file-attributes ss/people-roster-file))) - (mtime (and attributes (file-attribute-modification-time attributes)))) - (unless (and ss/people-roster--cache - (equal mtime ss/people-roster--cache-mtime)) - (setq ss/people-roster--cache - (when (file-exists-p ss/people-roster-file) - (with-temp-buffer - (insert-file-contents ss/people-roster-file) - (org-mode) - (goto-char (point-min)) - (let (entries) - (org-element-map (org-element-parse-buffer) 'headline - (lambda (headline) - (goto-char (org-element-property :begin headline)) - (let ((name (or (org-entry-get nil "NAME") - (org-element-property :raw-value headline)))) - (push (list :name name - :abbrev (org-entry-get nil "ABBREV") - :aliases (ss/people-roster--split-values - (org-entry-get nil "ALIASES")) - :role (org-entry-get nil "ROLE") - :employee-time (org-entry-get nil "EMPLOYEE-TIME") - :engagement (org-entry-get nil "ENGAGEMENT") - :team (org-entry-get nil "TEAM") - :manager (org-entry-get nil "MANAGER") - :email (org-entry-get nil "EMAIL") - :location (org-entry-get nil "LOCATION")) - entries)))) - (nreverse entries)))) - ss/people-roster--cache-mtime mtime)) - ss/people-roster--cache)) - - (defun ss/people-roster-reload () - "Reload the roster cache and refresh prose buffers." + (string= name (ss/people--entry-name entry))) + (ss/people-entries))) + + (defun ss/people--search-keys (entry) + "Return canonical and alias search keys for ENTRY." + (cons (ss/people--entry-name entry) + (ss/people--entry-aliases entry))) + + (defun ss/people--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/people--search-keys entry)))) + (seq-every-p + (lambda (part) + (seq-some (lambda (key) + (string-match-p (regexp-quote part) key)) + keys)) + parts))) + + (defun ss/people--matching-entries (query) + "Return entries whose canonical name or aliases match QUERY." + (let ((entries (ss/people-entries))) + (if (string-empty-p (string-trim query)) + entries + (seq-filter (lambda (entry) + (ss/people--match-p query entry)) + entries)))) + + (defun ss/people--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/people--entry-name (ss/people--matching-entries string)) + string + pred))) + + (defun ss/people-marginalia-annotator (candidate) + "Return a Marginalia annotation for person CANDIDATE." + (when-let ((entry (ss/people--entry-by-name candidate))) + (concat " " (ss/people--summary entry)))) + + (with-eval-after-load 'marginalia + (add-to-list 'marginalia-annotator-registry + '(ss-person ss/people-marginalia-annotator builtin none))) + + (defun ss/people-select-entry (&optional prompt) + "Select a person entry using PROMPT." + (let ((completion-extra-properties '(:annotation-function ss/people-marginalia-annotator))) + (ss/people--entry-by-name + (completing-read (or prompt "Person: ") + #'ss/people--completion-table + nil + t)))) + + (defun ss/people-overview () + "Show `ss/people-file' in overview mode." (interactive) - (setq ss/people-roster--cache nil - ss/people-roster--cache-mtime nil) - (ss/name-dictionary-refresh-buffers) - (message "Reloaded people roster")) - - (defun ss/people-roster-canonical-names () - "Return the canonical names from the roster." - (mapcar #'ss/people-roster--entry-name (ss/people-roster-entries))) - - (defun ss/people-roster-completion-candidates () - "Return roster names and aliases for completion." - (delete-dups - (apply #'append - (mapcar (lambda (entry) - (cons (ss/people-roster--entry-name entry) - (ss/people-roster--entry-aliases entry))) - (ss/people-roster-entries))))) - - (defun ss/people-roster-entry-display-candidates () - "Return searchable completion candidates for the roster." - (mapcar (lambda (entry) - (cons (ss/people-roster-entry-display entry) entry)) - (ss/people-roster-entries))) - - (defun ss/people-roster-select-entry (&optional prompt) - "Select a roster ENTRY using PROMPT." - (let* ((candidates (ss/people-roster-entry-display-candidates)) - (choice (completing-read (or prompt "Person: ") candidates nil t))) - (or (cdr (assoc choice candidates)) - (user-error "No roster entry selected")))) - - (defun ss/people-roster-open () - "Open the roster file." + (unless (and buffer-file-name + (string= (file-truename buffer-file-name) + (file-truename ss/people-file))) + (find-file (ss/people--ensure-file))) + (widen) + (goto-char (point-min)) + (org-overview) + (org-cycle-hide-drawers 'all)) + + (defun ss/people-open () + "Open the rolodex in overview mode." (interactive) - (find-file (ss/people-roster--ensure-file))) + (ss/people-overview)) - (defun ss/people-roster-track-buffer () - "Refresh roster caches when the roster file is saved." + (defun ss/people--track-buffer () + "Refresh rolodex caches when `ss/people-file' is saved." (when (and buffer-file-name - (string= buffer-file-name ss/people-roster-file)) - (add-hook 'after-save-hook #'ss/people-roster-reload nil t))) + (string= (file-truename buffer-file-name) + (file-truename ss/people-file))) + (add-hook 'after-save-hook #'ss/people-reload nil t))) - (defun ss/people-roster-open-entry (entry) - "Open the roster file, jump to ENTRY, and narrow to its subtree." - (find-file (ss/people-roster--ensure-file)) + (defun ss/people--open-entry (entry) + "Open people.org and narrow to ENTRY." + (find-file (ss/people--ensure-file)) (widen) (let ((position (org-find-exact-headline-in-buffer - (ss/people-roster--entry-name entry)))) + (ss/people--entry-name entry)))) (unless position - (user-error "No roster heading for %s" (ss/people-roster--entry-name entry))) + (user-error "No people card for %s" (ss/people--entry-name entry))) (goto-char position)) (org-narrow-to-subtree) - (org-show-subtree) - (goto-char (point-max))) + (org-fold-show-subtree) + (org-show-entry) + (goto-char (point-min))) (defun ss/people-find () - "Find and open a roster entry." + "Find a person and open that card." (interactive) - (ss/people-roster-open-entry - (ss/people-roster-select-entry "Find person: "))) + (ss/people--open-entry + (or (ss/people-select-entry "Find person: ") + (user-error "No person selected")))) - (defun ss/people-roster-insert-summary () - "Insert a compact roster summary at point." + (defun ss/people-insert-name () + "Insert a canonical person name at point." (interactive) - (let ((entry (ss/people-roster-select-entry "Insert person: "))) - (insert (ss/people-roster-entry-display entry)))) - - (defvar ss/people-roster--capture-name nil - "Most recent roster name captured through `ss/people-roster-capture-name'.") + (let ((entry (or (ss/people-select-entry "Insert person name: ") + (user-error "No person selected")))) + (insert (ss/people--entry-name entry)))) - (defun ss/people-roster-read-string (prompt &optional default) - "Read PROMPT and trim the result." - (string-trim (read-string prompt nil nil default))) + (defun ss/people-insert-summary () + "Insert a compact person summary at point." + (interactive) + (let ((entry (or (ss/people-select-entry "Insert person summary: ") + (user-error "No person selected")))) + (insert (ss/people--display entry)))) - (defun ss/people-roster-capture-name () - "Read the canonical roster name." - (or ss/people-roster--capture-name - (setq ss/people-roster--capture-name - (ss/people-roster-read-string "Full name: ")))) - - (defun ss/people-roster-capture-begin () - "Reset cached roster capture state." - (setq ss/people-roster--capture-name nil) - "") - - (defun ss/people-roster-capture-abbrev () - "Read the roster abbrev trigger." - (let ((name (or ss/people-roster--capture-name - (ss/people-roster-capture-name)))) - (ss/people-roster-read-string - "Abbrev trigger: " - (ss/name-dictionary-default-abbrev name)))) - - (defun ss/people-roster-capture-aliases () - "Read optional alias variants for a roster entry." - (ss/people-roster-read-string "Aliases (comma-separated, optional): ")) - - (defun ss/people-roster-capture-role () - "Read the role for a roster entry." - (ss/people-roster-read-string "Role: ")) - - (defun ss/people-roster-capture-engagement () - "Read the engagement type for a roster entry." - (completing-read "Engagement: " '("permanent" "sow" "other") nil t nil nil - "permanent")) - - (defun ss/people-roster-capture-team () - "Read the team for a roster entry." - (ss/people-roster-read-string "Team: ")) - - (defun ss/people-roster-capture-manager () - "Read the manager for a roster entry." - (ss/people-roster-read-string "Manager: " "You")) - - (defun ss/people-roster-capture-email () - "Read the email address for a roster entry." - (ss/people-roster-read-string "Email: ")) - - (defun ss/people-roster-capture-location () - "Read the location for a roster entry." - (ss/people-roster-read-string "Location: ")) - - (defun ss/people-roster-report-buffer (title group-fn) - "Render a grouped roster report into a dedicated buffer." + (defun ss/people--report-buffer (title group-fn) + "Render a grouped rolodex report titled TITLE using GROUP-FN." (let ((groups (sort (seq-group-by (lambda (entry) @@ -589,227 +564,169 @@ reports. (if (string-empty-p (or value "")) "(none)" value))) - (ss/people-roster-entries)) + (ss/people-entries)) (lambda (left right) (string< (car left) (car right)))))) - (with-current-buffer (get-buffer-create "*People Roster*") + (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/people-roster--entry-name left) - (ss/people-roster--entry-name right))))) - (insert "- " (ss/people-roster-entry-display entry) "\n"))) + (dolist (entry (cdr group)) + (insert "- " (ss/people--display entry) "\n"))) (goto-char (point-min)) + (read-only-mode 1) (view-mode 1)) (pop-to-buffer (current-buffer))))) + (defun ss/people-report-by-relationship () + "Show people grouped by relationship." + (interactive) + (ss/people--report-buffer + "People by relationship" + #'ss/people--entry-relationship)) + (defun ss/people-report-by-engagement () - "Show roster entries grouped by engagement." + "Show people grouped by engagement." (interactive) - (ss/people-roster-report-buffer + (ss/people--report-buffer "People by engagement" - #'ss/people-roster--entry-engagement)) + #'ss/people--entry-engagement)) (defun ss/people-report-by-role () - "Show roster entries grouped by role." + "Show people grouped by role." (interactive) - (ss/people-roster-report-buffer + (ss/people--report-buffer "People by role" - #'ss/people-roster--entry-role)) + #'ss/people--entry-role)) - (defun ss/people-report-by-manager () - "Show roster entries grouped by manager." + (defun ss/people-report-by-location () + "Show people grouped by location." (interactive) - (ss/people-roster-report-buffer - "People by manager" - #'ss/people-roster--entry-manager)) - - (defun ss/name-dictionary-canonical-names () - "Return the canonical names from the dictionary and roster." - (delete-dups - (append (mapcar #'ss/name-dictionary--entry-name ss/name-dictionary-entries) - (ss/people-roster-canonical-names)))) - - (defun ss/name-dictionary-candidates () - "Return all CAPF candidates from the dictionary." - (delete-dups - (append - (apply #'append - (mapcar (lambda (entry) - (cons (ss/name-dictionary--entry-name entry) - (ss/name-dictionary--entry-aliases entry))) - ss/name-dictionary-entries)) - (ss/people-roster-completion-candidates)))) - - (defun ss/name-dictionary-entry-by-name (name) - "Return the legacy dictionary entry matching NAME or an alias." - (seq-find - (lambda (entry) - (or (string= name (ss/name-dictionary--entry-name entry)) - (member name (ss/name-dictionary--entry-aliases entry)))) - ss/name-dictionary-entries)) + (ss/people--report-buffer + "People by location" + #'ss/people--entry-location)) - (defun ss/name-entry-by-name (name) - "Return the matching name entry from the roster or legacy dictionary." - (or (ss/people-roster--entry-by-name name) - (ss/name-dictionary-entry-by-name name))) + (defun ss/people-read-string (prompt &optional default) + "Read PROMPT and trim the result." + (string-trim (read-string prompt nil nil default))) - (defun ss/name-dictionary-install-abbrevs () - "Install name abbrevs into the current buffer." + (defun ss/people-read-required-string (prompt &optional default) + "Read PROMPT and require a non-empty result." + (let ((value (ss/people-read-string prompt default))) + (if (string-empty-p value) + (user-error "%s is required" (string-remove-suffix ": " prompt)) + value))) + + (defun ss/people-read-optional-string (prompt) + "Read PROMPT and return nil when the answer is empty." + (let ((value (ss/people-read-string prompt))) + (unless (string-empty-p value) + value))) + + (defun ss/people-add () + "Add a new compact person card to `ss/people-file'." + (interactive) + (let* ((name (ss/people-read-required-string "Full name: ")) + (abbrev (ss/people-read-string "Abbrev: " (ss/people-default-abbrev name))) + (aliases (ss/people-read-string "Aliases (comma-separated, optional): ")) + (role (ss/people-read-required-string "Role: ")) + (location (ss/people-read-required-string "Location: ")) + (engagement (completing-read "Engagement: " + ss/people-engagement-values nil t nil nil + "permanent")) + (relationship (completing-read "Relationship: " + ss/people-relationship-values nil t)) + (current-focus (ss/people-read-required-string "Current focus: ")) + (team (ss/people-read-optional-string "Team (optional): "))) + (when (ss/people--entry-by-name name) + (user-error "A person card for %s already exists" name)) + (when (string-empty-p abbrev) + (setq abbrev (ss/people-default-abbrev name))) + (find-file (ss/people--ensure-file)) + (widen) + (goto-char (point-max)) + (unless (bolp) + (insert "\n")) + (unless (looking-back "\n\n" nil) + (insert "\n")) + (insert "* " name "\n" + ":PROPERTIES:\n" + (ss/people--property-line "ABBREV" abbrev) + (ss/people--property-line "ALIASES" aliases) + (ss/people--property-line "ROLE" role) + (ss/people--property-line "LOCATION" location) + (ss/people--property-line "ENGAGEMENT" engagement) + (ss/people--property-line "RELATIONSHIP" relationship) + (ss/people--property-line "CURRENT_FOCUS" current-focus) + (ss/people--property-line "TEAM" team) + ":END:\n\n" + "** Context\n\n" + "** TODOs\n") + (save-buffer) + (ss/people-reload) + (ss/people--open-entry (ss/people--entry-by-name name)))) + + (defun ss/people-install-abbrevs () + "Install people abbrevs into the current buffer." (setq-local local-abbrev-table (copy-abbrev-table local-abbrev-table)) - (dolist (entry (append ss/name-dictionary-entries (ss/people-roster-entries))) - (when-let ((name (or (ss/name-dictionary--entry-name entry) - (ss/people-roster--entry-name entry)))) - (let ((abbrev (or (ss/name-dictionary--entry-abbrev entry) - (ss/people-roster--entry-abbrev entry)))) - (define-abbrev local-abbrev-table - (if (or (null abbrev) (string-empty-p abbrev)) - (ss/name-dictionary-default-abbrev name) - abbrev) - name))))) - - (defun ss/name-dictionary-refresh-buffers () - "Refresh name abbrevs in every prose buffer." + (dolist (entry (ss/people-entries)) + (let ((name (ss/people--entry-name entry)) + (abbrev (ss/people--entry-abbrev entry))) + (define-abbrev local-abbrev-table + (if (or (null abbrev) (string-empty-p abbrev)) + (ss/people-default-abbrev name) + abbrev) + name)))) + + (defun ss/people-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/name-dictionary-install-abbrevs))))) - - (defun ss/name-dictionary-save () - "Write the name dictionary file." - (let ((print-length nil) - (print-level nil)) - (with-temp-file ss/name-dictionary-file - (insert ";; -*- lexical-binding: t; -*-\n") - (insert ";; Persistent name entries used by abbrev and CAPF.\n\n") - (insert "(setq ss/name-dictionary-entries\n '") - (insert (pp-to-string ss/name-dictionary-entries)) - (insert ")\n")))) - - (defun ss/name-dictionary-reload () - "Reload the name dictionary file and refresh prose buffers." - (interactive) - (when (file-exists-p ss/name-dictionary-file) - (load ss/name-dictionary-file nil t)) - (ss/people-roster-reload) - (message "Reloaded name dictionary")) - - (defun ss/name-dictionary--upsert (entry) - "Insert or replace ENTRY in `ss/name-dictionary-entries'." - (setq ss/name-dictionary-entries - (sort - (cons entry - (seq-remove (lambda (existing) - (or (string= (ss/name-dictionary--entry-name existing) - (ss/name-dictionary--entry-name entry)) - (string= (ss/name-dictionary--entry-abbrev existing) - (ss/name-dictionary--entry-abbrev entry)))) - ss/name-dictionary-entries)) - (lambda (left right) - (string< (ss/name-dictionary--entry-name left) - (ss/name-dictionary--entry-name right)))))) - - (defun ss/name-dictionary--remove (name) - "Remove NAME from `ss/name-dictionary-entries'." - (setq ss/name-dictionary-entries - (seq-remove (lambda (entry) - (string= (ss/name-dictionary--entry-name entry) name)) - ss/name-dictionary-entries))) - - (defun ss/name-dictionary--save-entry (name abbrev aliases) - "Persist a name entry and refresh prose buffers." - (let ((entry (list :name name :abbrev abbrev))) - (when aliases - (setq entry (append entry (list :aliases aliases)))) - (ss/name-dictionary--upsert entry) - (ss/name-dictionary-save) - (ss/name-dictionary-refresh-buffers) - (message "Added name: %s" name))) - - (defun ss/name-dictionary-add-name (name abbrev aliases) - "Add a canonical NAME, ABBREV trigger, and optional ALIASES." - (interactive - (let* ((name (read-string "Full name: ")) - (abbrev (string-trim - (read-string "Abbrev trigger: " - (ss/name-dictionary-default-abbrev name)))) - (aliases (ss/name-dictionary-read-aliases - "Aliases (comma-separated, optional): "))) - (list name abbrev aliases))) - (when (string-empty-p abbrev) - (setq abbrev (ss/name-dictionary-default-abbrev name))) - (ss/name-dictionary--save-entry name abbrev aliases)) - - (defun ss/name-dictionary-add-name-from-region (beg end abbrev aliases) - "Add the active region as a name entry." - (interactive - (if (use-region-p) - (let* ((name (string-trim - (buffer-substring-no-properties - (region-beginning) (region-end)))) - (abbrev (string-trim - (read-string "Abbrev trigger: " - (ss/name-dictionary-default-abbrev name)))) - (aliases (ss/name-dictionary-read-aliases - "Aliases (comma-separated, optional): "))) - (list (region-beginning) (region-end) abbrev aliases)) - (user-error "Select a name first"))) - (let ((name (string-trim - (buffer-substring-no-properties beg end)))) - (when (string-empty-p abbrev) - (setq abbrev (ss/name-dictionary-default-abbrev name))) - (ss/name-dictionary--save-entry name abbrev aliases))) - - (defun ss/name-dictionary-remove-name (name) - "Remove NAME from the persistent dictionary." - (interactive - (list (completing-read "Remove name: " - (mapcar #'ss/name-dictionary--entry-name - ss/name-dictionary-entries) - nil t))) - (ss/name-dictionary--remove name) - (ss/name-dictionary-save) - (ss/name-dictionary-refresh-buffers) - (message "Removed name: %s" name)) - - (defun ss/name-dictionary-open () - "Open the persistent name dictionary." - (interactive) - (find-file ss/name-dictionary-file)) + (ss/people-install-abbrevs))))) - (defun ss/name-capf () - "Return a name completion candidate set at a word boundary." + (defun ss/people-capf () + "Return canonical people completions at a word boundary." (let ((end (point))) (save-excursion (skip-syntax-backward "w_") - (let ((beg (point)) - (candidates (ss/name-dictionary-candidates))) - (when (and (< beg end) candidates) - (list beg end candidates + (let ((beg (point))) + (when (< beg end) + (list beg end #'ss/people--completion-table :exclusive 'no :annotation-function (lambda (candidate) - (when-let ((entry (ss/name-entry-by-name candidate))) - (let ((summary - (or (ss/people-roster--entry-summary entry) - ""))) - (when (not (string-empty-p summary)) - (concat " " summary))))))))))) - - (defun ss/enable-name-capf () - "Add `ss/name-capf' once in prose buffers." - (unless (memq #'ss/name-capf completion-at-point-functions) - (add-hook 'completion-at-point-functions #'ss/name-capf nil t))) + (when-let ((entry (ss/people--entry-by-name candidate))) + (concat " " (ss/people--summary entry)))) + :company-docsig + (lambda (candidate) + (when-let ((entry (ss/people--entry-by-name candidate))) + (ss/people--summary entry))))))))) + + (defun ss/enable-people-capf () + "Add `ss/people-capf' once in prose buffers." + (unless (memq #'ss/people-capf completion-at-point-functions) + (add-hook 'completion-at-point-functions #'ss/people-capf nil t))) + + (defun ss/people--maybe-overview-buffer () + "Reset people.org to overview when visiting it directly." + (when (and buffer-file-name + (string= (file-truename buffer-file-name) + (file-truename ss/people-file))) + (widen) + (goto-char (point-min)) + (org-overview) + (org-cycle-hide-drawers 'all)))) (dolist (hook '(text-mode-hook org-mode-hook)) - (add-hook hook #'ss/enable-name-capf)) - (add-hook 'find-file-hook #'ss/people-roster-track-buffer) + (add-hook hook #'ss/enable-people-capf) + (add-hook hook #'ss/people-install-abbrevs)) + (add-hook 'find-file-hook #'ss/people--track-buffer) + (add-hook 'find-file-hook #'ss/people--maybe-overview-buffer) #+end_src * Notes workflow @@ -848,13 +765,6 @@ directly during startup rather than creating it on demand. (defconst ss/org-areas-directory (expand-file-name "areas/" ss/org-directory) "Directory for area notes.") - (defconst ss/org-people-directory (expand-file-name "areas/people/" ss/org-directory) - "Directory for people notes.") - - (defconst ss/people-roster-file - (expand-file-name "areas/people/roster.org" ss/org-directory) - "Structured roster of people and role metadata.") - (defconst ss/org-resources-directory (expand-file-name "resources/" ss/org-directory) "Directory for resource notes.") @@ -869,7 +779,6 @@ directly during startup rather than creating it on demand. ss/org-daily-directory ss/org-projects-directory ss/org-areas-directory - ss/org-people-directory ss/org-resources-directory ss/org-archives-directory) "Directories that make up the note-taking workflow.") @@ -882,7 +791,6 @@ directly during startup rather than creating it on demand. (defconst ss/org-subdirectory-roots `(("projects" . ,ss/org-projects-directory) ("areas" . ,ss/org-areas-directory) - ("people" . ,ss/org-people-directory) ("resources" . ,ss/org-resources-directory)) "Capture roots offered when creating note subdirectories.") @@ -982,9 +890,13 @@ directly during startup rather than creating it on demand. ("C-c c" . org-capture) ("C-c n M" . ss/open-moc) ("C-c n f" . ss/people-find) + ("C-c n i" . ss/people-insert-name) + ("C-c n I" . ss/people-insert-summary) ("C-c n m" . ss/create-note-subdirectory) ("C-c n d" . ss/open-todays-note) - ("C-c n r" . ss/people-roster-open)) + ("C-c n o" . ss/people-overview) + ("C-c n p" . ss/people-open) + ("C-c n P" . ss/people-add)) :config (setq org-directory ss/org-directory org-hide-emphasis-markers t) @@ -997,7 +909,8 @@ directly during startup rather than creating it on demand. (advice-add 'org-agenda :before #'ss/refresh-org-agenda-files) (mapc (lambda (directory) (make-directory directory t)) - ss/org-note-directories)) + ss/org-note-directories) + (ss/people--ensure-file)) #+end_src ** Capture entry points @@ -1007,8 +920,9 @@ notes and meetings land under =Notes=. Denote capture uses Denote's own Org integration so note identity, metadata, and directories stay under Denote's control rather than custom code. The convenience templates keep the familiar entry points, but only project capture injects a structural keyword by default. -People have two paths: =nP= creates a Denote note for narrative context, while -=nR= writes a structured roster entry with role and engagement metadata. +The people rolodex lives outside =org-capture=: adding a person uses the +dedicated =ss/people-add= command so =~/org/people.org= stays a compact, +structured card file rather than turning into another capture target. #+begin_src emacs-lisp (use-package org-capture @@ -1056,23 +970,6 @@ People have two paths: =nP= creates a Denote note for narrative context, while :immediate-finish nil :kill-buffer t :jump-to-captured t) - ("nP" "Person" plain - (file denote-last-path) - (function - (lambda () - (ss/denote-capture-in-directory - ss/org-people-directory nil :title :keywords :subdirectory))) - :no-save t - :immediate-finish nil - :kill-buffer t - :jump-to-captured t) - ("nR" "Roster" entry - (file ,#'ss/people-roster--ensure-file) - "%(ss/people-roster-capture-begin)* %(ss/people-roster-capture-name)\n:PROPERTIES:\n:NAME: %(ss/people-roster-capture-name)\n:ABBREV: %(ss/people-roster-capture-abbrev)\n:ALIASES: %(ss/people-roster-capture-aliases)\n:ROLE: %(ss/people-roster-capture-role)\n:ENGAGEMENT: %(ss/people-roster-capture-engagement)\n:TEAM: %(ss/people-roster-capture-team)\n:MANAGER: %(ss/people-roster-capture-manager)\n:EMAIL: %(ss/people-roster-capture-email)\n:LOCATION: %(ss/people-roster-capture-location)\n:END:\n%?" - :no-save t - :immediate-finish nil - :kill-buffer t - :jump-to-captured t) ("nr" "Resource" plain (file denote-last-path) (function @@ -1083,7 +980,6 @@ People have two paths: =nP= creates a Denote note for narrative context, while :immediate-finish nil :kill-buffer t :jump-to-captured t)))) - (add-hook 'org-capture-after-finalize-hook #'ss/people-roster-reload) #+end_src ** Denote |