code.delx.au - gnu-emacs/blob - lisp/epa.el

   1 ;;; epa.el --- the EasyPG Assistant -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2006-2012  Free Software Foundation, Inc.
   4
   5 ;; Author: Daiki Ueno <ueno@unixuser.org>
   6 ;; Keywords: PGP, GnuPG
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Code:
  24
  25 (require 'epg)
  26 (require 'font-lock)
  27 (require 'widget)
  28 (eval-when-compile (require 'wid-edit))
  29 (require 'derived)
  30
  31 (defgroup epa nil
  32   "The EasyPG Assistant"
  33   :version "23.1"
  34   :group 'epg)
  35
  36 (defcustom epa-popup-info-window t
  37   "If non-nil, status information from epa commands is displayed on
  38 the separate window."
  39   :type 'boolean
  40   :group 'epa)
  41
  42 (defcustom epa-info-window-height 5
  43   "Number of lines used to display status information."
  44   :type 'integer
  45   :group 'epa)
  46
  47 (defgroup epa-faces nil
  48   "Faces for epa-mode."
  49   :version "23.1"
  50   :group 'epa)
  51
  52 (defface epa-validity-high
  53   `((((class color) (background dark))
  54      (:foreground "PaleTurquoise"
  55                   ,@(if (assq ':weight custom-face-attributes)
  56                         '(:weight bold)
  57                       '(:bold t))))
  58     (t
  59      (,@(if (assq ':weight custom-face-attributes)
  60             '(:weight bold)
  61           '(:bold t)))))
  62   "Face used for displaying the high validity."
  63   :group 'epa-faces)
  64
  65 (defface epa-validity-medium
  66   `((((class color) (background dark))
  67      (:foreground "PaleTurquoise"
  68                   ,@(if (assq ':slant custom-face-attributes)
  69                         '(:slant italic)
  70                       '(:italic t))))
  71     (t
  72      (,@(if (assq ':slant custom-face-attributes)
  73             '(:slant italic)
  74           '(:italic t)))))
  75   "Face used for displaying the medium validity."
  76   :group 'epa-faces)
  77
  78 (defface epa-validity-low
  79   `((t
  80      (,@(if (assq ':slant custom-face-attributes)
  81             '(:slant italic)
  82           '(:italic t)))))
  83   "Face used for displaying the low validity."
  84   :group 'epa-faces)
  85
  86 (defface epa-validity-disabled
  87   `((t
  88      (,@(if (assq ':slant custom-face-attributes)
  89             '(:slant italic)
  90           '(:italic t))
  91         :inverse-video t)))
  92   "Face used for displaying the disabled validity."
  93   :group 'epa-faces)
  94
  95 (defface epa-string
  96   '((((class color) (background dark))
  97      (:foreground "lightyellow"))
  98     (((class color) (background light))
  99      (:foreground "blue4")))
 100   "Face used for displaying the string."
 101   :group 'epa-faces)
 102
 103 (defface epa-mark
 104   `((((class color) (background dark))
 105      (:foreground "orange"
 106                   ,@(if (assq ':weight custom-face-attributes)
 107                         '(:weight bold)
 108                       '(:bold t))))
 109     (((class color) (background light))
 110      (:foreground "red"
 111                   ,@(if (assq ':weight custom-face-attributes)
 112                         '(:weight bold)
 113                       '(:bold t))))
 114     (t
 115      (,@(if (assq ':weight custom-face-attributes)
 116             '(:weight bold)
 117           '(:bold t)))))
 118   "Face used for displaying the high validity."
 119   :group 'epa-faces)
 120
 121 (defface epa-field-name
 122   `((((class color) (background dark))
 123      (:foreground "PaleTurquoise"
 124                   ,@(if (assq ':weight custom-face-attributes)
 125                         '(:weight bold)
 126                       '(:bold t))))
 127     (t
 128      (,@(if (assq ':weight custom-face-attributes)
 129             '(:weight bold)
 130           '(:bold t)))))
 131   "Face for the name of the attribute field."
 132   :group 'epa)
 133
 134 (defface epa-field-body
 135   `((((class color) (background dark))
 136      (:foreground "turquoise"
 137                   ,@(if (assq ':slant custom-face-attributes)
 138                         '(:slant italic)
 139                       '(:italic t))))
 140     (t
 141      (,@(if (assq ':slant custom-face-attributes)
 142             '(:slant italic)
 143           '(:italic t)))))
 144   "Face for the body of the attribute field."
 145   :group 'epa)
 146
 147 (defcustom epa-validity-face-alist
 148   '((unknown . epa-validity-disabled)
 149     (invalid . epa-validity-disabled)
 150     (disabled . epa-validity-disabled)
 151     (revoked . epa-validity-disabled)
 152     (expired . epa-validity-disabled)
 153     (none . epa-validity-low)
 154     (undefined . epa-validity-low)
 155     (never . epa-validity-low)
 156     (marginal . epa-validity-medium)
 157     (full . epa-validity-high)
 158     (ultimate . epa-validity-high))
 159   "An alist mapping validity values to faces."
 160   :type '(repeat (cons symbol face))
 161   :group 'epa)
 162
 163 (defvar epa-font-lock-keywords
 164   '(("^\\*"
 165      (0 'epa-mark))
 166     ("^\t\\([^\t:]+:\\)[ \t]*\\(.*\\)$"
 167      (1 'epa-field-name)
 168      (2 'epa-field-body)))
 169   "Default expressions to addon in epa-mode.")
 170
 171 (defconst epa-pubkey-algorithm-letter-alist
 172   '((1 . ?R)
 173     (2 . ?r)
 174     (3 . ?s)
 175     (16 . ?g)
 176     (17 . ?D)
 177     (20 . ?G)))
 178
 179 (defvar epa-protocol 'OpenPGP
 180   "*The default protocol.
 181 The value can be either OpenPGP or CMS.
 182
 183 You should bind this variable with `let', but do not set it globally.")
 184
 185 (defvar epa-armor nil
 186   "*If non-nil, epa commands create ASCII armored output.
 187
 188 You should bind this variable with `let', but do not set it globally.")
 189
 190 (defvar epa-textmode nil
 191   "*If non-nil, epa commands treat input files as text.
 192
 193 You should bind this variable with `let', but do not set it globally.")
 194
 195 (defvar epa-keys-buffer nil)
 196 (defvar epa-key-buffer-alist nil)
 197 (defvar epa-key nil)
 198 (defvar epa-list-keys-arguments nil)
 199 (defvar epa-info-buffer nil)
 200 (defvar epa-last-coding-system-specified nil)
 201
 202 (defvar epa-key-list-mode-map
 203   (let ((keymap (make-sparse-keymap))
 204         (menu-map (make-sparse-keymap)))
 205     (define-key keymap "m" 'epa-mark-key)
 206     (define-key keymap "u" 'epa-unmark-key)
 207     (define-key keymap "d" 'epa-decrypt-file)
 208     (define-key keymap "v" 'epa-verify-file)
 209     (define-key keymap "s" 'epa-sign-file)
 210     (define-key keymap "e" 'epa-encrypt-file)
 211     (define-key keymap "r" 'epa-delete-keys)
 212     (define-key keymap "i" 'epa-import-keys)
 213     (define-key keymap "o" 'epa-export-keys)
 214     (define-key keymap "g" 'revert-buffer)
 215     (define-key keymap "n" 'next-line)
 216     (define-key keymap "p" 'previous-line)
 217     (define-key keymap " " 'scroll-up-command)
 218     (define-key keymap [delete] 'scroll-down-command)
 219     (define-key keymap "q" 'epa-exit-buffer)
 220     (define-key keymap [menu-bar epa-key-list-mode] (cons "Keys" menu-map))
 221     (define-key menu-map [epa-key-list-unmark-key]
 222       '(menu-item "Unmark Key" epa-unmark-key
 223                   :help "Unmark a key"))
 224     (define-key menu-map [epa-key-list-mark-key]
 225       '(menu-item "Mark Key" epa-mark-key
 226                   :help "Mark a key"))
 227     (define-key menu-map [separator-epa-file] '(menu-item "--"))
 228     (define-key menu-map [epa-verify-file]
 229       '(menu-item "Verify File..." epa-verify-file
 230                   :help "Verify FILE"))
 231     (define-key menu-map [epa-sign-file]
 232       '(menu-item "Sign File..." epa-sign-file
 233                   :help "Sign FILE by SIGNERS keys selected"))
 234     (define-key menu-map [epa-decrypt-file]
 235       '(menu-item "Decrypt File..." epa-decrypt-file
 236                   :help "Decrypt FILE"))
 237     (define-key menu-map [epa-encrypt-file]
 238       '(menu-item "Encrypt File..." epa-encrypt-file
 239                   :help "Encrypt FILE for RECIPIENTS"))
 240     (define-key menu-map [separator-epa-key-list] '(menu-item "--"))
 241     (define-key menu-map [epa-key-list-delete-keys]
 242       '(menu-item "Delete Keys" epa-delete-keys
 243                   :help "Delete Marked Keys"))
 244     (define-key menu-map [epa-key-list-import-keys]
 245       '(menu-item "Import Keys" epa-import-keys
 246                   :help "Import keys from a file"))
 247     (define-key menu-map [epa-key-list-export-keys]
 248       '(menu-item "Export Keys" epa-export-keys
 249                   :help "Export marked keys to a file"))
 250     keymap))
 251
 252 (defvar epa-key-mode-map
 253   (let ((keymap (make-sparse-keymap)))
 254     (define-key keymap "q" 'epa-exit-buffer)
 255     keymap))
 256
 257 (defvar epa-info-mode-map
 258   (let ((keymap (make-sparse-keymap)))
 259     (define-key keymap "q" 'delete-window)
 260     keymap))
 261
 262 (defvar epa-exit-buffer-function #'bury-buffer)
 263
 264 (define-widget 'epa-key 'push-button
 265   "Button for representing a epg-key object."
 266   :format "%[%v%]"
 267   :button-face-get 'epa--key-widget-button-face-get
 268   :value-create 'epa--key-widget-value-create
 269   :action 'epa--key-widget-action
 270   :help-echo 'epa--key-widget-help-echo)
 271
 272 (defun epa--key-widget-action (widget &optional _event)
 273   (save-selected-window
 274     (epa--show-key (widget-get widget :value))))
 275
 276 (defun epa--key-widget-value-create (widget)
 277   (let* ((key (widget-get widget :value))
 278          (primary-sub-key (car (epg-key-sub-key-list key)))
 279          (primary-user-id (car (epg-key-user-id-list key))))
 280     (insert (format "%c "
 281                     (if (epg-sub-key-validity primary-sub-key)
 282                         (car (rassq (epg-sub-key-validity primary-sub-key)
 283                                     epg-key-validity-alist))
 284                       ? ))
 285             (epg-sub-key-id primary-sub-key)
 286             " "
 287             (if primary-user-id
 288                 (if (stringp (epg-user-id-string primary-user-id))
 289                     (epg-user-id-string primary-user-id)
 290                   (epg-decode-dn (epg-user-id-string primary-user-id)))
 291               ""))))
 292
 293 (defun epa--key-widget-button-face-get (widget)
 294   (let ((validity (epg-sub-key-validity (car (epg-key-sub-key-list
 295                                               (widget-get widget :value))))))
 296     (if validity
 297         (cdr (assq validity epa-validity-face-alist))
 298       'default)))
 299
 300 (defun epa--key-widget-help-echo (widget)
 301   (format "Show %s"
 302           (epg-sub-key-id (car (epg-key-sub-key-list
 303                                 (widget-get widget :value))))))
 304
 305 (eval-and-compile
 306   (if (fboundp 'encode-coding-string)
 307       (defalias 'epa--encode-coding-string 'encode-coding-string)
 308     (defalias 'epa--encode-coding-string 'identity)))
 309
 310 (eval-and-compile
 311   (if (fboundp 'decode-coding-string)
 312       (defalias 'epa--decode-coding-string 'decode-coding-string)
 313     (defalias 'epa--decode-coding-string 'identity)))
 314
 315 (defun epa-key-list-mode ()
 316   "Major mode for `epa-list-keys'."
 317   (kill-all-local-variables)
 318   (buffer-disable-undo)
 319   (setq major-mode 'epa-key-list-mode
 320         mode-name "Keys"
 321         truncate-lines t
 322         buffer-read-only t)
 323   (use-local-map epa-key-list-mode-map)
 324   (make-local-variable 'font-lock-defaults)
 325   (setq font-lock-defaults '(epa-font-lock-keywords t))
 326   ;; In XEmacs, auto-initialization of font-lock is not effective
 327   ;; if buffer-file-name is not set.
 328   (font-lock-set-defaults)
 329   (make-local-variable 'epa-exit-buffer-function)
 330   (make-local-variable 'revert-buffer-function)
 331   (setq revert-buffer-function 'epa--key-list-revert-buffer)
 332   (run-mode-hooks 'epa-key-list-mode-hook))
 333
 334 (defun epa-key-mode ()
 335   "Major mode for a key description."
 336   (kill-all-local-variables)
 337   (buffer-disable-undo)
 338   (setq major-mode 'epa-key-mode
 339         mode-name "Key"
 340         truncate-lines t
 341         buffer-read-only t)
 342   (use-local-map epa-key-mode-map)
 343   (make-local-variable 'font-lock-defaults)
 344   (setq font-lock-defaults '(epa-font-lock-keywords t))
 345   ;; In XEmacs, auto-initialization of font-lock is not effective
 346   ;; if buffer-file-name is not set.
 347   (font-lock-set-defaults)
 348   (make-local-variable 'epa-exit-buffer-function)
 349   (run-mode-hooks 'epa-key-mode-hook))
 350
 351 (defun epa-info-mode ()
 352   "Major mode for `epa-info-buffer'."
 353   (kill-all-local-variables)
 354   (buffer-disable-undo)
 355   (setq major-mode 'epa-info-mode
 356         mode-name "Info"
 357         truncate-lines t
 358         buffer-read-only t)
 359   (use-local-map epa-info-mode-map)
 360   (run-mode-hooks 'epa-info-mode-hook))
 361
 362 (defun epa-mark-key (&optional arg)
 363   "Mark a key on the current line.
 364 If ARG is non-nil, unmark the key."
 365   (interactive "P")
 366   (let ((inhibit-read-only t)
 367         buffer-read-only
 368         properties)
 369     (beginning-of-line)
 370     (unless (get-text-property (point) 'epa-key)
 371       (error "No key on this line"))
 372     (setq properties (text-properties-at (point)))
 373     (delete-char 1)
 374     (insert (if arg " " "*"))
 375     (set-text-properties (1- (point)) (point) properties)
 376     (forward-line)))
 377
 378 (defun epa-unmark-key (&optional arg)
 379   "Unmark a key on the current line.
 380 If ARG is non-nil, mark the key."
 381   (interactive "P")
 382   (epa-mark-key (not arg)))
 383
 384 (defun epa-exit-buffer ()
 385   "Exit the current buffer.
 386 `epa-exit-buffer-function' is called if it is set."
 387   (interactive)
 388   (funcall epa-exit-buffer-function))
 389
 390 (defun epa--insert-keys (keys)
 391   (save-excursion
 392     (save-restriction
 393       (narrow-to-region (point) (point))
 394       (let (point)
 395         (while keys
 396           (setq point (point))
 397           (insert "  ")
 398           (add-text-properties point (point)
 399                                (list 'epa-key (car keys)
 400                                      'front-sticky nil
 401                                      'rear-nonsticky t
 402                                      'start-open t
 403                                      'end-open t))
 404           (widget-create 'epa-key :value (car keys))
 405           (insert "\n")
 406           (setq keys (cdr keys))))
 407       (add-text-properties (point-min) (point-max)
 408                            (list 'epa-list-keys t
 409                                  'front-sticky nil
 410                                  'rear-nonsticky t
 411                                  'start-open t
 412                                  'end-open t)))))
 413
 414 (defun epa--list-keys (name secret)
 415   (unless (and epa-keys-buffer
 416                (buffer-live-p epa-keys-buffer))
 417     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 418   (set-buffer epa-keys-buffer)
 419   (epa-key-list-mode)
 420   (let ((inhibit-read-only t)
 421         buffer-read-only
 422         (point (point-min))
 423         (context (epg-make-context epa-protocol)))
 424     (unless (get-text-property point 'epa-list-keys)
 425       (setq point (next-single-property-change point 'epa-list-keys)))
 426     (when point
 427       (delete-region point
 428                      (or (next-single-property-change point 'epa-list-keys)
 429                          (point-max)))
 430       (goto-char point))
 431     (epa--insert-keys (epg-list-keys context name secret))
 432     (widget-setup)
 433     (set-keymap-parent (current-local-map) widget-keymap))
 434   (make-local-variable 'epa-list-keys-arguments)
 435   (setq epa-list-keys-arguments (list name secret))
 436   (goto-char (point-min))
 437   (pop-to-buffer (current-buffer)))
 438
 439 ;;;###autoload
 440 (defun epa-list-keys (&optional name)
 441   "List all keys matched with NAME from the public keyring."
 442   (interactive
 443    (if current-prefix-arg
 444        (let ((name (read-string "Pattern: "
 445                                 (if epa-list-keys-arguments
 446                                     (car epa-list-keys-arguments)))))
 447          (list (if (equal name "") nil name)))
 448      (list nil)))
 449   (epa--list-keys name nil))
 450
 451 ;;;###autoload
 452 (defun epa-list-secret-keys (&optional name)
 453   "List all keys matched with NAME from the private keyring."
 454   (interactive
 455    (if current-prefix-arg
 456        (let ((name (read-string "Pattern: "
 457                                 (if epa-list-keys-arguments
 458                                     (car epa-list-keys-arguments)))))
 459          (list (if (equal name "") nil name)))
 460      (list nil)))
 461   (epa--list-keys name t))
 462
 463 (defun epa--key-list-revert-buffer (&optional _ignore-auto _noconfirm)
 464   (apply #'epa--list-keys epa-list-keys-arguments))
 465
 466 (defun epa--marked-keys ()
 467   (or (with-current-buffer epa-keys-buffer
 468         (goto-char (point-min))
 469         (let (keys key)
 470           (while (re-search-forward "^\\*" nil t)
 471             (if (setq key (get-text-property (match-beginning 0)
 472                                              'epa-key))
 473                 (setq keys (cons key keys))))
 474           (nreverse keys)))
 475       (let ((key (get-text-property (point-at-bol) 'epa-key)))
 476         (if key
 477             (list key)))))
 478
 479 (defun epa--select-keys (prompt keys)
 480   (unless (and epa-keys-buffer
 481                (buffer-live-p epa-keys-buffer))
 482     (setq epa-keys-buffer (generate-new-buffer "*Keys*")))
 483   (with-current-buffer epa-keys-buffer
 484     (epa-key-list-mode)
 485     (let ((inhibit-read-only t)
 486           buffer-read-only)
 487       (erase-buffer)
 488       (insert prompt "\n"
 489               (substitute-command-keys "\
 490 - `\\[epa-mark-key]' to mark a key on the line
 491 - `\\[epa-unmark-key]' to unmark a key on the line\n"))
 492       (widget-create 'link
 493                      :notify (lambda (&rest _ignore) (abort-recursive-edit))
 494                      :help-echo
 495                      (substitute-command-keys
 496                       "Click here or \\[abort-recursive-edit] to cancel")
 497                      "Cancel")
 498       (widget-create 'link
 499                      :notify (lambda (&rest _ignore) (exit-recursive-edit))
 500                      :help-echo
 501                      (substitute-command-keys
 502                       "Click here or \\[exit-recursive-edit] to finish")
 503                      "OK")
 504       (insert "\n\n")
 505       (epa--insert-keys keys)
 506       (widget-setup)
 507       (set-keymap-parent (current-local-map) widget-keymap)
 508       (setq epa-exit-buffer-function #'abort-recursive-edit)
 509       (goto-char (point-min))
 510       (let ((display-buffer-mark-dedicated 'soft))
 511         (pop-to-buffer (current-buffer))))
 512     (unwind-protect
 513         (progn
 514           (recursive-edit)
 515           (epa--marked-keys))
 516       (kill-buffer epa-keys-buffer))))
 517
 518 ;;;###autoload
 519 (defun epa-select-keys (context prompt &optional names secret)
 520   "Display a user's keyring and ask him to select keys.
 521 CONTEXT is an epg-context.
 522 PROMPT is a string to prompt with.
 523 NAMES is a list of strings to be matched with keys.  If it is nil, all
 524 the keys are listed.
 525 If SECRET is non-nil, list secret keys instead of public keys."
 526   (let ((keys (epg-list-keys context names secret)))
 527     (epa--select-keys prompt keys)))
 528
 529 (defun epa--show-key (key)
 530   (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
 531          (entry (assoc (epg-sub-key-id primary-sub-key)
 532                        epa-key-buffer-alist))
 533          (inhibit-read-only t)
 534          buffer-read-only
 535          pointer)
 536     (unless entry
 537       (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
 538             epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
 539     (unless (and (cdr entry)
 540                  (buffer-live-p (cdr entry)))
 541       (setcdr entry (generate-new-buffer
 542                      (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
 543     (set-buffer (cdr entry))
 544     (epa-key-mode)
 545     (make-local-variable 'epa-key)
 546     (setq epa-key key)
 547     (erase-buffer)
 548     (setq pointer (epg-key-user-id-list key))
 549     (while pointer
 550       (if (car pointer)
 551           (insert " "
 552                   (if (epg-user-id-validity (car pointer))
 553                       (char-to-string
 554                        (car (rassq (epg-user-id-validity (car pointer))
 555                                    epg-key-validity-alist)))
 556                     " ")
 557                   " "
 558                   (if (stringp (epg-user-id-string (car pointer)))
 559                       (epg-user-id-string (car pointer))
 560                     (epg-decode-dn (epg-user-id-string (car pointer))))
 561                   "\n"))
 562       (setq pointer (cdr pointer)))
 563     (setq pointer (epg-key-sub-key-list key))
 564     (while pointer
 565       (insert " "
 566               (if (epg-sub-key-validity (car pointer))
 567                   (char-to-string
 568                    (car (rassq (epg-sub-key-validity (car pointer))
 569                                epg-key-validity-alist)))
 570                 " ")
 571               " "
 572               (epg-sub-key-id (car pointer))
 573               " "
 574               (format "%dbits"
 575                       (epg-sub-key-length (car pointer)))
 576               " "
 577               (cdr (assq (epg-sub-key-algorithm (car pointer))
 578                          epg-pubkey-algorithm-alist))
 579               "\n\tCreated: "
 580               (condition-case nil
 581                   (format-time-string "%Y-%m-%d"
 582                                       (epg-sub-key-creation-time (car pointer)))
 583                 (error "????-??-??"))
 584               (if (epg-sub-key-expiration-time (car pointer))
 585                   (format (if (time-less-p (current-time)
 586                                            (epg-sub-key-expiration-time
 587                                             (car pointer)))
 588                               "\n\tExpires: %s"
 589                             "\n\tExpired: %s")
 590                           (condition-case nil
 591                               (format-time-string "%Y-%m-%d"
 592                                                   (epg-sub-key-expiration-time
 593                                                    (car pointer)))
 594                             (error "????-??-??")))
 595                 "")
 596               "\n\tCapabilities: "
 597               (mapconcat #'symbol-name
 598                          (epg-sub-key-capability (car pointer))
 599                          " ")
 600               "\n\tFingerprint: "
 601               (epg-sub-key-fingerprint (car pointer))
 602               "\n")
 603       (setq pointer (cdr pointer)))
 604     (goto-char (point-min))
 605     (pop-to-buffer (current-buffer))))
 606
 607 (defun epa-display-info (info)
 608   (if epa-popup-info-window
 609       (save-selected-window
 610         (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
 611           (setq epa-info-buffer (generate-new-buffer "*Info*")))
 612         (if (get-buffer-window epa-info-buffer)
 613             (delete-window (get-buffer-window epa-info-buffer)))
 614         (with-current-buffer epa-info-buffer
 615           (let ((inhibit-read-only t)
 616                 buffer-read-only)
 617             (erase-buffer)
 618             (insert info))
 619           (epa-info-mode)
 620           (goto-char (point-min)))
 621         (if (> (window-height)
 622                epa-info-window-height)
 623             (set-window-buffer (split-window nil (- (window-height)
 624                                                     epa-info-window-height))
 625                                epa-info-buffer)
 626           (pop-to-buffer epa-info-buffer)
 627           (if (> (window-height) epa-info-window-height)
 628               (shrink-window (- (window-height) epa-info-window-height)))))
 629     (message "%s" info)))
 630
 631 (defun epa-display-verify-result (verify-result)
 632   (epa-display-info (epg-verify-result-to-string verify-result)))
 633 (make-obsolete 'epa-display-verify-result 'epa-display-info "23.1")
 634
 635 (defun epa-passphrase-callback-function (context key-id handback)
 636   (if (eq key-id 'SYM)
 637       (read-passwd
 638        (format "Passphrase for symmetric encryption%s: "
 639                ;; Add the file name to the prompt, if any.
 640                (if (stringp handback)
 641                    (format " for %s" handback)
 642                  ""))
 643        (eq (epg-context-operation context) 'encrypt))
 644     (read-passwd
 645      (if (eq key-id 'PIN)
 646         "Passphrase for PIN: "
 647        (let ((entry (assoc key-id epg-user-id-alist)))
 648          (if entry
 649              (format "Passphrase for %s %s: " key-id (cdr entry))
 650            (format "Passphrase for %s: " key-id)))))))
 651
 652 (defun epa-progress-callback-function (_context what _char current total
 653                                                handback)
 654   (let ((prompt (or handback
 655                     (format "Processing %s: " what))))
 656     ;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that
 657     ;; the total amount is not known. The condition TOTAL && CUR ==
 658     ;; TOTAL may be used to detect the end of an operation.
 659     (if (> total 0)
 660         (if (= current total)
 661             (message "%s...done" prompt)
 662           (message "%s...%d%%" prompt
 663                    (floor (* (/ current (float total)) 100))))
 664       (message "%s..." prompt))))
 665
 666 ;;;###autoload
 667 (defun epa-decrypt-file (file)
 668   "Decrypt FILE."
 669   (interactive "fFile: ")
 670   (setq file (expand-file-name file))
 671   (let* ((default-name (file-name-sans-extension file))
 672          (plain (expand-file-name
 673                  (read-file-name
 674                   (concat "To file (default "
 675                           (file-name-nondirectory default-name)
 676                           ") ")
 677                   (file-name-directory default-name)
 678                   default-name)))
 679          (context (epg-make-context epa-protocol)))
 680     (epg-context-set-passphrase-callback context
 681                                          #'epa-passphrase-callback-function)
 682     (epg-context-set-progress-callback context
 683                                        (cons
 684                                         #'epa-progress-callback-function
 685                                         (format "Decrypting %s..."
 686                                                 (file-name-nondirectory file))))
 687     (message "Decrypting %s..." (file-name-nondirectory file))
 688     (epg-decrypt-file context file plain)
 689     (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
 690              (file-name-nondirectory plain))
 691     (if (epg-context-result-for context 'verify)
 692         (epa-display-info (epg-verify-result-to-string
 693                            (epg-context-result-for context 'verify))))))
 694
 695 ;;;###autoload
 696 (defun epa-verify-file (file)
 697   "Verify FILE."
 698   (interactive "fFile: ")
 699   (setq file (expand-file-name file))
 700   (let* ((context (epg-make-context epa-protocol))
 701          (plain (if (equal (file-name-extension file) "sig")
 702                     (file-name-sans-extension file))))
 703     (epg-context-set-progress-callback context
 704                                        (cons
 705                                         #'epa-progress-callback-function
 706                                         (format "Verifying %s..."
 707                                                 (file-name-nondirectory file))))
 708     (message "Verifying %s..." (file-name-nondirectory file))
 709     (epg-verify-file context file plain)
 710     (message "Verifying %s...done" (file-name-nondirectory file))
 711     (if (epg-context-result-for context 'verify)
 712         (epa-display-info (epg-verify-result-to-string
 713                            (epg-context-result-for context 'verify))))))
 714
 715 (defun epa--read-signature-type ()
 716   (let (type c)
 717     (while (null type)
 718       (message "Signature type (n,c,d,?) ")
 719       (setq c (read-char))
 720       (cond ((eq c ?c)
 721              (setq type 'clear))
 722             ((eq c ?d)
 723              (setq type 'detached))
 724             ((eq c ??)
 725              (with-output-to-temp-buffer "*Help*"
 726                (with-current-buffer standard-output
 727                  (insert "\
 728 n - Create a normal signature
 729 c - Create a cleartext signature
 730 d - Create a detached signature
 731 ? - Show this help
 732 "))))
 733             (t
 734              (setq type 'normal))))
 735     type))
 736
 737 ;;;###autoload
 738 (defun epa-sign-file (file signers mode)
 739   "Sign FILE by SIGNERS keys selected."
 740   (interactive
 741    (let ((verbose current-prefix-arg))
 742      (list (expand-file-name (read-file-name "File: "))
 743            (if verbose
 744                (epa-select-keys (epg-make-context epa-protocol)
 745                                 "Select keys for signing.
 746 If no one is selected, default secret key is used.  "
 747                                 nil t))
 748            (if verbose
 749                (epa--read-signature-type)
 750              'clear))))
 751   (let ((signature (concat file
 752                            (if (eq epa-protocol 'OpenPGP)
 753                                (if (or epa-armor
 754                                        (not (memq mode
 755                                                   '(nil t normal detached))))
 756                                    ".asc"
 757                                  (if (memq mode '(t detached))
 758                                      ".sig"
 759                                    ".gpg"))
 760                              (if (memq mode '(t detached))
 761                                  ".p7s"
 762                                ".p7m"))))
 763         (context (epg-make-context epa-protocol)))
 764     (epg-context-set-armor context epa-armor)
 765     (epg-context-set-textmode context epa-textmode)
 766     (epg-context-set-signers context signers)
 767     (epg-context-set-passphrase-callback context
 768                                          #'epa-passphrase-callback-function)
 769     (epg-context-set-progress-callback context
 770                                        (cons
 771                                         #'epa-progress-callback-function
 772                                         (format "Signing %s..."
 773                                                 (file-name-nondirectory file))))
 774     (message "Signing %s..." (file-name-nondirectory file))
 775     (epg-sign-file context file signature mode)
 776     (message "Signing %s...wrote %s" (file-name-nondirectory file)
 777              (file-name-nondirectory signature))))
 778
 779 ;;;###autoload
 780 (defun epa-encrypt-file (file recipients)
 781   "Encrypt FILE for RECIPIENTS."
 782   (interactive
 783    (list (expand-file-name (read-file-name "File: "))
 784          (epa-select-keys (epg-make-context epa-protocol)
 785                           "Select recipients for encryption.
 786 If no one is selected, symmetric encryption will be performed.  ")))
 787   (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
 788                                  (if epa-armor ".asc" ".gpg")
 789                                ".p7m")))
 790         (context (epg-make-context epa-protocol)))
 791     (epg-context-set-armor context epa-armor)
 792     (epg-context-set-textmode context epa-textmode)
 793     (epg-context-set-passphrase-callback context
 794                                          #'epa-passphrase-callback-function)
 795     (epg-context-set-progress-callback context
 796                                        (cons
 797                                         #'epa-progress-callback-function
 798                                         (format "Encrypting %s..."
 799                                                 (file-name-nondirectory file))))
 800     (message "Encrypting %s..." (file-name-nondirectory file))
 801     (epg-encrypt-file context file recipients cipher)
 802     (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
 803              (file-name-nondirectory cipher))))
 804
 805 ;;;###autoload
 806 (defun epa-decrypt-region (start end &optional make-buffer-function)
 807   "Decrypt the current region between START and END.
 808
 809 If MAKE-BUFFER-FUNCTION is non-nil, call it to prepare an output buffer.
 810 It should return that buffer.  If it copies the input, it should
 811 delete the text now being decrypted.  It should leave point at the
 812 proper place to insert the plaintext.
 813
 814 Be careful about using this command in Lisp programs!
 815 Since this function operates on regions, it does some tricks such
 816 as coding-system detection and unibyte/multibyte conversion.  If
 817 you are sure how the data in the region should be treated, you
 818 should consider using the string based counterpart
 819 `epg-decrypt-string', or the file based counterpart
 820 `epg-decrypt-file' instead.
 821
 822 For example:
 823
 824 \(let ((context (epg-make-context 'OpenPGP)))
 825   (decode-coding-string
 826     (epg-decrypt-string context (buffer-substring start end))
 827     'utf-8))"
 828   (interactive "r")
 829   (save-excursion
 830     (let ((context (epg-make-context epa-protocol))
 831           plain)
 832       (epg-context-set-passphrase-callback context
 833                                            #'epa-passphrase-callback-function)
 834       (epg-context-set-progress-callback context
 835                                          (cons
 836                                           #'epa-progress-callback-function
 837                                           "Decrypting..."))
 838       (message "Decrypting...")
 839       (setq plain (epg-decrypt-string context (buffer-substring start end)))
 840       (message "Decrypting...done")
 841       (setq plain (epa--decode-coding-string
 842                    plain
 843                    (or coding-system-for-read
 844                        (get-text-property start 'epa-coding-system-used)
 845                        'undecided)))
 846       (if make-buffer-function
 847           (with-current-buffer (funcall make-buffer-function)
 848             (let ((inhibit-read-only t))
 849               (insert plain)))
 850         (if (y-or-n-p "Replace the original text? ")
 851             (let ((inhibit-read-only t))
 852               (delete-region start end)
 853               (goto-char start)
 854               (insert plain))
 855           (with-output-to-temp-buffer "*Temp*"
 856             (set-buffer standard-output)
 857               (insert plain)
 858               (epa-info-mode))))
 859       (if (epg-context-result-for context 'verify)
 860           (epa-display-info (epg-verify-result-to-string
 861                              (epg-context-result-for context 'verify)))))))
 862
 863 (defun epa--find-coding-system-for-mime-charset (mime-charset)
 864   (if (featurep 'xemacs)
 865       (if (fboundp 'find-coding-system)
 866           (find-coding-system mime-charset))
 867     ;; Find the first coding system which corresponds to MIME-CHARSET.
 868     (let ((pointer (coding-system-list)))
 869       (while (and pointer
 870                   (not (eq (coding-system-get (car pointer) 'mime-charset)
 871                            mime-charset)))
 872         (setq pointer (cdr pointer)))
 873       (car pointer))))
 874
 875 ;;;###autoload
 876 (defun epa-decrypt-armor-in-region (start end)
 877   "Decrypt OpenPGP armors in the current region between START and END.
 878
 879 Don't use this command in Lisp programs!
 880 See the reason described in the `epa-decrypt-region' documentation."
 881   (interactive "r")
 882   (save-excursion
 883     (save-restriction
 884       (narrow-to-region start end)
 885       (goto-char start)
 886       (let (armor-start armor-end)
 887         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 888           (setq armor-start (match-beginning 0)
 889                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 890                                              nil t))
 891           (unless armor-end
 892             (error "Encryption armor beginning has no matching end"))
 893           (goto-char armor-start)
 894           (let ((coding-system-for-read
 895                  (or coding-system-for-read
 896                      (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 897                          (epa--find-coding-system-for-mime-charset
 898                           (intern (downcase (match-string 1))))))))
 899             (goto-char armor-end)
 900             (epa-decrypt-region armor-start armor-end)))))))
 901
 902 ;;;###autoload
 903 (defun epa-verify-region (start end)
 904   "Verify the current region between START and END.
 905
 906 Don't use this command in Lisp programs!
 907 Since this function operates on regions, it does some tricks such
 908 as coding-system detection and unibyte/multibyte conversion.  If
 909 you are sure how the data in the region should be treated, you
 910 should consider using the string based counterpart
 911 `epg-verify-string', or the file based counterpart
 912 `epg-verify-file' instead.
 913
 914 For example:
 915
 916 \(let ((context (epg-make-context 'OpenPGP)))
 917   (decode-coding-string
 918     (epg-verify-string context (buffer-substring start end))
 919     'utf-8))"
 920   (interactive "r")
 921   (let ((context (epg-make-context epa-protocol))
 922         plain)
 923     (epg-context-set-progress-callback context
 924                                        (cons
 925                                         #'epa-progress-callback-function
 926                                         "Verifying..."))
 927     (message "Verifying...")
 928     (setq plain (epg-verify-string
 929                  context
 930                  (epa--encode-coding-string
 931                   (buffer-substring start end)
 932                   (or coding-system-for-write
 933                       (get-text-property start 'epa-coding-system-used)))))
 934     (message "Verifying...done")
 935     (setq plain (epa--decode-coding-string
 936                  plain
 937                  (or coding-system-for-read
 938                      (get-text-property start 'epa-coding-system-used)
 939                      'undecided)))
 940     (if (y-or-n-p "Replace the original text? ")
 941         (let ((inhibit-read-only t)
 942               buffer-read-only)
 943           (delete-region start end)
 944           (goto-char start)
 945           (insert plain))
 946       (with-output-to-temp-buffer "*Temp*"
 947         (set-buffer standard-output)
 948         (insert plain)
 949         (epa-info-mode)))
 950     (if (epg-context-result-for context 'verify)
 951         (epa-display-info (epg-verify-result-to-string
 952                            (epg-context-result-for context 'verify))))))
 953
 954 ;;;###autoload
 955 (defun epa-verify-cleartext-in-region (start end)
 956   "Verify OpenPGP cleartext signed messages in the current region
 957 between START and END.
 958
 959 Don't use this command in Lisp programs!
 960 See the reason described in the `epa-verify-region' documentation."
 961   (interactive "r")
 962   (save-excursion
 963     (save-restriction
 964       (narrow-to-region start end)
 965       (goto-char start)
 966       (let (cleartext-start cleartext-end)
 967         (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
 968                                   nil t)
 969           (setq cleartext-start (match-beginning 0))
 970           (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
 971                                            nil t)
 972             (error "Invalid cleartext signed message"))
 973           (setq cleartext-end (re-search-forward
 974                            "^-----END PGP SIGNATURE-----$"
 975                            nil t))
 976           (unless cleartext-end
 977             (error "No cleartext tail"))
 978           (epa-verify-region cleartext-start cleartext-end))))))
 979
 980 (eval-and-compile
 981   (if (fboundp 'select-safe-coding-system)
 982       (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
 983     (defun epa--select-safe-coding-system (_from _to)
 984       buffer-file-coding-system)))
 985
 986 ;;;###autoload
 987 (defun epa-sign-region (start end signers mode)
 988   "Sign the current region between START and END by SIGNERS keys selected.
 989
 990 Don't use this command in Lisp programs!
 991 Since this function operates on regions, it does some tricks such
 992 as coding-system detection and unibyte/multibyte conversion.  If
 993 you are sure how the data should be treated, you should consider
 994 using the string based counterpart `epg-sign-string', or the file
 995 based counterpart `epg-sign-file' instead.
 996
 997 For example:
 998
 999 \(let ((context (epg-make-context 'OpenPGP)))
1000   (epg-sign-string
1001     context
1002     (encode-coding-string (buffer-substring start end) 'utf-8)))"
1003   (interactive
1004    (let ((verbose current-prefix-arg))
1005      (setq epa-last-coding-system-specified
1006            (or coding-system-for-write
1007                (epa--select-safe-coding-system
1008                 (region-beginning) (region-end))))
1009      (list (region-beginning) (region-end)
1010            (if verbose
1011                (epa-select-keys (epg-make-context epa-protocol)
1012                                 "Select keys for signing.
1013 If no one is selected, default secret key is used.  "
1014                                 nil t))
1015            (if verbose
1016                (epa--read-signature-type)
1017              'clear))))
1018   (save-excursion
1019     (let ((context (epg-make-context epa-protocol))
1020           signature)
1021       ;;(epg-context-set-armor context epa-armor)
1022       (epg-context-set-armor context t)
1023       ;;(epg-context-set-textmode context epa-textmode)
1024       (epg-context-set-textmode context t)
1025       (epg-context-set-signers context signers)
1026       (epg-context-set-passphrase-callback context
1027                                            #'epa-passphrase-callback-function)
1028       (epg-context-set-progress-callback context
1029                                          (cons
1030                                           #'epa-progress-callback-function
1031                                           "Signing..."))
1032       (message "Signing...")
1033       (setq signature (epg-sign-string context
1034                                        (epa--encode-coding-string
1035                                         (buffer-substring start end)
1036                                         epa-last-coding-system-specified)
1037                                        mode))
1038       (message "Signing...done")
1039       (delete-region start end)
1040       (goto-char start)
1041       (add-text-properties (point)
1042                            (progn
1043                              (insert (epa--decode-coding-string
1044                                       signature
1045                                       (or coding-system-for-read
1046                                           epa-last-coding-system-specified)))
1047                              (point))
1048                            (list 'epa-coding-system-used
1049                                  epa-last-coding-system-specified
1050                                  'front-sticky nil
1051                                  'rear-nonsticky t
1052                                  'start-open t
1053                                  'end-open t)))))
1054
1055 (eval-and-compile
1056   (if (fboundp 'derived-mode-p)
1057       (defalias 'epa--derived-mode-p 'derived-mode-p)
1058     (defun epa--derived-mode-p (&rest modes)
1059       "Non-nil if the current major mode is derived from one of MODES.
1060 Uses the `derived-mode-parent' property of the symbol to trace backwards."
1061       (let ((parent major-mode))
1062         (while (and (not (memq parent modes))
1063                     (setq parent (get parent 'derived-mode-parent))))
1064         parent))))
1065
1066 ;;;###autoload
1067 (defun epa-encrypt-region (start end recipients sign signers)
1068   "Encrypt the current region between START and END for RECIPIENTS.
1069
1070 Don't use this command in Lisp programs!
1071 Since this function operates on regions, it does some tricks such
1072 as coding-system detection and unibyte/multibyte conversion.  If
1073 you are sure how the data should be treated, you should consider
1074 using the string based counterpart `epg-encrypt-string', or the
1075 file based counterpart `epg-encrypt-file' instead.
1076
1077 For example:
1078
1079 \(let ((context (epg-make-context 'OpenPGP)))
1080   (epg-encrypt-string
1081     context
1082     (encode-coding-string (buffer-substring start end) 'utf-8)
1083     nil))"
1084   (interactive
1085    (let ((verbose current-prefix-arg)
1086          (context (epg-make-context epa-protocol))
1087          sign)
1088      (setq epa-last-coding-system-specified
1089            (or coding-system-for-write
1090                (epa--select-safe-coding-system
1091                 (region-beginning) (region-end))))
1092      (list (region-beginning) (region-end)
1093            (epa-select-keys context
1094                             "Select recipients for encryption.
1095 If no one is selected, symmetric encryption will be performed.  ")
1096            (setq sign (if verbose (y-or-n-p "Sign? ")))
1097            (if sign
1098                (epa-select-keys context
1099                                 "Select keys for signing.  ")))))
1100   (save-excursion
1101     (let ((context (epg-make-context epa-protocol))
1102           cipher)
1103       ;;(epg-context-set-armor context epa-armor)
1104       (epg-context-set-armor context t)
1105       ;;(epg-context-set-textmode context epa-textmode)
1106       (epg-context-set-textmode context t)
1107       (if sign
1108           (epg-context-set-signers context signers))
1109       (epg-context-set-passphrase-callback context
1110                                            #'epa-passphrase-callback-function)
1111       (epg-context-set-progress-callback context
1112                                          (cons
1113                                           #'epa-progress-callback-function
1114                                           "Encrypting..."))
1115       (message "Encrypting...")
1116       (setq cipher (epg-encrypt-string context
1117                                        (epa--encode-coding-string
1118                                         (buffer-substring start end)
1119                                         epa-last-coding-system-specified)
1120                                        recipients
1121                                        sign))
1122       (message "Encrypting...done")
1123       (delete-region start end)
1124       (goto-char start)
1125       (add-text-properties (point)
1126                            (progn
1127                              (insert cipher)
1128                              (point))
1129                            (list 'epa-coding-system-used
1130                                  epa-last-coding-system-specified
1131                                  'front-sticky nil
1132                                  'rear-nonsticky t
1133                                  'start-open t
1134                                  'end-open t)))))
1135
1136 ;;;###autoload
1137 (defun epa-delete-keys (keys &optional allow-secret)
1138   "Delete selected KEYS."
1139   (interactive
1140    (let ((keys (epa--marked-keys)))
1141      (unless keys
1142        (error "No keys selected"))
1143      (list keys
1144            (eq (nth 1 epa-list-keys-arguments) t))))
1145   (let ((context (epg-make-context epa-protocol)))
1146     (message "Deleting...")
1147     (epg-delete-keys context keys allow-secret)
1148     (message "Deleting...done")
1149     (apply #'epa--list-keys epa-list-keys-arguments)))
1150
1151 ;;;###autoload
1152 (defun epa-import-keys (file)
1153   "Import keys from FILE."
1154   (interactive "fFile: ")
1155   (setq file (expand-file-name file))
1156   (let ((context (epg-make-context epa-protocol)))
1157     (message "Importing %s..." (file-name-nondirectory file))
1158     (condition-case nil
1159         (progn
1160           (epg-import-keys-from-file context file)
1161           (message "Importing %s...done" (file-name-nondirectory file)))
1162       (error
1163        (message "Importing %s...failed" (file-name-nondirectory file))))
1164     (if (epg-context-result-for context 'import)
1165         (epa-display-info (epg-import-result-to-string
1166                            (epg-context-result-for context 'import))))
1167     (if (eq major-mode 'epa-key-list-mode)
1168         (apply #'epa--list-keys epa-list-keys-arguments))))
1169
1170 ;;;###autoload
1171 (defun epa-import-keys-region (start end)
1172   "Import keys from the region."
1173   (interactive "r")
1174   (let ((context (epg-make-context epa-protocol)))
1175     (message "Importing...")
1176     (condition-case nil
1177         (progn
1178           (epg-import-keys-from-string context (buffer-substring start end))
1179           (message "Importing...done"))
1180       (error
1181        (message "Importing...failed")))
1182     (if (epg-context-result-for context 'import)
1183         (epa-display-info (epg-import-result-to-string
1184                            (epg-context-result-for context 'import))))))
1185
1186 ;;;###autoload
1187 (defun epa-import-armor-in-region (start end)
1188   "Import keys in the OpenPGP armor format in the current region
1189 between START and END."
1190   (interactive "r")
1191   (save-excursion
1192     (save-restriction
1193       (narrow-to-region start end)
1194       (goto-char start)
1195       (let (armor-start armor-end)
1196         (while (re-search-forward
1197                 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
1198                 nil t)
1199           (setq armor-start (match-beginning 0)
1200                 armor-end (re-search-forward
1201                            (concat "^-----END " (match-string 1) "-----$")
1202                            nil t))
1203           (unless armor-end
1204             (error "No armor tail"))
1205           (epa-import-keys-region armor-start armor-end))))))
1206
1207 ;;;###autoload
1208 (defun epa-export-keys (keys file)
1209   "Export selected KEYS to FILE."
1210   (interactive
1211    (let ((keys (epa--marked-keys))
1212          default-name)
1213      (unless keys
1214        (error "No keys selected"))
1215      (setq default-name
1216            (expand-file-name
1217             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
1218                     (if epa-armor ".asc" ".gpg"))
1219             default-directory))
1220      (list keys
1221            (expand-file-name
1222             (read-file-name
1223              (concat "To file (default "
1224                      (file-name-nondirectory default-name)
1225                      ") ")
1226              (file-name-directory default-name)
1227              default-name)))))
1228   (let ((context (epg-make-context epa-protocol)))
1229     (epg-context-set-armor context epa-armor)
1230     (message "Exporting to %s..." (file-name-nondirectory file))
1231     (epg-export-keys-to-file context keys file)
1232     (message "Exporting to %s...done" (file-name-nondirectory file))))
1233
1234 ;;;###autoload
1235 (defun epa-insert-keys (keys)
1236   "Insert selected KEYS after the point."
1237   (interactive
1238    (list (epa-select-keys (epg-make-context epa-protocol)
1239                           "Select keys to export.  ")))
1240   (let ((context (epg-make-context epa-protocol)))
1241     ;;(epg-context-set-armor context epa-armor)
1242     (epg-context-set-armor context t)
1243     (insert (epg-export-keys-to-string context keys))))
1244
1245 ;; (defun epa-sign-keys (keys &optional local)
1246 ;;   "Sign selected KEYS.
1247 ;; If a prefix-arg is specified, the signature is marked as non exportable.
1248
1249 ;; Don't use this command in Lisp programs!"
1250 ;;   (interactive
1251 ;;    (let ((keys (epa--marked-keys)))
1252 ;;      (unless keys
1253 ;;        (error "No keys selected"))
1254 ;;      (list keys current-prefix-arg)))
1255 ;;   (let ((context (epg-make-context epa-protocol)))
1256 ;;     (epg-context-set-passphrase-callback context
1257 ;;                                       #'epa-passphrase-callback-function)
1258 ;;     (epg-context-set-progress-callback context
1259 ;;                                     (cons
1260 ;;                                      #'epa-progress-callback-function
1261 ;;                                      "Signing keys..."))
1262 ;;     (message "Signing keys...")
1263 ;;     (epg-sign-keys context keys local)
1264 ;;     (message "Signing keys...done")))
1265 ;; (make-obsolete 'epa-sign-keys "Do not use.")
1266
1267 (provide 'epa)
1268
1269 ;;; epa.el ends here