From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 26 Oct 2000 22:12:50 +0000 (+0000)
Subject: Add code to mark buffer layout inactive when one of its windows is
X-Git-Tag: 20090517-FFI~3212
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=017f72d899b4b50bc2fa6dc8170850f34479063f;p=mit-scheme.git

Add code to mark buffer layout inactive when one of its windows is
deleted.
---

diff --git a/v7/src/edwin/comwin.scm b/v7/src/edwin/comwin.scm
index 623789f19..04d7c9019 100644
--- a/v7/src/edwin/comwin.scm
+++ b/v7/src/edwin/comwin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: comwin.scm,v 1.144 1999/01/02 06:11:34 cph Exp $
+;;; $Id: comwin.scm,v 1.145 2000/10/26 22:12:47 cph Exp $
 ;;;
 ;;; Copyright (c) 1985, 1989-1999 Massachusetts Institute of Technology
 ;;;
@@ -368,53 +368,55 @@
 
 (define (window-delete! leaf #!optional merge-into)
   (check-leaf-window leaf 'WINDOW-DELETE!)
-  (without-interrupts
-   (lambda ()
-     (let ((superior (window-superior leaf))
-	   (next (window-next leaf))
-	   (previous (window-previous leaf))
-	   (x-size (window-x-size leaf))
-	   (y-size (window-y-size leaf)))
-       (if (not (combination? superior))
-	   (editor-error "Window has no neighbors; can't delete"))
-       (let ((adjust-size!
-	      (lambda (window)
-		(if (current-window? leaf)
-		    (select-window
-		     (let loop ((window window))
-		       (if (combination? window)
-			   (loop (combination-child window))
-			   window))))
-		(unlink-leaf! leaf)
-		(if (combination-vertical? superior)
-		    (=> window :set-y-size!
-			(+ (window-y-size window) y-size))
-		    (=> window :set-x-size!
-			(+ (window-x-size window) x-size))))))
-	 (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)))))
+  (let ((screen (window-screen leaf)))
+    (without-interrupts
+     (lambda ()
+       (let ((superior (window-superior leaf))
+	     (next (window-next leaf))
+	     (previous (window-previous leaf))
+	     (x-size (window-x-size leaf))
+	     (y-size (window-y-size leaf)))
+	 (if (not (combination? superior))
+	     (editor-error "Window has no neighbors; can't delete"))
+	 (let ((adjust-size!
+		(lambda (window)
+		  (if (current-window? leaf)
+		      (select-window
+		       (let loop ((window window))
+			 (if (combination? window)
+			     (loop (combination-child window))
+			     window))))
+		  (unlink-leaf! leaf)
+		  (if (combination-vertical? superior)
+		      (=> window :set-y-size!
+			  (+ (window-y-size window) y-size))
+		      (=> window :set-x-size!
+			  (+ (window-x-size window) x-size))))))
+	   (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))))
+    (maybe-deselect-buffer-layout screen)))
 
 (define (unlink-leaf! leaf)
   (let ((combination (window-superior leaf))
diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index ca7b95440..4ab1e3356 100644
--- a/v7/src/edwin/curren.scm
+++ b/v7/src/edwin/curren.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: curren.scm,v 1.136 2000/10/26 19:22:20 cph Exp $
+;;; $Id: curren.scm,v 1.137 2000/10/26 22:12:50 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -575,6 +575,15 @@ The buffer is guaranteed to be selected at that time."
 				  (delete-buffer-layout buffer)
 				  #f)))))))))))
     (if thunk (thunk))))
+
+(define (maybe-deselect-buffer-layout screen)
+  (without-interrupts
+   (lambda ()
+     (let ((layout (hash-table/get screen-buffer-layouts screen #f)))
+       (and layout
+	    (begin
+	      (hash-table/remove! screen-buffer-layouts screen)
+	      layout))))))
 
 (define (delete-buffer-layout buffer)
   (without-interrupts