X-Git-Url: https://git.notmuchmail.org/git?p=notmuch;a=blobdiff_plain;f=emacs%2Fnotmuch-crypto.el;h=94da325d8a72177735d399ce8db4a4aef2348484;hp=cb02840d14639d0a8828bdf206618e4bb304e327;hb=17a06ab990217fe3f8d71d9fd2520bcfbb79d9ed;hpb=cb8418784c21155ffea79cce8409a7ea3c546937 diff --git a/emacs/notmuch-crypto.el b/emacs/notmuch-crypto.el index cb02840d..94da325d 100644 --- a/emacs/notmuch-crypto.el +++ b/emacs/notmuch-crypto.el @@ -31,41 +31,81 @@ on the success or failure of the verification process and on the validity of user ID of the signer. The effect of setting this variable can be seen temporarily by -viewing a signed or encrypted message with M-RET in notmuch -search." - :group 'notmuch - :type 'boolean) +providing a prefix when viewing a signed or encrypted message, or +by providing a prefix when reloading the message in notmuch-show +mode." + :type 'boolean + :group 'notmuch-crypto) + +(defface notmuch-crypto-part-header + '((t (:foreground "blue"))) + "Face used for crypto parts headers." + :group 'notmuch-crypto + :group 'notmuch-faces) + +(defface notmuch-crypto-signature-good + '((t (:background "green" :foreground "black"))) + "Face used for good signatures." + :group 'notmuch-crypto + :group 'notmuch-faces) + +(defface notmuch-crypto-signature-good-key + '((t (:background "orange" :foreground "black"))) + "Face used for good signatures." + :group 'notmuch-crypto + :group 'notmuch-faces) + +(defface notmuch-crypto-signature-bad + '((t (:background "red" :foreground "black"))) + "Face used for bad signatures." + :group 'notmuch-crypto + :group 'notmuch-faces) + +(defface notmuch-crypto-signature-unknown + '((t (:background "red" :foreground "black"))) + "Face used for signatures of unknown status." + :group 'notmuch-crypto + :group 'notmuch-faces) + +(defface notmuch-crypto-decryption + '((t (:background "purple" :foreground "black"))) + "Face used for encryption/decryption status messages." + :group 'notmuch-crypto + :group 'notmuch-faces) (define-button-type 'notmuch-crypto-status-button-type - 'action '(lambda (button) (message (button-get button 'help-echo))) + 'action (lambda (button) (message (button-get button 'help-echo))) 'follow-link t - 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts." - 'face '(:foreground "blue") - 'mouse-face '(:foreground "blue")) + 'help-echo "Set notmuch-crypto-process-mime to process cryptographic mime parts.") (defun notmuch-crypto-insert-sigstatus-button (sigstatus from) (let* ((status (plist-get sigstatus :status)) (help-msg nil) (label "Signature not processed") - (face '(:background "red" :foreground "black"))) + (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 '(:background "green" :foreground "black"))) - (let ((fingerprint (concat "0x" (plist-get sigstatus :fingerprint)))) - (setq label (concat "Good signature by key: " fingerprint)) - (setq face '(:background "orange" :foreground "black"))))) + (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 face '(:background "red" :foreground "black")))) + (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 ")")) - (setq face '(:background "red" :foreground "black")))) + (setq face 'notmuch-crypto-signature-bad))) (t (setq label "Unknown signature status") (if status (setq label (concat label " \"" status "\""))))) @@ -75,15 +115,43 @@ 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 reset-state)) + +(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 + (goto-char (point-max)) + (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 + (goto-char (point-max)) + (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 t))) + (defun notmuch-crypto-insert-encstatus-button (encstatus) (let* ((status (plist-get encstatus :status)) (help-msg nil) (label "Decryption not attempted") - (face '(:background "purple" :foreground "black"))) + (face 'notmuch-crypto-decryption)) (cond ((string= status "good") (setq label "Decryption successful"))