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.

diff --git a/v7/src/edwin/bufcom.scm b/v7/src/edwin/bufcom.scm
index 4f3975be1ffb822e178522a41a8ed6beec3c690b..6f976895765e91cdc57582c5da8352f950d8a166 100644 (file)
--- 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 08de6e91fec6c0f096298f08a9e80124226dfeed..fe35be6eae5bf7d67143791981419c0389b78729 100644 (file)
--- 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?