Reduce the traffic generated by completion code to determine if a
authorChris Hanson <org/chris-hanson/cph>
Wed, 5 Jul 2000 03:29:28 +0000 (03:29 +0000)
committerChris Hanson <org/chris-hanson/cph>
Wed, 5 Jul 2000 03:29:28 +0000 (03:29 +0000)
mailbox has inferiors or not.

v7/src/imail/imail-imap.scm

index a69800aeb8147fbe98de6da6431f3dfb98437ecf..02b62b140e56432367a2a3afed7b12b098962bb4 100644 (file)
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-imap.scm,v 1.137 2000/07/05 00:32:45 cph Exp $
+;;; $Id: imail-imap.scm,v 1.138 2000/07/05 03:29:28 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
       (if-not-unique mailbox
                     (lambda () (imap-mailbox-completions mailbox url)))
       (let ((responses (imap-mailbox-completions mailbox url)))
-       (cond ((not (pair? responses))
-              (if-not-found))
+       (cond ((not (pair? responses)) (if-not-found))
              ((pair? (cdr responses))
               (if-not-unique (string-greatest-common-prefix responses)
                              (lambda () responses)))
-             (else
-              (if-unique (car responses)))))))
+             (else (if-unique (car responses)))))))
 
 (define (imap-mailbox-completions prefix url)
   (with-open-imap-connection url
                        mailbox)))
               (let ((tail
                      (if (and delimiter
-                              (not (memq '\NOINFERIORS flags))
-                              (pair?
-                               (get-list (string-append mailbox delimiter))))
+                              (or (memq '\NOSELECT flags)
+                                  (and (not (memq '\NOINFERIORS flags))
+                                       (pair?
+                                        (get-list
+                                         (string-append mailbox
+                                                        delimiter))))))
                          (list (string-append mailbox* "/"))
                          '())))
                 (if (memq '\NOSELECT flags)
         (lambda (connection thunk)
           (if (imap:catch-no-response
                (lambda (response)
-                 (imap:response-code:trycreate?
-                  (imap:response:response-text-code response)))
+                 (let ((code (imap:response:response-text-code response)))
+                   (and code
+                        (imap:response-code:trycreate? code))))
                (lambda ()
                  (thunk)
                  #f))