X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmm-uu.el;h=c3991c3b25b0a6c90f24be8ec3e5ab256e8cb014;hb=0fc7cfe44d8a7e783f48ebd0a91a614f5a67842d;hp=e36007102123f6ad0acc07913ecf55694e5b8e61;hpb=b309effceda71146639ffecece770ff708455457;p=elisp%2Fgnus.git-

diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el
index e360071..c3991c3 100644
--- a/lisp/mm-uu.el
+++ b/lisp/mm-uu.el
@@ -51,29 +51,40 @@
 (defconst mm-uu-postscript-begin-line "^%!PS-")
 (defconst mm-uu-postscript-end-line "^%%EOF$")
 
-(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
+(defconst mm-uu-uu-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+")
 (defconst mm-uu-uu-end-line "^end[ \t]*$")
-(defvar mm-uu-decode-function 'uudecode-decode-region)
+
+(defcustom mm-uu-decode-function 'uudecode-decode-region
+  "*Function to uudecode.
+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 uudecode."
+  :type '(choice (item :tag "internal" uudecode-decode-region)
+		 (item :tag "external" uudecode-decode-region-external))
+  :group 'gnus-article-mime) 
 
 (defconst mm-uu-binhex-begin-line
   "^:...............................................................$")
 (defconst mm-uu-binhex-end-line ":$")
-(defvar mm-uu-binhex-decode-function 'binhex-decode-region)
+
+(defcustom mm-uu-binhex-decode-function 'binhex-decode-region
+  "*Function to binhex decode.
+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 (item :tag "internal" binhex-decode-region)
+		 (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")
+(defconst mm-uu-shar-end-line "^exit 0\\|^$")
 
 ;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and 
 ;;; Peter von der Ah\'e <pahe@daimi.au.dk>
-(defconst mm-uu-forward-begin-line "^-+ \\(Start of \\)?Forwarded message")
+(defconst mm-uu-forward-begin-line "^-+ \\(?:Start of \\)?Forwarded message")
 (defconst mm-uu-forward-end-line "^-+ End of forwarded message")
 
-(defconst mm-uu-begin-line
-  (concat mm-uu-postscript-begin-line "\\|"
-	  mm-uu-uu-begin-line "\\|"
-	  mm-uu-binhex-begin-line "\\|"
-	  mm-uu-shar-begin-line "\\|"
-	  mm-uu-forward-begin-line))
+(defvar mm-uu-begin-line nil)
 
 (defconst mm-uu-identifier-alist
   '((?% . postscript) (?b . uu) (?: . binhex) (?# . shar)
@@ -83,6 +94,39 @@
   "The default disposition of uu parts.
 This can be either \"inline\" or \"attachment\".")
 
+(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)))
+
+(defcustom mm-uu-configure-list nil
+  "A list of mm-uu configuration.
+To disable dissecting shar codes, for instance, add
+`(shar . disabled)' to this list."
+  :type '(repeat (cons 
+		  (choice (item postscript)
+			  (item uu) 
+			  (item binhex)
+			  (item shar)
+			  (item forward))
+		  (choice (item disabled))))
+  :group 'gnus-article-mime
+  :set 'mm-uu-configure) 
+
+(mm-uu-configure)
+
 ;;;### autoload
 
 (defun mm-uu-dissect ()
@@ -111,20 +155,22 @@ This can be either \"inline\" or \"attachment\".")
 				      (list (cons 'charset charset)))))
       (while (re-search-forward mm-uu-begin-line nil t)
 	(setq start-char (match-beginning 0))
-	(forward-line) ;; in case of failure
-	(setq start-char-1 (point))
 	(setq type (cdr (assq (aref (match-string 0) 0)
 			      mm-uu-identifier-alist)))
 	(setq file-name
-	      (if (eq type 'uu)
+	      (if (and (eq type 'uu)
+		       (looking-at "\\(.+\\)$"))
 		  (and (match-string 1)
 		       (let ((nnheader-file-name-translation-alist
 			      '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
 			 (nnheader-translate-file-chars (match-string 1))))))
+	(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 (re-search-forward end-line nil t)
+	(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))
@@ -191,14 +237,16 @@ This can be either \"inline\" or \"attachment\".")
     (forward-line)
     (let (type end-line result
 	       (case-fold-search t))
-      (while (and (not result) (re-search-forward mm-uu-begin-line nil 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 (re-search-forward end-line nil t)
+	(if (and (re-search-forward end-line nil t)
+		 (not (eq (match-beginning 0) (match-end 0))))
 	    (setq result t)))
       result)))