From: David Edmondson <dme@dme.org>
To: notmuch@notmuchmail.org
Subject: [PATCH v2 1/4] emacs: Asynchronous retrieval of GPG keys
Date: Fri, 7 Sep 2018 12:29:17 +0100 [thread overview]
Message-ID: <20180907112920.3130-2-dme@dme.org> (raw)
In-Reply-To: <20180907112920.3130-1-dme@dme.org>
Rather than blocking emacs while gpg does its' thing, by default run
key retrieval asynchronously, possibly updating the display of the
message on successful completion.
---
emacs/notmuch-crypto.el | 79 ++++++++++++++++++++++++++++++++++++++++++-------
1 file changed, 69 insertions(+), 10 deletions(-)
diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el
index fc2b5301..ddb447a6 100644
--- a/emacs/notmuch-crypto.el
+++ b/emacs/notmuch-crypto.el
@@ -43,6 +43,11 @@ mode."
:package-version '(notmuch . "0.25")
:group 'notmuch-crypto)
+(defcustom notmuch-crypto-get-keys-asynchronously t
+ "Retrieve gpg keys asynchronously."
+ :type 'boolean
+ :group 'notmuch-crypto)
+
(defface notmuch-crypto-part-header
'((((class color)
(background dark))
@@ -145,19 +150,73 @@ mode."
(call-process epg-gpg-program nil t t "--list-keys" fingerprint))
(recenter -1))))
+(defun notmuch-crypto--async-key-sentinel (process event)
+ "When the user asks for a GPG key to be retrieved
+asynchronously, handle completion of that task."
+ (let ((status (process-status process))
+ (exit-status (process-exit-status process))
+ (keyid (process-get process :gpg-key-id)))
+ (when (memq status '(exit signal))
+ (message "Getting the GPG key %s asynchronously...%s."
+ keyid
+ (if (= exit-status 0)
+ "completed"
+ "failed"))
+ ;; If the original buffer is still alive and point didn't move
+ ;; (i.e. the user didn't move on or away), refresh the buffer to
+ ;; show the updated signature status.
+ (let ((show-buffer (process-get process :notmuch-show-buffer))
+ (show-point (process-get process :notmuch-show-point)))
+ (when (and (bufferp show-buffer)
+ (buffer-live-p show-buffer)
+ (= show-point
+ (with-current-buffer show-buffer
+ (point))))
+ (with-current-buffer show-buffer
+ (notmuch-show-refresh-view)))))))
+
+(defun notmuch-crypto--set-button-label (button label)
+ "Set the text displayed in BUTTON to LABEL."
+ (save-excursion
+ (let ((inhibit-read-only t))
+ ;; This knows rather too much about how we typically format
+ ;; buttons.
+ (goto-char (button-start button))
+ (forward-char 2)
+ (delete-region (point) (- (button-end button) 2))
+ (insert label))))
+
(defun notmuch-crypto-sigstatus-error-callback (button)
(let* ((sigstatus (button-get button :notmuch-sigstatus))
(keyid (concat "0x" (plist-get sigstatus :keyid)))
- (buffer (get-buffer-create "*notmuch-crypto-gpg-out*"))
- (window (display-buffer buffer t nil)))
- (with-selected-window window
- (with-current-buffer buffer
- (goto-char (point-max))
- (call-process epg-gpg-program nil t t "--recv-keys" keyid)
- (insert "\n")
- (call-process epg-gpg-program nil t t "--list-keys" keyid))
- (recenter -1))
- (notmuch-show-refresh-view)))
+ (buffer (get-buffer-create "*notmuch-crypto-gpg-out*")))
+ (if notmuch-crypto-get-keys-asynchronously
+ (progn
+ (notmuch-crypto--set-button-label
+ button (format "Retrieving key %s asynchronously..." keyid))
+ (let ((p (make-process :name "notmuch GPG key retrieval"
+ :buffer buffer
+ :command (list epg-gpg-program "--recv-keys" keyid)
+ :connection-type 'pipe
+ :sentinel #'notmuch-crypto--async-key-sentinel
+ ;; Create the process stopped so that
+ ;; we have time to store the key id,
+ ;; etc. on it.
+ :stop t)))
+ (process-put p :gpg-key-id keyid)
+ (process-put p :notmuch-show-buffer (current-buffer))
+ (process-put p :notmuch-show-point (point))
+ (message "Getting the GPG key %s asynchronously..." keyid)
+ (continue-process p)))
+ (let ((window (display-buffer buffer t nil)))
+ (with-selected-window window
+ (with-current-buffer buffer
+ (goto-char (point-max))
+ (call-process epg-gpg-program nil t t "--recv-keys" keyid)
+ (insert "\n")
+ (call-process epg-gpg-program nil t t "--list-keys" keyid))
+ (recenter -1))
+ (notmuch-show-refresh-view)))))
(defun notmuch-crypto-insert-encstatus-button (encstatus)
(let* ((status (plist-get encstatus :status))
--
2.11.0
next prev parent reply other threads:[~2018-09-07 11:29 UTC|newest]
Thread overview: 13+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-09-07 11:29 [PATCH v2 0/4] Retrieve GPG keys asynchronously David Edmondson
2018-09-07 11:29 ` David Edmondson [this message]
2018-09-30 1:48 ` [PATCH v2 1/4] emacs: Asynchronous retrieval of GPG keys David Bremner
2018-10-01 9:48 ` David Edmondson
2018-10-01 11:00 ` David Bremner
2018-09-07 11:29 ` [PATCH v2 2/4] emacs: Minor refactoring of crypto code David Edmondson
2018-09-30 12:07 ` David Bremner
2018-10-01 9:49 ` David Edmondson
2018-09-07 11:29 ` [PATCH v2 3/4] emacs: Add notmuch-crypto-gpg-program and use it David Edmondson
2018-09-30 11:34 ` David Bremner
2018-10-01 9:52 ` David Edmondson
2018-10-01 11:02 ` David Bremner
2018-09-07 11:29 ` [PATCH v2 4/4] emacs: Improve the reporting of key activity David Edmondson
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://notmuchmail.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20180907112920.3130-2-dme@dme.org \
--to=dme@dme.org \
--cc=notmuch@notmuchmail.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://yhetil.org/notmuch.git/
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).