diff options
Diffstat (limited to 'lisp/ss-crm.el')
| -rw-r--r-- | lisp/ss-crm.el | 314 |
1 files changed, 286 insertions, 28 deletions
diff --git a/lisp/ss-crm.el b/lisp/ss-crm.el index c9b8c16..62dc3e3 100644 --- a/lisp/ss-crm.el +++ b/lisp/ss-crm.el @@ -18,6 +18,155 @@ '("Perm" "SOW" "SOW Fixed Outcome" "NCS India") "Canonical engagement values for people cards.") +(defconst ss-crm-seeded-roles + '("Account Manager" + "AD Platform Manager" + "AD, Billing & Catalogue, Engineering" + "AD, Frontend Engineering" + "AD, IT Core & MarTech" + "AD, Mobile Engineering" + "AD, Platform Engineering" + "AD, Portfolio Delivery Products and API Management" + "AD, Portfolio Mgmt. Customer Engagement" + "AD, Quality Engineering" + "AD, Tech Product Owner" + "AD, Technical Delivery" + "AD, Technical Platform Management" + "AD, Technical Platform Manager, API" + "AD, Technical Platform Manager, Catalog" + "AD, Technical Platform Manager, Order and Quote" + "AD, Technical Product Management" + "Agile Scrum Master" + "Analyst Programmer - Senior" + "Android Developer" + "Android Developer - Senior" + "Application Development Lead" + "Architect" + "Associate Engineer" + "Associate Engineer" + "Associate Engineer, Frontend" + "Associate Engineer, Platform Engineering" + "Associate Software Engineer" + "Billing Executive" + "Business Analyst" + "Business Analyst - Senior" + "Business Development Manager" + "Business Intelligence Analyst" + "Business Program Manager" + "Cloud Engineer" + "Consultant" + "CRM Developer" + "Data Analyst" + "Data Analyst - Senior" + "Delivery Lead" + "Delivery Manager" + "Demand Lead" + "Deployment Manager" + "Development Manager" + "DevOps Engineer" + "DevOps Engineer - Senior" + "Digital Delivery Manager" + "Director Customer Engagement" + "Director Sales Technology" + "Director, Billing and Charging" + "Director, Delivery Portfolio Billing and Charging" + "Director, Digital Engineering" + "Director, Portfolio Mgmt." + "Director, SF Comms Technical Platform" + "Director, SSF Core & Commerce" + "Engineer" + "Engineer - Junior" + "Engineer - Senior" + "Engineer, Platform Engineering" + "Engineer, Salesforce" + "Engineering Manager" + "Engineering Manager, Mobile" + "Engineering Manager, Platform Engineering" + "Executive Assistant" + "Integration Lead" + "Integration Solution Designer" + "Integration Technical Specialist" + "iOS Developer" + "iOS Developer - Senior" + "IT Business Partner" + "Lead Consultant" + "Lead Developer" + "Manager, Release Engineer" + "Manager, Release Train Engineer" + "Mobile API Developer" + "Optus Tech Graduate" + "Portfolio Manager" + "Process Analyst - Senior" + "Product Manager" + "Product Solution Designer" + "Program Analyst" + "Program Director" + "Program Manager" + "Project Architect" + "Project Coordinator" + "Project Manager" + "Quality Assurance Analyst" + "Quality Engineering Professional" + "Release Coordinator" + "Release Manager" + "Salesforce Administrator" + "Salesforce Developer (Heroku, Lightning, etc)" + "Salesforce Marketing Cloud Architect" + "Salesforce Operations Manager" + "Scrum Master" + "SD, Engineering Capability" + "SD, Marketing Technology" + "SD, Technical Products" + "Senior Business Analyst" + "Senior Delivery Manager" + "Senior Delivery Manger" + "Senior Digital Technical Producer" + "Senior E2E Business Analyst Lead" + "Senior Engineer" + "Senior Engineer, API Engineering" + "Senior Engineer, Billing & Catalogue" + "Senior Engineer, Platform Engineering" + "Senior Engineer, Salesforce" + "Senior Front End Developer" + "Senior Integration Solution Designer" + "Senior Quality Engineering Professional" + "Senior Salesforce Administrator" + "Senior Salesforce Consultant" + "Senior Salesforce Functional Consultant" + "Senior Salesforce Operations Lead" + "Senior Software Developer" + "Senior Software Engineer" + "Senior Software Engineer, Frontend" + "Senior Software Engineer, Mobile" + "Senior Solution Designer" + "Snr Dir, Delivery & Platform Manager" + "Snr Director, Portfolio Mgmt. & Delivery" + "Software Developer" + "Software Developer - Junior" + "Software Developer - Senior" + "Software Engineer" + "Software Engineer, Frontend" + "Software Engineer, Mobile" + "Solution Architect" + "Solution Designer" + "Solution Designer - Senior" + "Staff Engineer" + "Support Analyst" + "System Analyst" + "System Engineer" + "Technical Lead" + "Technical Platform Manager" + "Technical Platform Manager, Billing and Charging" + "Technical Product Manager" + "Technical Project Manager - Senior" + "Technical Specialist - Senior" + "Technology Delivery Analyst" + "Test Analyst" + "Test Lead" + "Test Manager" + "VP, EB IT") + "Seeded role values derived from the historic roles CSV.") + (defconst ss-crm-supplier-options '("Accenture Song" "INFOSYS TECHNOLOGIES LIMITED" @@ -392,6 +541,93 @@ (user-error "%s is required" (string-remove-suffix ": " prompt)) value))) +(defun ss-crm-known-property-values (property) + "Return sorted unique non-empty values for PROPERTY from CRM entries." + (let ((key (intern (concat ":" (downcase property))))) + (seq-sort + #'string< + (delete-dups + (seq-filter + (lambda (value) + (and (stringp value) + (not (string-empty-p (string-trim value))))) + (mapcar + (lambda (entry) + (plist-get entry key)) + (ss-crm-entries))))))) + +(defun ss-crm-known-person-names () + "Return sorted top-level person names from CRM entries." + (seq-sort + #'string< + (delete-dups + (seq-filter + (lambda (name) + (and (stringp name) + (not (string-empty-p (string-trim name))))) + (mapcar #'ss-crm--entry-name (ss-crm-entries)))))) + +(defun ss-crm-lookup-values (property &optional seeded) + "Return sorted unique values for PROPERTY merged with SEEDED values." + (seq-sort + #'string< + (delete-dups + (seq-filter + (lambda (value) + (and (stringp value) + (not (string-empty-p (string-trim value))))) + (append seeded + (ss-crm-known-property-values property)))))) + +(defun ss-crm--read-choice-warning (prompt similar) + "Warn that PROMPT value is similar to existing SIMILAR." + (display-warning + 'ss-crm + (format "%sA similar existing value already exists: %s" + prompt + similar) + :warning)) + +(defun ss-crm-read-choice (prompt choices &rest plist) + "Read a value for PROMPT from CHOICES using options in PLIST. +Supported keywords are :allow-blank, :allow-new, and :require-match." + (let* ((allow-blank (plist-get plist :allow-blank)) + (allow-new (plist-get plist :allow-new)) + (require-match (plist-get plist :require-match)) + (blank-choice "[none]") + (collection (if allow-blank + (cons blank-choice choices) + choices)) + (completion-require-match (if allow-new nil require-match))) + (catch 'done + (while t + (let* ((value (completing-read prompt collection nil completion-require-match)) + (existing + (seq-find + (lambda (choice) + (string= value choice)) + choices))) + (cond + ((or (string-empty-p value) + (and allow-blank + (string= value blank-choice))) + (throw 'done nil)) + (existing + (throw 'done existing)) + ((not allow-new) + (user-error "Please choose an existing value")) + (t + (when-let ((similar + (seq-find + (lambda (choice) + (and (not (string= value choice)) + (string-equal (downcase value) + (downcase choice)))) + choices))) + (ss-crm--read-choice-warning prompt similar)) + (when (yes-or-no-p (format "Create new value `%s'? " value)) + (throw 'done value))))))))) + (defun ss-crm--completion-values (extractor &optional include-empty) "Return sorted unique values using EXTRACTOR. When INCLUDE-EMPTY is non-nil, keep empty values." @@ -404,6 +640,50 @@ When INCLUDE-EMPTY is non-nil, keep empty values." (not (string-empty-p (or value ""))))) values)))) +(defun ss-crm-read-role () + "Read a CRM role using seeded and known role values." + (ss-crm-read-choice "Role: " + (ss-crm-lookup-values "ROLE" ss-crm-seeded-roles) + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-team () + "Read a CRM team using known team values." + (ss-crm-read-choice "Team: " + (ss-crm-lookup-values "TEAM") + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-manager () + "Read a CRM manager using known person names." + (ss-crm-read-choice "Manager: " + (ss-crm-known-person-names) + :allow-blank t + :require-match t)) + +(defun ss-crm-read-engagement () + "Read a CRM engagement using seeded and known engagement values." + (ss-crm-read-choice "Engagement: " + (ss-crm-lookup-values "ENGAGEMENT" + ss-crm-engagement-options) + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-supplier () + "Read a CRM supplier using seeded and known supplier values." + (ss-crm-read-choice "Supplier: " + (ss-crm-lookup-values "SUPPLIER" + ss-crm-supplier-options) + :allow-blank t + :allow-new t)) + +(defun ss-crm-read-location () + "Read a CRM location using known location values." + (ss-crm-read-choice "Location: " + (ss-crm-lookup-values "LOCATION") + :allow-blank t + :allow-new t)) + (defun ss-crm-add () "Add a new compact person card to `ss-crm-file'." (interactive) @@ -419,35 +699,13 @@ When INCLUDE-EMPTY is non-nil, keep empty values." (current-focus nil)) (setq abbrev (ss-crm-read-string "Abbrev: " (ss-crm-default-abbrev name)) aliases (ss-crm-read-string "Aliases (comma-separated, optional): ") - role (completing-read "Role: " - (ss-crm--completion-values #'ss-crm--entry-role) - nil nil) - team (completing-read "Team: " - (ss-crm--completion-values #'ss-crm--entry-team) - nil nil) - manager (completing-read "Manager: " - (mapcar #'ss-crm--entry-name (ss-crm-entries)) - nil nil) - engagement (completing-read "Engagement: " - ss-crm-engagement-options nil t) - supplier (completing-read "Supplier: " - ss-crm-supplier-options nil t) - location (completing-read "Location: " - (ss-crm--completion-values #'ss-crm--entry-location) - nil nil) + role (ss-crm-read-role) + team (ss-crm-read-team) + manager (ss-crm-read-manager) + engagement (ss-crm-read-engagement) + supplier (ss-crm-read-supplier) + location (ss-crm-read-location) current-focus (ss-crm-read-required-string "Current focus: ")) - (setq role (if (string-empty-p role) - (ss-crm-read-required-string "Role: ") - role)) - (setq team (if (string-empty-p team) - (ss-crm-read-required-string "Team: ") - team)) - (setq manager (if (string-empty-p manager) - (ss-crm-read-required-string "Manager: ") - manager)) - (setq location (if (string-empty-p location) - (ss-crm-read-required-string "Location: ") - location)) (when (ss-crm--entry-by-name name) (user-error "A person card for %s already exists" name)) (when (string-empty-p abbrev) |