From fe14417a5f6ff70aa0758200fe831e7eb7c452fd Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 18 May 1997 07:50:51 +0000
Subject: [PATCH] Implement POP-UP-TEMPORARY-BUFFER, a fairly general mechanism
 for popping up temporary buffers.  Redefine several old uses of such buffers
 to use this new mechanism.

---
 v7/src/edwin/bufcom.scm | 44 ++++++++++++++++++++++++++++++-----------
 v7/src/edwin/dired.scm  | 16 +++++----------
 2 files changed, 37 insertions(+), 23 deletions(-)

diff --git a/v7/src/edwin/bufcom.scm b/v7/src/edwin/bufcom.scm
index 4f3975be1..6f9768957 100644
--- a/v7/src/edwin/bufcom.scm
+++ b/v7/src/edwin/bufcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: bufcom.scm,v 1.102 1997/04/17 03:49:04 cph Exp $
+;;;	$Id: bufcom.scm,v 1.103 1997/05/18 07:50:30 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989-96 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989-97 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -255,19 +255,39 @@ When locked, the buffer's major mode may not be changed."
 	      new-name)))
       name))
 
-(define (string->temporary-buffer string name)
+(define (pop-up-temporary-buffer name properties initialization)
   (let ((buffer (temporary-buffer name)))
-    (insert-string string (buffer-point buffer))
-    (set-buffer-point! buffer (buffer-start buffer))
-    (buffer-not-modified! buffer)
-    (pop-up-buffer buffer false)))
+    (let ((window (pop-up-buffer buffer #f)))
+      (initialization buffer window)
+      (set-buffer-point! buffer (buffer-start buffer))
+      (buffer-not-modified! buffer)
+      (if (memq 'READ-ONLY properties)
+	  (set-buffer-read-only! buffer))
+      (if (and window (memq 'SHRINK-WINDOW properties))
+	  (shrink-window-if-larger-than-buffer window))
+      (if (and (memq 'FLUSH-ON-SPACE properties)
+	       (not (typein-window? (current-window))))
+	  (begin
+	    (message "Hit space to flush.")
+	    (reset-command-prompt!)
+	    (let ((char (keyboard-peek)))
+	      (if (eqv? #\space char)
+		  (begin
+		    (keyboard-read)
+		    (kill-pop-up-buffer #f))))
+	    (clear-message))))))
+
+(define (string->temporary-buffer string name)
+  (pop-up-temporary-buffer name '()
+    (lambda (buffer window)
+      window
+      (insert-string string (buffer-point buffer)))))
 
 (define (call-with-output-to-temporary-buffer name procedure)
-  (let ((buffer (temporary-buffer name)))
-    (call-with-output-mark (buffer-point buffer) procedure)
-    (set-buffer-point! buffer (buffer-start buffer))
-    (buffer-not-modified! buffer)
-    (pop-up-buffer buffer false)))
+  (pop-up-temporary-buffer name '()
+    (lambda (buffer window)
+      window
+      (call-with-output-mark (buffer-point buffer) procedure))))
 
 (define (with-output-to-temporary-buffer name thunk)
   (call-with-output-to-temporary-buffer name
diff --git a/v7/src/edwin/dired.scm b/v7/src/edwin/dired.scm
index 08de6e91f..fe35be6ea 100644
--- a/v7/src/edwin/dired.scm
+++ b/v7/src/edwin/dired.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Id: dired.scm,v 1.166 1997/03/04 06:43:01 cph Exp $
+;;;	$Id: dired.scm,v 1.167 1997/05/18 07:50:51 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989-97 Massachusetts Institute of Technology
 ;;;
@@ -900,21 +900,15 @@ Actions controlled by variables list-directory-brief-switches
 		 (message "Deletions failed: " failures)))))))
 
 (define (dired-pop-up-files-window filenames)
-  (let ((buffer (temporary-buffer " *dired-files*")))
-    (define-variable-local-value! buffer
-	(ref-variable-object truncate-partial-width-windows)
-      #f)
-    (let ((window (pop-up-buffer buffer #f)))
+  (pop-up-temporary-buffer " *dired-files*" '(READ-ONLY SHRINK-WINDOW)
+    (lambda (buffer window)
+      (local-set-variable! truncate-partial-width-windows #f buffer)
       (write-strings-densely (map (lambda (filename)
 				    (file-namestring (car filename)))
 				  filenames)
 			     (mark->output-port (buffer-point buffer))
 			     (window-x-size
-			      (or window (car (buffer-windows buffer)))))
-      (set-buffer-point! buffer (buffer-start buffer))
-      (buffer-not-modified! buffer)
-      (set-buffer-read-only! buffer)
-      (if window (shrink-window-if-larger-than-buffer window)))))
+			      (or window (car (buffer-windows buffer))))))))
 
 (define (dired-kill-file! filename lstart)
   (let ((deleted?
-- 
2.25.1