diff options
| -rw-r--r-- | config.org | 522 |
1 files changed, 500 insertions, 22 deletions
@@ -279,11 +279,12 @@ annotations. * Name shortcuts -The name workflow uses one repository file for both abbrev triggers and CAPF -candidates. Abbrev handles deterministic one-shot expansions, while Corfu-backed -CAPF completion offers explicit choice among name variants. The two mechanisms -stay separate: abbrev mutates the buffer immediately, CAPF only proposes -candidates. +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. #+begin_src emacs-lisp (defconst ss/name-dictionary-file @@ -317,34 +318,480 @@ candidates. (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) - first))) + (concat ";" first last) + (concat ";" first)))) (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))) + (defvar ss/people-roster--cache nil + "Cached roster entries loaded from `ss/people-roster-file'.") + + (defvar ss/people-roster--cache-mtime nil + "Modification time of the cached roster entries.") + + (defun ss/people-roster--split-values (value) + "Split VALUE on commas or semicolons 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/people-roster--normalize-engagement (employee-time) + "Map the CSV EMPLOYEE-TIME field to a roster engagement category." + (cond ((or (null employee-time) (string-empty-p employee-time)) nil) + ((string-match-p "\\`Perm\\'" employee-time) "permanent") + ((string-match-p "\\`NCS India\\'" employee-time) "permanent") + ((string-match-p "\\`SOW" employee-time) "sow") + (t (downcase employee-time)))) + + (defun ss/people-roster--csv-header-key (header) + "Convert a CSV HEADER to a plist keyword." + (intern + (concat ":" + (replace-regexp-in-string + "[^[:alnum:]]+" "-" + (downcase (string-trim header)))))) + + (defun ss/people-roster--csv-row-values (line) + "Split a CSV LINE into trimmed values." + (mapcar #'string-trim + (split-string (string-trim-right line "\r") "," nil))) + + (defun ss/people-roster--csv-row-plist (headers values) + "Zip HEADERS and VALUES into a plist." + (let ((plist nil)) + (while headers + (setq plist (plist-put plist (pop headers) (or (pop values) "")))) + plist)) + + (defun ss/people-roster--csv-rows () + "Return the rows from `ss/people-roster-source-file'." + (when (file-exists-p ss/people-roster-source-file) + (with-temp-buffer + (insert-file-contents ss/people-roster-source-file) + (let* ((lines (split-string (buffer-string) "\n" t)) + (headers (mapcar #'ss/people-roster--csv-header-key + (ss/people-roster--csv-row-values (car lines))))) + (mapcar (lambda (line) + (ss/people-roster--csv-row-plist + headers + (ss/people-roster--csv-row-values line))) + (cdr lines)))))) + + (defun ss/people-roster--csv-row->entry (row) + "Convert CSV ROW to a roster entry plist." + (let ((name (string-trim (or (plist-get row :name) ""))) + (role (string-trim (or (plist-get row :role) + (plist-get row :title) + ""))) + (employee-time (string-trim (or (plist-get row :employee-time) ""))) + (team (string-trim (or (plist-get row :team) ""))) + (abbrev (string-trim (or (plist-get row :abbrev) ""))) + (aliases (ss/people-roster--split-values (plist-get row :aliases))) + (manager (string-trim (or (plist-get row :manager) ""))) + (email (string-trim (or (plist-get row :email) ""))) + (location (string-trim (or (plist-get row :location) ""))) + (engagement (string-trim + (or (plist-get row :engagement) + (ss/people-roster--normalize-engagement employee-time) + "")))) + (list :name name + :abbrev (if (string-empty-p abbrev) + (ss/name-dictionary-default-abbrev name) + abbrev) + :aliases aliases + :role role + :employee-time employee-time + :engagement engagement + :team team + :manager manager + :email email + :location location))) + + (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) + "")) + + (defun ss/people-roster--csv-entry-to-org (entry) + "Render ENTRY as an Org headline with properties." + (let ((name (ss/people-roster--entry-name entry)) + (abbrev (ss/people-roster--entry-abbrev entry)) + (aliases (ss/people-roster--entry-aliases entry)) + (role (ss/people-roster--entry-role entry)) + (employee-time (plist-get entry :employee-time)) + (engagement (ss/people-roster--entry-engagement entry)) + (team (ss/people-roster--entry-team entry)) + (manager (ss/people-roster--entry-manager entry)) + (email (ss/people-roster--entry-email entry)) + (location (ss/people-roster--entry-location entry))) + (concat + "* " name "\n" + ":PROPERTIES:\n" + (ss/people-roster--org-property-line "NAME" name) + (ss/people-roster--org-property-line "ABBREV" abbrev) + (ss/people-roster--org-property-line "ALIASES" (mapconcat #'identity aliases "; ")) + (ss/people-roster--org-property-line "EMPLOYEE-TIME" employee-time) + (ss/people-roster--org-property-line "ROLE" role) + (ss/people-roster--org-property-line "ENGAGEMENT" engagement) + (ss/people-roster--org-property-line "TEAM" team) + (ss/people-roster--org-property-line "MANAGER" manager) + (ss/people-roster--org-property-line "EMAIL" email) + (ss/people-roster--org-property-line "LOCATION" location) + ":END:\n\n"))) + + (defun ss/people-roster--seed-from-csv () + "Write the roster file from the CSV seed data." + (let ((entries (mapcar #'ss/people-roster--csv-row->entry + (ss/people-roster--csv-rows)))) + (with-temp-file ss/people-roster-file + (insert "#+title: People roster\n\n") + (dolist (entry entries) + (insert (ss/people-roster--csv-entry-to-org entry)))) + entries)) + + (defun ss/people-roster--entry-name (entry) + "Return the canonical name in ENTRY." + (plist-get entry :name)) + + (defun ss/people-roster--entry-abbrev (entry) + "Return the abbrev trigger in ENTRY." + (plist-get entry :abbrev)) + + (defun ss/people-roster--entry-aliases (entry) + "Return alias variants in ENTRY." + (plist-get entry :aliases)) + + (defun ss/people-roster--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-roster--entry-team (entry) + "Return the team in ENTRY." + (plist-get entry :team)) + + (defun ss/people-roster--entry-employee-time (entry) + "Return the raw employee time in ENTRY." + (plist-get entry :employee-time)) + + (defun ss/people-roster--entry-manager (entry) + "Return the manager in ENTRY." + (plist-get entry :manager)) + + (defun ss/people-roster--entry-email (entry) + "Return the email address in ENTRY." + (plist-get entry :email)) + + (defun ss/people-roster--entry-location (entry) + "Return the location in ENTRY." + (plist-get entry :location)) + + (defun ss/people-roster--entry-summary (entry) + "Return a 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))) + " | ")) + + (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))) + (if (string-empty-p summary) + name + (format "%s | %s" name summary)))) + + (defun ss/people-roster--entry-by-name (name) + "Return the roster entry matching NAME or one of its aliases." + (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) + (if (file-exists-p ss/people-roster-source-file) + (ss/people-roster--seed-from-csv) + (with-temp-file ss/people-roster-file + (insert "#+title: People roster\n\n")))) + ss/people-roster-file) + + (defun ss/people-roster-seed-from-csv (&optional overwrite) + "Seed the roster file from the CSV source. +With OVERWRITE, rebuild the roster even when it already exists." + (interactive "P") + (when (and (file-exists-p ss/people-roster-file) (not overwrite)) + (user-error "Roster already exists; use C-u M-x ss/people-roster-seed-from-csv to rebuild it")) + (unless (file-exists-p ss/people-roster-source-file) + (user-error "Missing seed CSV: %s" ss/people-roster-source-file)) + (ss/people-roster--seed-from-csv) + (ss/people-roster-reload) + (message "Seeded people roster from CSV")) + + (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." + (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." + (interactive) + (find-file (ss/people-roster--ensure-file))) + + (defun ss/people-roster-track-buffer () + "Refresh roster caches when the roster 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))) + + (defun ss/people-roster-open-entry (entry) + "Open the roster file and jump to ENTRY." + (find-file (ss/people-roster--ensure-file)) + (let ((position (org-find-exact-headline-in-buffer + (ss/people-roster--entry-name entry)))) + (unless position + (user-error "No roster heading for %s" (ss/people-roster--entry-name entry))) + (goto-char position)) + (org-show-entry)) + + (defun ss/people-find () + "Find and open a roster entry." + (interactive) + (ss/people-roster-open-entry + (ss/people-roster-select-entry "Find person: "))) + + (defun ss/people-roster-insert-summary () + "Insert a compact roster summary 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'.") + + (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-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." + (let ((groups + (sort (seq-group-by + (lambda (entry) + (let ((value (funcall group-fn entry))) + (if (string-empty-p (or value "")) + "(none)" + value))) + (ss/people-roster-entries)) + (lambda (left right) + (string< (car left) (car right)))))) + (with-current-buffer (get-buffer-create "*People Roster*") + (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"))) + (goto-char (point-min)) + (view-mode 1)) + (pop-to-buffer (current-buffer))))) + + (defun ss/people-report-by-engagement () + "Show roster entries grouped by engagement." + (interactive) + (ss/people-roster-report-buffer + "People by engagement" + #'ss/people-roster--entry-engagement)) + + (defun ss/people-report-by-role () + "Show roster entries grouped by role." + (interactive) + (ss/people-roster-report-buffer + "People by role" + #'ss/people-roster--entry-role)) + + (defun ss/people-report-by-manager () + "Show roster entries grouped by manager." + (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." - (mapcar #'ss/name-dictionary--entry-name ss/name-dictionary-entries)) + "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 - (apply #'append - (mapcar (lambda (entry) - (cons (ss/name-dictionary--entry-name entry) - (ss/name-dictionary--entry-aliases entry))) - ss/name-dictionary-entries)))) + (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)) + + (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/name-dictionary-install-abbrevs () "Install name abbrevs into the current buffer." (setq-local local-abbrev-table (copy-abbrev-table local-abbrev-table)) - (dolist (entry ss/name-dictionary-entries) - (when-let ((name (ss/name-dictionary--entry-name entry)) - (abbrev (ss/name-dictionary--entry-abbrev entry))) - (define-abbrev local-abbrev-table abbrev name)))) + (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." @@ -370,7 +817,7 @@ candidates. (interactive) (when (file-exists-p ss/name-dictionary-file) (load ss/name-dictionary-file nil t)) - (ss/name-dictionary-refresh-buffers) + (ss/people-roster-reload) (message "Reloaded name dictionary")) (defun ss/name-dictionary--upsert (entry) @@ -443,7 +890,8 @@ candidates. "Remove NAME from the persistent dictionary." (interactive (list (completing-read "Remove name: " - (ss/name-dictionary-canonical-names) + (mapcar #'ss/name-dictionary--entry-name + ss/name-dictionary-entries) nil t))) (ss/name-dictionary--remove name) (ss/name-dictionary-save) @@ -463,7 +911,16 @@ candidates. (let ((beg (point)) (candidates (ss/name-dictionary-candidates))) (when (and (< beg end) candidates) - (list beg end candidates :exclusive 'no)))))) + (list beg end candidates + :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." @@ -472,6 +929,7 @@ candidates. (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) #+end_src * Notes workflow @@ -513,6 +971,14 @@ directly during startup rather than creating it on demand. (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/people-roster-source-file + (expand-file-name "people.csv" user-emacs-directory) + "CSV seed data for the roster.") + (defconst ss/org-resources-directory (expand-file-name "resources/" ss/org-directory) "Directory for resource notes.") @@ -639,8 +1105,10 @@ directly during startup rather than creating it on demand. :bind (("C-c a" . ss/open-agenda) ("C-c c" . org-capture) ("C-c n M" . ss/open-moc) + ("C-c n f" . ss/people-find) ("C-c n m" . ss/create-note-subdirectory) - ("C-c n d" . ss/open-todays-note)) + ("C-c n d" . ss/open-todays-note) + ("C-c n r" . ss/people-roster-open)) :config (setq org-directory ss/org-directory org-hide-emphasis-markers t) @@ -663,6 +1131,8 @@ 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. #+begin_src emacs-lisp (use-package org-capture @@ -720,6 +1190,13 @@ entry points, but only project capture injects a structural keyword by default. :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 @@ -730,6 +1207,7 @@ entry points, but only project capture injects a structural keyword by default. :immediate-finish nil :kill-buffer t :jump-to-captured t)))) + (add-hook 'org-capture-after-finalize-hook #'ss/people-roster-reload) #+end_src ** Denote |