Implement FOLDER-PRESENTATION-NAME.

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 9f849381899d1ecb1c6298729ca894347afb5740..1d4dc56045271d3ce11d40eef4f7715b800cb720 100644 (file)
--- a/v7/src/imail/imail-core.scm
+++ b/v7/src/imail/imail-core.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-core.scm,v 1.38 2000/05/03 20:28:38 cph Exp $
+;;; $Id: imail-core.scm,v 1.39 2000/05/04 17:40:01 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -259,6 +259,12 @@
 
 (define-generic close-folder (folder))
 
+;; -------------------------------------------------------------------
+;; Return a string that concisely identifies FOLDER, for use in the
+;; presentation layer.
+
+(define-generic folder-presentation-name (folder))
+
 ;; -------------------------------------------------------------------
 ;; Return #T if FOLDER represents a real folder, i.e. has a
 ;; corresponding file or server entry.

diff --git a/v7/src/imail/imail-file.scm b/v7/src/imail/imail-file.scm
index 819de391b32b7ceb1ca049364e1d2f3662f32670..ad6816c69ff83aa064b6448a8c82b6152fc7b072 100644 (file)
--- a/v7/src/imail/imail-file.scm
+++ b/v7/src/imail/imail-file.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-file.scm,v 1.16 2000/05/03 20:28:42 cph Exp $
+;;; $Id: imail-file.scm,v 1.17 2000/05/04 17:40:03 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -85,6 +85,9 @@
             (set-file-folder-messages! folder 'UNKNOWN)
             (for-each detach-message messages)))))))
 
+(define-method folder-presentation-name ((folder <file-folder>))
+  (url-body (folder-url folder)))
+
 (define-method %folder-valid? ((folder <file-folder>))
   (file-exists? (file-folder-pathname folder)))
 

diff --git a/v7/src/imail/imail-imap.scm b/v7/src/imail/imail-imap.scm
index 8c583127c331ac635653b407d6c75a9058557fe7..d62cb7c5e21830022322bfaddd98a06aff2b4fb9 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.15 2000/05/04 17:30:29 cph Exp $
+;;; $Id: imail-imap.scm,v 1.16 2000/05/04 17:40:04 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -351,6 +351,9 @@
 (define-method close-folder ((folder <imap-folder>))
   (close-imap-connection (imap-folder-connection folder)))
 
+(define-method folder-presentation-name ((folder <imap-folder>))
+  (imap-url-mailbox (folder-url folder)))
+
 (define-method %folder-valid? ((folder <imap-folder>))
   folder
   #t)

diff --git a/v7/src/imail/imail-top.scm b/v7/src/imail/imail-top.scm
index 6dc5e20ddd17c46f95109c11245847abbad590d1..6e8527b41c001b9468b83ad6a469ee8a116812bc 100644 (file)
--- a/v7/src/imail/imail-top.scm
+++ b/v7/src/imail/imail-top.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: imail-top.scm,v 1.29 2000/05/04 17:29:36 cph Exp $
+;;; $Id: imail-top.scm,v 1.30 2000/05/04 17:39:53 cph Exp $
 ;;;
 ;;; Copyright (c) 1999-2000 Massachusetts Institute of Technology
 ;;;
@@ -108,7 +108,7 @@ May be called with an IMAIL folder URL as argument;
               (folder (open-folder url)))
          (select-buffer
           (or (imail-folder->buffer folder #f)
-              (let ((buffer (new-buffer (imail-url->buffer-name url))))
+              (let ((buffer (new-buffer (folder-presentation-name folder))))
                 (associate-imail-folder-with-buffer folder buffer)
                 (select-message folder (first-unseen-message folder) #t)
                 buffer))))))))
@@ -160,9 +160,6 @@ May be called with an IMAIL folder URL as argument;
       (or folder
          (and (if (default-object? error?) #t error?)
               (error:bad-range-argument buffer 'SELECTED-FOLDER))))))
-
-(define (imail-url->buffer-name url)
-  (url-body url))
 \f
 (define-major-mode imail read-only "IMAIL"
   "IMAIL mode is used by \\[imail] for editing IMAIL files.
@@ -293,15 +290,14 @@ DEL       Scroll to previous screen of this message.
             #t))))))
 
 (define (imail-kill-buffer buffer)
-  (let ((folder (selected-folder #f buffer)))
-    (if folder
-       (close-folder folder))))
+  (imail-close-buffer-folder buffer))
 
 (define-command imail-quit
   "Quit out of IMAIL."
   ()
   (lambda ()
     ((ref-command imail-save-folder))
+    (imail-close-buffer-folder (selected-buffer))
     ((ref-command bury-buffer))))
 
 (define-command imail-save-folder
@@ -309,6 +305,11 @@ DEL        Scroll to previous screen of this message.
   ()
   (lambda ()
     (save-folder (selected-folder))))
+
+(define (imail-close-buffer-folder buffer)
+  (let ((folder (selected-folder #f buffer)))
+    (if folder
+       (close-folder folder))))
 \f
 ;;;; Navigation