From 18aad9ea3fdce868c626bfd8871c557dd5b9e751 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 23 Jan 2001 05:15:41 +0000
Subject: [PATCH] Fix bug: UW IMAP sometimes returns multiple FETCH responses
 to a FETCH, while we were expecting just one with multiple attributes.  So if
 there are multiple responses, merge them.

---
 v7/src/imail/imail-imap.scm | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 18b2b7a42..80718c6a8 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.145 2001/01/22 18:38:11 cph Exp $
+;;; $Id: imail-imap.scm,v 1.146 2001/01/23 05:15:41 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -1371,12 +1371,25 @@
 				items))
 
 (define (imap:command:fetch connection index items)
-  (imap:command:single-response imap:response:fetch? connection 'FETCH
-				(+ index 1) items))
+  (imap:command:fetch-response connection 'FETCH (list (+ index 1) items)))
 
 (define (imap:command:uid-fetch connection uid items)
-  (imap:command:single-response imap:response:fetch? connection 'UID 'FETCH
-				uid items))
+  (imap:command:fetch-response connection 'UID (list 'FETCH uid items)))
+
+(define (imap:command:fetch-response connection command arguments)
+  (let ((responses (apply imap:command connection command arguments)))
+    (if (and (pair? (cdr responses))
+	     (for-all? (cdr responses) imap:response:fetch?))
+	(if (null? (cddr responses))
+	    (cadr responses)
+	    ;; Some servers, notably UW IMAP, sometimes return
+	    ;; multiple FETCH responses.  This can happen even if only
+	    ;; one item is fetched.  Since the caller expects a single
+	    ;; response, synthesize one from the available responses.
+	    (cons* (caadr responses)
+		   (cadadr responses)
+		   (append-map cddr (cdr responses))))
+	(error "Malformed response from IMAP server:" responses))))
 
 (define (imap:command:fetch-range connection start end items)
   (imap:command:fetch-set connection
-- 
2.25.1