From 8663a352c8b3070516e068c4529c37715b7b30e9 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 26 Oct 2000 02:30:07 +0000
Subject: [PATCH] Eliminate pre-select-buffer-hooks mechanism from previous
 change. This turns out not to work quite right for the problem at hand.
 Instead implement a buffer-layout mechanism that should solve the problem
 more neatly.

---
 v7/src/edwin/curren.scm | 89 +++++++++++++++++++++++++++++------------
 1 file changed, 63 insertions(+), 26 deletions(-)

diff --git a/v7/src/edwin/curren.scm b/v7/src/edwin/curren.scm
index b6e01e469..5cc37672d 100644
--- a/v7/src/edwin/curren.scm
+++ b/v7/src/edwin/curren.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;; $Id: curren.scm,v 1.127 2000/10/25 05:07:27 cph Exp $
+;;; $Id: curren.scm,v 1.128 2000/10/26 02:30:07 cph Exp $
 ;;;
 ;;; Copyright (c) 1986, 1989-2000 Massachusetts Institute of Technology
 ;;;
@@ -410,6 +410,7 @@ The frame is guaranteed to be deselected at that time."
 	       (buffer-processes buffer))
      (for-each (lambda (hook) (hook buffer))
 	       (get-buffer-hooks buffer 'KILL-BUFFER-HOOKS))
+     (delete-buffer-layout buffer)
      (if (not (make-buffer-invisible buffer))
 	 (error "Buffer to be killed has no replacement" buffer))
      (bufferset-kill-buffer! (current-bufferset) buffer))))
@@ -455,33 +456,20 @@ The frame is guaranteed to be deselected at that time."
      (if (selected-window? window)
 	 (change-selected-buffer window buffer record?
 	   (lambda ()
-	     (set-window-buffer! window buffer)))
-	 (set-window-buffer! window buffer)))))
+	     (maybe-select-buffer-layout window buffer)))
+	 (maybe-select-buffer-layout window buffer)))))
 
 (define (change-selected-buffer window buffer record? selection-thunk)
-  (let ((finish-selection
-	 (lambda ()
-	   (change-local-bindings! (selected-buffer) buffer selection-thunk)
-	   (set-buffer-point! buffer (window-point window))
-	   (if record?
-	       (bufferset-select-buffer! (current-bufferset) buffer))
-	   (for-each (lambda (hook) (hook buffer window))
-		     (get-buffer-hooks buffer 'SELECT-BUFFER-HOOKS))
-	   (if (not (minibuffer? buffer))
-	       (event-distributor/invoke! (ref-variable select-buffer-hook #f)
-					  buffer
-					  window)))))
-    (let loop ((hooks (get-buffer-hooks buffer 'PRE-SELECT-BUFFER-HOOKS)))
-      (if (pair? hooks)
-	  ((car hooks) buffer window finish-selection
-		       (lambda () (loop (cdr hooks))))
-	  (finish-selection)))))
-
-(define (add-pre-select-buffer-hook buffer hook)
-  (add-buffer-hook buffer 'PRE-SELECT-BUFFER-HOOKS hook))
-
-(define (remove-pre-select-buffer-hook buffer hook)
-  (remove-buffer-hook buffer 'PRE-SELECT-BUFFER-HOOKS hook))
+  (change-local-bindings! (selected-buffer) buffer selection-thunk)
+  (set-buffer-point! buffer (window-point window))
+  (if record?
+      (bufferset-select-buffer! (current-bufferset) buffer))
+  (for-each (lambda (hook) (hook buffer window))
+	    (get-buffer-hooks buffer 'SELECT-BUFFER-HOOKS))
+  (if (not (minibuffer? buffer))
+      (event-distributor/invoke! (ref-variable select-buffer-hook #f)
+				 buffer
+				 window)))
 
 (define (add-select-buffer-hook buffer hook)
   (add-buffer-hook buffer 'SELECT-BUFFER-HOOKS hook))
@@ -519,6 +507,55 @@ The buffer is guaranteed to be selected at that time."
 	(editor-error "Selected buffer has no process"))
     process))
 
+;;;; Buffer Layouts
+
+(define (create-buffer-layout selector buffers)
+  (let ((layout (cons selector (list->weak-list buffers))))
+    (for-each (lambda (buffer)
+		(if (buffer-get buffer buffer-layout-key #f)
+		    (error "Can't add buffer to multiple layouts:" buffer))
+		(buffer-put! buffer buffer-layout-key layout))
+	      buffers)))
+
+(define (maybe-select-buffer-layout window buffer)
+  (let ((screen (window-screen window)))
+    (if (let ((layout (hash-table/get screen-buffer-layouts screen #f)))
+	  (and layout
+	       (not (weak-memq buffer (cdr layout)))))
+	(begin
+	  (delete-other-windows window)
+	  (hash-table/remove! screen-buffer-layouts screen)))
+    (let ((layout (buffer-get buffer buffer-layout-key #f)))
+      (if layout
+	  (begin
+	    (hash-table/put! screen-buffer-layouts screen layout)
+	    (delete-other-windows window)
+	    ((car layout) window (cdr layout)))
+	  (set-window-buffer! window buffer)))))
+
+(define (delete-buffer-layout buffer)
+  (let ((layout (buffer-get buffer buffer-layout-key #f)))
+    (if layout
+	(begin
+	  (do ((buffers (cdr layout) (weak-cdr buffers)))
+	      ((not (weak-pair? buffers)))
+	    (let ((buffer (weak-car buffers)))
+	      (if buffer
+		  (buffer-remove! buffer buffer-layout-key))))
+	  (hash-table/for-each screen-buffer-layouts
+	    (lambda (screen layout*)
+	      (if (eq? layout layout*)
+		  (hash-table/remove! screen-buffer-layouts screen))))))))
+
+(define buffer-layout-key
+  (list 'BUFFER-LAYOUT))
+
+(define screen-buffer-layouts)
+(add-event-receiver! editor-initializations
+  (lambda ()
+    (set! screen-buffer-layouts (make-eq-hash-table))
+    unspecific))
+
 ;;;; Point
 
 (define (current-point)
-- 
2.25.1