emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/gnus/mm-uu.el


From: Miles Bader
Subject: [Emacs-diffs] Changes to emacs/lisp/gnus/mm-uu.el
Date: Mon, 16 Jan 2006 09:27:43 +0000

Index: emacs/lisp/gnus/mm-uu.el
diff -u emacs/lisp/gnus/mm-uu.el:1.18 emacs/lisp/gnus/mm-uu.el:1.19
--- emacs/lisp/gnus/mm-uu.el:1.18       Wed Sep 28 05:26:01 2005
+++ emacs/lisp/gnus/mm-uu.el    Mon Jan 16 09:27:42 2006
@@ -174,6 +174,10 @@
                   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)
@@ -375,7 +379,7 @@
       (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"))))
@@ -407,9 +411,7 @@
        (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"))))
@@ -443,23 +445,24 @@
                    '("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)
@@ -488,7 +491,7 @@
                     (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))
@@ -501,11 +504,32 @@
                   (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)
+          (dolist (elem (cdr handle))
+            (mm-uu-dissect-text-parts elem)))
+         ((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
+          (dolist (elem handle)
+            (mm-uu-dissect-text-parts elem))))))
+
 (provide 'mm-uu)
 
 ;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c




reply via email to

[Prev in Thread] Current Thread [Next in Thread]