X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=epa.el;h=49ddd4a72a758e08f6cad6d6107f2605648649ac;hb=372371d54ef4c1060f3cfc70e557b28f4a4f8ee1;hp=6e96a7b856846446391fddd6d3cfc269db9bef46;hpb=7f1f6fca222a32fc153ffddfc180d3d0855c2650;p=elisp%2Fepg.git diff --git a/epa.el b/epa.el index 6e96a7b..49ddd4a 100644 --- a/epa.el +++ b/epa.el @@ -1,4 +1,4 @@ -;;; epa.el --- EasyPG Assistant, GUI of EasyPG +;;; epa.el --- the EasyPG Assistant ;; Copyright (C) 2006 Daiki Ueno ;; Author: Daiki Ueno @@ -29,15 +29,13 @@ (eval-when-compile (require 'wid-edit)) (defgroup epa nil - "EasyPG Assistant, GUI of EasyPG." + "The EasyPG Assistant" :group 'epg) (defgroup epa-faces nil "Faces for epa-mode." :group 'epa) -(defvar epa-buffer nil) - (defface epa-validity-high-face '((((class color) (background dark)) (:foreground "PaleTurquoise" :bold t)) @@ -132,7 +130,7 @@ (3 . ?s) (16 . ?g) (17 . ?D) - (20 . G))) + (20 . ?G))) (defvar epa-keys-buffer nil) (defvar epa-key-buffer-alist nil) @@ -142,6 +140,10 @@ (let ((keymap (make-sparse-keymap))) (define-key keymap "m" 'epa-mark) (define-key keymap "u" 'epa-unmark) + (define-key keymap "d" 'epa-decrypt-file) + (define-key keymap "v" 'epa-verify-file) + (define-key keymap "s" 'epa-sign-file) + (define-key keymap "e" 'epa-encrypt-file) (define-key keymap "n" 'next-line) (define-key keymap "p" 'previous-line) (define-key keymap " " 'scroll-up) @@ -205,7 +207,7 @@ (let ((inhibit-read-only t) buffer-read-only keys point primary-sub-key primary-user-id) - (setq keys (epg-list-keys)) + (setq keys (epg-list-keys name)) (while keys (setq point (point) primary-sub-key (car (epg-key-sub-key-list (car keys))) @@ -217,43 +219,59 @@ (widget-create 'link :tag (epg-sub-key-id primary-sub-key) :notify 'epa-show-key-notify + :help-echo + (format "Show key %s" + (epg-sub-key-id primary-sub-key)) (car keys)) (insert " " (epg-user-id-name primary-user-id) "\n") (put-text-property point (point) 'epa-key (car keys)) (setq keys (cdr keys))))) -(defun epa-ask-keys (prompt function &optional names &rest args) - (unless (and epa-keys-buffer - (buffer-live-p epa-keys-buffer)) - (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) - (let ((buffer (current-buffer)) - (inhibit-read-only t) - buffer-read-only) - (set-buffer epa-keys-buffer) - (erase-buffer) - (insert prompt) - (widget-create 'push-button - :tag "Done" - :notify (lambda (widget &rest ignore) - (let ((callback (widget-value widget)) - keys key) - (while (re-search-forward "^\\*" nil t) - (if (setq key (get-text-property (point) - 'epa-key)) - (setq keys (cons key keys)))) - (set-buffer (car callback)) - (apply (car (cdr callback)) keys - (cdr (cdr callback))))) - (cons buffer (cons function args))) - (insert "\n\n") - (if names - (while names - (epa-list-keys-1 (car names)) - (setq names (cdr names))) - (epa-list-keys-1 nil)) - (epa-keys-mode) - (goto-char (point-min)) - (pop-to-buffer (current-buffer)))) +(defun epa-select-keys (prompt &optional names) + (save-excursion + (unless (and epa-keys-buffer + (buffer-live-p epa-keys-buffer)) + (setq epa-keys-buffer (generate-new-buffer "*Keys*"))) + (let ((inhibit-read-only t) + buffer-read-only + point) + (set-buffer epa-keys-buffer) + (erase-buffer) + (insert prompt "\n") + (widget-create 'link + :notify (lambda (&rest ignore) (exit-recursive-edit)) + :help-echo + (substitute-command-keys + "Click here or \\[exit-recursive-edit] to finish") + "OK") + (insert "\n\n") + (if names + (while names + (setq point (point)) + (epa-list-keys-1 (car names)) + (goto-char point) + (epa-mark) + (goto-char (point-max)) + (setq names (cdr names))) + (epa-list-keys-1 nil)) + (epa-keys-mode) + (goto-char (point-min)) + (pop-to-buffer (current-buffer)) + (unwind-protect + (progn + (recursive-edit) + (save-excursion + (set-buffer epa-keys-buffer) + (goto-char (point-min)) + (let (keys key) + (while (re-search-forward "^\\*" nil t) + (if (setq key (get-text-property (match-beginning 0) + 'epa-key)) + (setq keys (cons key keys)))) + (nreverse keys)))) + (if (get-buffer-window epa-keys-buffer) + (delete-window (get-buffer-window epa-keys-buffer))) + (kill-buffer epa-keys-buffer))))) (defun epa-show-key (key) (let* ((primary-sub-key (car (epg-key-sub-key-list key))) @@ -318,31 +336,87 @@ (defun epa-show-key-notify (widget &rest ignore) (epa-show-key (widget-value widget))) -(defun epa-mark () +(defun epa-mark (&optional arg) "Mark the current line." - (interactive) + (interactive "P") (let ((inhibit-read-only t) buffer-read-only properties) (beginning-of-line) (setq properties (text-properties-at (point))) (delete-char 1) - (insert "*") + (insert (if arg " " "*")) (set-text-properties (1- (point)) (point) properties) (forward-line))) -(defun epa-unmark () +(defun epa-unmark (&optional arg) "Unmark the current line." - (interactive) - (let ((inhibit-read-only t) - buffer-read-only - properties) - (beginning-of-line) - (setq properties (text-properties-at (point))) - (delete-char 1) - (insert " ") - (set-text-properties (1- (point)) (point) properties) - (forward-line))) + (interactive "P") + (epa-mark (not arg))) + +(defun epa-decrypt-file (file) + (interactive "fFile: ") + (let* ((default-name (file-name-sans-extension file)) + (plain (expand-file-name + (read-file-name + (concat "To file (default " + (file-name-nondirectory default-name) + ") ") + (file-name-directory default-name) + default-name))) + (context (epg-make-context))) + (message "Decrypting %s..." (file-name-nondirectory file)) + (epg-decrypt-file context file plain) + (message "Decrypting %s...done" (file-name-nondirectory file)))) + +(defun epa-verify-file (file) + (interactive "fFile: ") + (let* ((context (epg-make-context)) + (plain (if (equal (file-name-extension file) "sig") + (file-name-sans-extension file))) + signature) + (message "Verifying %s..." (file-name-nondirectory file)) + (epg-verify-file context file plain) + (setq signature (reverse (epg-context-result-for context 'verify))) + (with-output-to-temp-buffer "*epa-verify-file*" + (set-buffer standard-output) + (while signature + (insert (format "%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)))) + (shrink-window-if-larger-than-buffer + (get-buffer-window "*epa-verify-file*")) + (message "Verifying %s...done" (file-name-nondirectory file)))) + +(defun epa-sign-file (file detached) + (interactive + (list (expand-file-name (read-file-name "File: ")) + (y-or-n-p "Make a detached signature? "))) + (let ((signature (concat file (if detached ".sig" ".gpg"))) + (context (epg-make-context))) + (message "Signing %s..." (file-name-nondirectory file)) + (epg-sign-file context file signature (not (null detached))) + (message "Signing %s...done" (file-name-nondirectory file)))) + +(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. ")))) + (let ((cipher (concat file ".gpg")) + (context (epg-make-context))) + (message "Encrypting %s..." (file-name-nondirectory file)) + (epg-encrypt-file context + file + recipients + cipher) + (message "Encrypting %s...done" (file-name-nondirectory file)))) (provide 'epa)