X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmm-uu.el;h=6ad7abaf11d7d8fd46caf1c836e85051991f39f5;hb=e405b22c6b46721607c5e6c712a4705c23dee751;hp=5324d0d1cf791528cfcc606eb04f9fc4624bdc48;hpb=fc38ea1bfea3f656900e3df6dacb39b064902343;p=gnus

diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el
index 5324d0d1c..6ad7abaf1 100644
--- a/lisp/mm-uu.el
+++ b/lisp/mm-uu.el
@@ -1,5 +1,6 @@
 ;;; mm-uu.el --- Return uu stuff as mm handles
-;; Copyright (c) 1998, 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+;; Copyright (c) 1998, 1999, 2000, 2001, 2002, 2003, 2004
+;;        Free Software Foundation, Inc.
 
 ;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
 ;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
@@ -76,7 +77,13 @@ decoder, such as hexbin."
 This can be either \"inline\" or \"attachment\".")
 
 (defvar mm-uu-emacs-sources-regexp "gnu\\.emacs\\.sources"
-  "The regexp of emacs sources groups.")
+  "The regexp of Emacs sources groups.")
+
+(defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
+  "*Regexp matching diff groups."
+  :version "22.1"
+  :type 'regexp
+  :group 'gnus-article-mime)
 
 (defvar mm-uu-type-alist
   '((postscript
@@ -139,9 +146,15 @@ This can be either \"inline\" or \"attachment\".")
      "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
      mm-uu-emacs-sources-extract
      nil
-     mm-uu-emacs-sources-test)))
+     mm-uu-emacs-sources-test)
+    (diff
+     "^Index: "
+     nil
+     mm-uu-diff-extract
+     nil
+     mm-uu-diff-test)))
 
-(defcustom mm-uu-configure-list nil
+(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."
@@ -151,6 +164,10 @@ To disable dissecting shar codes, for instance, add
 		   mm-uu-type-alist)
   :group 'gnus-article-mime)
 
+(defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded))
+  "MIME type and parameters for text/plain parts.
+`gnus-decoded' is a fake charset, which means no further decoding.")
+
 ;; functions
 
 (defsubst mm-uu-type (entry)
@@ -175,8 +192,13 @@ To disable dissecting shar codes, for instance, add
   "Copy the contents of the current buffer to a fresh buffer.
 Return that buffer."
   (save-excursion
-    (let ((obuf (current-buffer)))
+    (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))))
 
@@ -207,7 +229,7 @@ Return that buffer."
   (if (looking-at ".+")
       (setq file-name
 	    (let ((nnheader-file-name-translation-alist
-		   '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
+		   '((?/ . ?,) (?\  . ?_) (?* . ?_) (?$ . ?_))))
 	      (nnheader-translate-file-chars (match-string 0))))))
 
 (defun mm-uu-binhex-filename ()
@@ -247,6 +269,15 @@ Return that buffer."
        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))
@@ -310,7 +341,7 @@ Return that buffer."
     ((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?")))))
+    (t (y-or-n-p "Verify pgp signed part? ")))))
 
 (eval-when-compile
   (defvar gnus-newsgroup-charset))
@@ -337,7 +368,7 @@ Return that buffer."
       (while (re-search-forward "^- " nil t)
 	(replace-match "" t t)
 	(forward-line 1)))
-    (list (mm-make-handle buf '("text/plain" (charset . gnus-decoded))))))
+    (list (mm-make-handle buf mm-uu-text-plain-type))))
 
 (defun mm-uu-pgp-signed-extract ()
   (let ((mm-security-handle (list (format "multipart/signed"))))
@@ -361,7 +392,7 @@ Return that buffer."
     ((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?")))))
+    (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))))
@@ -369,9 +400,7 @@ Return that buffer."
 	(with-current-buffer buf
 	  (mml2015-clean-buffer)
 	  (funcall (mml2015-clear-decrypt-function))))
-    (list
-     (mm-make-handle buf
-		     '("text/plain"  (charset . gnus-decoded))))))
+    (list (mm-make-handle buf mm-uu-text-plain-type))))
 
 (defun mm-uu-pgp-encrypted-extract ()
   (let ((mm-security-handle (list (format "multipart/encrypted"))))
@@ -405,23 +434,24 @@ Return that buffer."
 		    '("application/pgp-keys"))))
 
 ;;;###autoload
-(defun mm-uu-dissect ()
-  "Dissect the current buffer and return a list of uu handles."
+(defun mm-uu-dissect (&optional noheader mime-type)
+  "Dissect the current buffer and return a list of uu handles.
+The optional NOHEADER means there's no header in the buffer.
+MIME-TYPE specifies a MIME type and parameters, which defaults to the
+value of `mm-uu-text-plain-type'."
   (let ((case-fold-search t)
-	text-start start-point end-point file-name result
-	text-plain-type entry func)
+	(mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type))
+	text-start start-point end-point file-name result entry func)
     (save-excursion
       (goto-char (point-min))
       (cond
+       (noheader)
        ((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)))
+      (setq text-start (point))
       (while (re-search-forward mm-uu-beginning-regexp nil t)
 	(setq start-point (match-beginning 0))
 	(let ((alist mm-uu-type-alist)
@@ -450,7 +480,7 @@ Return that buffer."
 		     (re-search-forward "." start-point t)))
 	      (push
 	       (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
-			       text-plain-type)
+			       mm-uu-text-plain-type)
 	       result))
 	  (push
 	   (funcall (mm-uu-function-extract entry))
@@ -463,11 +493,31 @@ Return that buffer."
 		   (re-search-forward "." nil t)))
 	    (push
 	     (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
-			     text-plain-type)
+			     mm-uu-text-plain-type)
 	     result))
 	(setq result (cons "multipart/mixed" (nreverse result))))
       result)))
 
+(defun mm-uu-dissect-text-parts (handle)
+  "Dissect text parts and put uu handles into HANDLE."
+  (let ((buffer (mm-handle-buffer handle))
+	type children)
+    (cond ((stringp buffer)
+	   (mapc 'mm-uu-dissect-text-parts (cdr handle)))
+	  ((bufferp buffer)
+	   (when (and (setq type (mm-handle-media-type handle))
+		      (stringp type)
+		      (string-match "\\`text/" type)
+		      (with-current-buffer buffer
+			(setq children
+			      (mm-uu-dissect t (mm-handle-type handle)))))
+	     (kill-buffer buffer)
+	     (setcar handle (car children))
+	     (setcdr handle (cdr children))))
+	  (t
+	   (mapc 'mm-uu-dissect-text-parts handle)))))
+
 (provide 'mm-uu)
 
+;;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
 ;;; mm-uu.el ends here