From 7b2bedf9877fa691ae6ac9f3157280b005704ac3 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 28 Jul 2000 15:15:38 +0000
Subject: [PATCH] Change POP-UP-BUFFER in several ways: (1) SELECT? argument is
 now required; (2) optional argument NOT-CURRENT-WINDOW? has been replaced by
 a list of option symbols; (3) when popping into an existing window, if it's
 the previously popped-up window, it's returned.

---
 v7/src/edwin/abbrev.scm   |  4 ++--
 v7/src/edwin/bufmnu.scm   |  4 ++--
 v7/src/edwin/debug.scm    |  4 ++--
 v7/src/edwin/os2.scm      |  4 ++--
 v7/src/edwin/sendmail.scm |  4 ++--
 v7/src/edwin/unix.scm     |  4 ++--
 v7/src/edwin/vc.scm       |  7 ++++---
 v7/src/edwin/webster.scm  |  4 ++--
 v7/src/edwin/wincom.scm   | 21 +++++++++------------
 9 files changed, 27 insertions(+), 29 deletions(-)

diff --git a/v7/src/edwin/abbrev.scm b/v7/src/edwin/abbrev.scm
index d35792dd6..0d4239728 100644
--- a/v7/src/edwin/abbrev.scm
+++ b/v7/src/edwin/abbrev.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: abbrev.scm,v 1.4 2000/04/30 22:16:57 cph Exp $
+;;; $Id: abbrev.scm,v 1.5 2000/07/28 15:15:29 cph Exp $
 ;;;
 ;;; Copyright (c) 2000 Massachusetts Institute of Technology
 ;;;
@@ -445,7 +445,7 @@ or may be omitted (it is usually omitted)."
 (define-command list-abbrevs
   "Display a list of all defined abbrevs."
   ()
-  (lambda () (pop-up-buffer (prepare-abbrev-list-buffer) #f #f)))
+  (lambda () (pop-up-buffer (prepare-abbrev-list-buffer) #f)))
 
 (define (prepare-abbrev-list-buffer)
   (let ((buffer (find-or-create-buffer "*Abbrevs*")))
diff --git a/v7/src/edwin/bufmnu.scm b/v7/src/edwin/bufmnu.scm
index 067256f5b..3c23dc8c5 100644
--- a/v7/src/edwin/bufmnu.scm
+++ b/v7/src/edwin/bufmnu.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: bufmnu.scm,v 1.129 2000/05/23 20:06:35 cph Exp $
+;;; $Id: bufmnu.scm,v 1.130 2000/07/28 15:15:30 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -232,7 +232,7 @@ You can mark buffers with the \\[buffer-menu-mark] command."
 			#f)
     (with-variable-value! (ref-variable-object pop-up-windows) #t
       (lambda ()
-	(pop-up-buffer (previous-buffer))))
+	(pop-up-buffer (previous-buffer) #f)))
     (clear-message)))
 
 (define-command buffer-menu-this-window
diff --git a/v7/src/edwin/debug.scm b/v7/src/edwin/debug.scm
index 8a0208d1c..fb02e1eaf 100644
--- a/v7/src/edwin/debug.scm
+++ b/v7/src/edwin/debug.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: debug.scm,v 1.50 2000/04/30 22:17:00 cph Exp $
+;;; $Id: debug.scm,v 1.51 2000/07/28 15:15:31 cph Exp $
 ;;;
 ;;; Copyright (c) 1992-2000 Massachusetts Institute of Technology
 ;;;
@@ -480,7 +480,7 @@
 	    (call-with-interface-port
 	     (let ((buff (new-buffer " *debug*-RESTARTS")))
 	       (add-browser-buffer! browser buff)
-	       (pop-up-buffer buff)
+	       (pop-up-buffer buff #f)
 	       (buffer-start buff))
 	     (lambda (port)
 	       (write-string "  " port)
diff --git a/v7/src/edwin/os2.scm b/v7/src/edwin/os2.scm
index 53ecdf04d..f4c361099 100644
--- a/v7/src/edwin/os2.scm
+++ b/v7/src/edwin/os2.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: os2.scm,v 1.49 2000/03/23 03:19:15 cph Exp $
+;;; $Id: os2.scm,v 1.50 2000/07/28 15:15:33 cph Exp $
 ;;;
 ;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology
 ;;;
@@ -157,7 +157,7 @@
     (let ((buffer (temporary-buffer "*popclient*")))
       (cleanup-pop-up-buffers
        (lambda ()
-	 (pop-up-buffer buffer)
+	 (pop-up-buffer buffer #f)
 	 (let ((status.reason
 		(let ((args
 		       (list "-u" user-name
diff --git a/v7/src/edwin/sendmail.scm b/v7/src/edwin/sendmail.scm
index 64370f891..c2939df7f 100644
--- a/v7/src/edwin/sendmail.scm
+++ b/v7/src/edwin/sendmail.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: sendmail.scm,v 1.67 2000/07/20 02:30:03 cph Exp $
+;;; $Id: sendmail.scm,v 1.68 2000/07/28 15:15:34 cph Exp $
 ;;;
 ;;; Copyright (c) 1991-2000 Massachusetts Institute of Technology
 ;;;
@@ -242,7 +242,7 @@ is inserted."
 	     (if selector (selector buffer))
 	     (if (cleanup-pop-up-buffers
 		  (lambda ()
-		    (if (not selector) (pop-up-buffer buffer))
+		    (if (not selector) (pop-up-buffer buffer #f))
 		    (prompt-for-confirmation?
 		     "Unsent message being composed; erase it")))
 		 (continue #f)
diff --git a/v7/src/edwin/unix.scm b/v7/src/edwin/unix.scm
index 7859128db..1c6e9184a 100644
--- a/v7/src/edwin/unix.scm
+++ b/v7/src/edwin/unix.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: unix.scm,v 1.108 2000/04/30 22:17:08 cph Exp $
+;;; $Id: unix.scm,v 1.109 2000/07/28 15:15:35 cph Exp $
 ;;;
 ;;; Copyright (c) 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -575,7 +575,7 @@ option, instead taking -P <filename>."
     (let ((buffer (temporary-buffer "*popclient*")))
       (cleanup-pop-up-buffers
        (lambda ()
-	 (pop-up-buffer buffer)
+	 (pop-up-buffer buffer #f)
 	 (let ((status.reason
 		(unix/call-with-pop-client-password-options password
 		  (lambda (password-options)
diff --git a/v7/src/edwin/vc.scm b/v7/src/edwin/vc.scm
index 19cec6d36..8484cb387 100644
--- a/v7/src/edwin/vc.scm
+++ b/v7/src/edwin/vc.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: vc.scm,v 1.69 2000/05/16 15:12:07 cph Exp $
+;;; $Id: vc.scm,v 1.70 2000/07/28 15:15:37 cph Exp $
 ;;;
 ;;; Copyright (c) 1994-2000 Massachusetts Institute of Technology
 ;;;
@@ -487,7 +487,8 @@ merge in the changes into your working copy."
 			   (if (not shown?)
 			       (begin
 				 (if from-dired?
-				     (pop-up-buffer buffer #f #t)
+				     (pop-up-buffer buffer #f
+						    '(NOT-CURRENT-WINDOW))
 				     (select-buffer buffer))
 				 (set! shown? #t))))))
 		   ;; If the file on disk is newer, then the user just
@@ -1847,7 +1848,7 @@ the value of vc-log-mode-hook."
 		 ;; anyhow:
 		 #f)
 		(else
-		 (pop-up-buffer buffer)
+		 (pop-up-buffer buffer #f)
 		 (error "Couldn't analyze cvs update result."))))))))
 
 ;;;; Command Execution
diff --git a/v7/src/edwin/webster.scm b/v7/src/edwin/webster.scm
index d0872e9b2..86c479c88 100644
--- a/v7/src/edwin/webster.scm
+++ b/v7/src/edwin/webster.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: webster.scm,v 1.4 2000/04/30 22:17:10 cph Exp $
+$Id: webster.scm,v 1.5 2000/07/28 15:15:38 cph Exp $
 
 Copyright (c) 1998-2000 Massachusetts Institute of Technology
 
@@ -111,7 +111,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	     (let ((windows (buffer-windows buffer)))
 	       (if (null? windows)
 		   (begin
-		     (pop-up-buffer buffer #f #f)
+		     (pop-up-buffer buffer #f)
 		     (car (buffer-windows buffer)))
 		   (car windows)))))
 	(set-window-point! window m)
diff --git a/v7/src/edwin/wincom.scm b/v7/src/edwin/wincom.scm
index 4de840ae4..7624f4ae7 100644
--- a/v7/src/edwin/wincom.scm
+++ b/v7/src/edwin/wincom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: wincom.scm,v 1.125 2000/04/07 19:53:16 cph Exp $
+;;; $Id: wincom.scm,v 1.126 2000/07/28 15:14:19 cph Exp $
 ;;;
 ;;; Copyright (c) 1987, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -474,14 +474,11 @@ Also kills any pop up window it may have created."
 (define *minibuffer-scroll-window* (weak-cons #f #f))
 (define *pop-up-buffer-window-alist* '())
 
-(define (pop-up-buffer buffer #!optional select? not-current-window?)
+(define (pop-up-buffer buffer select? #!optional options)
   ;; If some new window is created by this procedure, it is returned
   ;; as the value.  Otherwise the value is #f.
-  (let ((select? (and (not (default-object? select?)) select?))
-	(current-window-ok?
-	 (if (default-object? not-current-window?)
-	     #t
-	     (not not-current-window?))))
+  (let ((select? (if (default-object? select?) #f select?))
+	(options (if (default-object? options) '() options)))
 
     (define (pop-up-window window)
       (let ((window (window-split-vertically! window #f)))
@@ -497,14 +494,16 @@ Also kills any pop up window it may have created."
     (define (maybe-record-window window)
       (weak-set-car! *minibuffer-scroll-window* window)
       (if select? (select-window window))
-      #f)
+      (and (eq? window (weak-car *previous-popped-up-window*))
+	   window))
 
     (define (find-visible-window buffer)
       (let loop ((windows (buffer-windows buffer)))
 	(and (not (null? windows))
 	     (let ((window (car windows)))
 	       (if (and (window-visible? window)
-			(or current-window-ok? (not (current-window? window))))
+			(or (not (memq 'NOT-CURRENT-WINDOW options))
+			    (not (current-window? window))))
 		   window
 		   (loop (cdr windows)))))))
 
@@ -535,9 +534,7 @@ Also kills any pop up window it may have created."
 		   (let ((window (largest-window)))
 		     (if (and (>= (window-y-size window)
 				  (ref-variable split-height-threshold))
-			      (not
-			       (window-has-horizontal-neighbor?
-				window)))
+			      (not (window-has-horizontal-neighbor? window)))
 			 (pop-up-window window)
 			 (let ((window (lru-window))
 			       (current (current-window)))
-- 
2.25.1