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     ;; C-c C-c is the usual way to finish the selection (bug#11159).
 486     (define-key (current-local-map) "\C-c\C-c" 'exit-recursive-edit)
 487     (let ((inhibit-read-only t)
 488           buffer-read-only)
 489       (erase-buffer)
 490       (insert prompt "\n"
 491               (substitute-command-keys "\
 492 - `\\[epa-mark-key]' to mark a key on the line
 493 - `\\[epa-unmark-key]' to unmark a key on the line\n"))
 494       (widget-create 'link
 495                      :notify (lambda (&rest _ignore) (abort-recursive-edit))
 496                      :help-echo
 497                      (substitute-command-keys
 498                       "Click here or \\[abort-recursive-edit] to cancel")
 499                      "Cancel")
 500       (widget-create 'link
 501                      :notify (lambda (&rest _ignore) (exit-recursive-edit))
 502                      :help-echo
 503                      (substitute-command-keys
 504                       "Click here or \\[exit-recursive-edit] to finish")
 505                      "OK")
 506       (insert "\n\n")
 507       (epa--insert-keys keys)
 508       (widget-setup)
 509       (set-keymap-parent (current-local-map) widget-keymap)
 510       (setq epa-exit-buffer-function #'abort-recursive-edit)
 511       (goto-char (point-min))
 512       (let ((display-buffer-mark-dedicated 'soft))
 513         (pop-to-buffer (current-buffer))))
 514     (unwind-protect
 515         (progn
 516           (recursive-edit)
 517           (epa--marked-keys))
 518       (kill-buffer epa-keys-buffer))))
 519
 520 ;;;###autoload
 521 (defun epa-select-keys (context prompt &optional names secret)
 522   "Display a user's keyring and ask him to select keys.
 523 CONTEXT is an epg-context.
 524 PROMPT is a string to prompt with.
 525 NAMES is a list of strings to be matched with keys.  If it is nil, all
 526 the keys are listed.
 527 If SECRET is non-nil, list secret keys instead of public keys."
 528   (let ((keys (epg-list-keys context names secret)))
 529     (epa--select-keys prompt keys)))
 530
 531 (defun epa--show-key (key)
 532   (let* ((primary-sub-key (car (epg-key-sub-key-list key)))
 533          (entry (assoc (epg-sub-key-id primary-sub-key)
 534                        epa-key-buffer-alist))
 535          (inhibit-read-only t)
 536          buffer-read-only
 537          pointer)
 538     (unless entry
 539       (setq entry (cons (epg-sub-key-id primary-sub-key) nil)
 540             epa-key-buffer-alist (cons entry epa-key-buffer-alist)))
 541     (unless (and (cdr entry)
 542                  (buffer-live-p (cdr entry)))
 543       (setcdr entry (generate-new-buffer
 544                      (format "*Key*%s" (epg-sub-key-id primary-sub-key)))))
 545     (set-buffer (cdr entry))
 546     (epa-key-mode)
 547     (make-local-variable 'epa-key)
 548     (setq epa-key key)
 549     (erase-buffer)
 550     (setq pointer (epg-key-user-id-list key))
 551     (while pointer
 552       (if (car pointer)
 553           (insert " "
 554                   (if (epg-user-id-validity (car pointer))
 555                       (char-to-string
 556                        (car (rassq (epg-user-id-validity (car pointer))
 557                                    epg-key-validity-alist)))
 558                     " ")
 559                   " "
 560                   (if (stringp (epg-user-id-string (car pointer)))
 561                       (epg-user-id-string (car pointer))
 562                     (epg-decode-dn (epg-user-id-string (car pointer))))
 563                   "\n"))
 564       (setq pointer (cdr pointer)))
 565     (setq pointer (epg-key-sub-key-list key))
 566     (while pointer
 567       (insert " "
 568               (if (epg-sub-key-validity (car pointer))
 569                   (char-to-string
 570                    (car (rassq (epg-sub-key-validity (car pointer))
 571                                epg-key-validity-alist)))
 572                 " ")
 573               " "
 574               (epg-sub-key-id (car pointer))
 575               " "
 576               (format "%dbits"
 577                       (epg-sub-key-length (car pointer)))
 578               " "
 579               (cdr (assq (epg-sub-key-algorithm (car pointer))
 580                          epg-pubkey-algorithm-alist))
 581               "\n\tCreated: "
 582               (condition-case nil
 583                   (format-time-string "%Y-%m-%d"
 584                                       (epg-sub-key-creation-time (car pointer)))
 585                 (error "????-??-??"))
 586               (if (epg-sub-key-expiration-time (car pointer))
 587                   (format (if (time-less-p (current-time)
 588                                            (epg-sub-key-expiration-time
 589                                             (car pointer)))
 590                               "\n\tExpires: %s"
 591                             "\n\tExpired: %s")
 592                           (condition-case nil
 593                               (format-time-string "%Y-%m-%d"
 594                                                   (epg-sub-key-expiration-time
 595                                                    (car pointer)))
 596                             (error "????-??-??")))
 597                 "")
 598               "\n\tCapabilities: "
 599               (mapconcat #'symbol-name
 600                          (epg-sub-key-capability (car pointer))
 601                          " ")
 602               "\n\tFingerprint: "
 603               (epg-sub-key-fingerprint (car pointer))
 604               "\n")
 605       (setq pointer (cdr pointer)))
 606     (goto-char (point-min))
 607     (pop-to-buffer (current-buffer))))
 608
 609 (defun epa-display-info (info)
 610   (if epa-popup-info-window
 611       (save-selected-window
 612         (unless (and epa-info-buffer (buffer-live-p epa-info-buffer))
 613           (setq epa-info-buffer (generate-new-buffer "*Info*")))
 614         (if (get-buffer-window epa-info-buffer)
 615             (delete-window (get-buffer-window epa-info-buffer)))
 616         (with-current-buffer epa-info-buffer
 617           (let ((inhibit-read-only t)
 618                 buffer-read-only)
 619             (erase-buffer)
 620             (insert info))
 621           (epa-info-mode)
 622           (goto-char (point-min)))
 623         (if (> (window-height)
 624                epa-info-window-height)
 625             (set-window-buffer (split-window nil (- (window-height)
 626                                                     epa-info-window-height))
 627                                epa-info-buffer)
 628           (pop-to-buffer epa-info-buffer)
 629           (if (> (window-height) epa-info-window-height)
 630               (shrink-window (- (window-height) epa-info-window-height)))))
 631     (message "%s" info)))
 632
 633 (defun epa-display-verify-result (verify-result)
 634   (epa-display-info (epg-verify-result-to-string verify-result)))
 635 (make-obsolete 'epa-display-verify-result 'epa-display-info "23.1")
 636
 637 (defun epa-passphrase-callback-function (context key-id handback)
 638   (if (eq key-id 'SYM)
 639       (read-passwd
 640        (format "Passphrase for symmetric encryption%s: "
 641                ;; Add the file name to the prompt, if any.
 642                (if (stringp handback)
 643                    (format " for %s" handback)
 644                  ""))
 645        (eq (epg-context-operation context) 'encrypt))
 646     (read-passwd
 647      (if (eq key-id 'PIN)
 648         "Passphrase for PIN: "
 649        (let ((entry (assoc key-id epg-user-id-alist)))
 650          (if entry
 651              (format "Passphrase for %s %s: " key-id (cdr entry))
 652            (format "Passphrase for %s: " key-id)))))))
 653
 654 (defun epa-progress-callback-function (_context what _char current total
 655                                                handback)
 656   (let ((prompt (or handback
 657                     (format "Processing %s: " what))))
 658     ;; According to gnupg/doc/DETAIL: a "total" of 0 indicates that
 659     ;; the total amount is not known. The condition TOTAL && CUR ==
 660     ;; TOTAL may be used to detect the end of an operation.
 661     (if (> total 0)
 662         (if (= current total)
 663             (message "%s...done" prompt)
 664           (message "%s...%d%%" prompt
 665                    (floor (* (/ current (float total)) 100))))
 666       (message "%s..." prompt))))
 667
 668 ;;;###autoload
 669 (defun epa-decrypt-file (file)
 670   "Decrypt FILE."
 671   (interactive "fFile: ")
 672   (setq file (expand-file-name file))
 673   (let* ((default-name (file-name-sans-extension file))
 674          (plain (expand-file-name
 675                  (read-file-name
 676                   (concat "To file (default "
 677                           (file-name-nondirectory default-name)
 678                           ") ")
 679                   (file-name-directory default-name)
 680                   default-name)))
 681          (context (epg-make-context epa-protocol)))
 682     (epg-context-set-passphrase-callback context
 683                                          #'epa-passphrase-callback-function)
 684     (epg-context-set-progress-callback context
 685                                        (cons
 686                                         #'epa-progress-callback-function
 687                                         (format "Decrypting %s..."
 688                                                 (file-name-nondirectory file))))
 689     (message "Decrypting %s..." (file-name-nondirectory file))
 690     (epg-decrypt-file context file plain)
 691     (message "Decrypting %s...wrote %s" (file-name-nondirectory file)
 692              (file-name-nondirectory plain))
 693     (if (epg-context-result-for context 'verify)
 694         (epa-display-info (epg-verify-result-to-string
 695                            (epg-context-result-for context 'verify))))))
 696
 697 ;;;###autoload
 698 (defun epa-verify-file (file)
 699   "Verify FILE."
 700   (interactive "fFile: ")
 701   (setq file (expand-file-name file))
 702   (let* ((context (epg-make-context epa-protocol))
 703          (plain (if (equal (file-name-extension file) "sig")
 704                     (file-name-sans-extension file))))
 705     (epg-context-set-progress-callback context
 706                                        (cons
 707                                         #'epa-progress-callback-function
 708                                         (format "Verifying %s..."
 709                                                 (file-name-nondirectory file))))
 710     (message "Verifying %s..." (file-name-nondirectory file))
 711     (epg-verify-file context file plain)
 712     (message "Verifying %s...done" (file-name-nondirectory file))
 713     (if (epg-context-result-for context 'verify)
 714         (epa-display-info (epg-verify-result-to-string
 715                            (epg-context-result-for context 'verify))))))
 716
 717 (defun epa--read-signature-type ()
 718   (let (type c)
 719     (while (null type)
 720       (message "Signature type (n,c,d,?) ")
 721       (setq c (read-char))
 722       (cond ((eq c ?c)
 723              (setq type 'clear))
 724             ((eq c ?d)
 725              (setq type 'detached))
 726             ((eq c ??)
 727              (with-output-to-temp-buffer "*Help*"
 728                (with-current-buffer standard-output
 729                  (insert "\
 730 n - Create a normal signature
 731 c - Create a cleartext signature
 732 d - Create a detached signature
 733 ? - Show this help
 734 "))))
 735             (t
 736              (setq type 'normal))))
 737     type))
 738
 739 ;;;###autoload
 740 (defun epa-sign-file (file signers mode)
 741   "Sign FILE by SIGNERS keys selected."
 742   (interactive
 743    (let ((verbose current-prefix-arg))
 744      (list (expand-file-name (read-file-name "File: "))
 745            (if verbose
 746                (epa-select-keys (epg-make-context epa-protocol)
 747                                 "Select keys for signing.
 748 If no one is selected, default secret key is used.  "
 749                                 nil t))
 750            (if verbose
 751                (epa--read-signature-type)
 752              'clear))))
 753   (let ((signature (concat file
 754                            (if (eq epa-protocol 'OpenPGP)
 755                                (if (or epa-armor
 756                                        (not (memq mode
 757                                                   '(nil t normal detached))))
 758                                    ".asc"
 759                                  (if (memq mode '(t detached))
 760                                      ".sig"
 761                                    ".gpg"))
 762                              (if (memq mode '(t detached))
 763                                  ".p7s"
 764                                ".p7m"))))
 765         (context (epg-make-context epa-protocol)))
 766     (epg-context-set-armor context epa-armor)
 767     (epg-context-set-textmode context epa-textmode)
 768     (epg-context-set-signers context signers)
 769     (epg-context-set-passphrase-callback context
 770                                          #'epa-passphrase-callback-function)
 771     (epg-context-set-progress-callback context
 772                                        (cons
 773                                         #'epa-progress-callback-function
 774                                         (format "Signing %s..."
 775                                                 (file-name-nondirectory file))))
 776     (message "Signing %s..." (file-name-nondirectory file))
 777     (epg-sign-file context file signature mode)
 778     (message "Signing %s...wrote %s" (file-name-nondirectory file)
 779              (file-name-nondirectory signature))))
 780
 781 ;;;###autoload
 782 (defun epa-encrypt-file (file recipients)
 783   "Encrypt FILE for RECIPIENTS."
 784   (interactive
 785    (list (expand-file-name (read-file-name "File: "))
 786          (epa-select-keys (epg-make-context epa-protocol)
 787                           "Select recipients for encryption.
 788 If no one is selected, symmetric encryption will be performed.  ")))
 789   (let ((cipher (concat file (if (eq epa-protocol 'OpenPGP)
 790                                  (if epa-armor ".asc" ".gpg")
 791                                ".p7m")))
 792         (context (epg-make-context epa-protocol)))
 793     (epg-context-set-armor context epa-armor)
 794     (epg-context-set-textmode context epa-textmode)
 795     (epg-context-set-passphrase-callback context
 796                                          #'epa-passphrase-callback-function)
 797     (epg-context-set-progress-callback context
 798                                        (cons
 799                                         #'epa-progress-callback-function
 800                                         (format "Encrypting %s..."
 801                                                 (file-name-nondirectory file))))
 802     (message "Encrypting %s..." (file-name-nondirectory file))
 803     (epg-encrypt-file context file recipients cipher)
 804     (message "Encrypting %s...wrote %s" (file-name-nondirectory file)
 805              (file-name-nondirectory cipher))))
 806
 807 ;;;###autoload
 808 (defun epa-decrypt-region (start end &optional make-buffer-function)
 809   "Decrypt the current region between START and END.
 810
 811 If MAKE-BUFFER-FUNCTION is non-nil, call it to prepare an output buffer.
 812 It should return that buffer.  If it copies the input, it should
 813 delete the text now being decrypted.  It should leave point at the
 814 proper place to insert the plaintext.
 815
 816 Be careful about using this command in Lisp programs!
 817 Since this function operates on regions, it does some tricks such
 818 as coding-system detection and unibyte/multibyte conversion.  If
 819 you are sure how the data in the region should be treated, you
 820 should consider using the string based counterpart
 821 `epg-decrypt-string', or the file based counterpart
 822 `epg-decrypt-file' instead.
 823
 824 For example:
 825
 826 \(let ((context (epg-make-context 'OpenPGP)))
 827   (decode-coding-string
 828     (epg-decrypt-string context (buffer-substring start end))
 829     'utf-8))"
 830   (interactive "r")
 831   (save-excursion
 832     (let ((context (epg-make-context epa-protocol))
 833           plain)
 834       (epg-context-set-passphrase-callback context
 835                                            #'epa-passphrase-callback-function)
 836       (epg-context-set-progress-callback context
 837                                          (cons
 838                                           #'epa-progress-callback-function
 839                                           "Decrypting..."))
 840       (message "Decrypting...")
 841       (setq plain (epg-decrypt-string context (buffer-substring start end)))
 842       (message "Decrypting...done")
 843       (setq plain (epa--decode-coding-string
 844                    plain
 845                    (or coding-system-for-read
 846                        (get-text-property start 'epa-coding-system-used)
 847                        'undecided)))
 848       (if make-buffer-function
 849           (with-current-buffer (funcall make-buffer-function)
 850             (let ((inhibit-read-only t))
 851               (insert plain)))
 852         (if (y-or-n-p "Replace the original text? ")
 853             (let ((inhibit-read-only t))
 854               (delete-region start end)
 855               (goto-char start)
 856               (insert plain))
 857           (with-output-to-temp-buffer "*Temp*"
 858             (set-buffer standard-output)
 859               (insert plain)
 860               (epa-info-mode))))
 861       (if (epg-context-result-for context 'verify)
 862           (epa-display-info (epg-verify-result-to-string
 863                              (epg-context-result-for context 'verify)))))))
 864
 865 (defun epa--find-coding-system-for-mime-charset (mime-charset)
 866   (if (featurep 'xemacs)
 867       (if (fboundp 'find-coding-system)
 868           (find-coding-system mime-charset))
 869     ;; Find the first coding system which corresponds to MIME-CHARSET.
 870     (let ((pointer (coding-system-list)))
 871       (while (and pointer
 872                   (not (eq (coding-system-get (car pointer) 'mime-charset)
 873                            mime-charset)))
 874         (setq pointer (cdr pointer)))
 875       (car pointer))))
 876
 877 ;;;###autoload
 878 (defun epa-decrypt-armor-in-region (start end)
 879   "Decrypt OpenPGP armors in the current region between START and END.
 880
 881 Don't use this command in Lisp programs!
 882 See the reason described in the `epa-decrypt-region' documentation."
 883   (interactive "r")
 884   (save-excursion
 885     (save-restriction
 886       (narrow-to-region start end)
 887       (goto-char start)
 888       (let (armor-start armor-end)
 889         (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
 890           (setq armor-start (match-beginning 0)
 891                 armor-end (re-search-forward "^-----END PGP MESSAGE-----$"
 892                                              nil t))
 893           (unless armor-end
 894             (error "Encryption armor beginning has no matching end"))
 895           (goto-char armor-start)
 896           (let ((coding-system-for-read
 897                  (or coding-system-for-read
 898                      (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
 899                          (epa--find-coding-system-for-mime-charset
 900                           (intern (downcase (match-string 1))))))))
 901             (goto-char armor-end)
 902             (epa-decrypt-region armor-start armor-end)))))))
 903
 904 ;;;###autoload
 905 (defun epa-verify-region (start end)
 906   "Verify the current region between START and END.
 907
 908 Don't use this command in Lisp programs!
 909 Since this function operates on regions, it does some tricks such
 910 as coding-system detection and unibyte/multibyte conversion.  If
 911 you are sure how the data in the region should be treated, you
 912 should consider using the string based counterpart
 913 `epg-verify-string', or the file based counterpart
 914 `epg-verify-file' instead.
 915
 916 For example:
 917
 918 \(let ((context (epg-make-context 'OpenPGP)))
 919   (decode-coding-string
 920     (epg-verify-string context (buffer-substring start end))
 921     'utf-8))"
 922   (interactive "r")
 923   (let ((context (epg-make-context epa-protocol))
 924         plain)
 925     (epg-context-set-progress-callback context
 926                                        (cons
 927                                         #'epa-progress-callback-function
 928                                         "Verifying..."))
 929     (message "Verifying...")
 930     (setq plain (epg-verify-string
 931                  context
 932                  (epa--encode-coding-string
 933                   (buffer-substring start end)
 934                   (or coding-system-for-write
 935                       (get-text-property start 'epa-coding-system-used)))))
 936     (message "Verifying...done")
 937     (setq plain (epa--decode-coding-string
 938                  plain
 939                  (or coding-system-for-read
 940                      (get-text-property start 'epa-coding-system-used)
 941                      'undecided)))
 942     (if (y-or-n-p "Replace the original text? ")
 943         (let ((inhibit-read-only t)
 944               buffer-read-only)
 945           (delete-region start end)
 946           (goto-char start)
 947           (insert plain))
 948       (with-output-to-temp-buffer "*Temp*"
 949         (set-buffer standard-output)
 950         (insert plain)
 951         (epa-info-mode)))
 952     (if (epg-context-result-for context 'verify)
 953         (epa-display-info (epg-verify-result-to-string
 954                            (epg-context-result-for context 'verify))))))
 955
 956 ;;;###autoload
 957 (defun epa-verify-cleartext-in-region (start end)
 958   "Verify OpenPGP cleartext signed messages in the current region
 959 between START and END.
 960
 961 Don't use this command in Lisp programs!
 962 See the reason described in the `epa-verify-region' documentation."
 963   (interactive "r")
 964   (save-excursion
 965     (save-restriction
 966       (narrow-to-region start end)
 967       (goto-char start)
 968       (let (cleartext-start cleartext-end)
 969         (while (re-search-forward "-----BEGIN PGP SIGNED MESSAGE-----$"
 970                                   nil t)
 971           (setq cleartext-start (match-beginning 0))
 972           (unless (re-search-forward "^-----BEGIN PGP SIGNATURE-----$"
 973                                            nil t)
 974             (error "Invalid cleartext signed message"))
 975           (setq cleartext-end (re-search-forward
 976                            "^-----END PGP SIGNATURE-----$"
 977                            nil t))
 978           (unless cleartext-end
 979             (error "No cleartext tail"))
 980           (epa-verify-region cleartext-start cleartext-end))))))
 981
 982 (eval-and-compile
 983   (if (fboundp 'select-safe-coding-system)
 984       (defalias 'epa--select-safe-coding-system 'select-safe-coding-system)
 985     (defun epa--select-safe-coding-system (_from _to)
 986       buffer-file-coding-system)))
 987
 988 ;;;###autoload
 989 (defun epa-sign-region (start end signers mode)
 990   "Sign the current region between START and END by SIGNERS keys selected.
 991
 992 Don't use this command in Lisp programs!
 993 Since this function operates on regions, it does some tricks such
 994 as coding-system detection and unibyte/multibyte conversion.  If
 995 you are sure how the data should be treated, you should consider
 996 using the string based counterpart `epg-sign-string', or the file
 997 based counterpart `epg-sign-file' instead.
 998
 999 For example:
1000
1001 \(let ((context (epg-make-context 'OpenPGP)))
1002   (epg-sign-string
1003     context
1004     (encode-coding-string (buffer-substring start end) 'utf-8)))"
1005   (interactive
1006    (let ((verbose current-prefix-arg))
1007      (setq epa-last-coding-system-specified
1008            (or coding-system-for-write
1009                (epa--select-safe-coding-system
1010                 (region-beginning) (region-end))))
1011      (list (region-beginning) (region-end)
1012            (if verbose
1013                (epa-select-keys (epg-make-context epa-protocol)
1014                                 "Select keys for signing.
1015 If no one is selected, default secret key is used.  "
1016                                 nil t))
1017            (if verbose
1018                (epa--read-signature-type)
1019              'clear))))
1020   (save-excursion
1021     (let ((context (epg-make-context epa-protocol))
1022           signature)
1023       ;;(epg-context-set-armor context epa-armor)
1024       (epg-context-set-armor context t)
1025       ;;(epg-context-set-textmode context epa-textmode)
1026       (epg-context-set-textmode context t)
1027       (epg-context-set-signers context signers)
1028       (epg-context-set-passphrase-callback context
1029                                            #'epa-passphrase-callback-function)
1030       (epg-context-set-progress-callback context
1031                                          (cons
1032                                           #'epa-progress-callback-function
1033                                           "Signing..."))
1034       (message "Signing...")
1035       (setq signature (epg-sign-string context
1036                                        (epa--encode-coding-string
1037                                         (buffer-substring start end)
1038                                         epa-last-coding-system-specified)
1039                                        mode))
1040       (message "Signing...done")
1041       (delete-region start end)
1042       (goto-char start)
1043       (add-text-properties (point)
1044                            (progn
1045                              (insert (epa--decode-coding-string
1046                                       signature
1047                                       (or coding-system-for-read
1048                                           epa-last-coding-system-specified)))
1049                              (point))
1050                            (list 'epa-coding-system-used
1051                                  epa-last-coding-system-specified
1052                                  'front-sticky nil
1053                                  'rear-nonsticky t
1054                                  'start-open t
1055                                  'end-open t)))))
1056
1057 (eval-and-compile
1058   (if (fboundp 'derived-mode-p)
1059       (defalias 'epa--derived-mode-p 'derived-mode-p)
1060     (defun epa--derived-mode-p (&rest modes)
1061       "Non-nil if the current major mode is derived from one of MODES.
1062 Uses the `derived-mode-parent' property of the symbol to trace backwards."
1063       (let ((parent major-mode))
1064         (while (and (not (memq parent modes))
1065                     (setq parent (get parent 'derived-mode-parent))))
1066         parent))))
1067
1068 ;;;###autoload
1069 (defun epa-encrypt-region (start end recipients sign signers)
1070   "Encrypt the current region between START and END for RECIPIENTS.
1071
1072 Don't use this command in Lisp programs!
1073 Since this function operates on regions, it does some tricks such
1074 as coding-system detection and unibyte/multibyte conversion.  If
1075 you are sure how the data should be treated, you should consider
1076 using the string based counterpart `epg-encrypt-string', or the
1077 file based counterpart `epg-encrypt-file' instead.
1078
1079 For example:
1080
1081 \(let ((context (epg-make-context 'OpenPGP)))
1082   (epg-encrypt-string
1083     context
1084     (encode-coding-string (buffer-substring start end) 'utf-8)
1085     nil))"
1086   (interactive
1087    (let ((verbose current-prefix-arg)
1088          (context (epg-make-context epa-protocol))
1089          sign)
1090      (setq epa-last-coding-system-specified
1091            (or coding-system-for-write
1092                (epa--select-safe-coding-system
1093                 (region-beginning) (region-end))))
1094      (list (region-beginning) (region-end)
1095            (epa-select-keys context
1096                             "Select recipients for encryption.
1097 If no one is selected, symmetric encryption will be performed.  ")
1098            (setq sign (if verbose (y-or-n-p "Sign? ")))
1099            (if sign
1100                (epa-select-keys context
1101                                 "Select keys for signing.  ")))))
1102   (save-excursion
1103     (let ((context (epg-make-context epa-protocol))
1104           cipher)
1105       ;;(epg-context-set-armor context epa-armor)
1106       (epg-context-set-armor context t)
1107       ;;(epg-context-set-textmode context epa-textmode)
1108       (epg-context-set-textmode context t)
1109       (if sign
1110           (epg-context-set-signers context signers))
1111       (epg-context-set-passphrase-callback context
1112                                            #'epa-passphrase-callback-function)
1113       (epg-context-set-progress-callback context
1114                                          (cons
1115                                           #'epa-progress-callback-function
1116                                           "Encrypting..."))
1117       (message "Encrypting...")
1118       (setq cipher (epg-encrypt-string context
1119                                        (epa--encode-coding-string
1120                                         (buffer-substring start end)
1121                                         epa-last-coding-system-specified)
1122                                        recipients
1123                                        sign))
1124       (message "Encrypting...done")
1125       (delete-region start end)
1126       (goto-char start)
1127       (add-text-properties (point)
1128                            (progn
1129                              (insert cipher)
1130                              (point))
1131                            (list 'epa-coding-system-used
1132                                  epa-last-coding-system-specified
1133                                  'front-sticky nil
1134                                  'rear-nonsticky t
1135                                  'start-open t
1136                                  'end-open t)))))
1137
1138 ;;;###autoload
1139 (defun epa-delete-keys (keys &optional allow-secret)
1140   "Delete selected KEYS."
1141   (interactive
1142    (let ((keys (epa--marked-keys)))
1143      (unless keys
1144        (error "No keys selected"))
1145      (list keys
1146            (eq (nth 1 epa-list-keys-arguments) t))))
1147   (let ((context (epg-make-context epa-protocol)))
1148     (message "Deleting...")
1149     (epg-delete-keys context keys allow-secret)
1150     (message "Deleting...done")
1151     (apply #'epa--list-keys epa-list-keys-arguments)))
1152
1153 ;;;###autoload
1154 (defun epa-import-keys (file)
1155   "Import keys from FILE."
1156   (interactive "fFile: ")
1157   (setq file (expand-file-name file))
1158   (let ((context (epg-make-context epa-protocol)))
1159     (message "Importing %s..." (file-name-nondirectory file))
1160     (condition-case nil
1161         (progn
1162           (epg-import-keys-from-file context file)
1163           (message "Importing %s...done" (file-name-nondirectory file)))
1164       (error
1165        (message "Importing %s...failed" (file-name-nondirectory file))))
1166     (if (epg-context-result-for context 'import)
1167         (epa-display-info (epg-import-result-to-string
1168                            (epg-context-result-for context 'import))))
1169     (if (eq major-mode 'epa-key-list-mode)
1170         (apply #'epa--list-keys epa-list-keys-arguments))))
1171
1172 ;;;###autoload
1173 (defun epa-import-keys-region (start end)
1174   "Import keys from the region."
1175   (interactive "r")
1176   (let ((context (epg-make-context epa-protocol)))
1177     (message "Importing...")
1178     (condition-case nil
1179         (progn
1180           (epg-import-keys-from-string context (buffer-substring start end))
1181           (message "Importing...done"))
1182       (error
1183        (message "Importing...failed")))
1184     (if (epg-context-result-for context 'import)
1185         (epa-display-info (epg-import-result-to-string
1186                            (epg-context-result-for context 'import))))))
1187
1188 ;;;###autoload
1189 (defun epa-import-armor-in-region (start end)
1190   "Import keys in the OpenPGP armor format in the current region
1191 between START and END."
1192   (interactive "r")
1193   (save-excursion
1194     (save-restriction
1195       (narrow-to-region start end)
1196       (goto-char start)
1197       (let (armor-start armor-end)
1198         (while (re-search-forward
1199                 "-----BEGIN \\(PGP \\(PUBLIC\\|PRIVATE\\) KEY BLOCK\\)-----$"
1200                 nil t)
1201           (setq armor-start (match-beginning 0)
1202                 armor-end (re-search-forward
1203                            (concat "^-----END " (match-string 1) "-----$")
1204                            nil t))
1205           (unless armor-end
1206             (error "No armor tail"))
1207           (epa-import-keys-region armor-start armor-end))))))
1208
1209 ;;;###autoload
1210 (defun epa-export-keys (keys file)
1211   "Export selected KEYS to FILE."
1212   (interactive
1213    (let ((keys (epa--marked-keys))
1214          default-name)
1215      (unless keys
1216        (error "No keys selected"))
1217      (setq default-name
1218            (expand-file-name
1219             (concat (epg-sub-key-id (car (epg-key-sub-key-list (car keys))))
1220                     (if epa-armor ".asc" ".gpg"))
1221             default-directory))
1222      (list keys
1223            (expand-file-name
1224             (read-file-name
1225              (concat "To file (default "
1226                      (file-name-nondirectory default-name)
1227                      ") ")
1228              (file-name-directory default-name)
1229              default-name)))))
1230   (let ((context (epg-make-context epa-protocol)))
1231     (epg-context-set-armor context epa-armor)
1232     (message "Exporting to %s..." (file-name-nondirectory file))
1233     (epg-export-keys-to-file context keys file)
1234     (message "Exporting to %s...done" (file-name-nondirectory file))))
1235
1236 ;;;###autoload
1237 (defun epa-insert-keys (keys)
1238   "Insert selected KEYS after the point."
1239   (interactive
1240    (list (epa-select-keys (epg-make-context epa-protocol)
1241                                 "Select keys to export.
1242 If no one is selected, default public key is exported.  ")))
1243   (let ((context (epg-make-context epa-protocol)))
1244     ;;(epg-context-set-armor context epa-armor)
1245     (epg-context-set-armor context t)
1246     (insert (epg-export-keys-to-string context keys))))
1247
1248 ;; (defun epa-sign-keys (keys &optional local)
1249 ;;   "Sign selected KEYS.
1250 ;; If a prefix-arg is specified, the signature is marked as non exportable.
1251
1252 ;; Don't use this command in Lisp programs!"
1253 ;;   (interactive
1254 ;;    (let ((keys (epa--marked-keys)))
1255 ;;      (unless keys
1256 ;;        (error "No keys selected"))
1257 ;;      (list keys current-prefix-arg)))
1258 ;;   (let ((context (epg-make-context epa-protocol)))
1259 ;;     (epg-context-set-passphrase-callback context
1260 ;;                                       #'epa-passphrase-callback-function)
1261 ;;     (epg-context-set-progress-callback context
1262 ;;                                     (cons
1263 ;;                                      #'epa-progress-callback-function
1264 ;;                                      "Signing keys..."))
1265 ;;     (message "Signing keys...")
1266 ;;     (epg-sign-keys context keys local)
1267 ;;     (message "Signing keys...done")))
1268 ;; (make-obsolete 'epa-sign-keys "Do not use.")
1269
1270 (provide 'epa)
1271
1272 ;;; epa.el ends here