diff lisp/gnus/mm-uu.el @ 89971:cce1c0ee76ee

Revision: [e-mail]--gnu-2004/emacs--unicode--0--patch-36 Merge from emacs--cvs-trunk--0, emacs--gnus--5.10, gnus--rel--5.10 Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-523 Merge from emacs--gnus--5.10, gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-524 - [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-534 Update from CVS * [e-mail]--gnu-2004/emacs--gnus--5.10--base-0 tag of [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-464 * [e-mail]--gnu-2004/emacs--gnus--5.10--patch-1 Import from CVS branch gnus-5_10-branch * [e-mail]--gnu-2004/emacs--gnus--5.10--patch-2 Merge from [e-mail]--2004/emacs--multi-tty--0, emacs--cvs-trunk--0 * [e-mail]--gnu-2004/emacs--gnus--5.10--patch-3 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/emacs--gnus--5.10--patch-4 Merge from gnus--rel--5.10 * [e-mail]--gnu-2004/gnus--rel--5.10--patch-18 Update from CVS * [e-mail]--gnu-2004/gnus--rel--5.10--patch-19 Remove autoconf-generated files from archive * [e-mail]--gnu-2004/gnus--rel--5.10--patch-20 Update from CVS

--- a/lisp/gnus/mm-uu.el	Sun Sep 05 01:53:47 2004 +0000
+++ b/lisp/gnus/mm-uu.el	Thu Sep 09 09:36:36 2004 +0000
@@ -1,8 +1,8 @@
-;;; mm-uu.el --- return uu stuff as mm handles
-;; Copyright (c) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+;;; mm-uu.el --- Return uu stuff as mm handles
+;; Copyright (c) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <[e-mail]>
-;; Keywords: postscript uudecode binhex shar forward news
+;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
 
 ;; This file is part of GNU Emacs.
 
@@ -30,194 +30,462 @@
 (require 'nnheader)
 (require 'mm-decode)
 (require 'mailcap)
-(require 'uudecode)
-(require 'binhex)
+(require 'mml2015)
 
-(defun mm-uu-copy-to-buffer (from to)
-  "Copy the contents of the current buffer to a fresh buffer.
-Return that buffer."
-  (save-excursion
-    (let ((obuf (current-buffer)))
-      (set-buffer (generate-new-buffer " *mm-uu*"))
-      (insert-buffer-substring obuf from to)
-      (current-buffer))))
+(autoload 'uudecode-decode-region "uudecode")
+(autoload 'uudecode-decode-region-external "uudecode")
+(autoload 'uudecode-decode-region-internal "uudecode")
 
-;;; postscript
-
-(defconst mm-uu-postscript-begin-line "^%!PS-")
-(defconst mm-uu-postscript-end-line "^%%EOF$")
+(autoload 'binhex-decode-region "binhex")
+(autoload 'binhex-decode-region-external "binhex")
+(autoload 'binhex-decode-region-internal "binhex")
 
-(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+")
-(defconst mm-uu-uu-end-line "^end[ \t]*$")
+(autoload 'yenc-decode-region "yenc")
+(autoload 'yenc-extract-filename "yenc")
 
-;; This is not the right place for this.  uudecode.el should decide
-;; whether or not to use a program with a single interface, but I
-;; guess it's too late now.  Also the default should depend on a test
-;; for the program.  -- fx
 (defcustom mm-uu-decode-function 'uudecode-decode-region
   "*Function to uudecode.
 Internal function is done in Lisp by default, therefore decoding may
 appear to be horribly slow.  You can make Gnus use an external
 decoder, such as uudecode."
   :type '(choice
-	  (function-item :tag "Internal" uudecode-decode-region)
+	  (function-item :tag "Auto detect" uudecode-decode-region)
+	  (function-item :tag "Internal" uudecode-decode-region-internal)
 	  (function-item :tag "External" uudecode-decode-region-external))
   :group 'gnus-article-mime)
 
-(defconst mm-uu-binhex-begin-line
-  "^:...............................................................$")
-(defconst mm-uu-binhex-end-line ":$")
-
 (defcustom mm-uu-binhex-decode-function 'binhex-decode-region
   "*Function to binhex decode.
-Internal function is done in Lisp by default, therefore decoding may
-appear to be horribly slow.  You can make Gnus use an external
+Internal function is done in elisp by default, therefore decoding may
+appear to be horribly slow . You can make Gnus use the external Unix
 decoder, such as hexbin."
-  :type '(choice
-	  (function-item :tag "Internal" binhex-decode-region)
-	  (function-item :tag "External" binhex-decode-region-external))
+  :type '(choice (function-item :tag "Auto detect" binhex-decode-region)
+		 (function-item :tag "Internal" binhex-decode-region-internal)
+		 (function-item :tag "External" binhex-decode-region-external))
   :group 'gnus-article-mime)
 
-(defconst mm-uu-shar-begin-line "^#! */bin/sh")
-(defconst mm-uu-shar-end-line "^exit 0\\|^$")
+(defvar mm-uu-yenc-decode-function 'yenc-decode-region)
 
-;;; Thanks to Edward J. Sabol <[e-mail]> and
-;;; Peter von der Ah\'e <[e-mail]>
-(defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")
-(defconst mm-uu-forward-end-line "^-+ End \\(of \\)?forwarded message")
+(defvar mm-uu-pgp-beginning-signature
+     "^-----BEGIN PGP SIGNATURE-----")
 
-(defvar mm-uu-begin-line nil)
-
-(defconst mm-uu-identifier-alist
-  '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)
-    (?- . forward)))
+(defvar mm-uu-beginning-regexp nil)
 
 (defvar mm-dissect-disposition "inline"
   "The default disposition of uu parts.
 This can be either \"inline\" or \"attachment\".")
 
+(defvar mm-uu-emacs-sources-regexp "gnu\\.emacs\\.sources"
+  "The regexp of Emacs sources groups.")
+
+(defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
+  "*Regexp matching diff groups."
+  :type 'regexp
+  :group 'gnus-article-mime)
+
+(defvar mm-uu-type-alist
+  '((postscript
+     "^%!PS-"
+     "^%%EOF$"
+     mm-uu-postscript-extract
+     nil)
+    (uu
+     "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
+     "^end[ \t]*$"
+     mm-uu-uu-extract
+     mm-uu-uu-filename)
+    (binhex
+     "^:...............................................................$"
+     ":$"
+     mm-uu-binhex-extract
+     nil
+     mm-uu-binhex-filename)
+    (yenc
+     "^=ybegin.*size=[0-9]+.*name=.*$"
+     "^=yend.*size=[0-9]+"
+     mm-uu-yenc-extract
+     mm-uu-yenc-filename)
+    (shar
+     "^#! */bin/sh"
+     "^exit 0$"
+     mm-uu-shar-extract)
+    (forward
+;;; Thanks to Edward J. Sabol <[e-mail]> and
+;;; Peter von der Ah\'e <[e-mail]>
+     "^-+ \\(Start of \\)?Forwarded message"
+     "^-+ End \\(of \\)?forwarded message"
+     mm-uu-forward-extract
+     nil
+     mm-uu-forward-test)
+    (gnatsweb
+     "^----gnatsweb-attachment----"
+     nil
+     mm-uu-gnatsweb-extract)
+    (pgp-signed
+     "^-----BEGIN PGP SIGNED MESSAGE-----"
+     "^-----END PGP SIGNATURE-----"
+     mm-uu-pgp-signed-extract
+     nil
+     nil)
+    (pgp-encrypted
+     "^-----BEGIN PGP MESSAGE-----"
+     "^-----END PGP MESSAGE-----"
+     mm-uu-pgp-encrypted-extract
+     nil
+     nil)
+    (pgp-key
+     "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
+     "^-----END PGP PUBLIC KEY BLOCK-----"
+     mm-uu-pgp-key-extract
+     mm-uu-gpg-key-skip-to-last
+     nil)
+    (emacs-sources
+     "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
+     "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
+     mm-uu-emacs-sources-extract
+     nil
+     mm-uu-emacs-sources-test)
+    (diff
+     "^Index: "
+     nil
+     mm-uu-diff-extract
+     nil
+     mm-uu-diff-test)))
+
+(defcustom mm-uu-configure-list '((shar . disabled))
+  "A list of mm-uu configuration.
+To disable dissecting shar codes, for instance, add
+`(shar . disabled)' to this list."
+  :type 'alist
+  :options (mapcar (lambda (entry)
+		     (list (car entry) '(const disabled)))
+		   mm-uu-type-alist)
+  :group 'gnus-article-mime)
+
+;; functions
+
+(defsubst mm-uu-type (entry)
+  (car entry))
+
+(defsubst mm-uu-beginning-regexp (entry)
+  (nth 1 entry))
+
+(defsubst mm-uu-end-regexp (entry)
+  (nth 2 entry))
+
+(defsubst mm-uu-function-extract (entry)
+  (nth 3 entry))
+
+(defsubst mm-uu-function-1 (entry)
+  (nth 4 entry))
+
+(defsubst mm-uu-function-2 (entry)
+  (nth 5 entry))
+
+(defun mm-uu-copy-to-buffer (&optional from to)
+  "Copy the contents of the current buffer to a fresh buffer.
+Return that buffer."
+  (save-excursion
+    (let ((obuf (current-buffer))
+	  (coding-system
+	   ;; Might not exist in non-MULE XEmacs
+	   (when (boundp 'buffer-file-coding-system)
+	     buffer-file-coding-system)))
+      (set-buffer (generate-new-buffer " *mm-uu*"))
+      (setq buffer-file-coding-system coding-system)
+      (insert-buffer-substring obuf from to)
+      (current-buffer))))
+
 (defun mm-uu-configure-p  (key val)
   (member (cons key val) mm-uu-configure-list))
 
 (defun mm-uu-configure (&optional symbol value)
   (if symbol (set-default symbol value))
-  (setq mm-uu-begin-line nil)
-  (mapcar (lambda (type)
-	    (if (mm-uu-configure-p type 'disabled)
-		nil
-	      (setq mm-uu-begin-line
-		    (concat mm-uu-begin-line
-			    (if mm-uu-begin-line "\\|")
-			    (symbol-value
-			     (intern (concat "mm-uu-" (symbol-name type)
-					     "-begin-line")))))))
-	  '(uu postscript binhex shar forward)))
-
-;; Needs to come after mm-uu-configure.
-(defcustom mm-uu-configure-list nil
-  "Alist of mm-uu configurations to disable.
-To disable dissecting shar codes, for instance, add
-`(shar . disabled)' to this list."
-  :type '(repeat (choice (const :tag "postscript" (postscript . disabled))
-			 (const :tag "uu" (uu . disabled))
-			 (const :tag "binhex" (binhex . disabled))
-			 (const :tag "shar" (shar . disabled))
-			 (const :tag "forward" (forward . disabled))))
-  :group 'gnus-article-mime
-  :set 'mm-uu-configure)
+  (setq mm-uu-beginning-regexp nil)
+  (mapcar (lambda (entry)
+	     (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
+		 nil
+	       (setq mm-uu-beginning-regexp
+		     (concat mm-uu-beginning-regexp
+			     (if mm-uu-beginning-regexp "\\|")
+			     (mm-uu-beginning-regexp entry)))))
+	  mm-uu-type-alist))
 
 (mm-uu-configure)
 
+(eval-when-compile
+  (defvar file-name)
+  (defvar start-point)
+  (defvar end-point)
+  (defvar entry))
+
+(defun mm-uu-uu-filename ()
+  (if (looking-at ".+")
+      (setq file-name
+	    (let ((nnheader-file-name-translation-alist
+		   '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
+	      (nnheader-translate-file-chars (match-string 0))))))
+
+(defun mm-uu-binhex-filename ()
+  (setq file-name
+	(ignore-errors
+	  (binhex-decode-region start-point end-point t))))
+
+(defun mm-uu-yenc-filename ()
+  (goto-char start-point)
+  (setq file-name
+	(ignore-errors
+	  (yenc-extract-filename))))
+
+(defun mm-uu-forward-test ()
+  (save-excursion
+    (goto-char start-point)
+    (forward-line)
+    (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
+
+(defun mm-uu-postscript-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+		  '("application/postscript")))
+
+(defun mm-uu-emacs-sources-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+		  '("application/emacs-lisp")
+		  nil nil
+		  (list mm-dissect-disposition
+			(cons 'filename file-name))))
+
+(eval-when-compile
+  (defvar gnus-newsgroup-name))
+
+(defun mm-uu-emacs-sources-test ()
+  (setq file-name (match-string 1))
+  (and gnus-newsgroup-name
+       mm-uu-emacs-sources-regexp
+       (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name)))
+
+(defun mm-uu-diff-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+		  '("text/x-patch")))
+
+(defun mm-uu-diff-test ()
+  (and gnus-newsgroup-name
+       mm-uu-diff-groups-regexp
+       (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
+
+(defun mm-uu-forward-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer
+		   (progn (goto-char start-point) (forward-line) (point))
+		   (progn (goto-char end-point) (forward-line -1) (point)))
+		  '("message/rfc822" (charset . gnus-decoded))))
+
+(defun mm-uu-uu-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+		  (list (or (and file-name
+				 (string-match "\\.[^\\.]+$"
+					       file-name)
+				 (mailcap-extension-to-mime
+				  (match-string 0 file-name)))
+			    "application/octet-stream"))
+		  'x-uuencode nil
+		  (if (and file-name (not (equal file-name "")))
+		      (list mm-dissect-disposition
+			    (cons 'filename file-name)))))
+
+(defun mm-uu-binhex-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+		  (list (or (and file-name
+				 (string-match "\\.[^\\.]+$" file-name)
+				 (mailcap-extension-to-mime
+				  (match-string 0 file-name)))
+			    "application/octet-stream"))
+		  'x-binhex nil
+		  (if (and file-name (not (equal file-name "")))
+		      (list mm-dissect-disposition
+			    (cons 'filename file-name)))))
+
+(defun mm-uu-yenc-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+		  (list (or (and file-name
+				 (string-match "\\.[^\\.]+$" file-name)
+				 (mailcap-extension-to-mime
+				  (match-string 0 file-name)))
+			    "application/octet-stream"))
+		  'x-yenc nil
+		  (if (and file-name (not (equal file-name "")))
+		      (list mm-dissect-disposition
+			    (cons 'filename file-name)))))
+
+
+(defun mm-uu-shar-extract ()
+  (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
+		  '("application/x-shar")))
+
+(defun mm-uu-gnatsweb-extract ()
+  (save-restriction
+    (goto-char start-point)
+    (forward-line)
+    (narrow-to-region (point) end-point)
+    (mm-dissect-buffer t)))
+
+(defun mm-uu-pgp-signed-test (&rest rest)
+  (and
+   mml2015-use
+   (mml2015-clear-verify-function)
+   (cond
+    ((eq mm-verify-option 'never) nil)
+    ((eq mm-verify-option 'always) t)
+    ((eq mm-verify-option 'known) t)
+    (t (y-or-n-p "Verify pgp signed part? ")))))
+
+(eval-when-compile
+  (defvar gnus-newsgroup-charset))
+
+(defun mm-uu-pgp-signed-extract-1 (handles ctl)
+  (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
+    (with-current-buffer buf
+      (if (mm-uu-pgp-signed-test)
+	  (progn
+	    (mml2015-clean-buffer)
+	    (let ((coding-system-for-write (or gnus-newsgroup-charset
+					       'iso-8859-1)))
+	      (funcall (mml2015-clear-verify-function))))
+	(when (and mml2015-use (null (mml2015-clear-verify-function)))
+	  (mm-set-handle-multipart-parameter
+	   mm-security-handle 'gnus-details
+	   (format "Clear verification not supported by `%s'.\n" mml2015-use))))
+      (goto-char (point-min))
+      (if (search-forward "\n\n" nil t)
+	  (delete-region (point-min) (point)))
+      (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
+	  (delete-region (match-beginning 0) (point-max)))
+      (goto-char (point-min))
+      (while (re-search-forward "^- " nil t)
+	(replace-match "" t t)
+	(forward-line 1)))
+    (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded))))))
+
+(defun mm-uu-pgp-signed-extract ()
+  (let ((mm-security-handle (list (format "multipart/signed"))))
+    (mm-set-handle-multipart-parameter
+     mm-security-handle 'protocol "application/x-gnus-pgp-signature")
+    (save-restriction
+      (narrow-to-region start-point end-point)
+      (add-text-properties 0 (length (car mm-security-handle))
+			   (list 'buffer (mm-uu-copy-to-buffer))
+			   (car mm-security-handle))
+      (setcdr mm-security-handle
+	      (mm-uu-pgp-signed-extract-1 nil
+					  mm-security-handle)))
+    mm-security-handle))
+
+(defun mm-uu-pgp-encrypted-test (&rest rest)
+  (and
+   mml2015-use
+   (mml2015-clear-decrypt-function)
+   (cond
+    ((eq mm-decrypt-option 'never) nil)
+    ((eq mm-decrypt-option 'always) t)
+    ((eq mm-decrypt-option 'known) t)
+    (t (y-or-n-p "Decrypt pgp encrypted part? ")))))
+
+(defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
+  (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
+    (if (mm-uu-pgp-encrypted-test)
+	(with-current-buffer buf
+	  (mml2015-clean-buffer)
+	  (funcall (mml2015-clear-decrypt-function))))
+    (list
+     (mm-make-handle buf
+		     '("text/plain"  (charset . gnus-decoded))))))
+
+(defun mm-uu-pgp-encrypted-extract ()
+  (let ((mm-security-handle (list (format "multipart/encrypted"))))
+    (mm-set-handle-multipart-parameter
+     mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
+    (save-restriction
+      (narrow-to-region start-point end-point)
+      (add-text-properties 0 (length (car mm-security-handle))
+			   (list 'buffer (mm-uu-copy-to-buffer))
+			   (car mm-security-handle))
+      (setcdr mm-security-handle
+	      (mm-uu-pgp-encrypted-extract-1 nil
+					     mm-security-handle)))
+    mm-security-handle))
+
+(defun mm-uu-gpg-key-skip-to-last ()
+  (let ((point (point))
+	(end-regexp (mm-uu-end-regexp entry))
+	(beginning-regexp (mm-uu-beginning-regexp entry)))
+    (when (and end-regexp
+	       (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
+      (while (re-search-forward end-regexp nil t)
+	(skip-chars-forward " \t\n\r")
+	(if (looking-at beginning-regexp)
+	    (setq point (match-end 0)))))
+    (goto-char point)))
+
+(defun mm-uu-pgp-key-extract ()
+  (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
+    (mm-make-handle buf
+		    '("application/pgp-keys"))))
+
 ;;;###autoload
 (defun mm-uu-dissect ()
   "Dissect the current buffer and return a list of uu handles."
-  (let (text-start start-char end-char
-		   type file-name end-line result text-plain-type
-		   start-char-1 end-char-1
-		   (case-fold-search t))
+  (let ((case-fold-search t)
+	text-start start-point end-point file-name result
+	text-plain-type entry func)
     (save-excursion
-      (save-restriction
-	(mail-narrow-to-head)
-	(goto-char (point-max)))
-      (forward-line)
+      (goto-char (point-min))
+      (cond
+       ((looking-at "\n")
+	(forward-line))
+       ((search-forward "\n\n" nil t)
+	t)
+       (t (goto-char (point-max))))
       ;;; gnus-decoded is a fake charset, which means no further
       ;;; decoding.
       (setq text-start (point)
 	    text-plain-type '("text/plain"  (charset . gnus-decoded)))
-      (while (re-search-forward mm-uu-begin-line nil t)
-	(setq start-char (match-beginning 0))
-	(setq type (cdr (assq (aref (match-string 0) 0)
-			      mm-uu-identifier-alist)))
-	(setq file-name
-	      (if (and (eq type 'uu)
-		       (looking-at "\\(.+\\)$"))
-		  (and (match-string 1)
-		       (let ((nnheader-file-name-translation-alist
-			      '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
-			 (nnheader-translate-file-chars (match-string 1))))))
+      (while (re-search-forward mm-uu-beginning-regexp nil t)
+	(setq start-point (match-beginning 0))
+	(let ((alist mm-uu-type-alist)
+	      (beginning-regexp (match-string 0)))
+	  (while (not entry)
+	    (if (string-match (mm-uu-beginning-regexp (car alist))
+			      beginning-regexp)
+		(setq entry (car alist))
+	      (pop alist))))
+	(if (setq func (mm-uu-function-1 entry))
+	    (funcall func))
 	(forward-line);; in case of failure
-	(setq start-char-1 (point))
-	(setq end-line (symbol-value
-			(intern (concat "mm-uu-" (symbol-name type)
-					"-end-line"))))
-	(when (and (re-search-forward end-line nil t)
-		   (not (eq (match-beginning 0) (match-end 0))))
-	  (setq end-char-1 (match-beginning 0))
-	  (forward-line)
-	  (setq end-char (point))
-	  (when (cond
-		 ((eq type 'binhex)
-		  (setq file-name
-			(ignore-errors
-			  (binhex-decode-region start-char end-char t))))
-		 ((eq type 'forward)
-		  (save-excursion
-		    (goto-char start-char-1)
-		    (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
-		 (t t))
-	    (if (> start-char text-start)
-		(push
-		 (mm-make-handle (mm-uu-copy-to-buffer text-start start-char)
-				 text-plain-type)
-		 result))
-	    (push
-	     (cond
-	      ((eq type 'postscript)
-	       (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
-			       '("application/postscript")))
-	      ((eq type 'forward)
-	       (mm-make-handle (mm-uu-copy-to-buffer start-char-1 end-char-1)
-			       '("message/rfc822" (charset . gnus-decoded))))
-	      ((eq type 'uu)
-	       (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
-			       (list (or (and file-name
-					      (string-match "\\.[^\\.]+$"
-							    file-name)
-					      (mailcap-extension-to-mime
-					       (match-string 0 file-name)))
-					 "application/octet-stream"))
-			       'x-uuencode nil
-			       (if (and file-name (not (equal file-name "")))
-				   (list mm-dissect-disposition
-					 (cons 'filename file-name)))))
-	      ((eq type 'binhex)
-	       (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
-			       (list (or (and file-name
-					      (string-match "\\.[^\\.]+$" file-name)
-					      (mailcap-extension-to-mime
-					       (match-string 0 file-name)))
-					 "application/octet-stream"))
-			       'x-binhex nil
-			       (if (and file-name (not (equal file-name "")))
-				   (list mm-dissect-disposition
-					 (cons 'filename file-name)))))
-	      ((eq type 'shar)
-	       (mm-make-handle (mm-uu-copy-to-buffer start-char end-char)
-			       '("application/x-shar"))))
-	     result)
-	    (setq text-start end-char))))
+	(when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
+		   (let ((end-regexp (mm-uu-end-regexp entry)))
+		     (if (not end-regexp)
+			 (or (setq end-point (point-max)) t)
+		       (prog1
+			   (re-search-forward end-regexp nil t)
+			 (forward-line)
+			 (setq end-point (point)))))
+		   (or (not (setq func (mm-uu-function-2 entry)))
+		       (funcall func)))
+	  (if (and (> start-point text-start)
+		   (progn
+		     (goto-char text-start)
+		     (re-search-forward "." start-point t)))
+	      (push
+	       (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
+			       text-plain-type)
+	       result))
+	  (push
+	   (funcall (mm-uu-function-extract entry))
+	   result)
+	  (goto-char (setq text-start end-point))))
       (when result
-	(if (> (point-max) (1+ text-start))
+	(if (and (> (point-max) (1+ text-start))
+		 (save-excursion
+		   (goto-char text-start)
+		   (re-search-forward "." nil t)))
 	    (push
 	     (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
 			     text-plain-type)
@@ -225,26 +493,6 @@
 	(setq result (cons "multipart/mixed" (nreverse result))))
       result)))
 
-;;;###autoload
-(defun mm-uu-test ()
-  "Check whether the current buffer contains uu stuff."
-  (save-excursion
-    (goto-char (point-min))
-    (let (type end-line result
-	       (case-fold-search t))
-      (while (and mm-uu-begin-line
-		  (not result) (re-search-forward mm-uu-begin-line nil t))
-	(forward-line)
-	(setq type (cdr (assq (aref (match-string 0) 0)
-			      mm-uu-identifier-alist)))
-	(setq end-line (symbol-value
-			(intern (concat "mm-uu-" (symbol-name type)
-					"-end-line"))))
-	(if (and (re-search-forward end-line nil t)
-		 (not (eq (match-beginning 0) (match-end 0))))
-	    (setq result t)))
-      result)))
-
 (provide 'mm-uu)
 
 ;;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c