]> code.delx.au - gnu-emacs/blobdiff - lisp/epa.el
* mh-e.texi (VERSION, EDITION, UPDATED, UPDATE-MONTH): Update for
[gnu-emacs] / lisp / epa.el
index d4f4fab2eedae25615310250d80e6acfb5603619..852d10b1cf7f6ba40863f2dba61572911439edac 100644 (file)
@@ -1,6 +1,6 @@
 ;;; epa.el --- the EasyPG Assistant -*- lexical-binding: t -*-
 
-;; Copyright (C) 2006-201 Free Software Foundation, Inc.
+;; Copyright (C) 2006-2013 Free Software Foundation, Inc.
 
 ;; Author: Daiki Ueno <ueno@unixuser.org>
 ;; Keywords: PGP, GnuPG
@@ -50,97 +50,51 @@ the separate window."
   :group 'epa)
 
 (defface epa-validity-high
-  `((((class color) (background dark))
-     (:foreground "PaleTurquoise"
-                 ,@(if (assq ':weight custom-face-attributes)
-                       '(:weight bold)
-                     '(:bold t))))
-    (t
-     (,@(if (assq ':weight custom-face-attributes)
-           '(:weight bold)
-         '(:bold t)))))
-  "Face used for displaying the high validity."
+  '((default :weight bold)
+    (((class color) (background dark)) :foreground "PaleTurquoise"))
+  "Face for high validity EPA information."
   :group 'epa-faces)
 
 (defface epa-validity-medium
-  `((((class color) (background dark))
-     (:foreground "PaleTurquoise"
-                 ,@(if (assq ':slant custom-face-attributes)
-                       '(:slant italic)
-                     '(:italic t))))
-    (t
-     (,@(if (assq ':slant custom-face-attributes)
-           '(:slant italic)
-         '(:italic t)))))
-  "Face used for displaying the medium validity."
+  '((default :slant italic)
+    (((class color) (background dark)) :foreground "PaleTurquoise"))
+  "Face for medium validity EPA information."
   :group 'epa-faces)
 
 (defface epa-validity-low
-  `((t
-     (,@(if (assq ':slant custom-face-attributes)
-           '(:slant italic)
-         '(:italic t)))))
+  '((t :slant italic))
   "Face used for displaying the low validity."
   :group 'epa-faces)
 
 (defface epa-validity-disabled
-  `((t
-     (,@(if (assq ':slant custom-face-attributes)
-           '(:slant italic)
-         '(:italic t))
-       :inverse-video t)))
+  '((t :slant italic :inverse-video t))
   "Face used for displaying the disabled validity."
   :group 'epa-faces)
 
 (defface epa-string
   '((((class color) (background dark))
-     (:foreground "lightyellow"))
+     :foreground "lightyellow")
     (((class color) (background light))
-     (:foreground "blue4")))
+     :foreground "blue4"))
   "Face used for displaying the string."
   :group 'epa-faces)
 
 (defface epa-mark
-  `((((class color) (background dark))
-     (:foreground "orange"
-                 ,@(if (assq ':weight custom-face-attributes)
-                       '(:weight bold)
-                     '(:bold t))))
-    (((class color) (background light))
-     (:foreground "red"
-                 ,@(if (assq ':weight custom-face-attributes)
-                       '(:weight bold)
-                     '(:bold t))))
-    (t
-     (,@(if (assq ':weight custom-face-attributes)
-           '(:weight bold)
-         '(:bold t)))))
+  '((default :weight bold)
+    (((class color) (background dark))  :foreground "orange")
+    (((class color) (background light)) :foreground "red"))
   "Face used for displaying the high validity."
   :group 'epa-faces)
 
 (defface epa-field-name
-  `((((class color) (background dark))
-     (:foreground "PaleTurquoise"
-                 ,@(if (assq ':weight custom-face-attributes)
-                       '(:weight bold)
-                     '(:bold t))))
-    (t
-     (,@(if (assq ':weight custom-face-attributes)
-           '(:weight bold)
-         '(:bold t)))))
+  '((default :weight bold)
+    (((class color) (background dark)) :foreground "PaleTurquoise"))
   "Face for the name of the attribute field."
   :group 'epa)
 
 (defface epa-field-body
-  `((((class color) (background dark))
-     (:foreground "turquoise"
-                 ,@(if (assq ':slant custom-face-attributes)
-                       '(:slant italic)
-                     '(:italic t))))
-    (t
-     (,@(if (assq ':slant custom-face-attributes)
-           '(:slant italic)
-         '(:italic t)))))
+  '((default :slant italic)
+    (((class color) (background dark)) :foreground "turquoise"))
   "Face for the body of the attribute field."
   :group 'epa)
 
@@ -177,18 +131,18 @@ the separate window."
     (20 . ?G)))
 
 (defvar epa-protocol 'OpenPGP
-  "*The default protocol.
+  "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.
+  "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.
+  "If non-nil, epa commands treat input files as text.
 
 You should bind this variable with `let', but do not set it globally.")
 
@@ -214,8 +168,9 @@ You should bind this variable with `let', but do not set it globally.")
     (define-key keymap "g" 'revert-buffer)
     (define-key keymap "n" 'next-line)
     (define-key keymap "p" 'previous-line)
-    (define-key keymap " " 'scroll-up)
-    (define-key keymap [delete] 'scroll-down)
+    (define-key keymap " " 'scroll-up-command)
+    (define-key keymap [?\S-\ ] 'scroll-down-command)
+    (define-key keymap [delete] 'scroll-down-command)
     (define-key keymap "q" 'epa-exit-buffer)
     (define-key keymap [menu-bar epa-key-list-mode] (cons "Keys" menu-map))
     (define-key menu-map [epa-key-list-unmark-key]
@@ -239,7 +194,7 @@ You should bind this variable with `let', but do not set it globally.")
                  :help "Encrypt FILE for RECIPIENTS"))
     (define-key menu-map [separator-epa-key-list] '(menu-item "--"))
     (define-key menu-map [epa-key-list-delete-keys]
-      '(menu-item "Delete keys" epa-delete-keys
+      '(menu-item "Delete Keys" epa-delete-keys
                  :help "Delete Marked Keys"))
     (define-key menu-map [epa-key-list-import-keys]
       '(menu-item "Import Keys" epa-import-keys
@@ -482,6 +437,8 @@ If ARG is non-nil, mark the key."
     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
   (with-current-buffer epa-keys-buffer
     (epa-key-list-mode)
+    ;; C-c C-c is the usual way to finish the selection (bug#11159).
+    (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
     (let ((inhibit-read-only t)
          buffer-read-only)
       (erase-buffer)
@@ -629,8 +586,8 @@ If SECRET is non-nil, list secret keys instead of public keys."
     (message "%s" info)))
 
 (defun epa-display-verify-result (verify-result)
+  (declare (obsolete epa-display-info "23.1"))
   (epa-display-info (epg-verify-result-to-string verify-result)))
-(make-obsolete 'epa-display-verify-result 'epa-display-info "23.1")
 
 (defun epa-passphrase-callback-function (context key-id handback)
   (if (eq key-id 'SYM)
@@ -651,10 +608,17 @@ If SECRET is non-nil, list secret keys instead of public keys."
 
 (defun epa-progress-callback-function (_context what _char current total
                                               handback)
-  (message "%s%d%% (%d/%d)" (or handback
-                               (concat what ": "))
-          (if (> total 0) (floor (* (/ current (float total)) 100)) 0)
-          current total))
+  (let ((prompt (or handback
+                   (format "Processing %s: " what))))
+    ;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that
+    ;; the total amount is not known. The condition TOTAL && CUR ==
+    ;; TOTAL may be used to detect the end of an operation.
+    (if (> total 0)
+       (if (= current total)
+           (message "%s...done" prompt)
+         (message "%s...%d%%" prompt
+                  (floor (* (/ current (float total)) 100))))
+      (message "%s..." prompt))))
 
 ;;;###autoload
 (defun epa-decrypt-file (file)
@@ -796,10 +760,15 @@ If no one is selected, symmetric encryption will be performed.  ")))
             (file-name-nondirectory cipher))))
 
 ;;;###autoload
-(defun epa-decrypt-region (start end)
+(defun epa-decrypt-region (start end &optional make-buffer-function)
   "Decrypt the current region between START and END.
 
-Don't use this command in Lisp programs!
+If MAKE-BUFFER-FUNCTION is non-nil, call it to prepare an output buffer.
+It should return that buffer.  If it copies the input, it should
+delete the text now being decrypted.  It should leave point at the
+proper place to insert the plaintext.
+
+Be careful about using this command in Lisp programs!
 Since this function operates on regions, it does some tricks such
 as coding-system detection and unibyte/multibyte conversion.  If
 you are sure how the data in the region should be treated, you
@@ -831,16 +800,19 @@ For example:
                   (or coding-system-for-read
                       (get-text-property start 'epa-coding-system-used)
                       'undecided)))
-      (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 make-buffer-function
+         (with-current-buffer (funcall make-buffer-function)
+           (let ((inhibit-read-only t))
+             (insert plain)))
+       (if (y-or-n-p "Replace the original text? ")
+           (let ((inhibit-read-only t))
+             (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)))))))
@@ -849,12 +821,13 @@ For example:
   (if (featurep 'xemacs)
       (if (fboundp 'find-coding-system)
          (find-coding-system mime-charset))
+    ;; Find the first coding system which corresponds to MIME-CHARSET.
     (let ((pointer (coding-system-list)))
       (while (and pointer
-                 (eq (coding-system-get (car pointer) 'mime-charset)
-                     mime-charset))
+                 (not (eq (coding-system-get (car pointer) 'mime-charset)
+                          mime-charset)))
        (setq pointer (cdr pointer)))
-      pointer)))
+      (car pointer))))
 
 ;;;###autoload
 (defun epa-decrypt-armor-in-region (start end)
@@ -873,7 +846,7 @@ See the reason described in the `epa-decrypt-region' documentation."
                armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
                                             nil t))
          (unless armor-end
-           (error "No armor tail"))
+           (error "Encryption armor beginning has no matching end"))
          (goto-char armor-start)
          (let ((coding-system-for-read
                 (or coding-system-for-read
@@ -1220,7 +1193,8 @@ between START and END."
   "Insert selected KEYS after the point."
   (interactive
    (list (epa-select-keys (epg-make-context epa-protocol)
-                         "Select keys to export.  ")))
+                               "Select keys to export.
+If no one is selected, default public key is exported.  ")))
   (let ((context (epg-make-context epa-protocol)))
     ;;(epg-context-set-armor context epa-armor)
     (epg-context-set-armor context t)