If server supports the NAMESPACE extension, use it to get namespace

information and store it in the connection object.

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 4e0e1953896ab04d204332246bbff8987da0c29c..7d6d6b9d502a510e144e698cceae11c7dd2d4c30 100644 (file)
--- 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.114 2000/06/05 21:30:40 cph Exp $
+;;; $Id: imail-imap.scm,v 1.115 2000/06/10 20:17:57 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -67,7 +67,7 @@
           (substring-downcase! mailbox 0 6)
           mailbox))
        (else mailbox)))
-
+\f
 (define-method url-body ((url <imap-url>))
   (make-imap-url-string (imap-url-user-id url)
                        (imap-url-host url)
@@ -212,6 +212,7 @@
   (port            define standard initial-value #f)
   (greeting        define standard initial-value #f)
   (capabilities    define standard initial-value '())
+  (namespace       define standard initial-value #f)
   (sequence-number define standard initial-value 0)
   (response-queue  define accessor initializer (lambda () (cons '() '())))
   (folder          define standard initial-value #f)
@@ -228,6 +229,7 @@
    (lambda ()
      (set-imap-connection-greeting! connection #f)
      (set-imap-connection-capabilities! connection '())
+     (set-imap-connection-namespace! connection #f)
      (set-imap-connection-sequence-number! connection 0)
      (let ((queue (imap-connection-response-queue connection)))
        (set-car! queue '())
@@ -356,6 +358,8 @@
                  (imail-ui:delete-stored-pass-phrase url)
                  (error "Unable to log in:"
                         (imap:response:response-text-string response))))))
+       (if (memq 'NAMESPACE (imap-connection-capabilities connection))
+           (imap:command:namespace connection))
        #t)))
 \f
 (define (test-imap-connection-open connection)
@@ -708,11 +712,9 @@
          (receiver (imap-folder-connection folder))))))
 \f
 ;;; These reflectors are needed to guarantee that we read the
-;;; appropriate information from the server.  Normally most message
-;;; slots are filled in by READ-MESSAGE-HEADERS!, but it's possible
-;;; for READ-MESSAGE-HEADERS! to be interrupted, leaving unfilled
-;;; slots.  Also, we don't want to fill the BODY slot until it is
-;;; requested, as the body might be very large.
+;;; appropriate information from the server.  Some message slots are
+;;; filled in by READ-MESSAGE-HEADERS!, but it's possible for
+;;; READ-MESSAGE-HEADERS! to be interrupted, leaving unfilled slots.
 
 (let ((accessor (slot-accessor <imap-message> 'UID))
       (initpred (slot-initpred <imap-message> 'UID)))
@@ -786,7 +788,7 @@
                                           '(ENVELOPE))))
   (reflector imap-message-bodystructure 'BODYSTRUCTURE
             (lambda (message initpred)
-              (guarantee-slot-initialized message initpred "bodystructure"
+              (guarantee-slot-initialized message initpred "body structure"
                                           '(BODYSTRUCTURE)))))
 \f
 ;;;; MIME support
@@ -1152,6 +1154,9 @@
 (define (imap:command:capability connection)
   (imap:command:no-response connection 'CAPABILITY))
 
+(define (imap:command:namespace connection)
+  (imap:command:no-response connection 'NAMESPACE))
+
 (define (imap:command:login connection user-id pass-phrase)
   ((imail-ui:message-wrapper "Logging in as " user-id)
    (lambda ()
@@ -1463,6 +1468,9 @@
          connection
          (imap:response:capabilities response))
         #f)
+       ((imap:response:namespace? response)
+        (set-imap-connection-namespace! connection response)
+        #f)
        ((imap:response:list? response)
         (eq? command 'LIST))
        ((imap:response:lsub? response)

diff --git a/v7/src/imail/imail.pkg b/v7/src/imail/imail.pkg
index e7465f06bf37cddb04f4a7200c47de7f4bc39240..f527c5e9ac713a171b8208065a7669483462f809 100644 (file)
--- a/v7/src/imail/imail.pkg
+++ b/v7/src/imail/imail.pkg
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail.pkg,v 1.53 2000/06/09 04:17:52 cph Exp $
+;;; $Id: imail.pkg,v 1.54 2000/06/10 20:17:55 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -171,6 +171,10 @@
          imap:response:list-mailbox
          imap:response:list?
          imap:response:lsub?
+         imap:response:namespace-other
+         imap:response:namespace-personal
+         imap:response:namespace-shared
+         imap:response:namespace?
          imap:response:no?
          imap:response:ok?
          imap:response:preauth?

diff --git a/v7/src/imail/imap-response.scm b/v7/src/imail/imap-response.scm
index 04349caa7c8232eec01fd0b339b3d60558d11b50..ca5cce4cadd0b44d2fbdad74754a4013efc721bf 100644 (file)
--- a/v7/src/imail/imap-response.scm
+++ b/v7/src/imail/imap-response.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imap-response.scm,v 1.33 2000/06/01 20:07:07 cph Exp $
+;;; $Id: imap-response.scm,v 1.34 2000/06/10 20:18:06 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -66,6 +66,7 @@
                  ((SEARCH) (read-search-response port))
                  ((STATUS) (read-status-response port))
                  ((CAPABILITY) (read-capability-response port))
+                 ((NAMESPACE) (read-namespace-response port))
                  (else (error "Malformed response code:" x))))))))
 
 (define (read-tagged-response tag port)
@@ -102,6 +103,14 @@
 (define (read-capability-response port)
   (read-open-list read-interned-atom port))
 
+(define (read-namespace-response port)
+  (discard-known-char #\space port)
+  (let ((ns1 (read-generic port)))
+    (discard-known-char #\space port)
+    (let ((ns2 (read-generic port)))
+      (discard-known-char #\space port)
+      (list ns1 ns2 (read-generic port)))))
+
 (define (read-response-text port)
   (discard-known-char #\space port)
   (let ((code
@@ -597,6 +606,7 @@
 (define (imap:response:flags? response) (eq? (car response) 'FLAGS))
 (define (imap:response:list? response) (eq? (car response) 'LIST))
 (define (imap:response:lsub? response) (eq? (car response) 'LSUB))
+(define (imap:response:namespace? response) (eq? (car response) 'NAMESPACE))
 (define (imap:response:no? response) (eq? (car response) 'NO))
 (define (imap:response:ok? response) (eq? (car response) 'OK))
 (define (imap:response:preauth? response) (eq? (car response) 'PREAUTH))
@@ -612,6 +622,9 @@
 (define imap:response:list-delimiter cadr)
 (define imap:response:list-mailbox caddr)
 (define imap:response:list-flags cdddr)
+(define imap:response:namespace-personal cadr)
+(define imap:response:namespace-other caddr)
+(define imap:response:namespace-shared cadddr)
 (define imap:response:recent-count cadr)
 (define imap:response:search-indices cdr)