git.chise.org Git - elisp/gnus.git-/blob - lisp/mm-decode.el

   1 ;;; mm-decode.el --- Functions for decoding MIME things
   2 ;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
   3
   4 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
   5 ;;      MORIOKA Tomohiko <morioka@jaist.ac.jp>
   6 ;; This file is part of GNU Emacs.
   7
   8 ;; GNU Emacs 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 ;; GNU Emacs 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 the
  20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  21 ;; Boston, MA 02111-1307, USA.
  22
  23 ;;; Commentary:
  24
  25 ;; Jaap-Henk Hoepman (jhh@xs4all.nl):
  26 ;;
  27 ;; Added support for delayed destroy of external MIME viewers. All external
  28 ;; viewers for mime types in mm-keep-viewer-alive-types will remain active
  29 ;; after switching articles or groups, and will only be removed when exiting
  30 ;; gnus.
  31 ;;
  32
  33 ;;; Code:
  34
  35 (require 'mail-parse)
  36 (require 'gnus-mailcap)
  37 (require 'mm-bodies)
  38 (eval-when-compile (require 'cl))
  39
  40 (eval-and-compile
  41   (autoload 'mm-inline-partial "mm-partial")
  42   (autoload 'mm-inline-external-body "mm-extern")
  43   (autoload 'mm-insert-inline "mm-view"))
  44
  45 (add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
  46
  47 (defgroup mime-display ()
  48   "Display of MIME in mail and news articles."
  49   :link '(custom-manual "(emacs-mime)Customization")
  50   :version "21.1"
  51   :group 'mail
  52   :group 'news
  53   :group 'multimedia)
  54
  55 (defgroup mime-security ()
  56   "MIME security in mail and news articles."
  57   :link '(custom-manual "(emacs-mime)Customization")
  58   :group 'mail
  59   :group 'news
  60   :group 'multimedia)
  61
  62 ;;; Convenience macros.
  63
  64 (defmacro mm-handle-buffer (handle)
  65   `(nth 0 ,handle))
  66 (defmacro mm-handle-type (handle)
  67   `(nth 1 ,handle))
  68 (defsubst mm-handle-media-type (handle)
  69   (if (stringp (car handle))
  70       (car handle)
  71     (car (mm-handle-type handle))))
  72 (defsubst mm-handle-media-supertype (handle)
  73   (car (split-string (mm-handle-media-type handle) "/")))
  74 (defsubst mm-handle-media-subtype (handle)
  75   (cadr (split-string (mm-handle-media-type handle) "/")))
  76 (defmacro mm-handle-encoding (handle)
  77   `(nth 2 ,handle))
  78 (defmacro mm-handle-undisplayer (handle)
  79   `(nth 3 ,handle))
  80 (defmacro mm-handle-set-undisplayer (handle function)
  81   `(setcar (nthcdr 3 ,handle) ,function))
  82 (defmacro mm-handle-disposition (handle)
  83   `(nth 4 ,handle))
  84 (defmacro mm-handle-description (handle)
  85   `(nth 5 ,handle))
  86 (defmacro mm-handle-cache (handle)
  87   `(nth 6 ,handle))
  88 (defmacro mm-handle-set-cache (handle contents)
  89   `(setcar (nthcdr 6 ,handle) ,contents))
  90 (defmacro mm-handle-id (handle)
  91   `(nth 7 ,handle))
  92 (defmacro mm-handle-multipart-original-buffer (handle)
  93   `(get-text-property 0 'buffer (car ,handle)))
  94 (defmacro mm-handle-multipart-from (handle)
  95   `(get-text-property 0 'from (car ,handle)))
  96 (defmacro mm-handle-multipart-ctl-parameter (handle parameter)
  97   `(get-text-property 0 ,parameter (car ,handle)))
  98
  99 (defmacro mm-make-handle (&optional buffer type encoding undisplayer
 100                                     disposition description cache
 101                                     id)
 102   `(list ,buffer ,type ,encoding ,undisplayer
 103          ,disposition ,description ,cache ,id))
 104
 105 (defcustom mm-inline-media-tests
 106   '(("image/jpeg"
 107      mm-inline-image
 108      (lambda (handle)
 109        (mm-valid-and-fit-image-p 'jpeg handle)))
 110     ("image/png"
 111      mm-inline-image
 112      (lambda (handle)
 113        (mm-valid-and-fit-image-p 'png handle)))
 114     ("image/gif"
 115      mm-inline-image
 116      (lambda (handle)
 117        (mm-valid-and-fit-image-p 'gif handle)))
 118     ("image/tiff"
 119      mm-inline-image
 120      (lambda (handle)
 121        (mm-valid-and-fit-image-p 'tiff handle)) )
 122     ("image/xbm"
 123      mm-inline-image
 124      (lambda (handle)
 125        (mm-valid-and-fit-image-p 'xbm handle)))
 126     ("image/x-xbitmap"
 127      mm-inline-image
 128      (lambda (handle)
 129        (mm-valid-and-fit-image-p 'xbm handle)))
 130     ("image/xpm"
 131      mm-inline-image
 132      (lambda (handle)
 133        (mm-valid-and-fit-image-p 'xpm handle)))
 134     ("image/x-pixmap"
 135      mm-inline-image
 136      (lambda (handle)
 137        (mm-valid-and-fit-image-p 'xpm handle)))
 138     ("image/bmp"
 139      mm-inline-image
 140      (lambda (handle)
 141        (mm-valid-and-fit-image-p 'bmp handle)))
 142     ("image/x-portable-bitmap"
 143      mm-inline-image
 144      (lambda (handle)
 145        (mm-valid-and-fit-image-p 'pbm handle)))
 146     ("text/plain" mm-inline-text identity)
 147     ("text/enriched" mm-inline-text identity)
 148     ("text/richtext" mm-inline-text identity)
 149     ("text/x-patch" mm-display-patch-inline
 150      (lambda (handle)
 151        (locate-library "diff-mode")))
 152     ("application/emacs-lisp" mm-display-elisp-inline identity)
 153     ("text/html"
 154      mm-inline-text
 155      (lambda (handle)
 156        (locate-library "w3")))
 157     ("text/x-vcard"
 158      mm-inline-text
 159      (lambda (handle)
 160        (or (featurep 'vcard)
 161            (locate-library "vcard"))))
 162     ("message/delivery-status" mm-inline-text identity)
 163     ("message/rfc822" mm-inline-message identity)
 164     ("message/partial" mm-inline-partial identity)
 165     ("message/external-body" mm-inline-external-body identity)
 166     ("text/.*" mm-inline-text identity)
 167     ("audio/wav" mm-inline-audio
 168      (lambda (handle)
 169        (and (or (featurep 'nas-sound) (featurep 'native-sound))
 170             (device-sound-enabled-p))))
 171     ("audio/au"
 172      mm-inline-audio
 173      (lambda (handle)
 174        (and (or (featurep 'nas-sound) (featurep 'native-sound))
 175             (device-sound-enabled-p))))
 176     ("application/pgp-signature" ignore identity)
 177     ("application/x-pkcs7-signature" ignore identity)
 178     ("application/pkcs7-signature" ignore identity)
 179     ("multipart/alternative" ignore identity)
 180     ("multipart/mixed" ignore identity)
 181     ("multipart/related" ignore identity))
 182   "Alist of media types/tests saying whether types can be displayed inline."
 183   :type '(repeat (list (string :tag "MIME type")
 184                        (function :tag "Display function")
 185                        (function :tag "Display test")))
 186   :group 'mime-display)
 187
 188 (defcustom mm-inlined-types
 189   '("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
 190     "message/partial" "message/external-body" "application/emacs-lisp"
 191     "application/pgp-signature" "application/x-pkcs7-signature"
 192     "application/pkcs7-signature")
 193   "List of media types that are to be displayed inline."
 194   :type '(repeat string)
 195   :group 'mime-display)
 196
 197 (defcustom mm-keep-viewer-alive-types
 198   '("application/postscript" "application/msword" "application/vnd.ms-excel"
 199     "application/pdf" "application/x-dvi")
 200   "List of media types for which the external viewer will not be killed
 201 when selecting a different article."
 202   :type '(repeat string)
 203   :group 'mime-display)
 204
 205 (defcustom mm-automatic-display
 206   '("text/plain" "text/enriched" "text/richtext" "text/html"
 207     "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
 208     "message/rfc822" "text/x-patch" "application/pgp-signature"
 209     "application/emacs-lisp" "application/x-pkcs7-signature"
 210     "application/pkcs7-signature")
 211   "A list of MIME types to be displayed automatically."
 212   :type '(repeat string)
 213   :group 'mime-display)
 214
 215 (defcustom mm-attachment-override-types '("text/x-vcard")
 216   "Types to have \"attachment\" ignored if they can be displayed inline."
 217   :type '(repeat string)
 218   :group 'mime-display)
 219
 220 (defcustom mm-inline-override-types nil
 221   "Types to be treated as attachments even if they can be displayed inline."
 222   :type '(repeat string)
 223   :group 'mime-display)
 224
 225 (defcustom mm-automatic-external-display nil
 226   "List of MIME type regexps that will be displayed externally automatically."
 227   :type '(repeat string)
 228   :group 'mime-display)
 229
 230 (defcustom mm-discouraged-alternatives nil
 231   "List of MIME types that are discouraged when viewing multipart/alternative.
 232 Viewing agents are supposed to view the last possible part of a message,
 233 as that is supposed to be the richest.  However, users may prefer other
 234 types instead, and this list says what types are most unwanted.  If,
 235 for instance, text/html parts are very unwanted, and text/richtext are
 236 somewhat unwanted, then the value of this variable should be set
 237 to:
 238
 239  (\"text/html\" \"text/richtext\")"
 240   :type '(repeat string)
 241   :group 'mime-display)
 242
 243 (defcustom mm-tmp-directory
 244   (cond ((fboundp 'temp-directory) (temp-directory))
 245         ((boundp 'temporary-file-directory) temporary-file-directory)
 246         ("/tmp/"))
 247   "Where mm will store its temporary files."
 248   :type 'directory
 249   :group 'mime-display)
 250
 251 (defcustom mm-inline-large-images nil
 252   "If non-nil, then all images fit in the buffer."
 253   :type 'boolean
 254   :group 'mime-display)
 255
 256 (defvar mm-file-name-rewrite-functions nil
 257   "*List of functions used for rewriting file names of MIME parts.
 258 Each function takes a file name as input and returns a file name.
 259
 260 Ready-made functions include
 261 `mm-file-name-delete-whitespace',
 262 `mm-file-name-trim-whitespace',
 263 `mm-file-name-collapse-whitespace',
 264 `mm-file-name-replace-whitespace',
 265 `capitalize', `downcase', `upcase', and
 266 `upcase-initials'.")
 267
 268 (defvar mm-file-name-replace-whitespace nil
 269   "String used for replacing whitespace characters; default is `\"_\"'.")
 270
 271 (defcustom mm-default-directory nil
 272   "The default directory where mm will save files.
 273 If not set, `default-directory' will be used."
 274   :type 'directory
 275   :group 'mime-display)
 276
 277 ;;; Internal variables.
 278
 279 (defvar mm-dissection-list nil)
 280 (defvar mm-last-shell-command "")
 281 (defvar mm-content-id-alist nil)
 282 (defvar mm-postponed-undisplay-list nil)
 283
 284 ;; According to RFC2046, in particular, in a digest, the default
 285 ;; Content-Type value for a body part is changed from "text/plain" to
 286 ;; "message/rfc822".
 287 (defvar mm-dissect-default-type "text/plain")
 288
 289 (autoload 'mml2015-verify "mml2015")
 290 (autoload 'mml2015-verify-test "mml2015")
 291 (autoload 'mml-smime-verify "mml-smime")
 292 (autoload 'mml-smime-verify-test "mml-smime")
 293
 294 (defvar mm-verify-function-alist
 295   '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test)
 296     ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP"
 297      mm-uu-pgp-signed-test)
 298     ("application/pkcs7-signature" mml-smime-verify "S/MIME"
 299      mml-smime-verify-test)
 300     ("application/x-pkcs7-signature" mml-smime-verify "S/MIME"
 301      mml-smime-verify-test)))
 302
 303 (defcustom mm-verify-option 'never
 304   "Option of verifying signed parts.
 305 `never', not verify; `always', always verify;
 306 `known', only verify known protocols. Otherwise, ask user."
 307   :type '(choice (item always)
 308                  (item never)
 309                  (item :tag "only known protocols" known)
 310                  (item :tag "ask" nil))
 311   :group 'mime-security)
 312
 313 (autoload 'mml2015-decrypt "mml2015")
 314 (autoload 'mml2015-decrypt-test "mml2015")
 315
 316 (defvar mm-decrypt-function-alist
 317   '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)
 318     ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP"
 319      mm-uu-pgp-encrypted-test)))
 320
 321 (defcustom mm-decrypt-option nil
 322   "Option of decrypting encrypted parts.
 323 `never', not decrypt; `always', always decrypt;
 324 `known', only decrypt known protocols. Otherwise, ask user."
 325   :type '(choice (item always)
 326                  (item never)
 327                  (item :tag "only known protocols" known)
 328                  (item :tag "ask" nil))
 329   :group 'mime-security)
 330
 331 (defvar mm-viewer-completion-map
 332   (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
 333     (set-keymap-parent map minibuffer-local-completion-map)
 334     map)
 335   "Keymap for input viewer with completion.")
 336
 337 ;; Should we bind other key to minibuffer-complete-word?
 338 (define-key mm-viewer-completion-map " " 'self-insert-command)
 339
 340 (defvar mm-viewer-completion-map
 341   (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
 342     (set-keymap-parent map minibuffer-local-completion-map)
 343     map)
 344   "Keymap for input viewer with completion.")
 345
 346 ;; Should we bind other key to minibuffer-complete-word?
 347 (define-key mm-viewer-completion-map " " 'self-insert-command)
 348
 349 ;;; The functions.
 350
 351 (defun mm-alist-to-plist (alist)
 352   "Convert association list ALIST into the equivalent property-list form.
 353 The plist is returned.  This converts from
 354
 355 \((a . 1) (b . 2) (c . 3))
 356
 357 into
 358
 359 \(a 1 b 2 c 3)
 360
 361 The original alist is not modified.  See also `destructive-alist-to-plist'."
 362   (let (plist)
 363     (while alist
 364       (let ((el (car alist)))
 365         (setq plist (cons (cdr el) (cons (car el) plist))))
 366       (setq alist (cdr alist)))
 367     (nreverse plist)))
 368
 369 (defun mm-keep-viewer-alive-p (handle)
 370   "Say whether external viewer for HANDLE should stay alive."
 371   (let ((types mm-keep-viewer-alive-types)
 372         (type (mm-handle-media-type handle))
 373         ty)
 374     (catch 'found
 375       (while (setq ty (pop types))
 376         (when (string-match ty type)
 377           (throw 'found t))))))
 378
 379 (defun mm-handle-set-external-undisplayer (handle function)
 380  "Set the undisplayer for this handle; postpone undisplaying of viewers
 381 for types in mm-keep-viewer-alive-types."
 382  (if (mm-keep-viewer-alive-p handle)
 383      (let ((new-handle (copy-sequence handle)))
 384        (mm-handle-set-undisplayer new-handle function)
 385        (mm-handle-set-undisplayer handle nil)
 386        (push new-handle mm-postponed-undisplay-list))
 387    (mm-handle-set-undisplayer handle function)))
 388
 389 (defun mm-destroy-postponed-undisplay-list ()
 390   (message "Destroying external MIME viewers")
 391   (mm-destroy-parts mm-postponed-undisplay-list))
 392
 393 (defun mm-dissect-buffer (&optional no-strict-mime)
 394   "Dissect the current buffer and return a list of MIME handles."
 395   (save-excursion
 396     (let (ct ctl type subtype cte cd description id result from)
 397       (save-restriction
 398         (mail-narrow-to-head)
 399         (when (or no-strict-mime
 400                   (mail-fetch-field "mime-version"))
 401           (setq ct (mail-fetch-field "content-type")
 402                 ctl (ignore-errors (mail-header-parse-content-type ct))
 403                 cte (mail-fetch-field "content-transfer-encoding")
 404                 cd (mail-fetch-field "content-disposition")
 405                 description (mail-fetch-field "content-description")
 406                 from (mail-fetch-field "from")
 407                 id (mail-fetch-field "content-id"))
 408           ;; FIXME: In some circumstances, this code is running within
 409           ;; an unibyte macro.  mail-extract-address-components
 410           ;; creates unibyte buffers. This `if', though not a perfect
 411           ;; solution, avoids most of them.
 412           (if from
 413               (setq from (cadr (mail-extract-address-components from))))))
 414       (when cte
 415         (setq cte (mail-header-strip cte)))
 416       (if (or (not ctl)
 417               (not (string-match "/" (car ctl))))
 418           (mm-dissect-singlepart
 419            (list mm-dissect-default-type)
 420            (and cte (intern (downcase (mail-header-remove-whitespace
 421                                        (mail-header-remove-comments
 422                                         cte)))))
 423            no-strict-mime
 424            (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
 425            description)
 426         (setq type (split-string (car ctl) "/"))
 427         (setq subtype (cadr type)
 428               type (pop type))
 429         (setq
 430          result
 431          (cond
 432           ((equal type "multipart")
 433            (let ((mm-dissect-default-type (if (equal subtype "digest")
 434                                               "message/rfc822"
 435                                             "text/plain")))
 436              (add-text-properties 0 (length (car ctl))
 437                                   (mm-alist-to-plist (cdr ctl)) (car ctl))
 438
 439              ;; what really needs to be done here is a way to link a
 440              ;; MIME handle back to it's parent MIME handle (in a multilevel
 441              ;; MIME article).  That would probably require changing
 442              ;; the mm-handle API so we simply store the multipart buffert
 443              ;; name as a text property of the "multipart/whatever" string.
 444              (add-text-properties 0 (length (car ctl))
 445                                   (list 'buffer (mm-copy-to-buffer))
 446                                   (car ctl))
 447              (add-text-properties 0 (length (car ctl))
 448                                   (list 'from from)
 449                                   (car ctl))
 450              (cons (car ctl) (mm-dissect-multipart ctl))))
 451           (t
 452            (mm-dissect-singlepart
 453             ctl
 454             (and cte (intern (downcase (mail-header-remove-whitespace
 455                                         (mail-header-remove-comments
 456                                          cte)))))
 457             no-strict-mime
 458             (and cd (ignore-errors (mail-header-parse-content-disposition cd)))
 459             description id))))
 460         (when id
 461           (when (string-match " *<\\(.*\\)> *" id)
 462             (setq id (match-string 1 id)))
 463           (push (cons id result) mm-content-id-alist))
 464         result))))
 465
 466 (defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
 467   (when (or force
 468             (if (equal "text/plain" (car ctl))
 469                 (assoc 'format ctl)
 470               t))
 471     (let ((res (mm-make-handle
 472                 (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
 473       (push (car res) mm-dissection-list)
 474       res)))
 475
 476 (defun mm-remove-all-parts ()
 477   "Remove all MIME handles."
 478   (interactive)
 479   (mapcar 'mm-remove-part mm-dissection-list)
 480   (setq mm-dissection-list nil))
 481
 482 (defun mm-dissect-multipart (ctl)
 483   (goto-char (point-min))
 484   (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
 485          (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
 486          start parts
 487          (end (save-excursion
 488                 (goto-char (point-max))
 489                 (if (re-search-backward close-delimiter nil t)
 490                     (match-beginning 0)
 491                   (point-max)))))
 492     (setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
 493     (while (and (< (point) end) (re-search-forward boundary end t))
 494       (goto-char (match-beginning 0))
 495       (when start
 496         (save-excursion
 497           (save-restriction
 498             (narrow-to-region start (point))
 499             (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
 500       (forward-line 2)
 501       (setq start (point)))
 502     (when (and start (< start end))
 503       (save-excursion
 504         (save-restriction
 505           (narrow-to-region start end)
 506           (setq parts (nconc (list (mm-dissect-buffer t)) parts)))))
 507     (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
 508
 509 (defun mm-copy-to-buffer ()
 510   "Copy the contents of the current buffer to a fresh buffer."
 511   (save-excursion
 512     (let ((flag enable-multibyte-characters)
 513           (new-buffer (generate-new-buffer " *mm*")))
 514       (goto-char (point-min))
 515       (search-forward-regexp "^\n" nil t)
 516       (save-restriction
 517         (narrow-to-region (point) (point-max))
 518         (when flag
 519           (set-buffer-multibyte nil))
 520         (copy-to-buffer new-buffer (point-min) (point-max))
 521         (when flag
 522           (set-buffer-multibyte t)))
 523       new-buffer)))
 524
 525 (defun mm-display-parts (handle &optional no-default)
 526   (if (stringp (car handle))
 527       (mapcar 'mm-display-parts (cdr handle))
 528     (if (bufferp (car handle))
 529         (save-restriction
 530           (narrow-to-region (point) (point))
 531           (mm-display-part handle)
 532           (goto-char (point-max)))
 533       (mapcar 'mm-display-parts handle))))
 534
 535 (defun mm-display-part (handle &optional no-default)
 536   "Display the MIME part represented by HANDLE.
 537 Returns nil if the part is removed; inline if displayed inline;
 538 external if displayed external."
 539   (save-excursion
 540     (mailcap-parse-mailcaps)
 541     (if (mm-handle-displayed-p handle)
 542         (mm-remove-part handle)
 543       (let* ((type (mm-handle-media-type handle))
 544              (method (mailcap-mime-info type)))
 545         (if (mm-inlined-p handle)
 546             (progn
 547               (forward-line 1)
 548               (mm-display-inline handle)
 549               'inline)
 550           (when (or method
 551                     (not no-default))
 552             (if (and (not method)
 553                      (equal "text" (car (split-string type))))
 554                 (progn
 555                   (forward-line 1)
 556                   (mm-insert-inline handle (mm-get-part handle))
 557                   'inline)
 558               (mm-display-external
 559                handle (or method 'mailcap-save-binary-file)))))))))
 560
 561 (defun mm-display-external (handle method)
 562   "Display HANDLE using METHOD."
 563   (let ((outbuf (current-buffer)))
 564     (mm-with-unibyte-buffer
 565       (if (functionp method)
 566           (let ((cur (current-buffer)))
 567             (if (eq method 'mailcap-save-binary-file)
 568                 (progn
 569                   (set-buffer (generate-new-buffer " *mm*"))
 570                   (setq method nil))
 571               (mm-insert-part handle)
 572               (let ((win (get-buffer-window cur t)))
 573                 (when win
 574                   (select-window win)))
 575               (switch-to-buffer (generate-new-buffer " *mm*")))
 576             (buffer-disable-undo)
 577             (mm-set-buffer-file-coding-system mm-binary-coding-system)
 578             (insert-buffer-substring cur)
 579             (goto-char (point-min))
 580             (message "Viewing with %s" method)
 581             (let ((mm (current-buffer))
 582                   (non-viewer (assq 'non-viewer
 583                                     (mailcap-mime-info
 584                                      (mm-handle-media-type handle) t))))
 585               (unwind-protect
 586                   (if method
 587                       (funcall method)
 588                     (mm-save-part handle))
 589                 (when (and (not non-viewer)
 590                            method)
 591                   (mm-handle-set-undisplayer handle mm)))))
 592         ;; The function is a string to be executed.
 593         (mm-insert-part handle)
 594         (let* ((dir (make-temp-name (expand-file-name "emm." mm-tmp-directory)))
 595                (filename (mail-content-type-get
 596                           (mm-handle-disposition handle) 'filename))
 597                (mime-info (mailcap-mime-info
 598                            (mm-handle-media-type handle) t))
 599                (needsterm (or (assoc "needsterm" mime-info)
 600                               (assoc "needsterminal" mime-info)))
 601                (copiousoutput (assoc "copiousoutput" mime-info))
 602                file buffer)
 603           ;; We create a private sub-directory where we store our files.
 604           (make-directory dir)
 605           (set-file-modes dir 448)
 606           (if filename
 607               (setq file (expand-file-name (file-name-nondirectory filename)
 608                                            dir))
 609             (setq file (make-temp-name (expand-file-name "mm." dir))))
 610           (let ((coding-system-for-write mm-binary-coding-system))
 611             (write-region (point-min) (point-max) file nil 'nomesg))
 612           (message "Viewing with %s" method)
 613           (cond (needsterm
 614                  (unwind-protect
 615                      (start-process "*display*" nil
 616                                     "xterm"
 617                                     "-e" shell-file-name
 618                                     shell-command-switch
 619                                     (mm-mailcap-command
 620                                      method file (mm-handle-type handle)))
 621                    (mm-handle-set-external-undisplayer handle (cons file buffer)))
 622                  (message "Displaying %s..." (format method file))
 623                  'external)
 624                 (copiousoutput
 625                  (with-current-buffer outbuf
 626                    (forward-line 1)
 627                    (mm-insert-inline
 628                     handle
 629                     (unwind-protect
 630                         (progn
 631                           (call-process shell-file-name nil
 632                                         (setq buffer
 633                                               (generate-new-buffer " *mm*"))
 634                                         nil
 635                                         shell-command-switch
 636                                         (mm-mailcap-command
 637                                          method file (mm-handle-type handle)))
 638                           (if (buffer-live-p buffer)
 639                               (save-excursion
 640                                 (set-buffer buffer)
 641                                 (buffer-string))))
 642                       (progn
 643                         (ignore-errors (delete-file file))
 644                         (ignore-errors (delete-directory
 645                                         (file-name-directory file)))
 646                         (ignore-errors (kill-buffer buffer))))))
 647                  'inline)
 648                 (t
 649                  (unwind-protect
 650                      (start-process "*display*"
 651                                     (setq buffer
 652                                           (generate-new-buffer " *mm*"))
 653                                     shell-file-name
 654                                     shell-command-switch
 655                                     (mm-mailcap-command
 656                                      method file (mm-handle-type handle)))
 657                    (mm-handle-set-external-undisplayer handle (cons file buffer)))
 658                  (message "Displaying %s..." (format method file))
 659                  'external)))))))
 660
 661 (defun mm-mailcap-command (method file type-list)
 662   (let ((ctl (cdr type-list))
 663         (beg 0)
 664         (uses-stdin t)
 665         out sub total)
 666     (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg)
 667       (push (substring method beg (match-beginning 0)) out)
 668       (setq beg (match-end 0)
 669             total (match-string 0 method)
 670             sub (match-string 1 method))
 671       (cond
 672        ((string= total "%%")
 673         (push "%" out))
 674        ((string= total "%s")
 675         (setq uses-stdin nil)
 676         (push (mm-quote-arg file) out))
 677        ((string= total "%t")
 678         (push (mm-quote-arg (car type-list)) out))
 679        (t
 680         (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
 681     (push (substring method beg (length method)) out)
 682     (if uses-stdin
 683         (progn
 684           (push "<" out)
 685           (push (mm-quote-arg file) out)))
 686     (mapconcat 'identity (nreverse out) "")))
 687
 688 (defun mm-remove-parts (handles)
 689   "Remove the displayed MIME parts represented by HANDLES."
 690   (if (and (listp handles)
 691            (bufferp (car handles)))
 692       (mm-remove-part handles)
 693     (let (handle)
 694       (while (setq handle (pop handles))
 695         (cond
 696          ((stringp handle)
 697           (when (buffer-live-p (get-text-property 0 'buffer handle))
 698             (kill-buffer (get-text-property 0 'buffer handle))))
 699          ((and (listp handle)
 700                (stringp (car handle)))
 701           (mm-remove-parts (cdr handle)))
 702          (t
 703           (mm-remove-part handle)))))))
 704
 705 (defun mm-destroy-parts (handles)
 706   "Remove the displayed MIME parts represented by HANDLES."
 707   (if (and (listp handles)
 708            (bufferp (car handles)))
 709       (mm-destroy-part handles)
 710     (let (handle)
 711       (while (setq handle (pop handles))
 712         (cond
 713          ((stringp handle)
 714           (when (buffer-live-p (get-text-property 0 'buffer handle))
 715             (kill-buffer (get-text-property 0 'buffer handle))))
 716          ((and (listp handle)
 717                (stringp (car handle)))
 718           (mm-destroy-parts handle))
 719          (t
 720           (mm-destroy-part handle)))))))
 721
 722 (defun mm-remove-part (handle)
 723   "Remove the displayed MIME part represented by HANDLE."
 724   (when (listp handle)
 725     (let ((object (mm-handle-undisplayer handle)))
 726       (ignore-errors
 727         (cond
 728          ;; Internally displayed part.
 729          ((mm-annotationp object)
 730           (delete-annotation object))
 731          ((or (functionp object)
 732               (and (listp object)
 733                    (eq (car object) 'lambda)))
 734           (funcall object))
 735          ;; Externally displayed part.
 736          ((consp object)
 737           (ignore-errors (delete-file (car object)))
 738           (ignore-errors (delete-directory (file-name-directory (car object))))
 739           (ignore-errors (kill-buffer (cdr object))))
 740          ((bufferp object)
 741           (when (buffer-live-p object)
 742             (kill-buffer object)))))
 743       (mm-handle-set-undisplayer handle nil))))
 744
 745 (defun mm-display-inline (handle)
 746   (let* ((type (mm-handle-media-type handle))
 747          (function (cadr (mm-assoc-string-match mm-inline-media-tests type))))
 748     (funcall function handle)
 749     (goto-char (point-min))))
 750
 751 (defun mm-assoc-string-match (alist type)
 752   (dolist (elem alist)
 753     (when (string-match (car elem) type)
 754       (return elem))))
 755
 756 (defun mm-inlinable-p (handle)
 757   "Say whether HANDLE can be displayed inline."
 758   (let ((alist mm-inline-media-tests)
 759         (type (mm-handle-media-type handle))
 760         test)
 761     (while alist
 762       (when (string-match (caar alist) type)
 763         (setq test (caddar alist)
 764               alist nil)
 765         (setq test (funcall test handle)))
 766       (pop alist))
 767     test))
 768
 769 (defun mm-automatic-display-p (handle)
 770   "Say whether the user wants HANDLE to be displayed automatically."
 771   (let ((methods mm-automatic-display)
 772         (type (mm-handle-media-type handle))
 773         method result)
 774     (while (setq method (pop methods))
 775       (when (and (not (mm-inline-override-p handle))
 776                  (string-match method type)
 777                  (mm-inlinable-p handle))
 778         (setq result t
 779               methods nil)))
 780     result))
 781
 782 (defun mm-inlined-p (handle)
 783   "Say whether the user wants HANDLE to be displayed automatically."
 784   (let ((methods mm-inlined-types)
 785         (type (mm-handle-media-type handle))
 786         method result)
 787     (while (setq method (pop methods))
 788       (when (and (not (mm-inline-override-p handle))
 789                  (string-match method type)
 790                  (mm-inlinable-p handle))
 791         (setq result t
 792               methods nil)))
 793     result))
 794
 795 (defun mm-attachment-override-p (handle)
 796   "Say whether HANDLE should have attachment behavior overridden."
 797   (let ((types mm-attachment-override-types)
 798         (type (mm-handle-media-type handle))
 799         ty)
 800     (catch 'found
 801       (while (setq ty (pop types))
 802         (when (and (string-match ty type)
 803                    (mm-inlinable-p handle))
 804           (throw 'found t))))))
 805
 806 (defun mm-inline-override-p (handle)
 807   "Say whether HANDLE should have inline behavior overridden."
 808   (let ((types mm-inline-override-types)
 809         (type (mm-handle-media-type handle))
 810         ty)
 811     (catch 'found
 812       (while (setq ty (pop types))
 813         (when (string-match ty type)
 814           (throw 'found t))))))
 815
 816 (defun mm-automatic-external-display-p (type)
 817   "Return the user-defined method for TYPE."
 818   (let ((methods mm-automatic-external-display)
 819         method result)
 820     (while (setq method (pop methods))
 821       (when (string-match method type)
 822         (setq result t
 823               methods nil)))
 824     result))
 825
 826 (defun mm-destroy-part (handle)
 827   "Destroy the data structures connected to HANDLE."
 828   (when (listp handle)
 829     (mm-remove-part handle)
 830     (when (buffer-live-p (mm-handle-buffer handle))
 831       (kill-buffer (mm-handle-buffer handle)))))
 832
 833 (defun mm-handle-displayed-p (handle)
 834   "Say whether HANDLE is displayed or not."
 835   (mm-handle-undisplayer handle))
 836
 837 ;;;
 838 ;;; Functions for outputting parts
 839 ;;;
 840
 841 (defun mm-get-part (handle)
 842   "Return the contents of HANDLE as a string."
 843   (mm-with-unibyte-buffer
 844     (insert (with-current-buffer (mm-handle-buffer handle)
 845               (mm-with-unibyte-current-buffer-mule4
 846                 (buffer-string))))
 847     (mm-decode-content-transfer-encoding
 848      (mm-handle-encoding handle)
 849      (mm-handle-media-type handle))
 850     (buffer-string)))
 851
 852 (defun mm-insert-part (handle)
 853   "Insert the contents of HANDLE in the current buffer."
 854   (let ((cur (current-buffer)))
 855     (save-excursion
 856       (if (member (mm-handle-media-supertype handle) '("text" "message"))
 857           (with-temp-buffer
 858             (insert-buffer-substring (mm-handle-buffer handle))
 859             (mm-decode-content-transfer-encoding
 860              (mm-handle-encoding handle)
 861              (mm-handle-media-type handle))
 862             (let ((temp (current-buffer)))
 863               (set-buffer cur)
 864               (insert-buffer-substring temp)))
 865         (mm-with-unibyte-buffer
 866           (insert-buffer-substring (mm-handle-buffer handle))
 867           (mm-decode-content-transfer-encoding
 868            (mm-handle-encoding handle)
 869            (mm-handle-media-type handle))
 870           (let ((temp (current-buffer)))
 871             (set-buffer cur)
 872             (insert-buffer-substring temp)))))))
 873
 874 (defun mm-file-name-delete-whitespace (file-name)
 875   "Remove all whitespace characters from FILE-NAME."
 876   (while (string-match "\\s-+" file-name)
 877     (setq file-name (replace-match "" t t file-name)))
 878   file-name)
 879
 880 (defun mm-file-name-trim-whitespace (file-name)
 881   "Remove leading and trailing whitespace characters from FILE-NAME."
 882   (when (string-match "\\`\\s-+" file-name)
 883     (setq file-name (substring file-name (match-end 0))))
 884   (when (string-match "\\s-+\\'" file-name)
 885     (setq file-name (substring file-name 0 (match-beginning 0))))
 886   file-name)
 887
 888 (defun mm-file-name-collapse-whitespace (file-name)
 889   "Collapse multiple whitespace characters in FILE-NAME."
 890   (while (string-match "\\s-\\s-+" file-name)
 891     (setq file-name (replace-match " " t t file-name)))
 892   file-name)
 893
 894 (defun mm-file-name-replace-whitespace (file-name)
 895   "Replace whitespace characters in FILE-NAME with underscores.
 896 Set `mm-file-name-replace-whitespace' to any other string if you do not
 897 like underscores."
 898   (let ((s (or mm-file-name-replace-whitespace "_")))
 899     (while (string-match "\\s-" file-name)
 900       (setq file-name (replace-match s t t file-name))))
 901   file-name)
 902
 903 (defun mm-save-part (handle)
 904   "Write HANDLE to a file."
 905   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
 906          (filename (mail-content-type-get
 907                     (mm-handle-disposition handle) 'filename))
 908          file)
 909     (when filename
 910       (setq filename (gnus-map-function mm-file-name-rewrite-functions
 911                                         (file-name-nondirectory filename))))
 912     (setq file
 913           (read-file-name "Save MIME part to: "
 914                           (expand-file-name
 915                            (or filename name "")
 916                            (or mm-default-directory default-directory))))
 917     (setq mm-default-directory (file-name-directory file))
 918     (and (or (not (file-exists-p file))
 919              (yes-or-no-p (format "File %s already exists; overwrite? "
 920                                   file)))
 921          (progn
 922            (mm-save-part-to-file handle file)
 923            file))))
 924
 925 (defun mm-save-part-to-file (handle file)
 926   (mm-with-unibyte-buffer
 927     (mm-insert-part handle)
 928     (let ((coding-system-for-write 'binary)
 929           ;; Don't re-compress .gz & al.  Arguably we should make
 930           ;; `file-name-handler-alist' nil, but that would chop
 931           ;; ange-ftp, which is reasonable to use here.
 932           (inhibit-file-name-operation 'write-region)
 933           (inhibit-file-name-handlers
 934            (cons 'jka-compr-handler inhibit-file-name-handlers)))
 935       (write-region (point-min) (point-max) file))))
 936
 937 (defun mm-pipe-part (handle)
 938   "Pipe HANDLE to a process."
 939   (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
 940          (command
 941           (read-string "Shell command on MIME part: " mm-last-shell-command)))
 942     (mm-with-unibyte-buffer
 943       (mm-insert-part handle)
 944       (let ((coding-system-for-write 'binary))
 945         (shell-command-on-region (point-min) (point-max) command nil)))))
 946
 947 (defun mm-interactively-view-part (handle)
 948   "Display HANDLE using METHOD."
 949   (let* ((type (mm-handle-media-type handle))
 950          (methods
 951           (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
 952                   (mailcap-mime-info type 'all)))
 953          (method (let ((minibuffer-local-completion-map
 954                         mm-viewer-completion-map))
 955                    (completing-read "Viewer: " methods))))
 956     (when (string= method "")
 957       (error "No method given"))
 958     (if (string-match "^[^% \t]+$" method)
 959         (setq method (concat method " %s")))
 960     (mm-display-external handle method)))
 961
 962 (defun mm-preferred-alternative (handles &optional preferred)
 963   "Say which of HANDLES are preferred."
 964   (let ((prec (if preferred (list preferred)
 965                 (mm-preferred-alternative-precedence handles)))
 966         p h result type handle)
 967     (while (setq p (pop prec))
 968       (setq h handles)
 969       (while h
 970         (setq handle (car h))
 971         (setq type (mm-handle-media-type handle))
 972         (when (and (equal p type)
 973                    (mm-automatic-display-p handle)
 974                    (or (stringp (car handle))
 975                        (not (mm-handle-disposition handle))
 976                        (equal (car (mm-handle-disposition handle))
 977                               "inline")))
 978           (setq result handle
 979                 h nil
 980                 prec nil))
 981         (pop h)))
 982     result))
 983
 984 (defun mm-preferred-alternative-precedence (handles)
 985   "Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
 986   (let ((seq (nreverse (mapcar #'mm-handle-media-type
 987                                handles))))
 988     (dolist (disc (reverse mm-discouraged-alternatives))
 989       (dolist (elem (copy-sequence seq))
 990         (when (string-match disc elem)
 991           (setq seq (nconc (delete elem seq) (list elem))))))
 992     seq))
 993
 994 (defun mm-get-content-id (id)
 995   "Return the handle(s) referred to by ID."
 996   (cdr (assoc id mm-content-id-alist)))
 997
 998 (defun mm-get-image (handle)
 999   "Return an image instance based on HANDLE."
1000   (let ((type (mm-handle-media-subtype handle))
1001         spec)
1002     ;; Allow some common translations.
1003     (setq type
1004           (cond
1005            ((equal type "x-pixmap")
1006             "xpm")
1007            ((equal type "x-xbitmap")
1008             "xbm")
1009            ((equal type "x-portable-bitmap")
1010             "pbm")
1011            (t type)))
1012     (or (mm-handle-cache handle)
1013         (mm-with-unibyte-buffer
1014           (mm-insert-part handle)
1015           (prog1
1016               (setq spec
1017                     (ignore-errors
1018                      ;; Avoid testing `make-glyph' since W3 may define
1019                      ;; a bogus version of it.
1020                       (if (fboundp 'create-image)
1021                           (create-image (buffer-string) (intern type) 'data-p)
1022                         (cond
1023                          ((equal type "xbm")
1024                           ;; xbm images require special handling, since
1025                           ;; the only way to create glyphs from these
1026                           ;; (without a ton of work) is to write them
1027                           ;; out to a file, and then create a file
1028                           ;; specifier.
1029                           (let ((file (make-temp-name
1030                                        (expand-file-name "emm.xbm"
1031                                                          mm-tmp-directory))))
1032                             (unwind-protect
1033                                 (progn
1034                                   (write-region (point-min) (point-max) file)
1035                                   (make-glyph (list (cons 'x file))))
1036                               (ignore-errors
1037                                (delete-file file)))))
1038                          (t
1039                           (make-glyph
1040                            (vector (intern type) :data (buffer-string))))))))
1041             (mm-handle-set-cache handle spec))))))
1042
1043 (defun mm-image-fit-p (handle)
1044   "Say whether the image in HANDLE will fit the current window."
1045   (let ((image (mm-get-image handle)))
1046     (if (fboundp 'glyph-width)
1047         ;; XEmacs' glyphs can actually tell us about their width, so
1048         ;; lets be nice and smart about them.
1049         (or mm-inline-large-images
1050             (and (< (glyph-width image) (window-pixel-width))
1051                  (< (glyph-height image) (window-pixel-height))))
1052       (let* ((size (image-size image))
1053              (w (car size))
1054              (h (cdr size)))
1055         (or mm-inline-large-images
1056             (and (< h (1- (window-height))) ; Don't include mode line.
1057                  (< w (window-width))))))))
1058
1059 (defun mm-valid-image-format-p (format)
1060   "Say whether FORMAT can be displayed natively by Emacs."
1061   (cond
1062    ;; Handle XEmacs
1063    ((fboundp 'valid-image-instantiator-format-p)
1064     (valid-image-instantiator-format-p format))
1065    ;; Handle Emacs 21
1066    ((fboundp 'image-type-available-p)
1067     (and (display-graphic-p)
1068          (image-type-available-p format)))
1069    ;; Nobody else can do images yet.
1070    (t
1071     nil)))
1072
1073 (defun mm-valid-and-fit-image-p (format handle)
1074   "Say whether FORMAT can be displayed natively and HANDLE fits the window."
1075   (and (mm-valid-image-format-p format)
1076        (mm-image-fit-p handle)))
1077
1078 (defun mm-find-part-by-type (handles type &optional notp recursive)
1079   "Search in HANDLES for part with TYPE.
1080 If NOTP, returns first non-matching part.
1081 If RECURSIVE, search recursively."
1082   (let (handle)
1083     (while handles
1084       (if (and recursive (stringp (caar handles)))
1085           (if (setq handle (mm-find-part-by-type (cdar handles) type
1086                                                  notp recursive))
1087               (setq handles nil))
1088         (if (if notp
1089                 (not (equal (mm-handle-media-type (car handles)) type))
1090               (equal (mm-handle-media-type (car handles)) type))
1091             (setq handle (car handles)
1092                   handles nil)))
1093       (setq handles (cdr handles)))
1094     handle))
1095
1096 (defun mm-find-raw-part-by-type (ctl type &optional notp)
1097   (goto-char (point-min))
1098   (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl
1099                                                                    'boundary)))
1100          (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$"))
1101          start
1102          (end (save-excursion
1103                 (goto-char (point-max))
1104                 (if (re-search-backward close-delimiter nil t)
1105                     (match-beginning 0)
1106                   (point-max))))
1107          result)
1108     (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$"))
1109     (while (and (not result)
1110                 (re-search-forward boundary end t))
1111       (goto-char (match-beginning 0))
1112       (when start
1113         (save-excursion
1114           (save-restriction
1115             (narrow-to-region start (1- (point)))
1116             (when (let ((ctl (ignore-errors
1117                                (mail-header-parse-content-type
1118                                 (mail-fetch-field "content-type")))))
1119                     (if notp
1120                         (not (equal (car ctl) type))
1121                       (equal (car ctl) type)))
1122               (setq result (buffer-substring (point-min) (point-max)))))))
1123       (forward-line 1)
1124       (setq start (point)))
1125     (when (and (not result) start)
1126       (save-excursion
1127         (save-restriction
1128           (narrow-to-region start end)
1129           (when (let ((ctl (ignore-errors
1130                              (mail-header-parse-content-type
1131                               (mail-fetch-field "content-type")))))
1132                   (if notp
1133                       (not (equal (car ctl) type))
1134                     (equal (car ctl) type)))
1135             (setq result (buffer-substring (point-min) (point-max)))))))
1136     result))
1137
1138 (defvar mm-security-handle nil)
1139
1140 (defsubst mm-set-handle-multipart-parameter (handle parameter value)
1141   ;; HANDLE could be a CTL.
1142   (if handle
1143       (put-text-property 0 (length (car handle)) parameter value
1144                          (car handle))))
1145
1146 (defun mm-possibly-verify-or-decrypt (parts ctl)
1147   (let ((subtype (cadr (split-string (car ctl) "/")))
1148         (mm-security-handle ctl) ;; (car CTL) is the type.
1149         protocol func functest)
1150     (cond
1151      ((equal subtype "signed")
1152       (unless (and (setq protocol
1153                          (mm-handle-multipart-ctl-parameter ctl 'protocol))
1154                    (not (equal protocol "multipart/mixed")))
1155         ;; The message is broken or draft-ietf-openpgp-multsig-01.
1156         (let ((protocols mm-verify-function-alist))
1157           (while protocols
1158             (if (and (or (not (setq functest (nth 3 (car protocols))))
1159                          (funcall functest parts ctl))
1160                      (mm-find-part-by-type parts (caar protocols) nil t))
1161                 (setq protocol (caar protocols)
1162                       protocols nil)
1163               (setq protocols (cdr protocols))))))
1164       (setq func (nth 1 (assoc protocol mm-verify-function-alist)))
1165       (if (cond
1166            ((eq mm-verify-option 'never) nil)
1167            ((eq mm-verify-option 'always) t)
1168            ((eq mm-verify-option 'known)
1169             (and func
1170                  (or (not (setq functest
1171                                 (nth 3 (assoc protocol
1172                                               mm-verify-function-alist))))
1173                      (funcall functest parts ctl))))
1174            (t (y-or-n-p
1175                (format "Verify signed (%s) part? "
1176                        (or (nth 2 (assoc protocol mm-verify-function-alist))
1177                            (format "protocol=%s" protocol))))))
1178           (save-excursion
1179             (if func
1180                 (funcall func parts ctl)
1181               (mm-set-handle-multipart-parameter
1182                mm-security-handle 'gnus-details
1183                (format "Unknown sign protocol (%s)" protocol))))))
1184      ((equal subtype "encrypted")
1185       (unless (setq protocol
1186                     (mm-handle-multipart-ctl-parameter ctl 'protocol))
1187         ;; The message is broken.
1188         (let ((parts parts))
1189           (while parts
1190             (if (assoc (mm-handle-media-type (car parts))
1191                        mm-decrypt-function-alist)
1192                 (setq protocol (mm-handle-media-type (car parts))
1193                       parts nil)
1194               (setq parts (cdr parts))))))
1195       (setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
1196       (if (cond
1197            ((eq mm-decrypt-option 'never) nil)
1198            ((eq mm-decrypt-option 'always) t)
1199            ((eq mm-decrypt-option 'known)
1200             (and func
1201                  (or (not (setq functest
1202                                 (nth 3 (assoc protocol
1203                                               mm-decrypt-function-alist))))
1204                      (funcall functest parts ctl))))
1205            (t (y-or-n-p
1206                (format "Decrypt (%s) part? "
1207                        (or (nth 2 (assoc protocol mm-decrypt-function-alist))
1208                            (format "protocol=%s" protocol))))))
1209           (save-excursion
1210             (if func
1211                 (setq parts (funcall func parts ctl))
1212               (mm-set-handle-multipart-parameter
1213                mm-security-handle 'gnus-details
1214                (format "Unknown encrypt protocol (%s)" protocol))))))
1215      (t nil))
1216     parts))
1217
1218 (defun mm-multiple-handles (handles)
1219    (and (listp (car handles))
1220         (> (length handles) 1)))
1221
1222 (defun mm-merge-handles (handles1 handles2)
1223   (append
1224    (if (listp (car handles1))
1225        handles1
1226      (list handles1))
1227    (if (listp (car handles2))
1228        handles2
1229      (list handles2))))
1230
1231 (provide 'mm-decode)
1232
1233 ;;; mm-decode.el ends here