X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/09d9db2c4921cb2eb0974892164dd03d6bffdd80..7cef3569a3d872ea5be07a529b68910bf1d8b790:/lisp/epa.el diff --git a/lisp/epa.el b/lisp/epa.el index 43e202c1b1..b796f5fa77 100644 --- a/lisp/epa.el +++ b/lisp/epa.el @@ -1,6 +1,6 @@ -;;; epa.el --- the EasyPG Assistant +;;; epa.el --- the EasyPG Assistant -*- lexical-binding: t -*- -;; Copyright (C) 2006-2011 Free Software Foundation, Inc. +;; Copyright (C) 2006-2012 Free Software Foundation, Inc. ;; Author: Daiki Ueno ;; 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,8 @@ 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 [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 +193,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 @@ -269,7 +223,7 @@ You should bind this variable with `let', but do not set it globally.") :action 'epa--key-widget-action :help-echo 'epa--key-widget-help-echo) -(defun epa--key-widget-action (widget &optional event) +(defun epa--key-widget-action (widget &optional _event) (save-selected-window (epa--show-key (widget-get widget :value)))) @@ -460,7 +414,7 @@ If ARG is non-nil, mark the key." (list nil))) (epa--list-keys name t)) -(defun epa--key-list-revert-buffer (&optional ignore-auto noconfirm) +(defun epa--key-list-revert-buffer (&optional _ignore-auto _noconfirm) (apply #'epa--list-keys epa-list-keys-arguments)) (defun epa--marked-keys () @@ -482,6 +436,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) @@ -490,13 +446,13 @@ If ARG is non-nil, mark the key." - `\\[epa-mark-key]' to mark a key on the line - `\\[epa-unmark-key]' to unmark a key on the line\n")) (widget-create 'link - :notify (lambda (&rest ignore) (abort-recursive-edit)) + :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)) + :notify (lambda (&rest _ignore) (exit-recursive-edit)) :help-echo (substitute-command-keys "Click here or \\[exit-recursive-edit] to finish") @@ -649,12 +605,19 @@ If SECRET is non-nil, list secret keys instead of public keys." (format "Passphrase for %s %s: " key-id (cdr entry)) (format "Passphrase for %s: " key-id))))))) -(defun epa-progress-callback-function (context what char current total +(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 +759,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 +799,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 +820,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 +845,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 @@ -964,7 +936,7 @@ See the reason described in the `epa-verify-region' documentation." (eval-and-compile (if (fboundp 'select-safe-coding-system) (defalias 'epa--select-safe-coding-system 'select-safe-coding-system) - (defun epa--select-safe-coding-system (from to) + (defun epa--select-safe-coding-system (_from _to) buffer-file-coding-system))) ;;;###autoload @@ -1220,7 +1192,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)