From: Chris Hanson <org/chris-hanson/cph>
Date: Sun, 30 Apr 1995 06:56:13 +0000 (+0000)
Subject: Add optional argument to WINDOW-DELETE! procedure.  This argument is a
X-Git-Tag: 20090517-FFI~6368
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=9894d027f1bbef08845313d4615e6d74d2fc239e;p=mit-scheme.git

Add optional argument to WINDOW-DELETE! procedure.  This argument is a
window that should get the space released by the deleted window.  If
it is not adjacent to the deleted window, the argument is ignored.
---

diff --git a/v7/src/edwin/comwin.scm b/v7/src/edwin/comwin.scm
index d05a98a71..40ee6f55d 100644
--- a/v7/src/edwin/comwin.scm
+++ b/v7/src/edwin/comwin.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comwin.scm,v 1.142 1991/07/09 22:51:16 cph Exp $
+;;;	$Id: comwin.scm,v 1.143 1995/04/30 06:56:13 cph Exp $
 ;;;
-;;;	Copyright (c) 1985, 1989-91 Massachusetts Institute of Technology
+;;;	Copyright (c) 1985, 1989-95 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -390,7 +390,7 @@
 
 ;;;; Deletion
 
-(define (window-delete! leaf)
+(define (window-delete! leaf #!optional merge-into)
   (check-leaf-window leaf 'WINDOW-DELETE!)
   (without-interrupts
    (lambda ()
@@ -415,20 +415,29 @@
 			(+ (window-y-size window) y-size))
 		    (=> window :set-x-size!
 			(+ (window-x-size window) x-size))))))
-	 (cond (next
-		(adjust-size! next)
-		(let ((inferior (window-inferior superior next)))
-		  (if (combination-vertical? superior)
-		      (set-inferior-y-start!
-		       inferior
-		       (- (inferior-y-start inferior) y-size))
-		      (set-inferior-x-start!
-		       inferior
-		       (- (inferior-x-start inferior) x-size)))))
-	       (previous
-		(adjust-size! previous))
-	       (else
-		(error "combination with single child" superior))))
+	 (let ((do-next
+		(lambda ()
+		  (adjust-size! next)
+		  (let ((inferior (window-inferior superior next)))
+		    (if (combination-vertical? superior)
+			(set-inferior-y-start!
+			 inferior
+			 (- (inferior-y-start inferior) y-size))
+			(set-inferior-x-start!
+			 inferior
+			 (- (inferior-x-start inferior) x-size))))))
+	       (do-previous
+		(lambda ()
+		  (adjust-size! previous))))
+	   (cond ((and (not (default-object? merge-into))
+		       merge-into
+		       (or (eq? merge-into next) (eq? merge-into previous)))
+		  (if (eq? merge-into next)
+		      (do-next)
+		      (do-previous)))
+		 (next (do-next))
+		 (previous (do-previous))
+		 (else (error "Combination with single child:" superior)))))
        (maybe-delete-combination! superior)))))
 
 (define (unlink-leaf! leaf)