code.delx.au - gnu-emacs/blob - lisp/gnus/mm-uu.el

   1 ;;; mm-uu.el --- Return uu stuff as mm handles
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006 Free Software Foundation, Inc.
   5
   6 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
   7 ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  24 ;; Boston, MA 02110-1301, USA.
  25
  26 ;;; Commentary:
  27
  28 ;;; Code:
  29
  30 (eval-when-compile (require 'cl))
  31 (require 'mail-parse)
  32 (require 'nnheader)
  33 (require 'mm-decode)
  34 (require 'mailcap)
  35 (require 'mml2015)
  36
  37 (autoload 'uudecode-decode-region "uudecode")
  38 (autoload 'uudecode-decode-region-external "uudecode")
  39 (autoload 'uudecode-decode-region-internal "uudecode")
  40
  41 (autoload 'binhex-decode-region "binhex")
  42 (autoload 'binhex-decode-region-external "binhex")
  43 (autoload 'binhex-decode-region-internal "binhex")
  44
  45 (autoload 'yenc-decode-region "yenc")
  46 (autoload 'yenc-extract-filename "yenc")
  47
  48 (defcustom mm-uu-decode-function 'uudecode-decode-region
  49   "*Function to uudecode.
  50 Internal function is done in Lisp by default, therefore decoding may
  51 appear to be horribly slow.  You can make Gnus use an external
  52 decoder, such as uudecode."
  53   :type '(choice
  54           (function-item :tag "Auto detect" uudecode-decode-region)
  55           (function-item :tag "Internal" uudecode-decode-region-internal)
  56           (function-item :tag "External" uudecode-decode-region-external))
  57   :group 'gnus-article-mime)
  58
  59 (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
  60   "*Function to binhex decode.
  61 Internal function is done in elisp by default, therefore decoding may
  62 appear to be horribly slow . You can make Gnus use the external Unix
  63 decoder, such as hexbin."
  64   :type '(choice (function-item :tag "Auto detect" binhex-decode-region)
  65                  (function-item :tag "Internal" binhex-decode-region-internal)
  66                  (function-item :tag "External" binhex-decode-region-external))
  67   :group 'gnus-article-mime)
  68
  69 (defvar mm-uu-yenc-decode-function 'yenc-decode-region)
  70
  71 (defvar mm-uu-pgp-beginning-signature
  72      "^-----BEGIN PGP SIGNATURE-----")
  73
  74 (defvar mm-uu-beginning-regexp nil)
  75
  76 (defvar mm-dissect-disposition "inline"
  77   "The default disposition of uu parts.
  78 This can be either \"inline\" or \"attachment\".")
  79
  80 (defcustom mm-uu-emacs-sources-regexp "\\.emacs\\.sources"
  81   "The regexp of Emacs sources groups."
  82   :version "22.1"
  83   :type 'regexp
  84   :group 'gnus-article-mime)
  85
  86 (defcustom mm-uu-diff-groups-regexp
  87   "\\(gmane\\|gnu\\)\\..*\\(diff\\|commit\\|cvs\\|bug\\|devel\\)"
  88   "Regexp matching diff groups."
  89   :version "22.1"
  90   :type 'regexp
  91   :group 'gnus-article-mime)
  92
  93 (defvar mm-uu-type-alist
  94   '((postscript
  95      "^%!PS-"
  96      "^%%EOF$"
  97      mm-uu-postscript-extract
  98      nil)
  99     (uu
 100      "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
 101      "^end[ \t]*$"
 102      mm-uu-uu-extract
 103      mm-uu-uu-filename)
 104     (binhex
 105      "^:...............................................................$"
 106      ":$"
 107      mm-uu-binhex-extract
 108      nil
 109      mm-uu-binhex-filename)
 110     (yenc
 111      "^=ybegin.*size=[0-9]+.*name=.*$"
 112      "^=yend.*size=[0-9]+"
 113      mm-uu-yenc-extract
 114      mm-uu-yenc-filename)
 115     (shar
 116      "^#! */bin/sh"
 117      "^exit 0$"
 118      mm-uu-shar-extract)
 119     (forward
 120      ;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
 121      ;; Peter von der Ah\'e <pahe@daimi.au.dk>
 122      "^-+ \\(Start of \\)?Forwarded message"
 123      "^-+ End \\(of \\)?forwarded message"
 124      mm-uu-forward-extract
 125      nil
 126      mm-uu-forward-test)
 127     (gnatsweb
 128      "^----gnatsweb-attachment----"
 129      nil
 130      mm-uu-gnatsweb-extract)
 131     (pgp-signed
 132      "^-----BEGIN PGP SIGNED MESSAGE-----"
 133      "^-----END PGP SIGNATURE-----"
 134      mm-uu-pgp-signed-extract
 135      nil
 136      nil)
 137     (pgp-encrypted
 138      "^-----BEGIN PGP MESSAGE-----"
 139      "^-----END PGP MESSAGE-----"
 140      mm-uu-pgp-encrypted-extract
 141      nil
 142      nil)
 143     (pgp-key
 144      "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
 145      "^-----END PGP PUBLIC KEY BLOCK-----"
 146      mm-uu-pgp-key-extract
 147      mm-uu-gpg-key-skip-to-last
 148      nil)
 149     (emacs-sources
 150      "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
 151      "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
 152      mm-uu-emacs-sources-extract
 153      nil
 154      mm-uu-emacs-sources-test)
 155     (diff
 156      "^Index: "
 157      nil
 158      mm-uu-diff-extract
 159      nil
 160      mm-uu-diff-test))
 161   "A list of specifications for non-MIME attachments.
 162 Each element consist of the following entries: label,
 163 start-regexp, end-regexp, extract-function, test-function.
 164
 165 After modifying this list you must run \\[mm-uu-configure].")
 166
 167 (defcustom mm-uu-configure-list '((shar . disabled))
 168   "A list of mm-uu configuration.
 169 To disable dissecting shar codes, for instance, add
 170 `(shar . disabled)' to this list."
 171   :type 'alist
 172   :options (mapcar (lambda (entry)
 173                      (list (car entry) '(const disabled)))
 174                    mm-uu-type-alist)
 175   :group 'gnus-article-mime)
 176
 177 (defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded))
 178   "MIME type and parameters for text/plain parts.
 179 `gnus-decoded' is a fake charset, which means no further decoding.")
 180
 181 ;; functions
 182
 183 (defsubst mm-uu-type (entry)
 184   (car entry))
 185
 186 (defsubst mm-uu-beginning-regexp (entry)
 187   (nth 1 entry))
 188
 189 (defsubst mm-uu-end-regexp (entry)
 190   (nth 2 entry))
 191
 192 (defsubst mm-uu-function-extract (entry)
 193   (nth 3 entry))
 194
 195 (defsubst mm-uu-function-1 (entry)
 196   (nth 4 entry))
 197
 198 (defsubst mm-uu-function-2 (entry)
 199   (nth 5 entry))
 200
 201 (defun mm-uu-copy-to-buffer (&optional from to)
 202   "Copy the contents of the current buffer to a fresh buffer.
 203 Return that buffer."
 204   (let ((obuf (current-buffer))
 205         (coding-system
 206          ;; Might not exist in non-MULE XEmacs
 207          (when (boundp 'buffer-file-coding-system)
 208            buffer-file-coding-system)))
 209     (with-current-buffer (generate-new-buffer " *mm-uu*")
 210       (setq buffer-file-coding-system coding-system)
 211       (insert-buffer-substring obuf from to)
 212       (current-buffer))))
 213
 214 (defun mm-uu-configure-p  (key val)
 215   (member (cons key val) mm-uu-configure-list))
 216
 217 (defun mm-uu-configure (&optional symbol value)
 218   "Configure detection of non-MIME attachments."
 219   (interactive)
 220   (if symbol (set-default symbol value))
 221   (setq mm-uu-beginning-regexp nil)
 222   (mapcar (lambda (entry)
 223              (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
 224                  nil
 225                (setq mm-uu-beginning-regexp
 226                      (concat mm-uu-beginning-regexp
 227                              (if mm-uu-beginning-regexp "\\|")
 228                              (mm-uu-beginning-regexp entry)))))
 229           mm-uu-type-alist))
 230
 231 (mm-uu-configure)
 232
 233 (eval-when-compile
 234   (defvar file-name)
 235   (defvar start-point)
 236   (defvar end-point)
 237   (defvar entry))
 238
 239 (defun mm-uu-uu-filename ()
 240   (if (looking-at ".+")
 241       (setq file-name
 242             (let ((nnheader-file-name-translation-alist
 243                    '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
 244               (nnheader-translate-file-chars (match-string 0))))))
 245
 246 (defun mm-uu-binhex-filename ()
 247   (setq file-name
 248         (ignore-errors
 249           (binhex-decode-region start-point end-point t))))
 250
 251 (defun mm-uu-yenc-filename ()
 252   (goto-char start-point)
 253   (setq file-name
 254         (ignore-errors
 255           (yenc-extract-filename))))
 256
 257 (defun mm-uu-forward-test ()
 258   (save-excursion
 259     (goto-char start-point)
 260     (forward-line)
 261     (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
 262
 263 (defun mm-uu-postscript-extract ()
 264   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 265                   '("application/postscript")))
 266
 267 (defun mm-uu-emacs-sources-extract ()
 268   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 269                   '("application/emacs-lisp" (charset . gnus-decoded))
 270                   nil nil
 271                   (list mm-dissect-disposition
 272                         (cons 'filename file-name))))
 273
 274 (eval-when-compile
 275   (defvar gnus-newsgroup-name))
 276
 277 (defun mm-uu-emacs-sources-test ()
 278   (setq file-name (match-string 1))
 279   (and gnus-newsgroup-name
 280        mm-uu-emacs-sources-regexp
 281        (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name)))
 282
 283 (defun mm-uu-diff-extract ()
 284   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 285                   '("text/x-patch" (charset . gnus-decoded))))
 286
 287 (defun mm-uu-diff-test ()
 288   (and gnus-newsgroup-name
 289        mm-uu-diff-groups-regexp
 290        (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
 291
 292 (defun mm-uu-forward-extract ()
 293   (mm-make-handle (mm-uu-copy-to-buffer
 294                    (progn (goto-char start-point) (forward-line) (point))
 295                    (progn (goto-char end-point) (forward-line -1) (point)))
 296                   '("message/rfc822" (charset . gnus-decoded))))
 297
 298 (defun mm-uu-uu-extract ()
 299   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 300                   (list (or (and file-name
 301                                  (string-match "\\.[^\\.]+$"
 302                                                file-name)
 303                                  (mailcap-extension-to-mime
 304                                   (match-string 0 file-name)))
 305                             "application/octet-stream"))
 306                   'x-uuencode nil
 307                   (if (and file-name (not (equal file-name "")))
 308                       (list mm-dissect-disposition
 309                             (cons 'filename file-name)))))
 310
 311 (defun mm-uu-binhex-extract ()
 312   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 313                   (list (or (and file-name
 314                                  (string-match "\\.[^\\.]+$" file-name)
 315                                  (mailcap-extension-to-mime
 316                                   (match-string 0 file-name)))
 317                             "application/octet-stream"))
 318                   'x-binhex nil
 319                   (if (and file-name (not (equal file-name "")))
 320                       (list mm-dissect-disposition
 321                             (cons 'filename file-name)))))
 322
 323 (defun mm-uu-yenc-extract ()
 324   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 325                   (list (or (and file-name
 326                                  (string-match "\\.[^\\.]+$" file-name)
 327                                  (mailcap-extension-to-mime
 328                                   (match-string 0 file-name)))
 329                             "application/octet-stream"))
 330                   'x-yenc nil
 331                   (if (and file-name (not (equal file-name "")))
 332                       (list mm-dissect-disposition
 333                             (cons 'filename file-name)))))
 334
 335
 336 (defun mm-uu-shar-extract ()
 337   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 338                   '("application/x-shar")))
 339
 340 (defun mm-uu-gnatsweb-extract ()
 341   (save-restriction
 342     (goto-char start-point)
 343     (forward-line)
 344     (narrow-to-region (point) end-point)
 345     (mm-dissect-buffer t)))
 346
 347 (defun mm-uu-pgp-signed-test (&rest rest)
 348   (and
 349    mml2015-use
 350    (mml2015-clear-verify-function)
 351    (cond
 352     ((eq mm-verify-option 'never) nil)
 353     ((eq mm-verify-option 'always) t)
 354     ((eq mm-verify-option 'known) t)
 355     (t (prog1
 356            (y-or-n-p "Verify pgp signed part? ")
 357          (message ""))))))
 358
 359 (eval-when-compile
 360   (defvar gnus-newsgroup-charset))
 361
 362 (defun mm-uu-pgp-signed-extract-1 (handles ctl)
 363   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
 364     (with-current-buffer buf
 365       (if (mm-uu-pgp-signed-test)
 366           (progn
 367             (mml2015-clean-buffer)
 368             (let ((coding-system-for-write (or gnus-newsgroup-charset
 369                                                'iso-8859-1)))
 370               (funcall (mml2015-clear-verify-function))))
 371         (when (and mml2015-use (null (mml2015-clear-verify-function)))
 372           (mm-set-handle-multipart-parameter
 373            mm-security-handle 'gnus-details
 374            (format "Clear verification not supported by `%s'.\n" mml2015-use))))
 375       (goto-char (point-min))
 376       (if (re-search-forward "\n[\t ]*\n" nil t)
 377           (delete-region (point-min) (point)))
 378       (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
 379           (delete-region (match-beginning 0) (point-max)))
 380       (goto-char (point-min))
 381       (while (re-search-forward "^- " nil t)
 382         (replace-match "" t t)
 383         (forward-line 1)))
 384     (list (mm-make-handle buf mm-uu-text-plain-type))))
 385
 386 (defun mm-uu-pgp-signed-extract ()
 387   (let ((mm-security-handle (list (format "multipart/signed"))))
 388     (mm-set-handle-multipart-parameter
 389      mm-security-handle 'protocol "application/x-gnus-pgp-signature")
 390     (save-restriction
 391       (narrow-to-region start-point end-point)
 392       (add-text-properties 0 (length (car mm-security-handle))
 393                            (list 'buffer (mm-uu-copy-to-buffer))
 394                            (car mm-security-handle))
 395       (setcdr mm-security-handle
 396               (mm-uu-pgp-signed-extract-1 nil
 397                                           mm-security-handle)))
 398     mm-security-handle))
 399
 400 (defun mm-uu-pgp-encrypted-test (&rest rest)
 401   (and
 402    mml2015-use
 403    (mml2015-clear-decrypt-function)
 404    (cond
 405     ((eq mm-decrypt-option 'never) nil)
 406     ((eq mm-decrypt-option 'always) t)
 407     ((eq mm-decrypt-option 'known) t)
 408     (t (prog1
 409            (y-or-n-p "Decrypt pgp encrypted part? ")
 410          (message ""))))))
 411
 412 (defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
 413   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))
 414         (first t)
 415         charset)
 416     ;; Make sure there's a blank line between header and body.
 417     (with-current-buffer buf
 418       (goto-char (point-min))
 419       (while (prog2
 420                  (forward-line 1)
 421                  (if first
 422                      (looking-at "[^\t\n ]+:")
 423                    (looking-at "[^\t\n ]+:\\|[\t ]"))
 424                (setq first nil)))
 425       (unless (memq (char-after) '(?\n nil))
 426         (insert "\n"))
 427       (save-restriction
 428         (narrow-to-region (point-min) (point))
 429         (setq charset (mail-fetch-field "charset")))
 430       (if (and (mm-uu-pgp-encrypted-test)
 431                (progn
 432                  (mml2015-clean-buffer)
 433                  (funcall (mml2015-clear-decrypt-function))
 434                  (equal (mm-handle-multipart-ctl-parameter mm-security-handle
 435                                                            'gnus-info)
 436                         "OK")))
 437           (progn
 438             ;; Decode charset.
 439             (if (and (or charset
 440                          (setq charset gnus-newsgroup-charset))
 441                      (setq charset (mm-charset-to-coding-system charset))
 442                      (not (eq charset 'ascii)))
 443                 ;; Assume that buffer's multibyteness is turned off.
 444                 ;; See `mml2015-pgg-clear-decrypt'.
 445                 (insert (mm-decode-coding-string (prog1
 446                                                      (buffer-string)
 447                                                    (erase-buffer)
 448                                                    (mm-enable-multibyte))
 449                                                  charset))
 450               (mm-enable-multibyte))
 451             (list (mm-make-handle buf mm-uu-text-plain-type)))
 452         (list (mm-make-handle buf '("application/pgp-encrypted")))))))
 453
 454 (defun mm-uu-pgp-encrypted-extract ()
 455   (let ((mm-security-handle (list (format "multipart/encrypted"))))
 456     (mm-set-handle-multipart-parameter
 457      mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
 458     (save-restriction
 459       (narrow-to-region start-point end-point)
 460       (add-text-properties 0 (length (car mm-security-handle))
 461                            (list 'buffer (mm-uu-copy-to-buffer))
 462                            (car mm-security-handle))
 463       (setcdr mm-security-handle
 464               (mm-uu-pgp-encrypted-extract-1 nil
 465                                              mm-security-handle)))
 466     mm-security-handle))
 467
 468 (defun mm-uu-gpg-key-skip-to-last ()
 469   (let ((point (point))
 470         (end-regexp (mm-uu-end-regexp entry))
 471         (beginning-regexp (mm-uu-beginning-regexp entry)))
 472     (when (and end-regexp
 473                (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
 474       (while (re-search-forward end-regexp nil t)
 475         (skip-chars-forward " \t\n\r")
 476         (if (looking-at beginning-regexp)
 477             (setq point (match-end 0)))))
 478     (goto-char point)))
 479
 480 (defun mm-uu-pgp-key-extract ()
 481   (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
 482     (mm-make-handle buf
 483                     '("application/pgp-keys"))))
 484
 485 ;;;###autoload
 486 (defun mm-uu-dissect (&optional noheader mime-type)
 487   "Dissect the current buffer and return a list of uu handles.
 488 The optional NOHEADER means there's no header in the buffer.
 489 MIME-TYPE specifies a MIME type and parameters, which defaults to the
 490 value of `mm-uu-text-plain-type'."
 491   (let ((case-fold-search t)
 492         (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type))
 493         text-start start-point end-point file-name result entry func)
 494     (save-excursion
 495       (goto-char (point-min))
 496       (cond
 497        (noheader)
 498        ((looking-at "\n")
 499         (forward-line))
 500        ((search-forward "\n\n" nil t)
 501         t)
 502        (t (goto-char (point-max))))
 503       (setq text-start (point))
 504       (while (re-search-forward mm-uu-beginning-regexp nil t)
 505         (setq start-point (match-beginning 0)
 506               entry nil)
 507         (let ((alist mm-uu-type-alist)
 508               (beginning-regexp (match-string 0)))
 509           (while (not entry)
 510             (if (string-match (mm-uu-beginning-regexp (car alist))
 511                               beginning-regexp)
 512                 (setq entry (car alist))
 513               (pop alist))))
 514         (if (setq func (mm-uu-function-1 entry))
 515             (funcall func))
 516         (forward-line);; in case of failure
 517         (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
 518                    (let ((end-regexp (mm-uu-end-regexp entry)))
 519                      (if (not end-regexp)
 520                          (or (setq end-point (point-max)) t)
 521                        (prog1
 522                            (re-search-forward end-regexp nil t)
 523                          (forward-line)
 524                          (setq end-point (point)))))
 525                    (or (not (setq func (mm-uu-function-2 entry)))
 526                        (funcall func)))
 527           (if (and (> start-point text-start)
 528                    (progn
 529                      (goto-char text-start)
 530                      (re-search-forward "." start-point t)))
 531               (push
 532                (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
 533                                mm-uu-text-plain-type)
 534                result))
 535           (push
 536            (funcall (mm-uu-function-extract entry))
 537            result)
 538           (goto-char (setq text-start end-point))))
 539       (when result
 540         (if (and (> (point-max) (1+ text-start))
 541                  (save-excursion
 542                    (goto-char text-start)
 543                    (re-search-forward "." nil t)))
 544             (push
 545              (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
 546                              mm-uu-text-plain-type)
 547              result))
 548         (setq result (cons "multipart/mixed" (nreverse result))))
 549       result)))
 550
 551 ;;;###autoload
 552 (defun mm-uu-dissect-text-parts (handle &optional decoded)
 553   "Dissect text parts and put uu handles into HANDLE.
 554 Assume text has been decoded if DECODED is non-nil."
 555   (let ((buffer (mm-handle-buffer handle)))
 556     (cond ((stringp buffer)
 557            (dolist (elem (cdr handle))
 558              (mm-uu-dissect-text-parts elem decoded)))
 559           ((bufferp buffer)
 560            (let ((type (mm-handle-media-type handle))
 561                  (case-fold-search t) ;; string-match
 562                  children charset encoding)
 563              (when (and
 564                     (stringp type)
 565                     ;; Mutt still uses application/pgp even though
 566                     ;; it has already been withdrawn.
 567                     (string-match "\\`text/\\|\\`application/pgp\\'" type)
 568                     (setq
 569                      children
 570                      (with-current-buffer buffer
 571                        (cond
 572                         ((or decoded
 573                              (eq (setq charset (mail-content-type-get
 574                                                 (mm-handle-type handle)
 575                                                 'charset))
 576                                  'gnus-decoded))
 577                          (setq decoded t)
 578                          (mm-uu-dissect
 579                           t (cons type '((charset . gnus-decoded)))))
 580                         (charset
 581                          (setq decoded t)
 582                          (mm-with-multibyte-buffer
 583                            (insert (mm-decode-string (mm-get-part handle)
 584                                                      charset))
 585                            (mm-uu-dissect
 586                             t (cons type '((charset . gnus-decoded))))))
 587                         ((setq encoding (mm-handle-encoding handle))
 588                          (setq decoded nil)
 589                          ;; Inherit the multibyteness of the `buffer'.
 590                          (with-temp-buffer
 591                            (insert-buffer-substring buffer)
 592                            (mm-decode-content-transfer-encoding
 593                             encoding type)
 594                            (mm-uu-dissect t (list type))))
 595                         (t
 596                          (setq decoded nil)
 597                          (mm-uu-dissect t (list type)))))))
 598                ;; Ignore it if a given part is dissected into a single
 599                ;; part of which the type is the same as the given one.
 600                (if (and (<= (length children) 2)
 601                         (string-equal (mm-handle-media-type (cadr children))
 602                                       type))
 603                    (kill-buffer (mm-handle-buffer (cadr children)))
 604                  (kill-buffer buffer)
 605                  (setcdr handle (cdr children))
 606                  (setcar handle (car children)) ;; "multipart/mixed"
 607                  (dolist (elem (cdr children))
 608                    (mm-uu-dissect-text-parts elem decoded))))))
 609           (t
 610            (dolist (elem handle)
 611              (mm-uu-dissect-text-parts elem decoded))))))
 612
 613 (provide 'mm-uu)
 614
 615 ;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
 616 ;;; mm-uu.el ends here