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