cgit.sxemacs.org Git - packages/blob - xemacs-packages/mailcrypt/mc-toplev.el

   1 ;; mc-toplev.el, entry point functions for Mailcrypt
   2 ;; Copyright (C) 1995  Jin Choi <jsc@mit.edu>
   3 ;;                     Patrick LoPresti <patl@lcs.mit.edu>
   4
   5 ;;{{{ Licensing
   6 ;; This file is intended to be used with GNU Emacs.
   7
   8 ;; This program is free software; you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation; either version 2, or (at your option)
  11 ;; any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with GNU Emacs; see the file COPYING.  If not, write to
  20 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  21 ;;}}}
  22 ;;{{{ Load some required packages
  23 (require 'mailcrypt)
  24 (require 'mail-utils)
  25 (require 'rfc822)
  26
  27 (eval-when-compile
  28   ;; RMAIL
  29   (condition-case nil (require 'rmail) (error nil))
  30   (autoload 'rmail-abort-edit "rmailedit")
  31   (autoload 'rmail-cease-edit "rmailedit")
  32   ;; Is this a good idea?
  33   (defvar rmail-buffer nil)
  34
  35   ;; VM
  36   (condition-case nil (require 'vm) (error nil))
  37
  38   ;; GNUS
  39   (condition-case nil (require 'gnus) (error nil))
  40   (autoload 'gnus-summary-select-article "gnus-sum")
  41   (autoload 'gnus-summary-edit-article "gnus-sum")
  42   (autoload 'gnus-summary-edit-article-postpone "gnus-sum")
  43   (autoload 'gnus-summary-edit-article-done "gnus-sum")
  44
  45   ;; MH-E
  46   (condition-case nil (require 'mh-e) (error nil))
  47   (autoload 'mh-in-show-buffer "mh-utils")
  48   (autoload 'mh-invalidate-show-buffer "mh-utils")
  49   (autoload 'mh-msg-filename "mh-utils")
  50   (autoload 'mh-show "mh-utils")
  51
  52   ;; Mew
  53   (condition-case nil (require 'mew) (error nil))
  54   (autoload 'mew-summary-display "mew-summary")
  55   (autoload 'mew-buffer-message "mew")
  56
  57 )
  58
  59 (eval-and-compile
  60   (condition-case nil (require 'mailalias) (error nil)))
  61
  62 (autoload 'mc-scheme-pgp   "mc-pgp"  nil t)
  63 (autoload 'mc-scheme-pgp50 "mc-pgp5" nil t)
  64 (autoload 'mc-scheme-gpg   "mc-gpg"  nil t)
  65
  66 ;;}}}
  67
  68 ;;{{{ Encryption
  69
  70 (defun mc-cleanup-recipient-headers (str)
  71   ;; Takes a comma separated string of recipients to encrypt for and,
  72   ;; assuming they were possibly extracted from the headers of a reply,
  73   ;; returns a list of the address components.
  74   (mapcar 'mc-strip-address
  75           (rfc822-addresses str)))
  76
  77 (defun mc-find-headers-end ()
  78   (save-excursion
  79     (goto-char (point-min))
  80     (re-search-forward
  81      (concat "^" (regexp-quote mail-header-separator) "\n"))
  82     (if (looking-at "^::\n")
  83         (re-search-forward "^\n" nil t))
  84     (if (looking-at "^##\n")
  85         (re-search-forward "^\n" nil t))
  86     (point-marker)))
  87
  88 (defun mc-encrypt (arg)
  89   "*Encrypt the current buffer.
  90
  91 Exact behavior depends on current major mode.
  92
  93 With \\[universal-argument], prompt for User ID to sign as.
  94
  95 With \\[universal-argument] \\[universal-argument], prompt for encryption scheme to use."
  96   (interactive "p")
  97   (mc-encrypt-region arg nil nil))
  98
  99 (defun mc-encrypt-region (arg start end)
 100   "*Encrypt the current region."
 101   (interactive "p\nr")
 102   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
 103          (func (or (cdr-safe (assq 'encrypt mode-alist))
 104                    'mc-encrypt-generic))
 105          sign scheme from)
 106     (if (>= arg 4)
 107         (setq from (read-string "User ID: ")
 108               sign t))
 109     (if (>= arg 16)
 110         (setq scheme
 111               (cdr (assoc
 112                     (completing-read "Encryption Scheme: " mc-schemes)
 113                     mc-schemes))))
 114     (funcall func nil scheme start end from sign)))
 115
 116 (defun mc-encrypt-generic (&optional recipients scheme start end from sign)
 117   "*Generic function to encrypt a region of data."
 118   (save-excursion
 119     (or start (setq start (point-min-marker)))
 120     (or (markerp start) (setq start (copy-marker start)))
 121     (or end (setq end (point-max-marker)))
 122     (or (markerp end) (setq end (copy-marker end)))
 123     (run-hooks 'mc-pre-encryption-hook)
 124     (cond ((stringp recipients)
 125            (setq recipients
 126                  (mc-split "\\([ \t\n]*,[ \t\n]*\\)+" recipients)))
 127           ((null recipients)
 128            (setq recipients
 129                  (mc-cleanup-recipient-headers (read-string "Recipients: "))))
 130           (t (error "mc-encrypt-generic: recipients not string or nil")))
 131     (or scheme (setq scheme mc-default-scheme))
 132     (if (funcall (cdr (assoc 'encryption-func (funcall scheme)))
 133                  recipients start end from sign)
 134         (progn
 135           (run-hooks 'mc-post-encryption-hook)
 136           t))))
 137
 138 (defun mc-encrypt-message (&optional recipients scheme start end from sign)
 139   "*Encrypt a message for RECIPIENTS using the given encryption SCHEME.
 140 RECIPIENTS is a comma separated string. If SCHEME is nil, use the value
 141 of `mc-default-scheme'.  Returns t on success, nil otherwise."
 142   (save-excursion
 143     (let ((headers-end (mc-find-headers-end))
 144           default-recipients)
 145
 146       (setq default-recipients
 147             (save-restriction
 148               (goto-char (point-min))
 149               (re-search-forward
 150                (concat "^" (regexp-quote mail-header-separator) "$"))
 151               (narrow-to-region (point-min) (point))
 152               (and (featurep 'mailalias)
 153                    (not (featurep 'mail-abbrevs))
 154                    mail-aliases
 155                    (expand-mail-aliases (point-min) (point-max)))
 156               (mc-strip-addresses
 157                (mapcar 'cdr
 158                        (mc-get-fields "to\\|cc\\|bcc")))))
 159
 160       (if (not from)
 161           (save-restriction
 162             (goto-char (point-min))
 163             (re-search-forward
 164              (concat "^" (regexp-quote mail-header-separator) "\n"))
 165             (narrow-to-region (point) headers-end)
 166             (setq from (mail-fetch-field "From"))))
 167
 168       (if (not recipients)
 169           (setq recipients
 170                 (if mc-use-default-recipients
 171                     default-recipients
 172                   (read-from-minibuffer "Recipients: " default-recipients))))
 173
 174       (or start (setq start headers-end))
 175       (or end (setq end (point-max-marker)))
 176
 177       (mc-encrypt-generic recipients scheme start end from sign))))
 178
 179
 180 ;;}}}
 181 ;;{{{ Decryption
 182
 183 (defun mc-decrypt ()
 184   "*Decrypt a message in the current buffer.
 185
 186 Exact behavior depends on current major mode."
 187   (interactive)
 188   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
 189          (func (or (cdr-safe (assq 'decrypt mode-alist))
 190                    'mc-decrypt-message)))
 191     (funcall func)))
 192
 193 (defun mc-decrypt-message ()
 194   "Decrypt whatever message is in the current buffer.
 195 Returns a pair (SUCCEEDED . VERIFIED) where SUCCEEDED is t if the encryption
 196 succeeded and VERIFIED is t if it had a valid signature."
 197   (save-excursion
 198     (let ((schemes mc-schemes)
 199           limits
 200           (scheme mc-default-scheme))
 201
 202       ; Attempt to find a message signed according to the default
 203       ; scheme.
 204       (if mc-default-scheme
 205           (setq
 206            limits
 207            (mc-message-delimiter-positions
 208             (cdr (assoc 'msg-begin-line (funcall mc-default-scheme)))
 209             (cdr (assoc 'msg-end-line (funcall mc-default-scheme))))))
 210
 211       ; We can't find a message signed in the default scheme.
 212       ; Step through all the schemes we know, trying to identify
 213       ; the applicable one by examining headers.
 214       (while (and (null limits)
 215                   schemes
 216                   (setq scheme (cdr (car schemes)))
 217                   (not (setq
 218                         limits
 219                         (mc-message-delimiter-positions
 220                          (cdr (assoc 'msg-begin-line (funcall scheme)))
 221                          (cdr (assoc 'msg-end-line (funcall scheme)))))))
 222         (setq schemes (cdr schemes)))
 223
 224       (if (null limits)
 225           (error "Found no encrypted message in this buffer.")
 226         (run-hooks 'mc-pre-decryption-hook)
 227         (let ((resultval (funcall (cdr (assoc 'decryption-func
 228                                               (funcall scheme)))
 229                                   (car limits) (cdr limits))))
 230           (goto-char (point-min))
 231           (if (car resultval) ; decryption succeeded
 232               (run-hooks 'mc-post-decryption-hook))
 233           resultval)))))
 234 ;;}}}
 235 ;;{{{ Signing
 236 (defun mc-sign (arg)
 237   "*Sign a message in the current buffer.
 238
 239 Exact behavior depends on current major mode.
 240
 241 With one prefix arg, prompts for private key to use, with two prefix args,
 242 also prompts for encryption scheme to use.  With negative prefix arg,
 243 inhibits clearsigning (pgp)."
 244   (interactive "p")
 245   (mc-sign-region arg nil nil))
 246
 247 (defun mc-sign-region (arg start end)
 248   "*Sign the current region."
 249   (interactive "p\nr")
 250   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
 251          (func (or (cdr-safe (assq 'sign mode-alist))
 252                    'mc-sign-generic))
 253          from scheme)
 254     (if (>= arg 16)
 255         (setq scheme
 256               (cdr (assoc
 257                     (completing-read "Encryption Scheme: " mc-schemes)
 258                     mc-schemes))))
 259     (if (>= arg 4)
 260         (setq from (read-string "User ID: ")))
 261
 262     (funcall func from scheme start end (< arg 0))))
 263
 264 (defun mc-sign-generic (withkey scheme start end unclearsig)
 265   (or scheme (setq scheme mc-default-scheme))
 266   (or start (setq start (point-min-marker)))
 267   (or (markerp start) (setq start (copy-marker start)))
 268   (or end (setq end (point-max-marker)))
 269   (or (markerp end) (setq end (copy-marker end)))
 270   (run-hooks 'mc-pre-signature-hook)
 271   (if (funcall (cdr (assoc 'signing-func (funcall scheme)))
 272                start end withkey unclearsig)
 273       (progn
 274         (run-hooks 'mc-post-signature-hook)
 275         t)))
 276
 277 (defun mc-sign-message (&optional withkey scheme start end unclearsig)
 278   "Clear sign the message."
 279   (save-excursion
 280     (let ((headers-end (mc-find-headers-end)))
 281       (or withkey
 282           (progn
 283             (goto-char (point-min))
 284             (re-search-forward
 285              (concat "^" (regexp-quote mail-header-separator) "\n"))
 286             (save-restriction
 287               (narrow-to-region (point) headers-end)
 288               (setq withkey (mail-fetch-field "From")))))
 289       (or start (setq start headers-end))
 290       (or end (setq end (point-max-marker)))
 291       (mc-sign-generic withkey scheme start end unclearsig))))
 292
 293 ;;}}}
 294 ;;{{{ Signature verification
 295
 296 (defun mc-verify ()
 297   "*Verify a message in the current buffer.
 298
 299 Exact behavior depends on current major mode."
 300   (interactive)
 301   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
 302          (func (or (cdr-safe (assq 'verify mode-alist))
 303                    'mc-verify-signature)))
 304     (funcall func)))
 305
 306 (defun mc-verify-signature ()
 307   "*Verify the signature of the signed message in the current buffer.
 308 Show the result as a message in the minibuffer. Returns t if the signature
 309 is verified."
 310   (save-excursion
 311     (let ((schemes mc-schemes)
 312           limits
 313           (scheme mc-default-scheme))
 314
 315       ; Attempt to find a message signed according to the default
 316       ; scheme.
 317       (if mc-default-scheme
 318           (setq
 319            limits
 320            (mc-message-delimiter-positions
 321             (cdr (assoc 'signed-begin-line (funcall mc-default-scheme)))
 322             (cdr (assoc 'signed-end-line (funcall mc-default-scheme))))))
 323
 324       ; We can't find a message signed in the default scheme.
 325       ; Step through all the schemes we know, trying to identify
 326       ; the applicable one by examining headers.
 327       (while (and (null limits)
 328                   schemes
 329                   (setq scheme (cdr (car schemes)))
 330                   (not
 331                    (setq
 332                     limits
 333                     (mc-message-delimiter-positions
 334                      (cdr (assoc 'signed-begin-line (funcall scheme)))
 335                      (cdr (assoc 'signed-end-line (funcall scheme)))))))
 336         (setq schemes (cdr schemes)))
 337
 338       (if (null limits)
 339           (error "Found no signed message in this buffer.")
 340         (funcall (cdr (assoc 'verification-func (funcall scheme)))
 341                  (car limits) (cdr limits))))))
 342
 343
 344 ;;}}}
 345 ;;{{{ Key management
 346
 347 ;;{{{ mc-insert-public-key
 348
 349 (defun mc-insert-public-key (&optional userid scheme)
 350   "*Insert your public key at point.
 351 With one prefix arg, prompts for user id to use. With two prefix
 352 args, prompts for encryption scheme."
 353   (interactive
 354    (let (arglist)
 355      (if (not (and (listp current-prefix-arg)
 356                    (numberp (car current-prefix-arg))))
 357          nil
 358        (if (>= (car current-prefix-arg) 16)
 359            (setq arglist
 360                  (cons (cdr (assoc (completing-read "Encryption Scheme: "
 361                                                     mc-schemes)
 362                                    mc-schemes))
 363                        arglist)))
 364        (if (>= (car current-prefix-arg) 4)
 365            (setq arglist (cons (read-string "User ID: ") arglist))))
 366      arglist))
 367
 368 ;  (if (< (point) (mc-find-headers-end))
 369 ;      (error "Can't insert key inside message header"))
 370   (or scheme (setq scheme mc-default-scheme))
 371   (or userid (setq userid (cdr (assoc 'user-id (funcall scheme)))))
 372
 373   ;; (goto-char (point-max))
 374   (if (not (bolp))
 375       (insert "\n"))
 376   (funcall (cdr (assoc 'key-insertion-func (funcall scheme))) userid))
 377
 378 ;;}}}
 379 ;;{{{ mc-snarf-keys
 380
 381 (defun mc-snarf ()
 382   "*Add all public keys in the buffer to your keyring.
 383
 384 Exact behavior depends on current major mode."
 385   (interactive)
 386   (let* ((mode-alist (cdr-safe (assq major-mode mc-modes-alist)))
 387          (func (or (cdr-safe (assq 'snarf mode-alist))
 388                    'mc-snarf-keys)))
 389     (funcall func)))
 390
 391 (defun mc-snarf-keys ()
 392   "*Add all public keys in the buffer to your keyring."
 393   (interactive)
 394   (let ((schemes mc-schemes)
 395         (start (point-min))
 396         (found 0)
 397         limits
 398         (scheme mc-default-scheme))
 399     (save-excursion
 400       (catch 'done
 401         (while t
 402
 403           ; Attempt to find a message signed according to the default
 404           ; scheme.
 405           (if mc-default-scheme
 406               (setq
 407                limits
 408                (mc-message-delimiter-positions
 409                 (cdr (assoc 'key-begin-line (funcall mc-default-scheme)))
 410                 (cdr (assoc 'key-end-line (funcall mc-default-scheme)))
 411                 start)))
 412           ; We can't find a message signed in the default scheme.
 413           ; Step through all the schemes we know, trying to identify
 414           ; the applicable one by examining headers.
 415           (while (and (null limits)
 416                       schemes
 417                       (setq scheme (cdr (car schemes)))
 418                       (not
 419                        (setq
 420                         limits
 421                         (mc-message-delimiter-positions
 422                          (cdr (assoc 'key-begin-line (funcall scheme)))
 423                          (cdr (assoc 'key-end-line (funcall scheme)))
 424                          start))))
 425             (setq schemes (cdr schemes)))
 426           (if (null limits)
 427               (throw 'done found)
 428             (setq start (cdr limits))
 429             (setq found (+ found (funcall (cdr (assoc 'snarf-func
 430                                                       (funcall scheme)))
 431                                           (car limits) (cdr limits)))))))
 432       (message (format "%d new key%s found" found
 433                        (if (eq 1 found) "" "s"))))))
 434 ;;}}}
 435 ;;}}}
 436 ;;{{{ Mode specific functions
 437
 438 ;;{{{ RMAIL
 439 (defun mc-rmail-summary-verify-signature ()
 440   "*Verify the signature in the current message."
 441   (interactive)
 442   (if (not (eq major-mode 'rmail-summary-mode))
 443       (error
 444        "mc-rmail-summary-verify-signature called in inappropriate buffer"))
 445   (save-excursion
 446     (set-buffer rmail-buffer)
 447     (mc-verify)))
 448
 449 (defun mc-rmail-summary-decrypt-message ()
 450   "*Decrypt the contents of this message"
 451   (interactive)
 452   (if (not (eq major-mode 'rmail-summary-mode))
 453       (error
 454        "mc-rmail-summary-decrypt-message called in inappropriate buffer"))
 455   (save-excursion
 456     (set-buffer rmail-buffer)
 457     (mc-decrypt)))
 458
 459 (defun mc-rmail-summary-snarf-keys ()
 460   "*Adds keys from current message to public key ring"
 461   (interactive)
 462   (if (not (eq major-mode 'rmail-summary-mode))
 463       (error
 464        "mc-rmail-summary-snarf-keys called in inappropriate buffer"))
 465   (save-excursion
 466     (set-buffer rmail-buffer)
 467     (mc-snarf)))
 468
 469 (defun mc-rmail-verify-signature ()
 470   "*Verify the signature in the current message."
 471   (interactive)
 472   (if (not (equal mode-name "RMAIL"))
 473       (error "mc-rmail-verify-signature called in a non-RMAIL buffer"))
 474   ;; Hack to load rmailkwd before verifying sig
 475   (rmail-add-label "verified")
 476   (rmail-kill-label "verified")
 477   (if (mc-verify-signature)
 478       (rmail-add-label "verified")))
 479
 480 (defun mc-rmail-decrypt-message ()
 481   "*Decrypt the contents of this message"
 482   (interactive)
 483   (let (decryption-result)
 484     (if (not (equal mode-name "RMAIL"))
 485         (error "mc-rmail-decrypt-message called in a non-RMAIL buffer"))
 486     (unwind-protect
 487         (progn
 488           (rmail-edit-current-message)
 489           (setq decryption-result (mc-decrypt-message))
 490           (cond ((not (car decryption-result))
 491                  (rmail-abort-edit))
 492                 ((and (not (eq mc-always-replace 'never))
 493                       (or mc-always-replace
 494                           (y-or-n-p
 495                            "Replace encrypted message with decrypted? ")))
 496                  (rmail-cease-edit)
 497                  (rmail-kill-label "edited")
 498                  (rmail-add-label "decrypted")
 499                  (if (cdr decryption-result)
 500                      (rmail-add-label "verified")))
 501                 (t
 502                  (let ((tmp (generate-new-buffer "*Mailcrypt Viewing*")))
 503                    (copy-to-buffer tmp (point-min) (point-max))
 504                    (rmail-abort-edit)
 505                    (switch-to-buffer tmp t)
 506                    (goto-char (point-min))
 507                    (insert "From Mailcrypt-" mc-version " "
 508                            (current-time-string) "\n")
 509                    (rmail-convert-file)
 510                    (rmail-mode)
 511                    (use-local-map (copy-keymap (current-local-map)))
 512                    (local-set-key "q" 'mc-rmail-view-quit)
 513                    (set-buffer-modified-p nil)
 514                    (rmail-add-label "decrypted")
 515                    (if (cdr decryption-result)
 516                        (rmail-add-label "verified"))))))
 517       (if (eq major-mode 'rmail-edit-mode)
 518           (rmail-abort-edit)))))
 519
 520 (defun mc-rmail-view-quit ()
 521   (interactive)
 522   (let ((buf (current-buffer)))
 523     (set-buffer-modified-p nil)
 524     (rmail-quit)
 525     (kill-buffer buf)))
 526
 527 ;;}}}
 528 ;;{{{ VM
 529 (defun mc-vm-verify-signature ()
 530   "*Verify the signature in the current VM message"
 531   (interactive)
 532   (if (interactive-p)
 533       (vm-follow-summary-cursor))
 534   (vm-select-folder-buffer)
 535   (vm-check-for-killed-summary)
 536   (vm-error-if-folder-empty)
 537   (save-restriction
 538     (vm-widen-page)
 539     (mc-verify-signature)))
 540
 541 (defun mc-vm-decrypt-message ()
 542   "*Decrypt the contents of the current VM message"
 543   (interactive)
 544   (let ((vm-frame-per-edit nil)
 545         from-line)
 546     (if (interactive-p)
 547         (vm-follow-summary-cursor))
 548 ;   (vm-select-folder-buffer) ;; TNX Eric C. Newton for commenting out.
 549     (vm-check-for-killed-summary)
 550     (vm-error-if-folder-read-only)
 551     (vm-error-if-folder-empty)
 552
 553     ;; store away a valid "From " line for possible later use.
 554     (setq from-line (vm-leading-message-separator))
 555     (vm-edit-message)
 556     (cond ((not (condition-case condition-data
 557                     (car (mc-decrypt-message))
 558                   (error
 559                    (vm-edit-message-abort)
 560                    (error (message "Decryption failed: %s"
 561                                    (car (cdr condition-data)))))))
 562            (vm-edit-message-abort)
 563            (error "Decryption failed."))
 564           ((and (not (eq mc-always-replace 'never))
 565                 (or mc-always-replace
 566                     (y-or-n-p "Replace encrypted message with decrypted? ")))
 567            (let ((this-command 'vm-edit-message-end))
 568              (vm-edit-message-end)))
 569           (t
 570            (let ((tmp (generate-new-buffer "*Mailcrypt Viewing*")))
 571              (copy-to-buffer tmp (point-min) (point-max))
 572              (vm-edit-message-abort)
 573              (switch-to-buffer tmp t)
 574              (goto-char (point-min))
 575              (insert from-line)
 576              (set-buffer-modified-p nil)
 577              (vm-mode t))))))
 578
 579 (defun mc-vm-snarf-keys ()
 580   "*Snarf public key from the contents of the current VM message"
 581   (interactive)
 582   (if (interactive-p)
 583       (vm-follow-summary-cursor))
 584   (vm-select-folder-buffer)
 585   (vm-check-for-killed-summary)
 586   (vm-error-if-folder-empty)
 587   (save-restriction
 588     (vm-widen-page)
 589     (mc-snarf-keys)))
 590
 591 ;;}}}
 592 ;;{{{ GNUS
 593
 594 (defun mc-gnus-verify-signature ()
 595   (interactive)
 596   (gnus-summary-select-article t)
 597   (save-excursion
 598     (set-buffer gnus-original-article-buffer)
 599     (save-restriction (widen) (mc-verify-signature))))
 600
 601 (defun mc-gnus-snarf-keys ()
 602   (interactive)
 603   (gnus-summary-select-article t)
 604   (gnus-eval-in-buffer-window gnus-original-article-buffer
 605     (save-restriction (widen) (mc-snarf-keys))))
 606
 607 (defun mc-gnus-decrypt-message ()
 608   (interactive)
 609   (gnus-summary-select-article t)
 610   ;; Gnus 5 has the string "Gnus" instead of "GNUS" in gnus-version.
 611   (if (not (let ((case-fold-search nil))
 612              (string-match "Gnus" gnus-version)))
 613       (gnus-eval-in-buffer-window
 614        gnus-article-buffer
 615        (save-restriction (widen) (mc-decrypt-message)))
 616     ;; Gnus 5 allows editing of articles.  (Actually, it makes a great
 617     ;; mail reader.)
 618     (gnus-eval-in-buffer-window gnus-article-buffer
 619       (gnus-summary-edit-article t)
 620       (save-restriction
 621         (widen)
 622         (cond ((not (car (mc-decrypt-message)))
 623                (gnus-summary-edit-article-postpone))
 624               ((and (not (gnus-group-read-only-p))
 625                     (not (eq mc-always-replace 'never))
 626                     (or mc-always-replace
 627                         (y-or-n-p
 628                          "Replace encrypted message on disk? ")))
 629                (gnus-summary-edit-article-done))
 630               (t
 631                (gnus-summary-edit-article-postpone)))))))
 632
 633 ;;}}}
 634 ;;{{{ MH
 635 (defvar mc-mh-backup-msg 3
 636   "If 0, never back up MH messages.  If 3, always back up messages.")
 637
 638 (defun mc-mh-decrypt-message ()
 639   "Decrypt the contents of the current MH message in the show buffer."
 640   (interactive "P")
 641   (let* ((msg (mh-get-msg-num t))
 642          (msg-filename (mh-msg-filename msg))
 643          (show-buffer (get-buffer mh-show-buffer))
 644          decrypt-okay decrypt-on-disk)
 645     (setq
 646      decrypt-on-disk
 647      (and (not (eq mc-always-replace 'never))
 648           (or mc-always-replace
 649               (y-or-n-p "Replace encrypted message on disk? "))))
 650     (if decrypt-on-disk
 651         (progn
 652           (save-excursion
 653             (set-buffer (create-file-buffer msg-filename))
 654             (insert-file-contents msg-filename t)
 655             (if (setq decrypt-okay (car (mc-decrypt-message)))
 656                 (save-buffer mc-mh-backup-msg)
 657               (message "Decryption failed.")
 658               (set-buffer-modified-p nil))
 659             (kill-buffer nil))
 660           (if decrypt-okay
 661               (if (and show-buffer
 662                        (equal msg-filename (buffer-file-name show-buffer)))
 663                   (save-excursion
 664                     (save-window-excursion
 665                       (mh-invalidate-show-buffer)))))
 666           (mh-show msg))
 667       (mh-show msg)
 668       (save-excursion
 669         (set-buffer mh-show-buffer)
 670         (let ((read-only buffer-read-only))
 671           (unwind-protect
 672               (progn
 673                 (setq buffer-read-only nil)
 674                 (if (setq decrypt-okay (car (mc-decrypt-message)))
 675                     (progn
 676                       (goto-char (point-min))
 677                       (set-buffer-modified-p nil))
 678                   (message "Decryption failed.")))
 679             (setq buffer-read-only read-only)
 680             )))
 681       (if (not decrypt-okay)
 682           (progn
 683             (mh-invalidate-show-buffer)
 684             (mh-show msg))))))
 685
 686 (defun mc-mh-verify-signature ()
 687   "*Verify the signature in the current MH message."
 688   (interactive)
 689   (mh-show)
 690   (mh-in-show-buffer (mh-show-buffer)
 691     (mc-verify-signature)))
 692
 693
 694 (defun mc-mh-snarf-keys ()
 695   (interactive)
 696   (mh-show)
 697   (mh-in-show-buffer (mh-show-buffer)
 698     (mc-snarf-keys)))
 699
 700 ;;}}}
 701
 702 ;;{{{ mew
 703 ;; decrypt, verify, snarf, encrypt, sign
 704 ;; in summary mode, decrypt/verify/snarf must switch to correct buffer first
 705 ;; in correct buffer, generic functions are probably sufficient.
 706 ;;  mew doesn't have any labels to be added (though I really wish it did)
 707 ;;  could have a "replace encrypted with decrypted" hook for decrypt
 708
 709 ;; autoloads:
 710 ;;  mew-message-mode
 711 ;;   (add-hook 'mew-message-mode-hook 'mc-install-read-mode)
 712 ;;  mew-summary-mode
 713 ;;   (add-hook 'mew-summary-mode-hook 'mc-install-read-mode)
 714 ;;  mew-draft-mode
 715 ;;   (add-hook 'mew-draft-mode-hook 'mc-install-write-mode)
 716
 717 (defun mc-mew-summary-decrypt-message()
 718   "*Decrypt the current message"
 719   (interactive)
 720   (if (not (eq major-mode 'mew-summary-mode))
 721       (error
 722        "mc-mew-summary-decrypt-message called in inappropriate buffer"))
 723   (save-excursion
 724     (mew-summary-display t)
 725     (set-buffer (mew-buffer-message))
 726     (mc-decrypt)
 727 ))
 728
 729 (defun mc-mew-summary-verify-signature()
 730   "*Verify the signature in the current message."
 731   (interactive)
 732   (if (not (eq major-mode 'mew-summary-mode))
 733       (error
 734        "mc-mew-summary-verify-signature called in inappropriate buffer"))
 735   (save-excursion
 736     (mew-summary-display t)
 737     (set-buffer (mew-buffer-message))
 738     (mc-verify)
 739 ))
 740
 741 (defun mc-mew-summary-snarf-keys()
 742   "*Add keys from the current message to the public keyring."
 743   (interactive)
 744   (if (not (eq major-mode 'mew-summary-mode))
 745       (error
 746        "mc-mew-summary-snarf-keys called in inappropriate buffer"))
 747   (save-excursion
 748     (mew-summary-display t)
 749     (set-buffer (mew-buffer-message))
 750     (mc-snarf)
 751 ))
 752
 753 (defun mc-mew-decrypt-message ()
 754   "*Decrypt the contents of this message."
 755   ;; This is a hack to deal with the fact that mew-message buffers are
 756   ;; generally read-only. For now, there is no option to replace the
 757   ;; encrypted message in-place; it simply disappears when you move to a
 758   ;; different message.
 759   (interactive)
 760   (let ((read-only buffer-read-only))
 761     (unwind-protect
 762         (save-excursion
 763           (setq buffer-read-only nil)
 764           (mc-decrypt-message)
 765           )
 766       (setq buffer-read-only read-only)
 767       )
 768 ))
 769
 770 ;;}}}
 771
 772 ;;}}}