emacs-config/elisp/khard.el

;;; khard.el --- Emacs integration with khard -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:

(require 'with-editor)
(require 'cl-lib)
(require 'message)

(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 clean-items
        (format " (%s)" (string-join clean-items ", "))
      "")))

(defun khard--build-uid-email-phone-list ()
  "Build a list in the format (info . uid)."
  (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."
  (if-let ((uid-list (khard--build-uid-email-phone-list))
           (resp (completing-read (or prompt "Contact ") uid-list)))
      (assoc resp uid-list)))

(defun khard--process-sentinel (proc status)
  "Process sentinel for kahrd commands.
For info on PROC and STATUS, see `set-process-sentinel'."
  (when (memq (process-status proc) '(exit signal))
    (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 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' and `khard-edit'.
PROC and STR are described in `set-process-filter'."
  (let ((lines (string-split str "\n"))
        (errors nil))
    (dolist (line lines)
      (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)))
  (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 "))))
  (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."
  (if-let ((length (length list-str))
           ((>= length 2))
           (no-braces (substring list-str 1 -1)))
      (let ((output nil)
            (in-quote nil)
            (backslash nil)
            (in-value nil)
            (cur-str ""))
        (dotimes (i (- length 2))
          (let ((char (aref no-braces i)))
            (cond
             (in-quote
              (cond
               (backslash
                (setq cur-str (concat cur-str char)
                      backslash nil))
               ((= char ?\\)
                (setq backslash t))
               ((= char ?')
                (push cur-str output)
                (setq cur-str ""
                      in-quote nil))
               (t
                (setq cur-str (concat cur-str (list char))))))
             ((and in-value (= char ?'))
              (setq in-quote t))
             ((= char ?\[)
              (setq in-value t))
             ((= char ?\])
              (setq in-value nil)))))
        output)))

(defun khard--make-email-contacts-list ()
  "Make a list of email contacts from khard."
  (let ((lines (process-lines "khard" "ls"
                              "--parsable" "--fields=name,emails"))
        (output nil))
    (dolist (line lines)
      (cl-destructuring-bind (name email-list)
          (split-string line "\t")
        (dolist (email (khard--parse-email-list email-list))
          (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--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