From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 20 Oct 2000 04:30:19 +0000 (+0000)
Subject: Add option to POP-UP-BUFFER to allow the argument to
X-Git-Tag: 20090517-FFI~3238
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d9e7d5dd5f2cf06b840d620fb32a8f6dcfcc50ba;p=mit-scheme.git

Add option to POP-UP-BUFFER to allow the argument to
WINDOW-SPLIT-VERTICALLY! to be supplied.
---

diff --git a/v7/src/edwin/wincom.scm b/v7/src/edwin/wincom.scm
index 7624f4ae7..7e5265105 100644
--- a/v7/src/edwin/wincom.scm
+++ b/v7/src/edwin/wincom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: wincom.scm,v 1.126 2000/07/28 15:14:19 cph Exp $
+;;; $Id: wincom.scm,v 1.127 2000/10/20 04:30:19 cph Exp $
 ;;;
 ;;; Copyright (c) 1987, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -469,6 +469,21 @@ Also kills any pop up window it may have created."
 	(weak-set-car! *previous-popped-up-window* #f)
 	(weak-set-car! *previous-popped-up-buffer* #f))))
 
+(define (pop-up-buffer-option options name default)
+  (let loop ((options options))
+    (if (pair? options)
+	(let ((option (car options)))
+	  (cond ((eq? name option)
+		 #t)
+		((and (pair? option)
+		      (eq? name (car option))
+		      (pair? (cdr option))
+		      (null? (cddr option)))
+		 (cadr option))
+		(else
+		 (loop (cdr options)))))
+	default)))
+
 (define *previous-popped-up-window* (weak-cons #f #f))
 (define *previous-popped-up-buffer* (weak-cons #f #f))
 (define *minibuffer-scroll-window* (weak-cons #f #f))
@@ -481,7 +496,10 @@ Also kills any pop up window it may have created."
 	(options (if (default-object? options) '() options)))
 
     (define (pop-up-window window)
-      (let ((window (window-split-vertically! window #f)))
+      (let ((window
+	     (window-split-vertically!
+	      window
+	      (pop-up-buffer-option options 'HEIGHT #f))))
 	(weak-set-car! *previous-popped-up-window* window)
 	(weak-set-cdr! *previous-popped-up-window* (window-y-size window))
 	(pop-into-window window)
@@ -502,7 +520,9 @@ Also kills any pop up window it may have created."
 	(and (not (null? windows))
 	     (let ((window (car windows)))
 	       (if (and (window-visible? window)
-			(or (not (memq 'NOT-CURRENT-WINDOW options))
+			(or (not (pop-up-buffer-option options
+						       'NOT-CURRENT-WINDOW
+						       #f))
 			    (not (current-window? window))))
 		   window
 		   (loop (cdr windows)))))))