From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 14 Jun 2000 02:51:25 +0000 (+0000)
Subject: Change IMAP URL completion to work more like filename completion:
X-Git-Tag: 20090517-FFI~3543
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=76083734645566291fe2b0fd1bf147102e8c8bbd;p=mit-scheme.git

Change IMAP URL completion to work more like filename completion:
completion shows only the elements at the top level of the mailbox
being completed on.  Furthermore, non-selectable mailboxes are
suffixed with the heirarchy delimiter to cue the user.
---

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 19fa2d324..09366f3aa 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.117 2000/06/14 02:15:39 cph Exp $
+;;; $Id: imail-imap.scm,v 1.118 2000/06/14 02:51:25 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -255,10 +255,16 @@
 	       (if-unique (car responses)))))))
 
 (define (imap-mailbox-completions mailbox url)
-  (map imap:response:list-mailbox
+  (map (lambda (response)
+	 (let ((mailbox (imap:response:list-mailbox response))
+	       (delimiter (imap:response:list-delimiter response)))
+	   (if (and delimiter
+		    (memq '\NOSELECT (imap:response:list-flags response)))
+	       (string-append mailbox delimiter)
+	       mailbox)))
        (with-open-imap-connection url
 	 (lambda (connection)
-	   (imap:command:list connection "" (string-append mailbox "*"))))))
+	   (imap:command:list connection "" (string-append mailbox "%"))))))
 
 ;;;; Server connection