cgit.sxemacs.org Git - packages/blob - xemacs-packages/gnus/lisp/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, 2007, 2008 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 3, 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 You can disable elements from this list by customizing
 168 `mm-uu-configure-list'.")
 169
 170 (defcustom mm-uu-configure-list '((shar . disabled))
 171   "A list of mm-uu configuration.
 172 To disable dissecting shar codes, for instance, add
 173 `(shar . disabled)' to this list."
 174   :type 'alist
 175   :options (mapcar (lambda (entry)
 176                      (list (car entry) '(const disabled)))
 177                    mm-uu-type-alist)
 178   :group 'gnus-article-mime)
 179
 180 (defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded))
 181   "MIME type and parameters for text/plain parts.
 182 `gnus-decoded' is a fake charset, which means no further decoding.")
 183
 184 ;; functions
 185
 186 (defsubst mm-uu-type (entry)
 187   (car entry))
 188
 189 (defsubst mm-uu-beginning-regexp (entry)
 190   (nth 1 entry))
 191
 192 (defsubst mm-uu-end-regexp (entry)
 193   (nth 2 entry))
 194
 195 (defsubst mm-uu-function-extract (entry)
 196   (nth 3 entry))
 197
 198 (defsubst mm-uu-function-1 (entry)
 199   (nth 4 entry))
 200
 201 (defsubst mm-uu-function-2 (entry)
 202   (nth 5 entry))
 203
 204 (defun mm-uu-copy-to-buffer (&optional from to)
 205   "Copy the contents of the current buffer to a fresh buffer.
 206 Return that buffer."
 207   (let ((obuf (current-buffer))
 208         (coding-system
 209          ;; Might not exist in non-MULE XEmacs
 210          (when (boundp 'buffer-file-coding-system)
 211            buffer-file-coding-system)))
 212     (with-current-buffer (generate-new-buffer " *mm-uu*")
 213       (setq buffer-file-coding-system coding-system)
 214       (insert-buffer-substring obuf from to)
 215       (current-buffer))))
 216
 217 (defun mm-uu-configure-p  (key val)
 218   (member (cons key val) mm-uu-configure-list))
 219
 220 (defun mm-uu-configure (&optional symbol value)
 221   "Configure detection of non-MIME attachments."
 222   (interactive)
 223   (if symbol (set-default symbol value))
 224   (setq mm-uu-beginning-regexp nil)
 225   (mapcar (lambda (entry)
 226              (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
 227                  nil
 228                (setq mm-uu-beginning-regexp
 229                      (concat mm-uu-beginning-regexp
 230                              (if mm-uu-beginning-regexp "\\|")
 231                              (mm-uu-beginning-regexp entry)))))
 232           mm-uu-type-alist))
 233
 234 (mm-uu-configure)
 235
 236 (eval-when-compile
 237   (defvar file-name)
 238   (defvar start-point)
 239   (defvar end-point)
 240   (defvar entry))
 241
 242 (defun mm-uu-uu-filename ()
 243   (if (looking-at ".+")
 244       (setq file-name
 245             (let ((nnheader-file-name-translation-alist
 246                    '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
 247               (nnheader-translate-file-chars (match-string 0))))))
 248
 249 (defun mm-uu-binhex-filename ()
 250   (setq file-name
 251         (ignore-errors
 252           (binhex-decode-region start-point end-point t))))
 253
 254 (defun mm-uu-yenc-filename ()
 255   (goto-char start-point)
 256   (setq file-name
 257         (ignore-errors
 258           (yenc-extract-filename))))
 259
 260 (defun mm-uu-forward-test ()
 261   (save-excursion
 262     (goto-char start-point)
 263     (forward-line)
 264     (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
 265
 266 (defun mm-uu-postscript-extract ()
 267   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 268                   '("application/postscript")))
 269
 270 (defun mm-uu-emacs-sources-extract ()
 271   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 272                   '("application/emacs-lisp" (charset . gnus-decoded))
 273                   nil nil
 274                   (list mm-dissect-disposition
 275                         (cons 'filename file-name))))
 276
 277 (eval-when-compile
 278   (defvar gnus-newsgroup-name))
 279
 280 (defun mm-uu-emacs-sources-test ()
 281   (setq file-name (match-string 1))
 282   (and gnus-newsgroup-name
 283        mm-uu-emacs-sources-regexp
 284        (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name)))
 285
 286 (defun mm-uu-diff-extract ()
 287   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 288                   '("text/x-patch" (charset . gnus-decoded))))
 289
 290 (defun mm-uu-diff-test ()
 291   (and gnus-newsgroup-name
 292        mm-uu-diff-groups-regexp
 293        (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
 294
 295 (defun mm-uu-forward-extract ()
 296   (mm-make-handle (mm-uu-copy-to-buffer
 297                    (progn (goto-char start-point) (forward-line) (point))
 298                    (progn (goto-char end-point) (forward-line -1) (point)))
 299                   '("message/rfc822" (charset . gnus-decoded))))
 300
 301 (defun mm-uu-uu-extract ()
 302   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 303                   (list (or (and file-name
 304                                  (string-match "\\.[^\\.]+$"
 305                                                file-name)
 306                                  (mailcap-extension-to-mime
 307                                   (match-string 0 file-name)))
 308                             "application/octet-stream"))
 309                   'x-uuencode nil
 310                   (if (and file-name (not (equal file-name "")))
 311                       (list mm-dissect-disposition
 312                             (cons 'filename file-name)))))
 313
 314 (defun mm-uu-binhex-extract ()
 315   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 316                   (list (or (and file-name
 317                                  (string-match "\\.[^\\.]+$" file-name)
 318                                  (mailcap-extension-to-mime
 319                                   (match-string 0 file-name)))
 320                             "application/octet-stream"))
 321                   'x-binhex nil
 322                   (if (and file-name (not (equal file-name "")))
 323                       (list mm-dissect-disposition
 324                             (cons 'filename file-name)))))
 325
 326 (defun mm-uu-yenc-extract ()
 327   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 328                   (list (or (and file-name
 329                                  (string-match "\\.[^\\.]+$" file-name)
 330                                  (mailcap-extension-to-mime
 331                                   (match-string 0 file-name)))
 332                             "application/octet-stream"))
 333                   'x-yenc nil
 334                   (if (and file-name (not (equal file-name "")))
 335                       (list mm-dissect-disposition
 336                             (cons 'filename file-name)))))
 337
 338
 339 (defun mm-uu-shar-extract ()
 340   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 341                   '("application/x-shar")))
 342
 343 (defun mm-uu-gnatsweb-extract ()
 344   (save-restriction
 345     (goto-char start-point)
 346     (forward-line)
 347     (narrow-to-region (point) end-point)
 348     (mm-dissect-buffer t)))
 349
 350 (defun mm-uu-pgp-signed-test (&rest rest)
 351   (and
 352    mml2015-use
 353    (mml2015-clear-verify-function)
 354    (cond
 355     ((eq mm-verify-option 'never) nil)
 356     ((eq mm-verify-option 'always) t)
 357     ((eq mm-verify-option 'known) t)
 358     (t (prog1
 359            (y-or-n-p "Verify pgp signed part? ")
 360          (message ""))))))
 361
 362 (eval-when-compile
 363   (defvar gnus-newsgroup-charset))
 364
 365 (defun mm-uu-pgp-signed-extract-1 (handles ctl)
 366   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
 367     (with-current-buffer buf
 368       (if (mm-uu-pgp-signed-test)
 369           (progn
 370             (mml2015-clean-buffer)
 371             (let ((coding-system-for-write (or gnus-newsgroup-charset
 372                                                'iso-8859-1)))
 373               (funcall (mml2015-clear-verify-function))))
 374         (when (and mml2015-use (null (mml2015-clear-verify-function)))
 375           (mm-set-handle-multipart-parameter
 376            mm-security-handle 'gnus-details
 377            (format "Clear verification not supported by `%s'.\n" mml2015-use))))
 378       (goto-char (point-min))
 379       (forward-line)
 380       ;; We need to be careful not to strip beyond the armor headers.
 381       ;; Previously, an attacker could replace the text inside our
 382       ;; markup with trailing garbage by injecting whitespace into the
 383       ;; message.
 384       (while (looking-at "Hash:") ; The only header allowed in cleartext
 385         (forward-line))           ; signatures according to RFC2440.
 386       (when (looking-at "[\t ]*$")
 387         (forward-line))
 388       (delete-region (point-min) (point))
 389       (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
 390           (delete-region (match-beginning 0) (point-max)))
 391       (goto-char (point-min))
 392       (while (re-search-forward "^- " nil t)
 393         (replace-match "" t t)
 394         (forward-line 1)))
 395     (list (mm-make-handle buf mm-uu-text-plain-type))))
 396
 397 (defun mm-uu-pgp-signed-extract ()
 398   (let ((mm-security-handle (list (format "multipart/signed"))))
 399     (mm-set-handle-multipart-parameter
 400      mm-security-handle 'protocol "application/x-gnus-pgp-signature")
 401     (save-restriction
 402       (narrow-to-region start-point end-point)
 403       (add-text-properties 0 (length (car mm-security-handle))
 404                            (list 'buffer (mm-uu-copy-to-buffer))
 405                            (car mm-security-handle))
 406       (setcdr mm-security-handle
 407               (mm-uu-pgp-signed-extract-1 nil
 408                                           mm-security-handle)))
 409     mm-security-handle))
 410
 411 (defun mm-uu-pgp-encrypted-test (&rest rest)
 412   (and
 413    mml2015-use
 414    (mml2015-clear-decrypt-function)
 415    (cond
 416     ((eq mm-decrypt-option 'never) nil)
 417     ((eq mm-decrypt-option 'always) t)
 418     ((eq mm-decrypt-option 'known) t)
 419     (t (prog1
 420            (y-or-n-p "Decrypt pgp encrypted part? ")
 421          (message ""))))))
 422
 423 (defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
 424   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))
 425         (first t)
 426         charset)
 427     ;; Make sure there's a blank line between header and body.
 428     (with-current-buffer buf
 429       (goto-char (point-min))
 430       (while (prog2
 431                  (forward-line 1)
 432                  (if first
 433                      (looking-at "[^\t\n ]+:")
 434                    (looking-at "[^\t\n ]+:\\|[\t ]"))
 435                (setq first nil)))
 436       (unless (memq (char-after) '(?\n nil))
 437         (insert "\n"))
 438       (save-restriction
 439         (narrow-to-region (point-min) (point))
 440         (setq charset (mail-fetch-field "charset")))
 441       (if (and (mm-uu-pgp-encrypted-test)
 442                (progn
 443                  (mml2015-clean-buffer)
 444                  (funcall (mml2015-clear-decrypt-function))
 445                  (equal (mm-handle-multipart-ctl-parameter mm-security-handle
 446                                                            'gnus-info)
 447                         "OK")))
 448           (progn
 449             ;; Decode charset.
 450             (if (and (or charset
 451                          (setq charset gnus-newsgroup-charset))
 452                      (setq charset (mm-charset-to-coding-system charset))
 453                      (not (eq charset 'ascii)))
 454                 ;; Assume that buffer's multibyteness is turned off.
 455                 ;; See `mml2015-pgg-clear-decrypt'.
 456                 (insert (mm-decode-coding-string (prog1
 457                                                      (buffer-string)
 458                                                    (erase-buffer)
 459                                                    (mm-enable-multibyte))
 460                                                  charset))
 461               (mm-enable-multibyte))
 462             (list (mm-make-handle buf mm-uu-text-plain-type)))
 463         (list (mm-make-handle buf '("application/pgp-encrypted")))))))
 464
 465 (defun mm-uu-pgp-encrypted-extract ()
 466   (let ((mm-security-handle (list (format "multipart/encrypted"))))
 467     (mm-set-handle-multipart-parameter
 468      mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
 469     (save-restriction
 470       (narrow-to-region start-point end-point)
 471       (add-text-properties 0 (length (car mm-security-handle))
 472                            (list 'buffer (mm-uu-copy-to-buffer))
 473                            (car mm-security-handle))
 474       (setcdr mm-security-handle
 475               (mm-uu-pgp-encrypted-extract-1 nil
 476                                              mm-security-handle)))
 477     mm-security-handle))
 478
 479 (defun mm-uu-gpg-key-skip-to-last ()
 480   (let ((point (point))
 481         (end-regexp (mm-uu-end-regexp entry))
 482         (beginning-regexp (mm-uu-beginning-regexp entry)))
 483     (when (and end-regexp
 484                (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
 485       (while (re-search-forward end-regexp nil t)
 486         (skip-chars-forward " \t\n\r")
 487         (if (looking-at beginning-regexp)
 488             (setq point (match-end 0)))))
 489     (goto-char point)))
 490
 491 (defun mm-uu-pgp-key-extract ()
 492   (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
 493     (mm-make-handle buf
 494                     '("application/pgp-keys"))))
 495
 496 ;;;###autoload
 497 (defun mm-uu-dissect (&optional noheader mime-type)
 498   "Dissect the current buffer and return a list of uu handles.
 499 The optional NOHEADER means there's no header in the buffer.
 500 MIME-TYPE specifies a MIME type and parameters, which defaults to the
 501 value of `mm-uu-text-plain-type'."
 502   (let ((case-fold-search t)
 503         (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type))
 504         text-start start-point end-point file-name result entry func)
 505     (save-excursion
 506       (goto-char (point-min))
 507       (cond
 508        (noheader)
 509        ((looking-at "\n")
 510         (forward-line))
 511        ((search-forward "\n\n" nil t)
 512         t)
 513        (t (goto-char (point-max))))
 514       (setq text-start (point))
 515       (while (re-search-forward mm-uu-beginning-regexp nil t)
 516         (setq start-point (match-beginning 0)
 517               entry nil)
 518         (let ((alist mm-uu-type-alist)
 519               (beginning-regexp (match-string 0)))
 520           (while (not entry)
 521             (if (string-match (mm-uu-beginning-regexp (car alist))
 522                               beginning-regexp)
 523                 (setq entry (car alist))
 524               (pop alist))))
 525         (if (setq func (mm-uu-function-1 entry))
 526             (funcall func))
 527         (forward-line);; in case of failure
 528         (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
 529                    (let ((end-regexp (mm-uu-end-regexp entry)))
 530                      (if (not end-regexp)
 531                          (or (setq end-point (point-max)) t)
 532                        (prog1
 533                            (re-search-forward end-regexp nil t)
 534                          (forward-line)
 535                          (setq end-point (point)))))
 536                    (or (not (setq func (mm-uu-function-2 entry)))
 537                        (funcall func)))
 538           (if (and (> start-point text-start)
 539                    (progn
 540                      (goto-char text-start)
 541                      (re-search-forward "." start-point t)))
 542               (push
 543                (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
 544                                mm-uu-text-plain-type)
 545                result))
 546           (push
 547            (funcall (mm-uu-function-extract entry))
 548            result)
 549           (goto-char (setq text-start end-point))))
 550       (when result
 551         (if (and (> (point-max) (1+ text-start))
 552                  (save-excursion
 553                    (goto-char text-start)
 554                    (re-search-forward "." nil t)))
 555             (push
 556              (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
 557                              mm-uu-text-plain-type)
 558              result))
 559         (setq result (cons "multipart/mixed" (nreverse result))))
 560       result)))
 561
 562 ;;;###autoload
 563 (defun mm-uu-dissect-text-parts (handle &optional decoded)
 564   "Dissect text parts and put uu handles into HANDLE.
 565 Assume text has been decoded if DECODED is non-nil."
 566   (let ((buffer (mm-handle-buffer handle)))
 567     (cond ((stringp buffer)
 568            (dolist (elem (cdr handle))
 569              (mm-uu-dissect-text-parts elem decoded)))
 570           ((bufferp buffer)
 571            (let ((type (mm-handle-media-type handle))
 572                  (case-fold-search t) ;; string-match
 573                  children charset encoding)
 574              (when (and
 575                     (stringp type)
 576                     ;; Mutt still uses application/pgp even though
 577                     ;; it has already been withdrawn.
 578                     (string-match "\\`text/\\|\\`application/pgp\\'" type)
 579                     (setq
 580                      children
 581                      (with-current-buffer buffer
 582                        (cond
 583                         ((or decoded
 584                              (eq (setq charset (mail-content-type-get
 585                                                 (mm-handle-type handle)
 586                                                 'charset))
 587                                  'gnus-decoded))
 588                          (setq decoded t)
 589                          (mm-uu-dissect
 590                           t (cons type '((charset . gnus-decoded)))))
 591                         (charset
 592                          (setq decoded t)
 593                          (mm-with-multibyte-buffer
 594                            (insert (mm-decode-string (mm-get-part handle)
 595                                                      charset))
 596                            (mm-uu-dissect
 597                             t (cons type '((charset . gnus-decoded))))))
 598                         ((setq encoding (mm-handle-encoding handle))
 599                          (setq decoded nil)
 600                          ;; Inherit the multibyteness of the `buffer'.
 601                          (with-temp-buffer
 602                            (insert-buffer-substring buffer)
 603                            (mm-decode-content-transfer-encoding
 604                             encoding type)
 605                            (mm-uu-dissect t (list type))))
 606                         (t
 607                          (setq decoded nil)
 608                          (mm-uu-dissect t (list type)))))))
 609                ;; Ignore it if a given part is dissected into a single
 610                ;; part of which the type is the same as the given one.
 611                (if (and (<= (length children) 2)
 612                         (string-equal (mm-handle-media-type (cadr children))
 613                                       type))
 614                    (kill-buffer (mm-handle-buffer (cadr children)))
 615                  (kill-buffer buffer)
 616                  (setcdr handle (cdr children))
 617                  (setcar handle (car children)) ;; "multipart/mixed"
 618                  (dolist (elem (cdr children))
 619                    (mm-uu-dissect-text-parts elem decoded))))))
 620           (t
 621            (dolist (elem handle)
 622              (mm-uu-dissect-text-parts elem decoded))))))
 623
 624 (provide 'mm-uu)
 625
 626 ;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
 627 ;;; mm-uu.el ends here