209 lines
7.9 KiB
EmacsLisp
209 lines
7.9 KiB
EmacsLisp
;;; 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
|