From 0edb47c2b97e074841a0c85ae124584ab9441962 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 4 May 2000 17:40:04 +0000
Subject: [PATCH] Implement FOLDER-PRESENTATION-NAME.

---
 v7/src/imail/imail-core.scm |  8 +++++++-
 v7/src/imail/imail-file.scm |  5 ++++-
 v7/src/imail/imail-imap.scm |  5 ++++-
 v7/src/imail/imail-top.scm  | 17 +++++++++--------
 4 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/v7/src/imail/imail-core.scm b/v7/src/imail/imail-core.scm
index 9f8493818..1d4dc5604 100644
--- 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 819de391b..ad6816c69 100644
--- 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 8c583127c..d62cb7c5e 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.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 6dc5e20dd..6e8527b41 100644
--- 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))
 
 (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))))
 
 ;;;; Navigation
 
-- 
2.25.1