cgit.sxemacs.org Git - gnus/blob - 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 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 (defcustom mm-uu-tex-groups-regexp "\\.tex\\>"
  94   "*Regexp matching TeX groups."
  95   :version "23.0"
  96   :type 'regexp
  97   :group 'gnus-article-mime)
  98
  99 (defvar mm-uu-type-alist
 100   `((postscript
 101      "^%!PS-"
 102      "^%%EOF$"
 103      mm-uu-postscript-extract
 104      nil)
 105     (uu
 106      "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
 107      "^end[ \t]*$"
 108      mm-uu-uu-extract
 109      mm-uu-uu-filename)
 110     (binhex
 111      "^:...............................................................$"
 112      ":$"
 113      mm-uu-binhex-extract
 114      nil
 115      mm-uu-binhex-filename)
 116     (yenc
 117      "^=ybegin.*size=[0-9]+.*name=.*$"
 118      "^=yend.*size=[0-9]+"
 119      mm-uu-yenc-extract
 120      mm-uu-yenc-filename)
 121     (shar
 122      "^#! */bin/sh"
 123      "^exit 0$"
 124      mm-uu-shar-extract)
 125     (forward
 126      ;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
 127      ;; Peter von der Ah\'e <pahe@daimi.au.dk>
 128      "^-+ \\(Start of \\)?Forwarded message"
 129      "^-+ End \\(of \\)?forwarded message"
 130      mm-uu-forward-extract
 131      nil
 132      mm-uu-forward-test)
 133     (gnatsweb
 134      "^----gnatsweb-attachment----"
 135      nil
 136      mm-uu-gnatsweb-extract)
 137     (pgp-signed
 138      "^-----BEGIN PGP SIGNED MESSAGE-----"
 139      "^-----END PGP SIGNATURE-----"
 140      mm-uu-pgp-signed-extract
 141      nil
 142      nil)
 143     (pgp-encrypted
 144      "^-----BEGIN PGP MESSAGE-----"
 145      "^-----END PGP MESSAGE-----"
 146      mm-uu-pgp-encrypted-extract
 147      nil
 148      nil)
 149     (pgp-key
 150      "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
 151      "^-----END PGP PUBLIC KEY BLOCK-----"
 152      mm-uu-pgp-key-extract
 153      mm-uu-gpg-key-skip-to-last
 154      nil)
 155     (emacs-sources
 156      "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
 157      "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
 158      mm-uu-emacs-sources-extract
 159      nil
 160      mm-uu-emacs-sources-test)
 161     (diff
 162      "^Index: "
 163      nil
 164      mm-uu-diff-extract
 165      nil
 166      mm-uu-diff-test)
 167     (message-marks
 168      ,(concat "^" (regexp-quote message-mark-insert-begin))
 169      ,(concat "^" (regexp-quote message-mark-insert-end))
 170      (lambda () (mm-uu-verbatim-marks-extract 0 -1 1 -2))
 171      nil)
 172     ;; Omitting [a-z8<] leads to false positives (bogus signature separators
 173     ;; and mailing list banners).
 174     (insert-marks
 175      "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$"
 176      "^ *\\(-\\|_\\)\\{30,\\}.*[a-z8<].*\\(-\\|_\\)\\{30,\\} *$"
 177      (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1))
 178      nil)
 179     (verbatim-marks
 180      ;; slrn-style verbatim marks, see
 181      ;; http://www.slrn.org/manual/slrn-manual-6.html#ss6.81
 182      "^#v\\+"
 183      "^#v\\-$"
 184      (lambda () (mm-uu-verbatim-marks-extract 0 0 1 -1))
 185      nil)
 186     (LaTeX
 187      "^\\\\documentclass"
 188      "^\\\\end{document}"
 189      mm-uu-latex-extract
 190      nil
 191      mm-uu-latex-test))
 192   "A list of specifications for non-MIME attachments.
 193 Each element consist of the following entries: label,
 194 start-regexp, end-regexp, extract-function, test-function.
 195
 196 After modifying this list you must run \\[mm-uu-configure].")
 197
 198 (defcustom mm-uu-configure-list '((shar . disabled))
 199   "A list of mm-uu configuration.
 200 To disable dissecting shar codes, for instance, add
 201 `(shar . disabled)' to this list."
 202   :type 'alist
 203   :options (mapcar (lambda (entry)
 204                      (list (car entry) '(const disabled)))
 205                    mm-uu-type-alist)
 206   :group 'gnus-article-mime)
 207
 208 (defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded))
 209   "MIME type and parameters for text/plain parts.
 210 `gnus-decoded' is a fake charset, which means no further decoding.")
 211
 212 ;; functions
 213
 214 (defsubst mm-uu-type (entry)
 215   (car entry))
 216
 217 (defsubst mm-uu-beginning-regexp (entry)
 218   (nth 1 entry))
 219
 220 (defsubst mm-uu-end-regexp (entry)
 221   (nth 2 entry))
 222
 223 (defsubst mm-uu-function-extract (entry)
 224   (nth 3 entry))
 225
 226 (defsubst mm-uu-function-1 (entry)
 227   (nth 4 entry))
 228
 229 (defsubst mm-uu-function-2 (entry)
 230   (nth 5 entry))
 231
 232 ;; In Emacs 22, we could use `min-colors' in the face definition.  But Emacs
 233 ;; 21 and XEmacs don't support it.
 234 (defcustom mm-uu-hide-markers
 235   (< 16 (or (and (fboundp 'defined-colors)
 236                  (length (defined-colors)))
 237             (and (fboundp 'device-color-cells)
 238                  (device-color-cells))
 239             0))
 240   "If non-nil, hide verbatim markers.
 241 The value should be nil on displays where the face
 242 `mm-uu-extract' isn't distinguishable to the face `default'."
 243   :type '(choice (const :tag "Hide" t)
 244                  (const :tag "Don't hide" nil))
 245   :version "23.0" ;; No Gnus
 246   :group 'gnus-article-mime)
 247
 248 (defface mm-uu-extract '(;; Colors from `gnus-cite-3' plus background:
 249                          (((class color)
 250                            (background dark))
 251                           (:foreground "light yellow"
 252                            :background "dark green"))
 253                          (((class color)
 254                            (background light))
 255                           (:foreground "dark green"
 256                            :background "light yellow"))
 257                          (t
 258                           ()))
 259   "Face for extracted buffers."
 260   ;; See `mm-uu-verbatim-marks-extract'.
 261   :version "23.0" ;; No Gnus
 262   :group 'gnus-article-mime)
 263
 264 (defun mm-uu-copy-to-buffer (&optional from to properties)
 265   "Copy the contents of the current buffer to a fresh buffer.
 266 Return that buffer.
 267
 268 If PROPERTIES is non-nil, PROPERTIES are applied to the buffer,
 269 see `set-text-properties'.  If PROPERTIES equals t, this means to
 270 apply the face `mm-uu-extract'."
 271   (let ((obuf (current-buffer))
 272         (coding-system
 273          ;; Might not exist in non-MULE XEmacs
 274          (when (boundp 'buffer-file-coding-system)
 275            buffer-file-coding-system)))
 276     (with-current-buffer (generate-new-buffer " *mm-uu*")
 277       (setq buffer-file-coding-system coding-system)
 278       (insert-buffer-substring obuf from to)
 279       (cond ((eq properties  t)
 280              (set-text-properties (point-min) (point-max)
 281                                   '(face mm-uu-extract)))
 282             (properties
 283              (set-text-properties (point-min) (point-max) properties)))
 284       (current-buffer))))
 285
 286 (defun mm-uu-configure-p  (key val)
 287   (member (cons key val) mm-uu-configure-list))
 288
 289 (defun mm-uu-configure (&optional symbol value)
 290   "Configure detection of non-MIME attachments."
 291   (interactive)
 292   (if symbol (set-default symbol value))
 293   (setq mm-uu-beginning-regexp nil)
 294   (mapcar (lambda (entry)
 295              (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
 296                  nil
 297                (setq mm-uu-beginning-regexp
 298                      (concat mm-uu-beginning-regexp
 299                              (if mm-uu-beginning-regexp "\\|")
 300                              (mm-uu-beginning-regexp entry)))))
 301           mm-uu-type-alist))
 302
 303 (mm-uu-configure)
 304
 305 (eval-when-compile
 306   (defvar file-name)
 307   (defvar start-point)
 308   (defvar end-point)
 309   (defvar entry))
 310
 311 (defun mm-uu-uu-filename ()
 312   (if (looking-at ".+")
 313       (setq file-name
 314             (let ((nnheader-file-name-translation-alist
 315                    '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
 316               (nnheader-translate-file-chars (match-string 0))))))
 317
 318 (defun mm-uu-binhex-filename ()
 319   (setq file-name
 320         (ignore-errors
 321           (binhex-decode-region start-point end-point t))))
 322
 323 (defun mm-uu-yenc-filename ()
 324   (goto-char start-point)
 325   (setq file-name
 326         (ignore-errors
 327           (yenc-extract-filename))))
 328
 329 (defun mm-uu-forward-test ()
 330   (save-excursion
 331     (goto-char start-point)
 332     (forward-line)
 333     (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
 334
 335 (defun mm-uu-postscript-extract ()
 336   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 337                   '("application/postscript")))
 338
 339 (defun mm-uu-verbatim-marks-extract (start-offset end-offset
 340                                                   &optional
 341                                                   start-hide
 342                                                   end-hide)
 343   (let ((start (or (and mm-uu-hide-markers
 344                         start-hide)
 345                    start-offset
 346                    1))
 347         (end   (or (and mm-uu-hide-markers
 348                         end-hide)
 349                    end-offset
 350                    -1)))
 351     (mm-make-handle
 352      (mm-uu-copy-to-buffer
 353       (progn (goto-char start-point)
 354              (forward-line start)
 355              (point))
 356       (progn (goto-char end-point)
 357            (forward-line end)
 358            (point))
 359       t)
 360      '("text/x-verbatim" (charset . gnus-decoded)))))
 361
 362 (defun mm-uu-latex-extract ()
 363   (mm-make-handle
 364    (mm-uu-copy-to-buffer start-point end-point t)
 365    ;; application/x-tex?
 366    '("text/x-verbatim" (charset . gnus-decoded))))
 367
 368 (defun mm-uu-emacs-sources-extract ()
 369   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 370                   '("application/emacs-lisp")
 371                   nil nil
 372                   (list mm-dissect-disposition
 373                         (cons 'filename file-name))))
 374
 375 (eval-when-compile
 376   (defvar gnus-newsgroup-name))
 377
 378 (defun mm-uu-emacs-sources-test ()
 379   (setq file-name (match-string 1))
 380   (and gnus-newsgroup-name
 381        mm-uu-emacs-sources-regexp
 382        (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name)))
 383
 384 (defun mm-uu-diff-extract ()
 385   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 386                   '("text/x-patch")))
 387
 388 (defun mm-uu-diff-test ()
 389   (and gnus-newsgroup-name
 390        mm-uu-diff-groups-regexp
 391        (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
 392
 393 (defun mm-uu-latex-test ()
 394   (and gnus-newsgroup-name
 395        mm-uu-tex-groups-regexp
 396        (string-match mm-uu-tex-groups-regexp gnus-newsgroup-name)))
 397
 398 (defun mm-uu-forward-extract ()
 399   (mm-make-handle (mm-uu-copy-to-buffer
 400                    (progn (goto-char start-point) (forward-line) (point))
 401                    (progn (goto-char end-point) (forward-line -1) (point)))
 402                   '("message/rfc822" (charset . gnus-decoded))))
 403
 404 (defun mm-uu-uu-extract ()
 405   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 406                   (list (or (and file-name
 407                                  (string-match "\\.[^\\.]+$"
 408                                                file-name)
 409                                  (mailcap-extension-to-mime
 410                                   (match-string 0 file-name)))
 411                             "application/octet-stream"))
 412                   'x-uuencode nil
 413                   (if (and file-name (not (equal file-name "")))
 414                       (list mm-dissect-disposition
 415                             (cons 'filename file-name)))))
 416
 417 (defun mm-uu-binhex-extract ()
 418   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 419                   (list (or (and file-name
 420                                  (string-match "\\.[^\\.]+$" file-name)
 421                                  (mailcap-extension-to-mime
 422                                   (match-string 0 file-name)))
 423                             "application/octet-stream"))
 424                   'x-binhex nil
 425                   (if (and file-name (not (equal file-name "")))
 426                       (list mm-dissect-disposition
 427                             (cons 'filename file-name)))))
 428
 429 (defun mm-uu-yenc-extract ()
 430   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 431                   (list (or (and file-name
 432                                  (string-match "\\.[^\\.]+$" file-name)
 433                                  (mailcap-extension-to-mime
 434                                   (match-string 0 file-name)))
 435                             "application/octet-stream"))
 436                   'x-yenc nil
 437                   (if (and file-name (not (equal file-name "")))
 438                       (list mm-dissect-disposition
 439                             (cons 'filename file-name)))))
 440
 441
 442 (defun mm-uu-shar-extract ()
 443   (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
 444                   '("application/x-shar")))
 445
 446 (defun mm-uu-gnatsweb-extract ()
 447   (save-restriction
 448     (goto-char start-point)
 449     (forward-line)
 450     (narrow-to-region (point) end-point)
 451     (mm-dissect-buffer t)))
 452
 453 (defun mm-uu-pgp-signed-test (&rest rest)
 454   (and
 455    mml2015-use
 456    (mml2015-clear-verify-function)
 457    (cond
 458     ((eq mm-verify-option 'never) nil)
 459     ((eq mm-verify-option 'always) t)
 460     ((eq mm-verify-option 'known) t)
 461     (t (y-or-n-p "Verify pgp signed part? ")))))
 462
 463 (eval-when-compile
 464   (defvar gnus-newsgroup-charset))
 465
 466 (defun mm-uu-pgp-signed-extract-1 (handles ctl)
 467   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
 468     (with-current-buffer buf
 469       (if (mm-uu-pgp-signed-test)
 470           (progn
 471             (mml2015-clean-buffer)
 472             (let ((coding-system-for-write (or gnus-newsgroup-charset
 473                                                'iso-8859-1)))
 474               (funcall (mml2015-clear-verify-function))))
 475         (when (and mml2015-use (null (mml2015-clear-verify-function)))
 476           (mm-set-handle-multipart-parameter
 477            mm-security-handle 'gnus-details
 478            (format "Clear verification not supported by `%s'.\n" mml2015-use))))
 479       (goto-char (point-min))
 480       (if (search-forward "\n\n" nil t)
 481           (delete-region (point-min) (point)))
 482       (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
 483           (delete-region (match-beginning 0) (point-max)))
 484       (goto-char (point-min))
 485       (while (re-search-forward "^- " nil t)
 486         (replace-match "" t t)
 487         (forward-line 1)))
 488     (list (mm-make-handle buf mm-uu-text-plain-type))))
 489
 490 (defun mm-uu-pgp-signed-extract ()
 491   (let ((mm-security-handle (list (format "multipart/signed"))))
 492     (mm-set-handle-multipart-parameter
 493      mm-security-handle 'protocol "application/x-gnus-pgp-signature")
 494     (save-restriction
 495       (narrow-to-region start-point end-point)
 496       (add-text-properties 0 (length (car mm-security-handle))
 497                            (list 'buffer (mm-uu-copy-to-buffer))
 498                            (car mm-security-handle))
 499       (setcdr mm-security-handle
 500               (mm-uu-pgp-signed-extract-1 nil
 501                                           mm-security-handle)))
 502     mm-security-handle))
 503
 504 (defun mm-uu-pgp-encrypted-test (&rest rest)
 505   (and
 506    mml2015-use
 507    (mml2015-clear-decrypt-function)
 508    (cond
 509     ((eq mm-decrypt-option 'never) nil)
 510     ((eq mm-decrypt-option 'always) t)
 511     ((eq mm-decrypt-option 'known) t)
 512     (t (y-or-n-p "Decrypt pgp encrypted part? ")))))
 513
 514 (defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
 515   (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
 516     (if (mm-uu-pgp-encrypted-test)
 517         (with-current-buffer buf
 518           (mml2015-clean-buffer)
 519           (funcall (mml2015-clear-decrypt-function))))
 520     (list (mm-make-handle buf mm-uu-text-plain-type))))
 521
 522 (defun mm-uu-pgp-encrypted-extract ()
 523   (let ((mm-security-handle (list (format "multipart/encrypted"))))
 524     (mm-set-handle-multipart-parameter
 525      mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
 526     (save-restriction
 527       (narrow-to-region start-point end-point)
 528       (add-text-properties 0 (length (car mm-security-handle))
 529                            (list 'buffer (mm-uu-copy-to-buffer))
 530                            (car mm-security-handle))
 531       (setcdr mm-security-handle
 532               (mm-uu-pgp-encrypted-extract-1 nil
 533                                              mm-security-handle)))
 534     mm-security-handle))
 535
 536 (defun mm-uu-gpg-key-skip-to-last ()
 537   (let ((point (point))
 538         (end-regexp (mm-uu-end-regexp entry))
 539         (beginning-regexp (mm-uu-beginning-regexp entry)))
 540     (when (and end-regexp
 541                (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
 542       (while (re-search-forward end-regexp nil t)
 543         (skip-chars-forward " \t\n\r")
 544         (if (looking-at beginning-regexp)
 545             (setq point (match-end 0)))))
 546     (goto-char point)))
 547
 548 (defun mm-uu-pgp-key-extract ()
 549   (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
 550     (mm-make-handle buf
 551                     '("application/pgp-keys"))))
 552
 553 ;;;###autoload
 554 (defun mm-uu-dissect (&optional noheader mime-type)
 555   "Dissect the current buffer and return a list of uu handles.
 556 The optional NOHEADER means there's no header in the buffer.
 557 MIME-TYPE specifies a MIME type and parameters, which defaults to the
 558 value of `mm-uu-text-plain-type'."
 559   (let ((case-fold-search t)
 560         (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type))
 561         text-start start-point end-point file-name result entry func)
 562     (save-excursion
 563       (goto-char (point-min))
 564       (cond
 565        (noheader)
 566        ((looking-at "\n")
 567         (forward-line))
 568        ((search-forward "\n\n" nil t)
 569         t)
 570        (t (goto-char (point-max))))
 571       (setq text-start (point))
 572       (while (re-search-forward mm-uu-beginning-regexp nil t)
 573         (setq start-point (match-beginning 0))
 574         (let ((alist mm-uu-type-alist)
 575               (beginning-regexp (match-string 0)))
 576           (while (not entry)
 577             (if (string-match (mm-uu-beginning-regexp (car alist))
 578                               beginning-regexp)
 579                 (setq entry (car alist))
 580               (pop alist))))
 581         (if (setq func (mm-uu-function-1 entry))
 582             (funcall func))
 583         (forward-line);; in case of failure
 584         (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
 585                    (let ((end-regexp (mm-uu-end-regexp entry)))
 586                      (if (not end-regexp)
 587                          (or (setq end-point (point-max)) t)
 588                        (prog1
 589                            (re-search-forward end-regexp nil t)
 590                          (forward-line)
 591                          (setq end-point (point)))))
 592                    (or (not (setq func (mm-uu-function-2 entry)))
 593                        (funcall func)))
 594           (if (and (> start-point text-start)
 595                    (progn
 596                      (goto-char text-start)
 597                      (re-search-forward "." start-point t)))
 598               (push
 599                (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
 600                                mm-uu-text-plain-type)
 601                result))
 602           (push
 603            (funcall (mm-uu-function-extract entry))
 604            result)
 605           (goto-char (setq text-start end-point))))
 606       (when result
 607         (if (and (> (point-max) (1+ text-start))
 608                  (save-excursion
 609                    (goto-char text-start)
 610                    (re-search-forward "." nil t)))
 611             (push
 612              (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
 613                              mm-uu-text-plain-type)
 614              result))
 615         (setq result (cons "multipart/mixed" (nreverse result))))
 616       result)))
 617
 618 (defun mm-uu-dissect-text-parts (handle)
 619   "Dissect text parts and put uu handles into HANDLE."
 620   (let ((buffer (mm-handle-buffer handle))
 621         type children)
 622     (cond ((stringp buffer)
 623            (mapc 'mm-uu-dissect-text-parts (cdr handle)))
 624           ((bufferp buffer)
 625            (when (and (setq type (mm-handle-media-type handle))
 626                       (stringp type)
 627                       (string-match "\\`text/" type)
 628                       (with-current-buffer buffer
 629                         (setq children
 630                               (mm-uu-dissect t (mm-handle-type handle)))))
 631              (kill-buffer buffer)
 632              (setcar handle (car children))
 633              (setcdr handle (cdr children))))
 634           (t
 635            (mapc 'mm-uu-dissect-text-parts handle)))))
 636
 637 (provide 'mm-uu)
 638
 639 ;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
 640 ;;; mm-uu.el ends here