cgit.sxemacs.org Git - gnus/blob - lisp/mm-view.el

   1 ;;; mm-view.el --- functions for viewing MIME objects
   2 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;; This file is part of GNU Emacs.
   6
   7 ;; GNU Emacs is free software; you can redistribute it and/or modify
   8 ;; it under the terms of the GNU General Public License as published by
   9 ;; the Free Software Foundation; either version 2, or (at your option)
  10 ;; any later version.
  11
  12 ;; GNU Emacs is distributed in the hope that it will be useful,
  13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;; GNU General Public License for more details.
  16
  17 ;; You should have received a copy of the GNU General Public License
  18 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  20 ;; Boston, MA 02111-1307, USA.
  21
  22 ;;; Commentary:
  23
  24 ;;; Code:
  25
  26 (eval-when-compile (require 'cl))
  27 (require 'mail-parse)
  28 (require 'mailcap)
  29 (require 'mm-bodies)
  30 (require 'mm-decode)
  31
  32 (eval-and-compile
  33   (autoload 'gnus-article-prepare-display "gnus-art")
  34   (autoload 'vcard-parse-string "vcard")
  35   (autoload 'vcard-format-string "vcard")
  36   (autoload 'fill-flowed "flow-fill")
  37   (autoload 'html2text "html2text")
  38   (unless (fboundp 'diff-mode)
  39     (autoload 'diff-mode "diff-mode" "" t nil)))
  40
  41 (defvar mm-text-html-renderer-alist
  42   '((w3  . mm-inline-text-html-render-with-w3)
  43     (w3m . mm-inline-text-html-render-with-w3m)
  44     (links mm-inline-render-with-file
  45            mm-links-remove-leading-blank
  46            "links" "-dump" file)
  47     (lynx  mm-inline-render-with-stdin nil
  48            "lynx" "-dump" "-force_html" "-stdin")
  49     (html2text  mm-inline-render-with-function html2text))
  50   "The attributes of renderer types for text/html.")
  51
  52 (defvar mm-text-html-washer-alist
  53   '((w3  . gnus-article-wash-html-with-w3)
  54     (w3m . gnus-article-wash-html-with-w3m)
  55     (links mm-inline-wash-with-file
  56            mm-links-remove-leading-blank
  57            "links" "-dump" file)
  58     (lynx  mm-inline-wash-with-stdin nil
  59            "lynx" "-dump" "-force_html" "-stdin")
  60     (html2text  html2text))
  61   "The attributes of washer types for text/html.")
  62
  63 ;;; Internal variables.
  64
  65 ;;;
  66 ;;; Functions for displaying various formats inline
  67 ;;;
  68
  69 (defun mm-inline-image-emacs (handle)
  70   (let ((b (point-marker))
  71         buffer-read-only)
  72     (insert "\n")
  73     (put-image (mm-get-image handle) b)
  74     (mm-handle-set-undisplayer
  75      handle
  76      `(lambda () (remove-images ,b (1+ ,b))))))
  77
  78 (defun mm-inline-image-xemacs (handle)
  79   (insert "\n")
  80   (forward-char -1)
  81   (let ((b (point))
  82         (annot (make-annotation (mm-get-image handle) nil 'text))
  83         buffer-read-only)
  84     (mm-handle-set-undisplayer
  85      handle
  86      `(lambda ()
  87         (let (buffer-read-only)
  88           (delete-annotation ,annot)
  89           (delete-region ,(set-marker (make-marker) b)
  90                          ,(set-marker (make-marker) (point))))))
  91     (set-extent-property annot 'mm t)
  92     (set-extent-property annot 'duplicable t)))
  93
  94 (eval-and-compile
  95   (if (featurep 'xemacs)
  96       (defalias 'mm-inline-image 'mm-inline-image-xemacs)
  97     (defalias 'mm-inline-image 'mm-inline-image-emacs)))
  98
  99 (defvar mm-w3-setup nil)
 100 (defun mm-setup-w3 ()
 101   (unless mm-w3-setup
 102     (require 'w3)
 103     (w3-do-setup)
 104     (require 'url)
 105     (require 'w3-vars)
 106     (require 'url-vars)
 107     (setq mm-w3-setup t)))
 108
 109 (defun mm-inline-text-html-render-with-w3 (handle)
 110   (mm-setup-w3)
 111   (let ((text (mm-get-part handle))
 112         (b (point))
 113         (url-standalone-mode t)
 114         (url-gateway-unplugged t)
 115         (w3-honor-stylesheets nil)
 116         (url-current-object
 117          (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
 118         (width (window-width))
 119         (charset (mail-content-type-get
 120                   (mm-handle-type handle) 'charset)))
 121     (save-excursion
 122       (insert text)
 123       (save-restriction
 124         (narrow-to-region b (point))
 125         (goto-char (point-min))
 126         (if (or (and (boundp 'w3-meta-content-type-charset-regexp)
 127                      (re-search-forward
 128                       w3-meta-content-type-charset-regexp nil t))
 129                 (and (boundp 'w3-meta-charset-content-type-regexp)
 130                      (re-search-forward
 131                       w3-meta-charset-content-type-regexp nil t)))
 132             (setq charset
 133                   (or (let ((bsubstr (buffer-substring-no-properties
 134                                       (match-beginning 2)
 135                                       (match-end 2))))
 136                         (if (fboundp 'w3-coding-system-for-mime-charset)
 137                             (w3-coding-system-for-mime-charset bsubstr)
 138                           (mm-charset-to-coding-system bsubstr)))
 139                       charset)))
 140         (delete-region (point-min) (point-max))
 141         (insert (mm-decode-string text charset))
 142         (save-window-excursion
 143           (save-restriction
 144             (let ((w3-strict-width width)
 145                   ;; Don't let w3 set the global version of
 146                   ;; this variable.
 147                   (fill-column fill-column))
 148               (condition-case var
 149                   (w3-region (point-min) (point-max))
 150                 (error
 151                  (delete-region (point-min) (point-max))
 152                  (let ((b (point))
 153                        (charset (mail-content-type-get
 154                                  (mm-handle-type handle) 'charset)))
 155                    (if (or (eq charset 'gnus-decoded)
 156                            (eq mail-parse-charset 'gnus-decoded))
 157                        (save-restriction
 158                          (narrow-to-region (point) (point))
 159                          (mm-insert-part handle)
 160                          (goto-char (point-max)))
 161                      (insert (mm-decode-string (mm-get-part handle)
 162                                                charset))))
 163                  (message
 164                   "Error while rendering html; showing as text/plain"))))))
 165         (mm-handle-set-undisplayer
 166          handle
 167          `(lambda ()
 168             (let (buffer-read-only)
 169               (if (functionp 'remove-specifier)
 170                   (mapcar (lambda (prop)
 171                             (remove-specifier
 172                              (face-property 'default prop)
 173                              (current-buffer)))
 174                           '(background background-pixmap foreground)))
 175               (delete-region ,(point-min-marker)
 176                              ,(point-max-marker)))))))))
 177
 178 (defvar mm-w3m-mode-map nil
 179   "Local keymap for inlined text/html part rendered by emacs-w3m.  It will
 180 be different from `w3m-mode-map' to use in the article buffer.")
 181
 182 (defvar mm-w3m-mode-command-alist
 183   '((backward-char)
 184     (describe-mode)
 185     (forward-char)
 186     (goto-line)
 187     (next-line)
 188     (previous-line)
 189     (w3m-antenna)
 190     (w3m-antenna-add-current-url)
 191     (w3m-bookmark-add-current-url)
 192     (w3m-bookmark-add-this-url)
 193     (w3m-bookmark-view)
 194     (w3m-close-window)
 195     (w3m-copy-buffer)
 196     (w3m-delete-buffer)
 197     (w3m-dtree)
 198     (w3m-edit-current-url)
 199     (w3m-edit-this-url)
 200     (w3m-gohome)
 201     (w3m-goto-url)
 202     (w3m-goto-url-new-session)
 203     (w3m-history)
 204     (w3m-history-restore-position)
 205     (w3m-history-store-position)
 206     (w3m-namazu)
 207     (w3m-next-buffer)
 208     (w3m-previous-buffer)
 209     (w3m-quit)
 210     (w3m-redisplay-with-charset)
 211     (w3m-reload-this-page)
 212     (w3m-scroll-down-or-previous-url)
 213     (w3m-scroll-up-or-next-url)
 214     (w3m-search)
 215     (w3m-select-buffer)
 216     (w3m-switch-buffer)
 217     (w3m-view-header)
 218     (w3m-view-parent-page)
 219     (w3m-view-previous-page)
 220     (w3m-view-source)
 221     (w3m-weather))
 222   "Alist of commands to use for emacs-w3m in the article buffer.  Each
 223 element looks like (FROM-COMMAND . TO-COMMAND); FROM-COMMAND should be
 224 registered in `w3m-mode-map' which will be substituted by TO-COMMAND
 225 in `mm-w3m-mode-map'.  If TO-COMMAND is nil, an article command key
 226 will not be substituted.")
 227
 228 (defvar mm-w3m-mode-dont-bind-keys (list [up] [right] [left] [down])
 229   "List of keys which should not be bound for the emacs-w3m commands.")
 230
 231 (defvar mm-w3m-setup nil
 232   "Whether gnus-article-mode has been setup to use emacs-w3m.")
 233
 234 (defun mm-setup-w3m ()
 235   "Setup gnus-article-mode to use emacs-w3m."
 236   (unless mm-w3m-setup
 237     (require 'w3m)
 238     (unless mm-w3m-mode-map
 239       (setq mm-w3m-mode-map (copy-keymap w3m-mode-map))
 240       (dolist (def mm-w3m-mode-command-alist)
 241         (condition-case nil
 242             (substitute-key-definition (car def) (cdr def) mm-w3m-mode-map)
 243           (error)))
 244       (dolist (key mm-w3m-mode-dont-bind-keys)
 245         (condition-case nil
 246             (define-key mm-w3m-mode-map key nil)
 247           (error))))
 248     (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist)
 249       (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
 250             w3m-cid-retrieve-function-alist))
 251     (setq mm-w3m-setup t)))
 252
 253 (defun mm-w3m-cid-retrieve (url &rest args)
 254   "Insert a content pointed by URL if it has the cid: scheme."
 255   (when (string-match "\\`cid:" url)
 256     (setq url (concat "<" (substring url (match-end 0)) ">"))
 257     (catch 'found-handle
 258       (dolist (handle (with-current-buffer w3m-current-buffer
 259                         gnus-article-mime-handles))
 260         (when (and (listp handle)
 261                    (equal url (mm-handle-id handle)))
 262           (mm-insert-part handle)
 263           (throw 'found-handle (mm-handle-media-type handle)))))))
 264
 265 (defun mm-inline-text-html-render-with-w3m (handle)
 266   "Render a text/html part using emacs-w3m."
 267   (mm-setup-w3m)
 268   (let ((text (mm-get-part handle))
 269         (b (point))
 270         (charset (mail-content-type-get (mm-handle-type handle) 'charset)))
 271     (save-excursion
 272       (insert text)
 273       (save-restriction
 274         (narrow-to-region b (point))
 275         (goto-char (point-min))
 276         (when (re-search-forward w3m-meta-content-type-charset-regexp nil t)
 277           (setq charset (or (w3m-charset-to-coding-system (match-string 2))
 278                             charset)))
 279         (when charset
 280           (delete-region (point-min) (point-max))
 281           (insert (mm-decode-string text charset)))
 282         (let ((w3m-safe-url-regexp (if mm-inline-text-html-with-images
 283                                        nil
 284                                      "\\`cid:"))
 285               (w3m-display-inline-images mm-inline-text-html-with-images)
 286               w3m-force-redisplay)
 287           (w3m-region (point-min) (point-max)))
 288         (when mm-inline-text-html-with-w3m-keymap
 289           (add-text-properties
 290            (point-min) (point-max)
 291            (append '(mm-inline-text-html-with-w3m t)
 292                    (gnus-local-map-property mm-w3m-mode-map)))))
 293       (mm-handle-set-undisplayer
 294        handle
 295        `(lambda ()
 296           (let (buffer-read-only)
 297             (if (functionp 'remove-specifier)
 298                 (mapcar (lambda (prop)
 299                           (remove-specifier
 300                            (face-property 'default prop)
 301                            (current-buffer)))
 302                         '(background background-pixmap foreground)))
 303             (delete-region ,(point-min-marker)
 304                            ,(point-max-marker))))))))
 305
 306 (defun mm-links-remove-leading-blank ()
 307   ;; Delete the annoying three spaces preceding each line of links
 308   ;; output.
 309   (goto-char (point-min))
 310   (while (re-search-forward "^   " nil t)
 311     (delete-region (match-beginning 0) (match-end 0))))
 312
 313 (defun mm-inline-wash-with-file (post-func cmd &rest args)
 314   (let ((file (make-temp-name
 315                (expand-file-name "mm" mm-tmp-directory))))
 316     (let ((coding-system-for-write 'binary))
 317       (write-region (point-min) (point-max) file nil 'silent))
 318     (delete-region (point-min) (point-max))
 319     (unwind-protect
 320         (apply 'call-process cmd nil t nil (mapcar 'eval args))
 321       (delete-file file))
 322     (and post-func (funcall post-func))))
 323
 324 (defun mm-inline-wash-with-stdin (post-func cmd &rest args)
 325   (let ((coding-system-for-write 'binary))
 326     (apply 'call-process-region (point-min) (point-max)
 327            cmd t t nil args))
 328   (and post-func (funcall post-func)))
 329
 330 (defun mm-inline-render-with-file (handle post-func cmd &rest args)
 331   (let ((source (mm-get-part handle)))
 332     (mm-insert-inline
 333      handle
 334      (mm-with-unibyte-buffer
 335        (insert source)
 336        (apply 'mm-inline-wash-with-file post-func cmd args)
 337        (buffer-string)))))
 338
 339 (defun mm-inline-render-with-stdin (handle post-func cmd &rest args)
 340   (let ((source (mm-get-part handle)))
 341     (mm-insert-inline
 342      handle
 343      (mm-with-unibyte-buffer
 344        (insert source)
 345        (apply 'mm-inline-wash-with-stdin post-func cmd args)
 346        (buffer-string)))))
 347
 348 (defun mm-inline-render-with-function (handle func &rest args)
 349   (let ((source (mm-get-part handle)))
 350     (mm-insert-inline
 351      handle
 352      (mm-with-unibyte-buffer
 353        (insert source)
 354        (apply func args)
 355        (buffer-string)))))
 356
 357 (defun mm-inline-text-html (handle)
 358   (let* ((func (or mm-inline-text-html-renderer mm-text-html-renderer))
 359          (entry (assq func mm-text-html-renderer-alist))
 360          buffer-read-only)
 361     (if entry
 362         (setq func (cdr entry)))
 363     (cond
 364      ((gnus-functionp func)
 365       (funcall func handle))
 366      (t
 367       (apply (car func) handle (cdr func))))))
 368
 369 (defun mm-inline-text-vcard (handle)
 370   (let (buffer-read-only)
 371     (mm-insert-inline
 372      handle
 373      (concat "\n-- \n"
 374              (ignore-errors
 375                (if (fboundp 'vcard-pretty-print)
 376                    (vcard-pretty-print (mm-get-part handle))
 377                  (vcard-format-string
 378                   (vcard-parse-string (mm-get-part handle)
 379                                       'vcard-standard-filter))))))))
 380
 381 (defun mm-inline-text (handle)
 382   (let ((b (point))
 383         (type (mm-handle-media-subtype handle))
 384         (charset (mail-content-type-get
 385                   (mm-handle-type handle) 'charset))
 386         buffer-read-only)
 387     (if (or (eq charset 'gnus-decoded)
 388             ;; This is probably not entirely correct, but
 389             ;; makes rfc822 parts with embedded multiparts work.
 390             (eq mail-parse-charset 'gnus-decoded))
 391         (save-restriction
 392           (narrow-to-region (point) (point))
 393           (mm-insert-part handle)
 394           (goto-char (point-max)))
 395       (insert (mm-decode-string (mm-get-part handle) charset)))
 396     (when (and (equal type "plain")
 397                (equal (cdr (assoc 'format (mm-handle-type handle)))
 398                       "flowed"))
 399       (save-restriction
 400         (narrow-to-region b (point))
 401         (goto-char b)
 402         (fill-flowed)
 403         (goto-char (point-max))))
 404     (save-restriction
 405       (narrow-to-region b (point))
 406       (set-text-properties (point-min) (point-max) nil)
 407       (when (or (equal type "enriched")
 408                 (equal type "richtext"))
 409         (enriched-decode (point-min) (point-max)))
 410       (mm-handle-set-undisplayer
 411        handle
 412        `(lambda ()
 413           (let (buffer-read-only)
 414             (delete-region ,(point-min-marker)
 415                            ,(point-max-marker))))))))
 416
 417 (defun mm-insert-inline (handle text)
 418   "Insert TEXT inline from HANDLE."
 419   (let ((b (point)))
 420     (insert text)
 421     (mm-handle-set-undisplayer
 422      handle
 423      `(lambda ()
 424         (let (buffer-read-only)
 425           (delete-region ,(set-marker (make-marker) b)
 426                          ,(set-marker (make-marker) (point))))))))
 427
 428 (defun mm-inline-audio (handle)
 429   (message "Not implemented"))
 430
 431 (defun mm-view-sound-file ()
 432   (message "Not implemented"))
 433
 434 (defun mm-w3-prepare-buffer ()
 435   (require 'w3)
 436   (let ((url-standalone-mode t)
 437         (url-gateway-unplugged t)
 438         (w3-honor-stylesheets nil))
 439     (w3-prepare-buffer)))
 440
 441 (defun mm-view-message ()
 442   (mm-enable-multibyte)
 443   (let (handles)
 444     (let (gnus-article-mime-handles)
 445       ;; Double decode problem may happen.  See mm-inline-message.
 446       (run-hooks 'gnus-article-decode-hook)
 447       (gnus-article-prepare-display)
 448       (setq handles gnus-article-mime-handles))
 449     (when handles
 450       (setq gnus-article-mime-handles
 451             (mm-merge-handles gnus-article-mime-handles handles))))
 452   (fundamental-mode)
 453   (goto-char (point-min)))
 454
 455 (defun mm-inline-message (handle)
 456   (let ((b (point))
 457         (bolp (bolp))
 458         (charset (mail-content-type-get
 459                   (mm-handle-type handle) 'charset))
 460         gnus-displaying-mime handles)
 461     (when (and charset
 462                (stringp charset))
 463       (setq charset (intern (downcase charset)))
 464       (when (eq charset 'us-ascii)
 465         (setq charset nil)))
 466     (save-excursion
 467       (save-restriction
 468         (narrow-to-region b b)
 469         (mm-insert-part handle)
 470         (let (gnus-article-mime-handles
 471               ;; disable prepare hook
 472               gnus-article-prepare-hook
 473               (gnus-newsgroup-charset
 474                (or charset gnus-newsgroup-charset)))
 475           (run-hooks 'gnus-article-decode-hook)
 476           (gnus-article-prepare-display)
 477           (setq handles gnus-article-mime-handles))
 478         (goto-char (point-min))
 479         (unless bolp
 480           (insert "\n"))
 481         (goto-char (point-max))
 482         (unless (bolp)
 483           (insert "\n"))
 484         (insert "----------\n\n")
 485         (when handles
 486           (setq gnus-article-mime-handles
 487                 (mm-merge-handles gnus-article-mime-handles handles)))
 488         (mm-handle-set-undisplayer
 489          handle
 490          `(lambda ()
 491             (let (buffer-read-only)
 492               (if (fboundp 'remove-specifier)
 493                   ;; This is only valid on XEmacs.
 494                   (mapcar (lambda (prop)
 495                             (remove-specifier
 496                              (face-property 'default prop) (current-buffer)))
 497                           '(background background-pixmap foreground)))
 498               (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
 499
 500 (defun mm-display-inline-fontify (handle mode)
 501   (let (text)
 502     ;; XEmacs @#$@ version of font-lock refuses to fully turn itself
 503     ;; on for buffers whose name begins with " ".  That's why we use
 504     ;; save-current-buffer/get-buffer-create rather than
 505     ;; with-temp-buffer.
 506     (save-current-buffer
 507       (set-buffer (generate-new-buffer "*fontification*"))
 508       (unwind-protect
 509           (progn
 510             (buffer-disable-undo)
 511             (mm-insert-part handle)
 512             (funcall mode)
 513             (require 'font-lock)
 514             (let ((font-lock-verbose nil))
 515               ;; I find font-lock a bit too verbose.
 516               (font-lock-fontify-buffer))
 517             ;; By default, XEmacs font-lock uses non-duplicable text
 518             ;; properties.  This code forces all the text properties
 519             ;; to be copied along with the text.
 520             (when (fboundp 'extent-list)
 521               (map-extents (lambda (ext ignored)
 522                              (set-extent-property ext 'duplicable t)
 523                              nil)
 524                            nil nil nil nil nil 'text-prop))
 525             (setq text (buffer-string)))
 526         (kill-buffer (current-buffer))))
 527     (mm-insert-inline handle text)))
 528
 529 ;; Shouldn't these functions check whether the user even wants to use
 530 ;; font-lock?  At least under XEmacs, this fontification is pretty
 531 ;; much unconditional.  Also, it would be nice to change for the size
 532 ;; of the fontified region.
 533
 534 (defun mm-display-patch-inline (handle)
 535   (mm-display-inline-fontify handle 'diff-mode))
 536
 537 (defun mm-display-elisp-inline (handle)
 538   (mm-display-inline-fontify handle 'emacs-lisp-mode))
 539
 540 ;;      id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 541 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 }
 542 (defvar mm-pkcs7-signed-magic
 543   (mm-string-as-unibyte
 544    (apply 'concat
 545           (mapcar 'char-to-string
 546                   (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
 547                         ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
 548                         ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
 549                         ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02)))))
 550
 551 ;;      id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
 552 ;;          us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
 553 (defvar mm-pkcs7-enveloped-magic
 554   (mm-string-as-unibyte
 555    (apply 'concat
 556           (mapcar 'char-to-string
 557                   (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
 558                         ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
 559                         ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
 560                         ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03)))))
 561
 562 (defun mm-view-pkcs7-get-type (handle)
 563   (mm-with-unibyte-buffer
 564     (mm-insert-part handle)
 565     (cond ((looking-at mm-pkcs7-enveloped-magic)
 566            'enveloped)
 567           ((looking-at mm-pkcs7-signed-magic)
 568            'signed)
 569           (t
 570            (error "Could not identify PKCS#7 type")))))
 571
 572 (defun mm-view-pkcs7 (handle)
 573   (case (mm-view-pkcs7-get-type handle)
 574     (enveloped (mm-view-pkcs7-decrypt handle))
 575     (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
 576
 577 (defun mm-view-pkcs7-decrypt (handle)
 578   (insert-buffer (mm-handle-buffer handle))
 579   (goto-char (point-min))
 580   (insert "MIME-Version: 1.0\n")
 581   (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
 582   (smime-decrypt-region
 583    (point-min) (point-max)
 584    (if (= (length smime-keys) 1)
 585        (cadar smime-keys)
 586      (smime-get-key-by-email
 587       (completing-read "Decrypt this part with which key? "
 588                        smime-keys nil nil
 589                        (and (listp (car-safe smime-keys))
 590                             (caar smime-keys)))))))
 591
 592 (provide 'mm-view)
 593
 594 ;;; mm-view.el ends here