X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epa.el;h=cdd14fbf661609a7917c2ade9201a0c6513e61e0;hb=f60e21560324db2d229d2297ae79ec39b8d818b3;hp=6e5fe128c55abba0b172bb8ad03954294e215eec;hpb=69dacd8e529f38db107ad0fc4c8531ab8c8edc5c;p=elisp%2Fepg.git diff --git a/epa.el b/epa.el index 6e5fe12..cdd14fb 100644 --- a/epa.el +++ b/epa.el @@ -152,6 +152,7 @@ (define-key keymap "d" 'epa-decrypt-file) (define-key keymap "v" 'epa-verify-file) (define-key keymap "s" 'epa-sign-file) + (define-key keymap "S" 'epa-sign-keys) (define-key keymap "e" 'epa-encrypt-file) (define-key keymap "r" 'epa-delete-keys) (define-key keymap "i" 'epa-import-keys) @@ -161,9 +162,11 @@ (define-key keymap "p" 'previous-line) (define-key keymap " " 'scroll-up) (define-key keymap [delete] 'scroll-down) - (define-key keymap "q" 'bury-buffer) + (define-key keymap "q" 'epa-exit-buffer) keymap)) +(defvar epa-exit-buffer-function #'bury-buffer) + (define-widget 'epa-key 'push-button "Button for representing a epg-key object." :format "%[%v%]" @@ -186,7 +189,9 @@ ? )) (epg-sub-key-id primary-sub-key) " " - (epg-user-id-name primary-user-id)))) + (if (stringp (epg-user-id-name primary-user-id)) + (epg-user-id-name primary-user-id) + (epg-decode-dn (epg-user-id-name primary-user-id)))))) (defun epa-key-widget-button-face-get (widget) (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list @@ -237,44 +242,59 @@ ;; In XEmacs, auto-initialization of font-lock is not effective ;; if buffer-file-name is not set. (font-lock-set-defaults) + (make-local-variable 'epa-exit-buffer-function) (run-hooks 'epa-key-mode-hook)) ;;;###autoload -(defun epa-list-keys (&optional name mode) +(defun epa-list-keys (&optional name mode protocol) (interactive (if current-prefix-arg (let ((name (read-string "Pattern: " (if epa-list-keys-arguments (car epa-list-keys-arguments))))) (list (if (equal name "") nil name) - (y-or-n-p "Secret keys? "))) - (or epa-list-keys-arguments (list nil nil)))) + (y-or-n-p "Secret keys? ") + (intern (completing-read "Protocol? " + '(("OpenPGP") ("CMS")) + nil t)))) + (or epa-list-keys-arguments (list nil nil nil)))) (unless (and epa-keys-buffer (buffer-live-p epa-keys-buffer)) (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) (set-buffer epa-keys-buffer) (let ((inhibit-read-only t) - buffer-read-only) - (erase-buffer) - (epa-list-keys-1 name mode) + buffer-read-only + (point (point-min)) + (context (epg-make-context protocol))) + (unless (get-text-property point 'epa-list-keys) + (setq point (next-single-property-change point 'epa-list-keys))) + (when point + (delete-region point + (or (next-single-property-change point 'epa-list-keys) + (point-max))) + (goto-char point)) + (epa-list-keys-1 context name mode) (epa-keys-mode)) (make-local-variable 'epa-list-keys-arguments) - (setq epa-list-keys-arguments (list name mode)) + (setq epa-list-keys-arguments (list name mode protocol)) (goto-char (point-min)) (pop-to-buffer (current-buffer))) -(defun epa-list-keys-1 (name mode) - (let ((inhibit-read-only t) - buffer-read-only - (keys (epg-list-keys name mode)) - point) - (while keys - (setq point (point)) - (insert " ") - (put-text-property point (point) 'epa-key (car keys)) - (widget-create 'epa-key :value (car keys)) - (insert "\n") - (setq keys (cdr keys))))) +(defun epa-list-keys-1 (context name mode) + (save-restriction + (narrow-to-region (point) (point)) + (let ((inhibit-read-only t) + buffer-read-only + (keys (epg-list-keys context name mode)) + point) + (while keys + (setq point (point)) + (insert " ") + (put-text-property point (point) 'epa-key (car keys)) + (widget-create 'epa-key :value (car keys)) + (insert "\n") + (setq keys (cdr keys)))) + (put-text-property (point-min) (point-max) 'epa-list-keys t))) (defun epa-marked-keys () (or (save-excursion @@ -288,9 +308,11 @@ (nreverse keys))) (save-excursion (beginning-of-line) - (get-text-property (point) 'epa-key)))) + (let ((key (get-text-property (point) 'epa-key))) + (if key + (list key)))))) -(defun epa-select-keys (prompt &optional names) +(defun epa-select-keys (context prompt &optional names mode) (save-excursion (unless (and epa-keys-buffer (buffer-live-p epa-keys-buffer)) @@ -302,6 +324,12 @@ (erase-buffer) (insert prompt "\n") (widget-create 'link + :notify (lambda (&rest ignore) (abort-recursive-edit)) + :help-echo + (substitute-command-keys + "Click here or \\[abort-recursive-edit] to cancel") + "Cancel") + (widget-create 'link :notify (lambda (&rest ignore) (exit-recursive-edit)) :help-echo (substitute-command-keys @@ -311,13 +339,14 @@ (if names (while names (setq point (point)) - (epa-list-keys-1 (car names) nil) + (epa-list-keys-1 context (car names) mode) (goto-char point) (epa-mark) (goto-char (point-max)) (setq names (cdr names))) - (epa-list-keys-1 nil nil)) + (epa-list-keys-1 context nil mode)) (epa-keys-mode) + (setq epa-exit-buffer-function #'abort-recursive-edit) (goto-char (point-min)) (pop-to-buffer (current-buffer)) (unwind-protect @@ -355,7 +384,9 @@ epg-key-validity-alist))) " ") " " - (epg-user-id-name (car pointer)) + (if (stringp (epg-user-id-name (car pointer))) + (epg-user-id-name (car pointer)) + (epg-decode-dn (epg-user-id-name (car pointer)))) "\n") (setq pointer (cdr pointer))) (setq pointer (epg-key-sub-key-list key)) @@ -413,6 +444,10 @@ (interactive "P") (epa-mark (not arg))) +(defun epa-exit-buffer () + (interactive) + (funcall epa-exit-buffer-function)) + (defun epa-decrypt-file (file) (interactive "fFile: ") (let* ((default-name (file-name-sans-extension file)) @@ -432,19 +467,13 @@ (interactive "fFile: ") (let* ((context (epg-make-context)) (plain (if (equal (file-name-extension file) "sig") - (file-name-sans-extension file))) - signature) + (file-name-sans-extension file)))) (message "Verifying %s..." (file-name-nondirectory file)) (epg-verify-file context file plain) - (setq signature (reverse (epg-context-result-for context 'verify))) - (while signature - (message "%s: %s %s %s\n" - (epg-signature-status (car signature)) - (epg-signature-key-id (car signature)) - (epg-signature-user-id (car signature)) - (epg-signature-validity (car signature))) - (setq signature (cdr signature))) - (message "Verifying %s...done" (file-name-nondirectory file)))) + (message "Verifying %s...done" (file-name-nondirectory file)) + (message "%s" + (epg-verify-result-to-string + (epg-context-result-for context 'verify))))) (defun epa-sign-file (file detached) (interactive @@ -459,18 +488,12 @@ (defun epa-encrypt-file (file recipients) (interactive (list (expand-file-name (read-file-name "File: ")) - (mapcar (lambda (key) - (epg-sub-key-id - (car (epg-key-sub-key-list key)))) - (epa-select-keys "Select recipents for encryption. -If no one is selected, symmetric encryption will be performed. ")))) + (epa-select-keys (epg-make-context) "Select recipents for encryption. +If no one is selected, symmetric encryption will be performed. "))) (let ((cipher (concat file ".gpg")) (context (epg-make-context))) (message "Encrypting %s..." (file-name-nondirectory file)) - (epg-encrypt-file context - file - recipients - cipher) + (epg-encrypt-file context file recipients cipher) (message "Encrypting %s...done" (file-name-nondirectory file)))) (defun epa-delete-keys (keys) @@ -517,6 +540,17 @@ If no one is selected, symmetric encryption will be performed. ")))) (epg-export-keys-to-file context keys file) (message "Exporting to %s...done" (file-name-nondirectory file)))) +(defun epa-sign-keys (keys &optional local) + (interactive + (let ((keys (epa-marked-keys))) + (unless keys + (error "No keys selected")) + (list keys current-prefix-arg))) + (let ((context (epg-make-context))) + (message "Signing keys...") + (epg-sign-keys context keys local) + (message "Signing keys...done"))) + (provide 'epa) ;;; epa.el ends here