;;; org-contacts-config.el --- Org Contacts Configuration -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings ;; ;;; Commentary: ;; ;; Layer: 3 (Domain Workflow). ;; Category: D/P. ;; Load shape: eager. ;; Eager reason: none necessary; belongs after Org/mail load (after-load ;; deferral candidate). ;; Top-level side effects: one global key, package configuration via use-package. ;; Runtime requires: user-constants. ;; Direct test load: yes. ;; ;; Configuration for org-contacts, providing contact management within org-mode. ;; Integrates with mu4e for email address completion and org-roam for linking ;; contacts to projects and notes. ;; ;; Email completion functionality has been moved to mu4e-org-contacts-integration.el ;;; Code: (require 'user-constants) ;; Function declarations -- these live in lazily-loaded packages, so the ;; byte-compiler can't see their definitions when this module compiles ;; standalone. (declare-function org-contacts-db "org-contacts") (declare-function org-contacts-anniversaries "org-contacts") (declare-function org-contacts-files "org-contacts") (declare-function org-columns "org-colview") (declare-function org-reveal "org") (declare-function org-fold-show-entry "org-fold") (declare-function org-heading-components "org") (declare-function org-map-entries "org") (declare-function org-entry-get "org") (declare-function outline-next-heading "outline") (declare-function calendar-current-date "calendar") (declare-function mu4e-message-at-point "mu4e-message") (declare-function mu4e-message-field "mu4e-message") (declare-function which-key-add-key-based-replacements "which-key") ;; External package variables referenced below; declared so the compiler ;; treats them as special rather than free. (defvar org-capture-plist) (defvar org-capture-templates) (defvar mu4e~view-message) (defvar org-agenda-include-diary) (defvar org-agenda-custom-commands) (defvar mu4e-org-contacts-file) (defvar mu4e-headers-actions) (defvar mu4e-view-actions) (defvar mu4e-compose-complete-addresses) ;; Set `org-contacts-files' eagerly at require time. Setting it in the ;; `use-package' form below would only apply when org-contacts loads, which is ;; deferred behind `:after (org mu4e)' -- later than the first ;; `org-agenda-finalize'. The anniversaries hook below runs on that finalize ;; and calls `org-contacts-files', which *messages* (not signals) an error when ;; the variable is nil, so the hook's `ignore-errors' can't suppress it. Set ;; it here so the variable is never nil by the time the hook fires. (defvar org-contacts-files nil) (setq org-contacts-files (list contacts-file)) ;; --------------------------- Org Agenda Integration -------------------------- (with-eval-after-load 'org-agenda ;; Remove the direct hook first (in case it's already added) (remove-hook 'org-agenda-finalize-hook 'org-contacts-anniversaries) ;; Add a wrapper function that ensures proper context (defun cj/org-contacts-anniversaries-safe () "Safely call org-contacts-anniversaries with required bindings." (require 'diary-lib) ;; `date', `entry', and `original-date' are diary special vars that the ;; diary functions read dynamically. Declare them special locally; the ;; suppressed warning is the unprefixed-name lint on these calendar names. (with-suppressed-warnings ((lexical date entry original-date)) (defvar date) (defvar entry) (defvar original-date)) (let ((date (calendar-current-date)) (entry "") (original-date (calendar-current-date))) ;; `org-contacts-anniversaries' calls `org-contacts-files', which ;; messages an error when the variable is nil. A message isn't a ;; signal, so `ignore-errors' alone can't suppress it -- guard the call. (when org-contacts-files (ignore-errors (org-contacts-anniversaries))))) ;; Use the safe wrapper instead (add-hook 'org-agenda-finalize-hook 'cj/org-contacts-anniversaries-safe)) ;; ----------------------- Org-Contacts Capture Template ----------------------- (defun cj/org-contacts-finalize-birthday-timestamp () "Add yearly repeating timestamp after properties drawer if BIRTHDAY is set." (when (string= (plist-get org-capture-plist :key) "C") (save-excursion (goto-char (point-min)) (let ((birthday (org-entry-get (point) "BIRTHDAY"))) (when (and birthday (not (string-blank-p birthday))) ;; Parse birthday - returns (year month day) or nil (let ((parsed (cond ((string-match "^\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)$" birthday) (list (string-to-number (match-string 1 birthday)) (string-to-number (match-string 2 birthday)) (string-to-number (match-string 3 birthday)))) ((string-match "^\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)$" birthday) (list (nth 5 (decode-time)) (string-to-number (match-string 1 birthday)) (string-to-number (match-string 2 birthday)))) (t nil)))) (when parsed (let* ((year (nth 0 parsed)) (month (nth 1 parsed)) (day (nth 2 parsed)) (time (encode-time 0 0 0 day month year)) (dow (format-time-string "%a" time)) (timestamp (format "<%04d-%02d-%02d %s +1y>" year month day dow)) (heading-end (save-excursion (outline-next-heading) (point)))) ;; Find :END: and insert timestamp (when (re-search-forward "^[ \t]*:END:[ \t]*$" heading-end t) (let ((end-pos (point))) (goto-char end-pos) (unless (re-search-forward "<[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^>]*\\+1y>" heading-end t) (goto-char end-pos) (end-of-line) (insert "\n" timestamp)))))))))))) (with-eval-after-load 'org-capture (add-to-list 'org-capture-templates '("C" "Contact" entry (file+headline contacts-file "Contacts") "* %(cj/org-contacts-template-name) :PROPERTIES: :EMAIL: %(cj/org-contacts-template-email) :PHONE: %^{Phone(s) - separate multiple with commas} :ADDRESS: %^{Address} :BIRTHDAY: %^{Birthday (YYYY-MM-DD or MM-DD)} :NICKNAME: %^{Nickname} :COMPANY: %^{Company} :TITLE: %^{Title/Position} :WEBSITE: %^{URL} :NOTE: %^{Notes} :END: Added: %U" :prepare-finalize cj/org-contacts-finalize-birthday-timestamp))) (defun cj/org-contacts-template-name () "Get name for contact template from context." (or (when (eq major-mode 'mu4e-headers-mode) (mu4e-message-field (mu4e-message-at-point) :from-or-to)) (when (eq major-mode 'mu4e-view-mode) (mu4e-message-field mu4e~view-message :from-or-to)) (read-string "Name: "))) (defun cj/org-contacts-template-email () "Get email for contact template from context." (or (when (eq major-mode 'mu4e-headers-mode) (let ((from (mu4e-message-field (mu4e-message-at-point) :from))) (when from (cdr (car from))))) (when (eq major-mode 'mu4e-view-mode) (let ((from (mu4e-message-field mu4e~view-message :from))) (when from (cdr (car from))))) (read-string "Email: "))) ;;; ------------------------- Quick Contact Functions --------------------------- (require 'system-lib) (defun cj/--org-contacts-collect (buffer) "Return an alist of (NAME POSITION INFO) for the contact headings in BUFFER. NAME is the heading text, POSITION its buffer position, and INFO the EMAIL or PHONE property value (or nil)." (with-current-buffer buffer (org-map-entries (lambda () (list (nth 4 (org-heading-components)) (point) (or (org-entry-get nil "EMAIL") (org-entry-get nil "PHONE")))) nil nil))) (defun cj/org-contacts-find () "Find a contact and jump to its heading. Collect the contact headings before prompting, so cancelling the prompt leaves point where it was, and jump to the selected heading's stored position instead of a text search that could land inside another entry." (interactive) (let* ((buf (find-file-noselect contacts-file)) (alist (cj/--org-contacts-collect buf)) (contact (completing-read "Find contact: " (cj/completion-table-annotated 'contact (lambda (cand) (let ((info (nth 2 (assoc cand alist)))) (when (and info (> (length info) 0)) (concat " " (propertize info 'face 'completions-annotations))))) alist) nil t))) (switch-to-buffer buf) (goto-char (nth 1 (assoc contact alist))) (org-fold-show-entry) (org-reveal))) (defun cj/org-contacts-new () "Create a new contact." (interactive) (org-capture nil "C")) (defun cj/org-contacts-view-all () "View all contacts in a column view." (interactive) (find-file contacts-file) (org-columns)) ;;; ----------------------------- Birthday Agenda -------------------------------- (with-eval-after-load 'org-agenda ;; Add birthdays to agenda (setq org-agenda-include-diary t) ;; Custom agenda command for upcoming birthdays (add-to-list 'org-agenda-custom-commands '("b" "Birthdays and Anniversaries" ((tags-todo "BIRTHDAY|ANNIVERSARY" ((org-agenda-overriding-header "Upcoming Birthdays and Anniversaries") (org-agenda-sorting-strategy '(time-up)))))))) ;;; ---------------------------- Core Contact Data Functions --------------------------- (defun cj/org-contacts--props-matching (entry pattern) "Return all property values from ENTRY whose keys match PATTERN (a regexp)." (let ((props (nth 2 entry))) (delq nil (mapcar (lambda (prop) (when (string-match-p pattern (car prop)) (cdr prop))) props)))) (defun cj/--parse-email-string (name email-string) "Parse EMAIL-STRING and return formatted entries for NAME. EMAIL-STRING may contain multiple emails separated by commas, semicolons, or spaces. Returns a list of strings formatted as \"Name \". Returns nil if EMAIL-STRING is nil or contains only whitespace." (when (and email-string (string-match-p "[^[:space:]]" email-string)) (let ((emails (split-string email-string "[,;[:space:]]+" t))) (mapcar (lambda (email) (format "%s <%s>" name (string-trim email))) emails)))) (defun cj/get-all-contact-emails () "Retrieve all contact emails from org-contacts database. Returns a list of formatted strings like \"Name \". This is the core function used by the mu4e integration module." (let ((contacts (org-contacts-db))) (delq nil (mapcan (lambda (e) (let* ((name (car e)) ;; This returns a LIST of email strings (email-strings (cj/org-contacts--props-matching e "EMAIL"))) ;; Process each email string using the extracted parser (mapcan (lambda (email-str) (cj/--parse-email-string name email-str)) email-strings))) contacts)))) ;; Simple insertion function for use outside of mu4e (defun cj/insert-contact-email () "Select and insert a contact's email address at point. For use outside of mu4e compose buffers. In mu4e, the integration module provides more sophisticated completion." (interactive) (let* ((items (cj/get-all-contact-emails)) (selected (completing-read "Insert contact email: " items nil t))) (insert selected))) ;;; -------------------------------- Org Contacts -------------------------------- (use-package org-contacts :after (org mu4e) ;; `org-contacts-files' is set eagerly near the top of this file, not here, ;; so the agenda-finalize anniversaries hook never sees it nil at startup. :config (require 'mu4e) ;; Basic settings (setq org-contacts-icon-use-gravatar nil) ; Don't fetch gravatars ;; Birthday and anniversary handling (setq org-contacts-birthday-format "It's %l's birthday today! 🎂") ;; Email address formatting (setq org-contacts-email-link-description-format "%s <%e>") (setq mu4e-org-contacts-file contacts-file) (add-to-list 'mu4e-headers-actions '("org-contact-add" . mu4e-action-add-org-contact) t) (add-to-list 'mu4e-view-actions '("org-contact-add" . mu4e-action-add-org-contact) t) ;; Disable mu4e's built-in completion in favor of our custom solution (setq mu4e-compose-complete-addresses nil)) ;;; ---------------------------- Org-Contacts Keymap ---------------------------- ;; Keymap for `org-contacts' commands (defvar cj/org-contacts-map (let ((map (make-sparse-keymap))) (keymap-set map "f" #'cj/org-contacts-find) ;; find contact (keymap-set map "n" #'cj/org-contacts-new) ;; new contact (keymap-set map "e" #'cj/insert-contact-email) ;; inserts email from org-contact (keymap-set map "v" #'cj/org-contacts-view-all) ;; view all contacts map) "Keymap for `org-contacts' commands.") ;; Bind the org-contacts map to the C-c C prefix (keymap-global-set "C-c C" cj/org-contacts-map) ;; which-key labels (with-eval-after-load 'which-key (which-key-add-key-based-replacements "C-c C" "contacts menu" "C-c C f" "find contact" "C-c C n" "new contact" "C-c C e" "insert email" "C-c C v" "view all contacts")) (provide 'org-contacts-config) ;;; org-contacts-config.el ends here