[PATCH] emacs: Add callback functions to crypto sigstatus button.

diff --git a/eb/55189159ed08b73b39adcf3a9b3320c0c58d4e b/eb/55189159ed08b73b39adcf3a9b3320c0c58d4e
new file mode 100644 (file)
index 0000000..0849683
--- /dev/null
+++ b/eb/55189159ed08b73b39adcf3a9b3320c0c58d4e
@@ -0,0 +1,143 @@
+Return-Path: <jrollins@servo.finestructure.net>\r
+X-Original-To: notmuch@notmuchmail.org\r
+Delivered-To: notmuch@notmuchmail.org\r
+Received: from localhost (localhost [127.0.0.1])\r
+       by olra.theworths.org (Postfix) with ESMTP id 1E4FA429E2B\r
+       for <notmuch@notmuchmail.org>; Tue, 31 May 2011 10:07:21 -0700 (PDT)\r
+X-Virus-Scanned: Debian amavisd-new at olra.theworths.org\r
+X-Spam-Flag: NO\r
+X-Spam-Score: -1.921\r
+X-Spam-Level: \r
+X-Spam-Status: No, score=-1.921 tagged_above=-999 required=5\r
+       tests=[NO_DNS_FOR_FROM=0.379, RCVD_IN_DNSWL_MED=-2.3]\r
+       autolearn=disabled\r
+Received: from olra.theworths.org ([127.0.0.1])\r
+       by localhost (olra.theworths.org [127.0.0.1]) (amavisd-new, port 10024)\r
+       with ESMTP id CM1yeSxeT-b8 for <notmuch@notmuchmail.org>;\r
+       Tue, 31 May 2011 10:07:18 -0700 (PDT)\r
+Received: from outgoing-mail.its.caltech.edu (outgoing-mail.its.caltech.edu\r
+       [131.215.239.19])\r
+       by olra.theworths.org (Postfix) with ESMTP id BF883431FB6\r
+       for <notmuch@notmuchmail.org>; Tue, 31 May 2011 10:07:18 -0700 (PDT)\r
+Received: from fire-doxen.imss.caltech.edu (localhost [127.0.0.1])\r
+       by fire-doxen-postvirus (Postfix) with ESMTP id 0B58A328266;\r
+       Tue, 31 May 2011 10:00:39 -0700 (PDT)\r
+X-Spam-Scanned: at Caltech-IMSS on fire-doxen by amavisd-new\r
+Received: from servo.finestructure.net (cpe-98-149-172-122.socal.res.rr.com\r
+       [98.149.172.122]) (Authenticated sender: jrollins)\r
+       by fire-doxen-submit (Postfix) with ESMTP id 0A24C3280D3;\r
+       Tue, 31 May 2011 10:00:36 -0700 (PDT)\r
+Received: by servo.finestructure.net (Postfix, from userid 1000)\r
+       id ED87D7A0; Tue, 31 May 2011 10:07:14 -0700 (PDT)\r
+From: Jameson Graef Rollins <jrollins@finestructure.net>\r
+To: Notmuch Mail <notmuch@notmuchmail.org>\r
+Subject: [PATCH] emacs: Add callback functions to crypto sigstatus button.\r
+Date: Tue, 31 May 2011 10:07:13 -0700\r
+Message-Id: <1306861633-3873-1-git-send-email-jrollins@finestructure.net>\r
+X-Mailer: git-send-email 1.7.4.4\r
+X-BeenThere: notmuch@notmuchmail.org\r
+X-Mailman-Version: 2.1.13\r
+Precedence: list\r
+List-Id: "Use and development of the notmuch mail system."\r
+       <notmuch.notmuchmail.org>\r
+List-Unsubscribe: <http://notmuchmail.org/mailman/options/notmuch>,\r
+       <mailto:notmuch-request@notmuchmail.org?subject=unsubscribe>\r
+List-Archive: <http://notmuchmail.org/pipermail/notmuch>\r
+List-Post: <mailto:notmuch@notmuchmail.org>\r
+List-Help: <mailto:notmuch-request@notmuchmail.org?subject=help>\r
+List-Subscribe: <http://notmuchmail.org/mailman/listinfo/notmuch>,\r
+       <mailto:notmuch-request@notmuchmail.org?subject=subscribe>\r
+X-List-Received-Date: Tue, 31 May 2011 17:07:21 -0000\r
+\r
+This adds two callback functions to the sigstatus button.  If the sig\r
+status is "good", then clicking the button displays the output of "gpg\r
+--list-keys" on the key fingerprint.  If the sigstatus is "bad", then\r
+clicking the button will retrieve the key from the keyserver, and\r
+redisplay the current buffer.\r
+\r
+Thanks to David Bremner <bremner@unb.ca> for help with this.\r
+---\r
+ emacs/notmuch-crypto.el |   52 +++++++++++++++++++++++++++++++++++++---------\r
+ 1 files changed, 42 insertions(+), 10 deletions(-)\r
+\r
+diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el\r
+index f03266f..096dc5e 100644\r
+--- a/emacs/notmuch-crypto.el\r
++++ b/emacs/notmuch-crypto.el\r
+@@ -70,20 +70,26 @@ search."\r
+   (let* ((status (plist-get sigstatus :status))\r
+        (help-msg nil)\r
+        (label "Signature not processed")\r
+-       (face 'notmuch-crypto-signature-unknown))\r
++       (face 'notmuch-crypto-signature-unknown)\r
++       (button-action '(lambda (button) (message (button-get button 'help-echo)))))\r
+     (cond\r
+      ((string= status "good")\r
+-      ; if userid present, userid has full or greater validity\r
+-      (if (plist-member sigstatus :userid)\r
+-        (let ((userid (plist-get sigstatus :userid)))\r
+-          (setq label (concat "Good signature by: " userid))\r
+-          (setq face 'notmuch-crypto-signature-good))\r
+-      (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint))))\r
+-        (setq label (concat "Good signature by key: " fingerprint))\r
+-        (setq face 'notmuch-crypto-signature-good-key))))\r
++      (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint))))\r
++      ;; if userid present, userid has full or greater validity\r
++      (if (plist-member sigstatus :userid)\r
++          (let ((userid (plist-get sigstatus :userid)))\r
++            (setq label (concat "Good signature by: " userid))\r
++            (setq face 'notmuch-crypto-signature-good))\r
++        (progn\r
++          (setq label (concat "Good signature by key: " fingerprint))\r
++          (setq face 'notmuch-crypto-signature-good-key)))\r
++      (setq button-action 'notmuch-crypto-sigstatus-good-callback)\r
++      (setq help-msg (concat "Click to list key ID 0x" fingerprint "."))))\r
+      ((string= status "error")\r
+       (let ((keyid (concat "0x" (plist-get sigstatus :keyid))))\r
+-      (setq label (concat "Unknown key ID " keyid " or unsupported algorithm"))))\r
++      (setq label (concat "Unknown key ID " keyid " or unsupported algorithm"))\r
++      (setq button-action 'notmuch-crypto-sigstatus-error-callback)\r
++      (setq help-msg (concat "Click to retreive key ID " keyid " from keyserver and redisplay."))))\r
+      ((string= status "bad")\r
+       (let ((keyid (concat "0x" (plist-get sigstatus :keyid))))\r
+       (setq label (concat "Bad signature (claimed key ID " keyid ")"))\r
+@@ -97,10 +103,36 @@ search."\r
+      'help-echo help-msg\r
+      'face face\r
+      'mouse-face face\r
++     'action button-action\r
+      :notmuch-sigstatus sigstatus\r
+      :notmuch-from from)\r
+     (insert "\n")))\r
+ \r
++(declare-function notmuch-show-refresh-view "notmuch-show" (&optional crypto-switch))\r
++\r
++(defun notmuch-crypto-sigstatus-good-callback (button)\r
++  (let* ((sigstatus (button-get button :notmuch-sigstatus))\r
++       (fingerprint (concat "0x" (plist-get sigstatus :fingerprint)))\r
++       (buffer (get-buffer-create "*notmuch-crypto-gpg-out*"))\r
++       (window (display-buffer buffer t nil)))\r
++    (with-selected-window window\r
++      (with-current-buffer buffer\r
++      (call-process "gpg" nil t t "--list-keys" fingerprint))\r
++      (recenter -1))))\r
++\r
++(defun notmuch-crypto-sigstatus-error-callback (button)\r
++  (let* ((sigstatus (button-get button :notmuch-sigstatus))\r
++       (keyid (concat "0x" (plist-get sigstatus :keyid)))\r
++       (buffer (get-buffer-create "*notmuch-crypto-gpg-out*"))\r
++       (window (display-buffer buffer t nil)))\r
++    (with-selected-window window\r
++      (with-current-buffer buffer\r
++      (call-process "gpg" nil t t "--recv-keys" keyid)\r
++      (insert "\n")\r
++      (call-process "gpg" nil t t "--list-keys" keyid))\r
++      (recenter -1))\r
++    (notmuch-show-refresh-view)))\r
++\r
+ (defun notmuch-crypto-insert-encstatus-button (encstatus)\r
+   (let* ((status (plist-get encstatus :status))\r
+        (help-msg nil)\r
+-- \r
+1.7.4.4\r
+\r