OSDN Git Service

No need to specify --disable-gpg-test even if gpg has version < 1.4.3.
[epg/epg.git] / epa.el
diff --git a/epa.el b/epa.el
index 85421f2..a188e46 100644 (file)
--- a/epa.el
+++ b/epa.el
   "The EasyPG Assistant"
   :group 'epg)
 
-(defcustom epa-protocol 'OpenPGP
-  "The default protocol."
-  :type '(choice (const :tag "OpenPGP" OpenPGP)
-                (const :tag "CMS" CMS))
-  :group 'epa)
-
-(defcustom epa-armor nil
-  "If non-nil, epa commands create ASCII armored output."
-  :type 'boolean
-  :group 'epa)
-
-(defcustom epa-textmode nil
-  "If non-nil, epa commands treat input files as text."
-  :type 'boolean
-  :group 'epa)
-
 (defcustom epa-popup-info-window t
   "If non-nil, status information from epa commands is displayed on
 the separate window."
@@ -168,6 +152,22 @@ the separate window."
     (17 . ?D)
     (20 . ?G)))
 
+(defvar epa-protocol 'OpenPGP
+  "*The default protocol.
+The value can be either OpenPGP or CMS.
+
+You should bind this variable with `let', but do not set it globally.")
+
+(defvar epa-armor nil
+  "*If non-nil, epa commands create ASCII armored output.
+
+You should bind this variable with `let', but do not set it globally.")
+
+(defvar epa-textmode nil
+  "*If non-nil, epa commands treat input files as text.
+
+You should bind this variable with `let', but do not set it globally.")
+
 (defvar epa-keys-buffer nil)
 (defvar epa-key-buffer-alist nil)
 (defvar epa-key nil)
@@ -186,7 +186,7 @@ the separate window."
     (define-key keymap "r" 'epa-delete-keys)
     (define-key keymap "i" 'epa-import-keys)
     (define-key keymap "o" 'epa-export-keys)
-    (define-key keymap "g" 'epa-list-keys)
+    (define-key keymap "g" 'revert-buffer)
     (define-key keymap "n" 'next-line)
     (define-key keymap "p" 'previous-line)
     (define-key keymap " " 'scroll-up)
@@ -196,7 +196,7 @@ the separate window."
 
 (defvar epa-key-mode-map
   (let ((keymap (make-sparse-keymap)))
-    (define-key keymap "q" 'bury-buffer)
+    (define-key keymap "q" 'epa-exit-buffer)
     keymap))
 
 (defvar epa-info-mode-map
@@ -269,6 +269,8 @@ the separate window."
   ;; if buffer-file-name is not set.
   (font-lock-set-defaults)
   (make-local-variable 'epa-exit-buffer-function)
+  (make-local-variable 'revert-buffer-function)
+  (setq revert-buffer-function 'epa--key-list-revert-buffer)
   (run-hooks 'epa-key-list-mode-hook))
 
 (defun epa-key-mode ()
@@ -330,19 +332,31 @@ If ARG is non-nil, mark the current line."
   (interactive)
   (funcall epa-exit-buffer-function))
 
-;;;###autoload
-(defun epa-list-keys (&optional name mode)
-  "List all keys matched with NAME from the keyring.
-If MODE is non-nil, it reads the private keyring.  Otherwise, it
-reads the public keyring."
-  (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))))
+(defun epa--insert-keys (keys)
+  (save-excursion
+    (save-restriction
+      (narrow-to-region (point) (point))
+      (let (point)
+       (while keys
+         (setq point (point))
+         (insert "  ")
+         (add-text-properties point (point)
+                              (list 'epa-key (car keys)
+                                    'front-sticky nil
+                                    'rear-nonsticky t
+                                    'start-open t
+                                    'end-open t))
+         (widget-create 'epa-key :value (car keys))
+         (insert "\n")
+         (setq keys (cdr keys))))      
+      (add-text-properties (point-min) (point-max)
+                          (list 'epa-list-keys t
+                                'front-sticky nil
+                                'rear-nonsticky t
+                                'start-open t
+                                'end-open t)))))
+
+(defun epa--list-keys (name secret)
   (unless (and epa-keys-buffer
               (buffer-live-p epa-keys-buffer))
     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
@@ -359,38 +373,40 @@ reads the public keyring."
                     (or (next-single-property-change point 'epa-list-keys)
                         (point-max)))
       (goto-char point))
-    (epa--insert-keys context name mode)
+    (epa--insert-keys (epg-list-keys context name secret))
     (widget-setup)
     (set-keymap-parent (current-local-map) widget-keymap))
   (make-local-variable 'epa-list-keys-arguments)
-  (setq epa-list-keys-arguments (list name mode))
+  (setq epa-list-keys-arguments (list name secret))
   (goto-char (point-min))
   (pop-to-buffer (current-buffer)))
 
-(defun epa--insert-keys (context name mode)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region (point) (point))
-      (let ((keys (epg-list-keys context name mode))
-           point)
-       (while keys
-         (setq point (point))
-         (insert "  ")
-         (add-text-properties point (point)
-                              (list 'epa-key (car keys)
-                                    'front-sticky nil
-                                    'rear-nonsticky t
-                                    'start-open t
-                                    'end-open t))
-         (widget-create 'epa-key :value (car keys))
-         (insert "\n")
-         (setq keys (cdr keys))))      
-      (add-text-properties (point-min) (point-max)
-                          (list 'epa-list-keys t
-                                'front-sticky nil
-                                'rear-nonsticky t
-                                'start-open t
-                                'end-open t)))))
+;;;###autoload
+(defun epa-list-keys (&optional name)
+  "List all keys matched with NAME from the public keyring."
+  (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)))
+     (list nil)))
+  (epa--list-keys name nil))
+
+;;;###autoload
+(defun epa-list-secret-keys (&optional name)
+  "List all keys matched with NAME from the private keyring."
+  (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)))
+     (list nil)))
+  (epa--list-keys name t))
+
+(defun epa--key-list-revert-buffer (&optional ignore-auto noconfirm)
+  (apply #'epa--list-keys epa-list-keys-arguments))
 
 (defun epa--marked-keys ()
   (or (save-excursion
@@ -408,14 +424,7 @@ reads the public keyring."
          (if key
              (list key))))))
 
-;;;###autoload
-(defun epa-select-keys (context prompt &optional names secret)
-  "Display a user's keyring and ask him to select keys.
-CONTEXT is an epg-context.
-PROMPT is a string to prompt with.
-NAMES is a list of strings to be matched with keys.  If it is nil, all
-the keys are listed.
-If SECRET is non-nil, list secret keys instead of public keys."
+(defun epa--select-keys (prompt keys)
   (save-excursion
     (unless (and epa-keys-buffer
                 (buffer-live-p epa-keys-buffer))
@@ -442,19 +451,7 @@ If SECRET is non-nil, list secret keys instead of public keys."
                      "Click here or \\[exit-recursive-edit] to finish")
                     "OK")
       (insert "\n\n")
-      (if names
-         (while names
-           (epa--insert-keys context (car names) secret)
-           (if (get-text-property (point) 'epa-list-keys)
-               (epa-mark))
-           (goto-char (point-max))
-           (setq names (cdr names)))
-       (if secret
-           (progn
-             (epa--insert-keys context nil secret)
-             (if (get-text-property (point) 'epa-list-keys)
-                 (epa-mark)))
-         (epa--insert-keys context nil nil)))
+      (epa--insert-keys keys)
       (widget-setup)
       (set-keymap-parent (current-local-map) widget-keymap)
       (setq epa-exit-buffer-function #'abort-recursive-edit)
@@ -468,6 +465,19 @@ If SECRET is non-nil, list secret keys instead of public keys."
          (delete-window (get-buffer-window epa-keys-buffer)))
       (kill-buffer epa-keys-buffer))))
 
+;;;###autoload
+(defun epa-select-keys (context prompt &optional names secret)
+  "Display a user's keyring and ask him to select keys.
+CONTEXT is an epg-context.
+PROMPT is a string to prompt with.
+NAMES is a list of strings to be matched with keys.  If it is nil, all
+the keys are listed.
+If SECRET is non-nil, list secret keys instead of public keys."
+  (let ((keys (epg-list-keys context name secret)))
+    (if (> (length keys) 1)
+       (epa--select-keys prompt keys)
+      keys)))
+
 (defun epa--format-fingerprint-1 (fingerprint unit-size block-size)
   (let ((unit 0))
     (with-temp-buffer
@@ -561,7 +571,7 @@ If SECRET is non-nil, list secret keys instead of public keys."
 (defun epa-display-info (info)
   (if epa-popup-info-window
       (save-selected-window
-       (unless epa-info-buffer
+       (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
          (setq epa-info-buffer (generate-new-buffer "*Info*")))
        (if (get-buffer-window epa-info-buffer)
            (delete-window (get-buffer-window epa-info-buffer)))
@@ -819,16 +829,28 @@ Don't use this command in Lisp programs!"
 
 Don't use this command in Lisp programs!"
   (interactive "r")
-  (let ((context (epg-make-context epa-protocol)))
+  (let ((context (epg-make-context epa-protocol))
+       plain)
     (epg-context-set-progress-callback context
                                       #'epa-progress-callback-function
                                       "Verifying...")
-    (epg-verify-string context
-                      (epa--encode-coding-string
-                       (buffer-substring start end)
-                       (or coding-system-for-write
-                           (get-text-property start
-                                              'epa-coding-system-used))))
+    (setq plain (epg-verify-string
+                context
+                (epa--encode-coding-string
+                 (buffer-substring start end)
+                 (or coding-system-for-write
+                     (get-text-property start
+                                        'epa-coding-system-used)))))
+    (if (y-or-n-p "Replace the original text? ")
+       (let ((inhibit-read-only t)
+             buffer-read-only)
+         (delete-region start end)
+         (goto-char start)
+         (insert plain))
+       (with-output-to-temp-buffer "*Temp*"
+         (set-buffer standard-output)
+         (insert plain)
+         (epa-info-mode)))
     (if (epg-context-result-for context 'verify)
        (epa-display-info (epg-verify-result-to-string
                           (epg-context-result-for context 'verify))))))
@@ -844,19 +866,19 @@ Don't use this command in Lisp programs!"
     (save-restriction
       (narrow-to-region start end)
       (goto-char start)
-      (let (armor-start armor-end)
+      (let (cleartext-start cleartext-end)
        (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
                                  nil t)
-         (setq armor-start (match-beginning 0))
+         (setq cleartext-start (match-beginning 0))
          (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
                                           nil t)
            (error "Invalid cleartext signed message"))
-         (setq armor-end (re-search-forward
+         (setq cleartext-end (re-search-forward
                           "^-----END PGP SIGNATURE-----$"
                           nil t))
-         (unless armor-end
-           (error "No armor tail"))
-         (epa-verify-region armor-start armor-end))))))
+         (unless cleartext-end
+           (error "No cleartext tail"))
+         (epa-verify-region cleartext-start cleartext-end))))))
 
 (if (fboundp 'select-safe-coding-system)
     (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)