diff --git a/elisp/khard.el b/elisp/khard.el index 871125c..dc4857e 100644 --- a/elisp/khard.el +++ b/elisp/khard.el @@ -1,42 +1,38 @@ -;;; khard.el --- Emacs integration with khard +;;; khard.el --- Emacs integration with khard -*- lexical-binding: t -*- ;;; Commentary: ;;; Code: (require 'with-editor) +(require 'cl-lib) +(require 'message) -(add-to-list 'display-buffer-alist '(" \\*khard output\\*" . (display-buffer-no-window))) +(defcustom khard-executable "khard" + "The executable to use to run khard." + :group 'khard + :type 'string) + +(defvar-local khard--contacts-cache () + "List of contacts used while completing at point. +This exists so that Emacs doesn't slow down while running +`completion-at-point-functions'. This is local to each buffer.") (defun khard--build-list-entry-detail (&rest items) "Build a detail in the format \" (ITEMS)\", or an empty string." (let ((clean-items (remove "" items))) - (if (not (seq-empty-p clean-items)) - (format " (%s)" - (string-join clean-items ", ")) + (if clean-items + (format " (%s)" (string-join clean-items ", ")) ""))) -(defun khard--remove-leading-label (field) - "Remove a leading \"name: \" from FIELD." - (if-let (index (string-search ":" field)) - (substring field (+ index 2)) - field)) - (defun khard--build-uid-email-phone-list () "Build a list in the format (info . uid)." - (let ((lines (process-lines "khard" - "ls" - "--parsable" - "--fields=uid,name,email,phone"))) - (mapcar (lambda (line) - (let* ((fields (split-string line "\t")) - (uid (car fields)) - (name (cadr fields)) - (email (khard--remove-leading-label (caddr fields))) - (phone (khard--remove-leading-label (cadddr fields)))) - (cons (format "%s%s" - name - (khard--build-list-entry-detail email phone uid)) - uid))) - lines))) + (cl-loop for line in + (process-lines "khard" "ls" + "--parsable" "--fields=uid,name,email,phone") + for (uid name email phone) = (split-string line "\t") + collect + (cons (format "%s%s" name + (khard--build-list-entry-detail email phone uid)) + uid))) (defun khard--prompt-contact (&optional prompt) "Prompt user for a contact, optionally make the prompt text PROMPT." @@ -48,69 +44,69 @@ "Process sentinel for kahrd commands. For info on PROC and STATUS, see `set-process-sentinel'." (when (memq (process-status proc) '(exit signal)) - (shell-command-set-point-after-cmd (process-buffer proc)) (message "khard: %s." (substring status 0 -1)))) +(cl-defun khard--run-khard (args &key filter) + "Run khard with ARGS. +FILTER is a process filter to install on the child process." + (let ((process-environment process-environment)) + (setenv "EDITOR" with-editor-sleeping-editor) + (make-process + :name (concat "khard" (car args)) + :command (apply 'list khard-executable args) + :buffer nil + :filter filter + :sentinel 'khard--process-sentinel))) + (defun khard-delete (contact no-confirm) "Delete CONTACT, which is of the form (name . uid). When called interactively, prompt the user. If NO-CONFIRM is nil, do not ask the user." (interactive (list (khard--prompt-contact "Delete Contact ") nil)) (when (or no-confirm (yes-or-no-p (format "Really delete \"%s\"? " - (car-safe contact)))) - (make-process :name "khard delete" - :command - `("khard" "delete" "--force" - ,(format "uid:%s" (cdr-safe contact))) - :buffer " *khard output*" - :sentinel #'khard--process-sentinel))) + (car contact)))) + (khard--run-khard (list "delete" "--force" + (format "uid:%s" (cdr contact)))))) (defun khard--prompt-address-book () "Prompt for an address book." (completing-read "Address Book " (process-lines "khard" "abooks"))) (defun khard--new-process-filter (proc str) - "Process filter for `khard-new'. + "Process filter for `khard-new' and `khard-edit'. PROC and STR are described in `set-process-filter'." (let ((lines (string-split str "\n")) - (error-msg nil)) + (errors nil)) (dolist (line lines) - (if (equal - "Do you want to open the editor again? (y/N) " - line) - (if (y-or-n-p (format "%sReopen the editor? " - (or error-msg - "Unknown error"))) - (process-send-string proc "y\n") - (process-send-string proc "n\n")) - (setq error-msg (concat error-msg "\n" line))))) + (cond + ((string-prefix-p "Do you want to open the editor again? " line) + (if (y-or-n-p (format "%sReopen the editor? " + (cond + ((null errors) + "") + ((length= errors 1) + (concat (cl-first errors) ". ")) + (t + (concat (string-join errors "\n") "\n"))))) + (process-send-string proc "y\n") + (process-send-string proc "n\n"))) + ((string-match (rx bos "Error: " (group (+ any)) eol) line) + (push (match-string 1 line) errors))))) (with-editor-process-filter proc str t)) (defun khard-new (abook) "Create a new card and open it in an new buffer to edit. When called interactively, prompt for ABOOK." (interactive (list (khard--prompt-address-book))) - (when abook - (let ((error-msg nil)) - (make-process :name "khard new" - :command - `("env" ,(concat "EDITOR=" with-editor-sleeping-editor) - "khard" "new" "--edit" "-a" ,abook) - :buffer " *khard output*" - :filter #'khard--new-process-filter - :sentinel #'khard--process-sentinel)))) + (khard--run-khard (list "new" "--edit" "-a" abook) + :filter 'khard--new-process-filter)) (defun khard-edit (uid) "Edit the contact with UID. When called interactively, prompt the user." (interactive (list (cdr-safe (khard--prompt-contact "Edit Contact ")))) - (make-process :name "khard edit" - :command - `("env" ,(concat "EDITOR=" with-editor-sleeping-editor) - "khard" "edit" "--edit" ,(format "uid:%s" uid)) - :buffer " *khard output*" - :filter #'khard--new-process-filter - :sentinel #'khard--process-sentinel)) + (khard--run-khard (list "edit" "--edit" (format "uid:%s" uid)) + :filter 'khard--new-process-filter)) (defun khard--parse-email-list (list-str) "Parse LIST-STR, a python dictionary and array string of emails." @@ -133,7 +129,7 @@ When called interactively, prompt the user." ((= char ?\\) (setq backslash t)) ((= char ?') - (add-to-list 'output cur-str) + (push cur-str output) (setq cur-str "" in-quote nil)) (t @@ -148,27 +144,65 @@ When called interactively, prompt the user." (defun khard--make-email-contacts-list () "Make a list of email contacts from khard." - (let ((lines (process-lines "khard" - "ls" - "--parsable" - "--fields=name,emails")) + (let ((lines (process-lines "khard" "ls" + "--parsable" "--fields=name,emails")) (output nil)) (dolist (line lines) - (let* ((fields (split-string line "\t")) - (name (car fields)) - (email-list (cadr fields))) + (cl-destructuring-bind (name email-list) + (split-string line "\t") (dolist (email (khard--parse-email-list email-list)) - (add-to-list 'output (format "%s <%s>" - name - email))))) - output)) + (push (format "%s <%s>" + name + email) + output)))) + (seq-uniq output))) + +(defun khard--contacts-cache (&optional force) + "Return the contacts cache, building it if nessesary. +With FORCE, rebuild the cache no matter what." + (when (or force (not khard--contacts-cache)) + (setq-local khard--contacts-cache (khard--make-email-contacts-list))) + khard--contacts-cache) (defun khard-insert-email-contact () "Use `completing-read' to prompt for and insert a khard contact." (interactive) (if-let (contact (completing-read "Insert Contact " - (khard--make-email-contacts-list))) + (khard--contacts-cache t))) (insert contact))) +(defun khard--message-in-header-p (name &optional testfn) + "If in field NAME, return the start of the header, otherwise, return nil. +The name is compared with the field name using TESTFN (defaults to `equal')." + (save-excursion + (when (and (message-point-in-header-p) + (message-beginning-of-header t)) + (beginning-of-line) + (when (and (looking-at (rx bol (group (+? any)) ":" (? " "))) + (funcall (or testfn 'equal) (match-string 1) name)) + (match-end 0))))) + +(defun khard-message-mode-capf () + "Completion at point function for khard contacts in message mode." + (interactive) + (when-let ((field-start (khard--message-in-header-p "To"))) + (save-excursion + (let ((end (point))) + (re-search-backward (rx (any "\n" "," ":") (* whitespace)) + field-start t) + (list (match-end 0) end (khard--contacts-cache)))))) + +(defun khard-refresh-contact-cache (all-buffers &optional no-refresh) + "Refresh the khard contact cache. +When ALL-BUFFERS is non-nil, as it is with a prefix argument, refresh the cache +of all buffers. With NO-REFRESH, don't refresh the cache, just clear it." + (interactive "P") + (let ((new-cache (and (not no-refresh) (khard--make-email-contacts-list)))) + (if all-buffers + (cl-loop for buf being the buffers do + (setf (buffer-local-value 'khard--contacts-cache buf) + new-cache)) + (setq-local khard--contacts-cache new-cache)))) + (provide 'khard) ;;; khard.el ends here diff --git a/init.el b/init.el index 1544f4c..831a77f 100644 --- a/init.el +++ b/init.el @@ -20,9 +20,9 @@ ;; use-package (eval-when-compile + (require 'use-package) (setq use-package-always-ensure t - package-user-dir "~/.emacs.d/var/elpa") - (require 'use-package)) + package-user-dir "~/.emacs.d/var/elpa")) ;; no-littering (use-package no-littering @@ -48,8 +48,8 @@ (use-package emacs :hook (;;(emacs-lisp-mode . my/-emacs-lisp-mode-setup-evil-lookup) ;;(prog-mode . electric-pair-local-mode) - ((text-mode message-mode tex-mode prog-mode) . auto-fill-mode) - ((text-mode message-mode tex-mode prog-mode) . my/-enable-show-trailing-whitespace)) + ((text-mode tex-mode prog-mode) . auto-fill-mode) + ((text-mode tex-mode prog-mode) . my/-enable-show-trailing-whitespace)) :init (defun my/-enable-show-trailing-whitespace () (setq-local show-trailing-whitespace t)) @@ -435,14 +435,14 @@ directory. Otherwise, run `find-file' on that file." :map evil-cleverparens-mode-map ("C-c o" . evil-cp-open-below-form)) :custom + (evil-cleverparens-use-s-and-S nil) + :config (eldoc-add-command 'paredit-RET 'paredit-open-round 'paredit-open-angled 'paredit-open-bracket 'paredit-open-angled 'paredit-open-parenthesis) - (evil-cleverparens-use-s-and-S nil) - :config (define-key evil-cleverparens-mode-map (kbd " M-o") nil t) (defun my/-enable-evil-cleverparens () (if (member major-mode '(lisp-mode emacs-lisp-mode @@ -712,7 +712,8 @@ visual states." ;; Only run this if we are not in `TeX-mode' (unless (bound-and-true-p TeX-mode-p) (setq-local completion-at-point-functions - '(cape-dict cape-dabbrev) + (nconc completion-at-point-functions '(cape-dict + cape-dabbrev)) corfu-auto nil)))) ;; xref @@ -1734,13 +1735,27 @@ If no name is given, list all bookmarks instead." ;; khard contacts (require 'khard) +;; This is also in khard (see above), it's just also here so that if I remove +;; that file ever, other things will not break. +(defun my/message-in-header-p (name &optional testfn) + "If in field NAME, return the start of the header, otherwise, return nil. +The name is compared with the field name using TESTFN (defaults to `equal')." + (save-excursion + (when (and (message-point-in-header-p) + (message-beginning-of-header t)) + (beginning-of-line) + (when (and (looking-at (rx bol (group (+? any)) ":" (? " "))) + (funcall (or testfn 'equal) (match-string 1) name)) + (match-end 0))))) + ;; mu4e (use-package mu4e :ensure nil :defer nil :hook ((mu4e-index-updated . my/-mu4e-enable-index-messages) (mu4e-main-mode . my/-mu4e-setup-main-mode) - (mu4e-view-mode . my/-mu4e-setup-view-mode)) + (mu4e-view-mode . my/-mu4e-setup-view-mode) + (mu4e-compose-mode . my/-mu4e-setup-compose-mode)) :bind (("C-x C-m" . mu4e) ("C-x m" . mu4e-compose-new) :map message-mode-map @@ -1779,6 +1794,22 @@ If no name is given, list all bookmarks instead." (interactive) (mu4e--view-in-headers-context (my/mu4e-headers-mark-for-trash))) + (defun my/-mu4e-enable-autocomplete-in-header () + ;; corfu auto must be t (not the integer returned by + ;; `my/message-in-header-p' + (setq-local corfu-auto (and (not (window-minibuffer-p)) + (my/message-in-header-p "To") + t))) + (defun my/-mu4e-setup-compose-mode () + (add-hook 'post-command-hook 'my/-mu4e-enable-autocomplete-in-header + nil t) + (add-to-list + (make-local-variable 'completion-at-point-functions) + (cape-capf-super #'mu4e-complete-contact #'khard-message-mode-capf))) + (defun my/-mu4e-fix-cycle-threshold () + (setq-local completion-cycle-threshold nil)) + (advice-add 'mu4e--compose-setup-completion :after + 'my/-mu4e-fix-cycle-threshold) (setq message-kill-buffer-on-exit t message-send-mail-function 'sendmail-send-it mu4e-change-filenames-when-moving t