Synch to No Gnus 200507290604.

[elisp/gnus.git-] / lisp / mm-uu.el

diff --git a/lisp/mm-uu.el b/lisp/mm-uu.el
index 1bdebde..9f00f0c 100644 (file)
--- a/lisp/mm-uu.el
+++ b/lisp/mm-uu.el
@@ -19,8 +19,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -81,6 +81,7 @@ This can be either \"inline\" or \"attachment\".")
 
 (defcustom mm-uu-diff-groups-regexp "gnus\\.commits"
   "*Regexp matching diff groups."
+  :version "22.1"
   :type 'regexp
   :group 'gnus-article-mime)
 
@@ -111,8 +112,8 @@ This can be either \"inline\" or \"attachment\".")
      "^exit 0$"
      mm-uu-shar-extract)
     (forward
-;;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
-;;; Peter von der Ah\'e <pahe@daimi.au.dk>
+     ;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
+     ;; Peter von der Ah\'e <pahe@daimi.au.dk>
      "^-+ \\(Start of \\)?Forwarded message"
      "^-+ End \\(of \\)?forwarded message"
      mm-uu-forward-extract
@@ -163,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)
@@ -186,13 +191,12 @@ To disable dissecting shar codes, for instance, add
 (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*"))
+  (let ((obuf (current-buffer))
+        (coding-system
+         ;; Might not exist in non-MULE XEmacs
+         (when (boundp 'buffer-file-coding-system)
+           buffer-file-coding-system)))
+    (with-current-buffer (generate-new-buffer " *mm-uu*")
       (setq buffer-file-coding-system coding-system)
       (insert-buffer-substring obuf from to)
       (current-buffer))))
@@ -363,7 +367,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"))))
@@ -395,9 +399,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"))))
@@ -431,12 +433,14 @@ Return that buffer."
                    '("application/pgp-keys"))))
 
 ;;;###autoload
-(defun mm-uu-dissect (&optional noheader)
+(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."
+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
@@ -446,10 +450,7 @@ The optional NOHEADER means there's no header in the buffer."
        ((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)
@@ -478,7 +479,7 @@ The optional NOHEADER means there's no header in the 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))
@@ -491,7 +492,7 @@ The optional NOHEADER means there's no header in the 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)))
@@ -499,13 +500,16 @@ The optional NOHEADER means there's no header in the buffer."
 (defun mm-uu-dissect-text-parts (handle)
   "Dissect text parts and put uu handles into HANDLE."
   (let ((buffer (mm-handle-buffer handle))
-       children)
+       type children)
     (cond ((stringp buffer)
           (mapc 'mm-uu-dissect-text-parts (cdr handle)))
          ((bufferp buffer)
-          (when (and (equal "text/plain" (mm-handle-media-type handle))
+          (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))))
+                       (setq children
+                             (mm-uu-dissect t (mm-handle-type handle)))))
             (kill-buffer buffer)
             (setcar handle (car children))
             (setcdr handle (cdr children))))