[PATCH v1 1/4] emacs: Asynchronous retrieval of GPG keys

Subject: [PATCH v1 1/4] emacs: Asynchronous retrieval of GPG keys

Date: Tue, 4 Sep 2018 14:28:40 +0100

To: notmuch@notmuchmail.org

Cc:

From: David Edmondson


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 | 67 +++++++++++++++++++++++++++++++++++++++++--------
 1 file changed, 57 insertions(+), 10 deletions(-)

diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el
index fc2b5301..e9ef7b54 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,61 @@ 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 retrieving the key was successful, 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.
+      (when (= exit-status 0)
+	(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-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
+	(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

_______________________________________________
notmuch mailing list
notmuch@notmuchmail.org
https://notmuchmail.org/mailman/listinfo/notmuch

Thread: