From 67cb93282bfd886996e222e6956481aff8f82746 Mon Sep 17 00:00:00 2001
From: "Taylor R. Campbell" <net/mumble/campbell>
Date: Tue, 9 Sep 2008 06:13:43 +0000
Subject: [PATCH] Clarify IMAP MIME body sections, which are confusing because
 every message body is treated as a multipart body by the IMAP's indexing
 scheme.  This makes IMAIL never fetch TEXT body parts, except when the user
 views a message raw with `C-c C-t C-m' (eventually, which will also view
 arbitrary MIME bodies raw), and rather use numbered parts, which will cause
 IMAIL to refill existing disk caches, even though they already have mostly
 the same data in them.  IMAIL will also now show MIME bodies in IMAP and file
 folders more uniformly, especially complex nesting of message/rfc822 and
 multipart bodies.

---
 v7/src/imail/imail-imap.scm | 62 ++++++++++++++++++++++++-------------
 1 file changed, 40 insertions(+), 22 deletions(-)

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index cc6588d67..a63d1d0a8 100644
--- a/v7/src/imail/imail-imap.scm
+++ b/v7/src/imail/imail-imap.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: imail-imap.scm,v 1.233 2008/09/08 03:55:18 riastradh Exp $
+$Id: imail-imap.scm,v 1.234 2008/09/09 06:13:43 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -1308,7 +1308,7 @@ USA.
 			 (lambda (body-part)
 			   (fetch-message-body-part-to-cache
 			    message
-			    (imap-mime-body-section-text body-part))))))
+			    (imap-mime-body-section body-part))))))
 		 (else
 		  (fetch-message-body-part-to-cache message '(TEXT))))))))))
 
@@ -1406,7 +1406,7 @@ USA.
 	    (string->lines
 	     (fetch-message-body-part
 	      (imap-mime-body-message body)
-	      `(,@(imap-mime-body-section body) MIME))))))
+	      (imap-mime-body-section/mime-header body))))))
       (store value)
       value))
   (define-method mime-body-header-fields ((body <imap-mime-body>))
@@ -1456,31 +1456,34 @@ USA.
 (define-method write-mime-body ((body <imap-mime-body>) port)
   (write-imap-message-section
    (imap-mime-body-message body)
-   (imap-mime-body-section-text body)
+   (imap-mime-body-section body)
    ;++ Kludge.  The IMAP includes the length in octets only for
    ;++ one-part bodies.
    (and (mime-body-one-part? body)
 	(mime-body-one-part-n-octets body))
    port))
 
-(define (imap-mime-body-section-text body)
-  `(,@(imap-mime-body-section body)
-    ,@(if (let ((enclosure (mime-body-enclosure body)))
-	    (or (not enclosure)
-		(mime-body-message? enclosure)))
-	  '(TEXT)
-	  '())))
-
 (define-method mime-body-message-header-fields ((body <mime-body-message>))
   (lines->header-fields
    (string->lines
     (call-with-output-string
       (lambda (port)
-	(write-imap-message-section (imap-mime-body-message body)
-				    `(,@(imap-mime-body-section body) HEADER)
-				    #f
-				    port))))))
-
+	(write-imap-message-section
+	 (imap-mime-body-message body)
+	 (imap-mime-body-section/message-header body)
+	 #f
+	 port))))))
+
+(define (imap-mime-body-section/mime-header body)
+  (let ((section (imap-mime-body-section body)))
+    (if (pair? section)
+	`(,@section MIME)
+	'(HEADER))))
+
+(define (imap-mime-body-section/message-header body)
+  (let ((section (imap-mime-body-section body)))
+    `(,@section HEADER)))
+
 (define (write-imap-message-section message section length port)
   (cond ((search-imap-message-body-parts message section)
 	 => (lambda (entry)
@@ -1531,22 +1534,37 @@ USA.
   (cond ((not (and (pair? body) (list? body)))
 	 (parse-mime-body:lose body message section))
 	((string? (car body))
-	 (parse-mime-body:one-part body message section))
+	 ;; The IMAP's indexing scheme treats every message body as
+	 ;; multipart, so a `one-part' body is treated as part 1 of a
+	 ;; multipart body.
+	 (parse-mime-body:one-part body message `(,@section 1)))
 	((pair? (car body))
 	 (parse-mime-body:multi-part body message section))
 	(else
 	 (parse-mime-body:lose body message section))))
 
+(define (parse-mime-body-part body message section index)
+  (let ((section `(,@section ,index)))
+    (cond ((not (and (pair? body) (list? body)))
+	   (parse-mime-body:lose body message section))
+	  ((string? (car body))
+	   (parse-mime-body:one-part body message section))
+	  ((pair? (car body))
+	   (parse-mime-body:multi-part body message section))
+	  (else
+	   (parse-mime-body:lose body message section)))))
+
 (define (parse-mime-body:multi-part body message section)
   (let loop ((tail body) (index 0))
     (if (not (pair? tail))
 	(parse-mime-body:lose body))
     (if (string? (car tail))
 	(let ((enclosed
-	       (map (lambda (body index)
-		      (parse-mime-body body message `(,@section ,index)))
-		    (sublist body 0 index)
-		    (iota index 1)))
+	       (map
+		(lambda (body index)
+		  (parse-mime-body-part body message section index))
+		(sublist body 0 index)
+		(iota index 1)))
 	      (extensions
 	       (parse-mime-body:extensions (cdr tail))))
 	  (let ((enclosure
-- 
2.25.1