From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 2 Nov 1990 03:25:13 +0000 (+0000)
Subject: Requires microcode 11.50 and runtime 14.100.
X-Git-Tag: 20090517-FFI~11110
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a9adac1da72441e805c7b04667d957b94039c4ad;p=mit-scheme.git

Requires microcode 11.50 and runtime 14.100.

* Implementation of update optimizer, and direct use of termcap rather
  than the buggy curses.

* Extensive rewrite of display update code.  New display update
  scrolls lines in some cases, and is tuned to offset the added cost
  of running the update optimizer.

* New display update event-tracing facility for debugging.

* If the last line of the buffer is empty, and the previous line is
  completely visible, the modeline says that the bottom of the buffer
  is visible.

* Editor variables can have value validity tests, which are applied
  whenever the variable's value is altered.  If the test fails, an
  error is signalled, so that user code can depend on the variable's
  contents satisfying the validity test.

* `(buffer-point (current-buffer))' now equivalent to
  `(current-point)'.

* `window-redraw!' no longer takes a second argument.  It's new
  meaning is to force the window to be redrawn from scratch, without
  affecting the window starting point or cursor position.

* Removed procedures:
	window-end-index
	window-redraw-preserving-point!

* Changed `window-start-index' to `window-start-mark'.

* Change terminal state control to use new I/O port operations that
  extract channels, and perform the terminal controls directly on
  those channels.

* Internal flag `debug-internal-errors?' facilitates debugging Edwin
  if set true.  Normally this is false.

* When first starting the editor, the default behavior is to try to
  use Scheme's controlling terminal, and if that isn't available, to
  use X.  If Scheme is started under Emacs, it has no controlling
  terminal, and therefore it will use X.
---

diff --git a/v7/src/edwin/buffer.scm b/v7/src/edwin/buffer.scm
index 68a54accf..822c8a0d8 100644
--- a/v7/src/edwin/buffer.scm
+++ b/v7/src/edwin/buffer.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.137 1990/10/03 04:54:07 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffer.scm,v 1.138 1990/11/02 03:22:26 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -53,7 +53,7 @@
   modes
   comtabs
   windows
-  cursor-y
+  display-start
   pathname
   truename
   alist
@@ -100,7 +100,7 @@ The buffer is guaranteed to be deselected at that time."
 	(vector-set! buffer buffer-index:modes (list mode))
 	(vector-set! buffer buffer-index:comtabs (mode-comtabs mode))
 	(vector-set! buffer buffer-index:windows '())
-	(vector-set! buffer buffer-index:cursor-y false)
+	(vector-set! buffer buffer-index:display-start false)
 	(vector-set! buffer buffer-index:pathname false)
 	(vector-set! buffer buffer-index:truename false)
 	(vector-set! buffer buffer-index:alist '())
@@ -139,8 +139,7 @@ The buffer is guaranteed to be deselected at that time."
      (buffer-modeline-event! buffer 'BUFFER-PATHNAME)
      (vector-set! buffer buffer-index:auto-save-pathname false)
      (vector-set! buffer buffer-index:auto-save-modified? false)
-     (vector-set! buffer buffer-index:save-length 0)
-     unspecific)))
+     (vector-set! buffer buffer-index:save-length 0))))
 
 (define (set-buffer-name! buffer name)
   (vector-set! buffer buffer-index:name name)
@@ -155,31 +154,27 @@ The buffer is guaranteed to be deselected at that time."
   (buffer-modeline-event! buffer 'BUFFER-TRUENAME))
 
 (define-integrable (set-buffer-auto-save-pathname! buffer pathname)
-  (vector-set! buffer buffer-index:auto-save-pathname pathname)
-  unspecific)
+  (vector-set! buffer buffer-index:auto-save-pathname pathname))
 
 (define-integrable (set-buffer-auto-saved! buffer)
-  (vector-set! buffer buffer-index:auto-save-modified? false)
-  unspecific)
+  (vector-set! buffer buffer-index:auto-save-modified? false))
 
 (define-integrable (set-buffer-save-length! buffer)
-  (vector-set! buffer buffer-index:save-length (buffer-length buffer))
-  unspecific)
+  (vector-set! buffer buffer-index:save-length (buffer-length buffer)))
 
 (define-integrable (set-buffer-backed-up?! buffer flag)
-  (vector-set! buffer buffer-index:backed-up? flag)
-  unspecific)
+  (vector-set! buffer buffer-index:backed-up? flag))
 
 (define-integrable (set-buffer-modification-time! buffer flag)
-  (vector-set! buffer buffer-index:modification-time flag)
-  unspecific)
+  (vector-set! buffer buffer-index:modification-time flag))
 
 (define-integrable (set-buffer-comtabs! buffer comtabs)
-  (vector-set! buffer buffer-index:comtabs comtabs)
-  unspecific)
+  (vector-set! buffer buffer-index:comtabs comtabs))
 
-(define-integrable (buffer-point buffer)
-  (group-point (buffer-group buffer)))
+(define (buffer-point buffer)
+  (if (current-buffer? buffer)
+      (current-point)
+      (group-point (buffer-group buffer))))
 
 (define-integrable (%set-buffer-point! buffer mark)
   (set-group-point! (buffer-group buffer) mark))
@@ -211,18 +206,15 @@ The buffer is guaranteed to be deselected at that time."
 (define (add-buffer-window! buffer window)
   (vector-set! buffer
 	       buffer-index:windows
-	       (cons window (vector-ref buffer buffer-index:windows)))
-  unspecific)
+	       (cons window (vector-ref buffer buffer-index:windows))))
 
 (define (remove-buffer-window! buffer window)
   (vector-set! buffer
 	       buffer-index:windows
-	       (delq! window (vector-ref buffer buffer-index:windows)))
-  unspecific)
+	       (delq! window (vector-ref buffer buffer-index:windows))))
 
-(define-integrable (set-buffer-cursor-y! buffer cursor-y)
-  (vector-set! buffer buffer-index:cursor-y cursor-y)
-  unspecific)
+(define-integrable (set-buffer-display-start! buffer mark)
+  (vector-set! buffer buffer-index:display-start mark))
 
 (define-integrable (buffer-visible? buffer)
   (not (null? (buffer-windows buffer))))
@@ -238,18 +230,15 @@ The buffer is guaranteed to be deselected at that time."
 	(set-cdr! entry value)
 	(vector-set! buffer buffer-index:alist
 		     (cons (cons key value)
-			   (vector-ref buffer buffer-index:alist)))))
-  unspecific)
+			   (vector-ref buffer buffer-index:alist))))))
 
 (define (buffer-remove! buffer key)
   (vector-set! buffer
 	       buffer-index:alist
-	       (del-assq! key (vector-ref buffer buffer-index:alist)))
-  unspecific)
+	       (del-assq! key (vector-ref buffer buffer-index:alist))))
 
 (define-integrable (reset-buffer-alist! buffer)
-  (vector-set! buffer buffer-index:alist '())
-  unspecific)
+  (vector-set! buffer buffer-index:alist '()))
 
 ;;;; Modification Flags
 
@@ -278,8 +267,7 @@ The buffer is guaranteed to be deselected at that time."
 	(begin
 	  (set-group-modified! group true)
 	  (buffer-modeline-event! buffer 'BUFFER-MODIFIED)))
-    (vector-set! buffer buffer-index:auto-save-modified? true)
-    unspecific))
+    (vector-set! buffer buffer-index:auto-save-modified? true)))
 
 (define (buffer-clip-daemon buffer)
   (lambda (group start end)
@@ -327,8 +315,7 @@ The buffer is guaranteed to be deselected at that time."
 	(begin
 	  ((car thunks))
 	  (loop (cdr thunks)))))
-  (vector-set! buffer buffer-index:initializations '())
-  unspecific)
+  (vector-set! buffer buffer-index:initializations '()))
 
 ;;;; Local Bindings
 
@@ -337,6 +324,7 @@ The buffer is guaranteed to be deselected at that time."
    (lambda ()
      (let ((buffer (current-buffer))
 	   (old-value (variable-value variable)))
+       (check-variable-value-validity! variable new-value)
        (%set-variable-value! variable new-value)
        (invoke-variable-assignment-daemons! variable)
        (let ((bindings (buffer-local-bindings buffer)))
@@ -344,8 +332,7 @@ The buffer is guaranteed to be deselected at that time."
 	   (if (not binding)
 	       (vector-set! buffer
 			    buffer-index:local-bindings
-			    (cons (cons variable old-value) bindings))))))
-     unspecific)))
+			    (cons (cons variable old-value) bindings)))))))))
 
 (define (unmake-local-binding! variable)
   (without-interrupts
@@ -359,8 +346,7 @@ The buffer is guaranteed to be deselected at that time."
 		 (invoke-variable-assignment-daemons! variable)
 		 (vector-set! buffer
 			      buffer-index:local-bindings
-			      (delq! binding bindings)))))))
-     unspecific)))
+			      (delq! binding bindings))))))))))
 
 (define (undo-local-bindings!)
   (let ((buffer (current-buffer)))
@@ -369,8 +355,7 @@ The buffer is guaranteed to be deselected at that time."
 		  (%set-variable-value! variable (cdr binding))
 		  (invoke-variable-assignment-daemons! variable)))
 	      (buffer-local-bindings buffer))
-    (vector-set! buffer buffer-index:local-bindings '()))
-  unspecific)
+    (vector-set! buffer buffer-index:local-bindings '())))
 
 (define (with-current-local-bindings! thunk)
   (let ((wind-bindings
@@ -420,34 +405,24 @@ The buffer is guaranteed to be deselected at that time."
 	(for-each invoke-variable-assignment-daemons! variables))))
 
 (define (variable-local-value buffer variable)
-  (let ((in-cell
-	 (lambda ()
-	   (variable-value variable))))
-    (if (current-buffer? buffer)
-	(in-cell)
-	(let ((binding (assq variable (buffer-local-bindings buffer))))
-	  (cond (binding
-		 (cdr binding))
-		((and (variable-buffer-local? variable)
-		      (within-editor?))
-		 (let ((binding
-			(assq variable
-			      (buffer-local-bindings (current-buffer)))))
-		   (if binding
-		       (cdr binding)
-		       (in-cell))))
-		(else
-		 (in-cell)))))))
+  (let ((binding
+	 (and (within-editor?)
+	      (not (current-buffer? buffer))
+	      (or (assq variable (buffer-local-bindings buffer))
+		  (and (variable-buffer-local? variable)
+		       (assq variable
+			     (buffer-local-bindings (current-buffer))))))))
+    (if binding
+	(cdr binding)
+	(variable-value variable))))
 
 (define (set-variable-local-value! buffer variable value)
-  (if (current-buffer? buffer)
-      (set-variable-value! variable value)
-      (let ((binding (assq variable (buffer-local-bindings buffer))))
-	(if binding
-	    (begin
-	      (set-cdr! binding value)
-	      unspecific)
-	    (set-variable-value! variable value)))))
+  (let ((binding
+	 (and (not (current-buffer? buffer))
+	      (assq variable (buffer-local-bindings buffer)))))
+    (if binding
+	(set-cdr! binding value)
+	(set-variable-value! variable value))))
 
 (define (define-variable-local-value! buffer variable value)
   (if (current-buffer? buffer)
@@ -460,8 +435,7 @@ The buffer is guaranteed to be deselected at that time."
 		 (set-cdr! binding value)
 		 (vector-set! buffer
 			      buffer-index:local-bindings
-			      (cons (cons variable value) bindings)))
-	     unspecific))))))
+			      (cons (cons variable value) bindings)))))))))
 
 (define (variable-local-value? buffer variable)
   (assq variable (buffer-local-bindings buffer)))
@@ -475,11 +449,10 @@ The buffer is guaranteed to be deselected at that time."
 (define (set-variable-default-value! variable value)
   (let ((binding (assq variable (buffer-local-bindings (current-buffer)))))
     (if binding
-	(begin
-	  (set-cdr! binding value)
-	  unspecific)
+	(set-cdr! binding value)
 	(without-interrupts
 	 (lambda ()
+	   (check-variable-value-validity! variable value)
 	   (%set-variable-value! variable value)
 	   (invoke-variable-assignment-daemons! variable))))))
 
diff --git a/v7/src/edwin/buffrm.scm b/v7/src/edwin/buffrm.scm
index 011b888f0..dfd1ccec1 100644
--- a/v7/src/edwin/buffrm.scm
+++ b/v7/src/edwin/buffrm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.36 1990/10/06 00:15:22 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.37 1990/11/02 03:22:35 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -47,26 +47,31 @@
 (declare (usual-integrations))
 
 (define-class buffer-frame combination-leaf-window
-  (text-inferior
-   border-inferior
+  (
+   ;; The inferior (of type BUFFER-WINDOW) that displays the buffer's
+   ;; text.
+   text-inferior
+
+   ;; The inferior (of type MODELINE-WINDOW) that displays the
+   ;; modeline.  May be #F if this window has no modeline (e.g. a
+   ;; typein window).
    modeline-inferior
-   last-select-time
-   override-message))
 
-(define-integrable (buffer-frame? object)
-  (object-of-class? buffer-frame object))
+   ;; The inferior (of type VERTICAL-BORDER-WINDOW) that draws a
+   ;; vertical border on the right-hand side of the window when this
+   ;; window has a neighbor to its right.
+   border-inferior
 
-(define (make-buffer-frame superior new-buffer modeline?)
-  (let ((frame (=> superior :make-inferior buffer-frame)))
-    (let ((window (frame-text-inferior frame)))
-      (initial-buffer! window new-buffer)
-      (%window-setup-truncate-lines! window false))
-    (initial-modeline! frame modeline?)
-    frame))
+   ;; A nonnegative integer that is updated when this window is
+   ;; selected.  This updating is performed by the editor frame that
+   ;; this window is a part of.
+   last-select-time
+   ))
 
 (define-method buffer-frame (:make-leaf frame)
   (let ((frame* (=> superior :make-inferior buffer-frame)))
-    (initial-buffer! (frame-text-inferior frame*) (window-buffer frame))
+    (set-buffer-frame-size! frame* (window-x-size frame) (window-y-size frame))
+    (set-window-buffer! frame* (window-buffer frame))
     (initial-modeline! frame* modeline-inferior)
     frame*))
 
@@ -74,15 +79,31 @@
   (usual=> frame :initialize! window*)
   (set! text-inferior (make-inferior frame buffer-window))
   (set! border-inferior (make-inferior frame vertical-border-window))
-  (set! last-select-time 0)
-  (set! override-message false)
-  unspecific)
-
-;;; **** Kludge: The text-inferior will generate modeline events, so
-;;; if the modeline gets redisplayed first it will be left with its
-;;; redisplay-flag set but its superior's redisplay-flag cleared.
+  (set! last-select-time 0))
+
+(define-method buffer-frame (:kill! window)
+  (remove-buffer-window! (window-buffer window) window)
+  (usual=> window :kill!))
+
+(define-method buffer-frame (:update-display! window screen x-start y-start
+					      xl xu yl yu display-style)
+  ;; Assumes that interrupts are disabled.
+  (and (update-inferior! text-inferior screen x-start y-start
+			 xl xu yl yu display-style
+			 buffer-window:update-display!)
+       (if modeline-inferior
+	   (update-inferior! modeline-inferior screen x-start y-start
+			     xl xu yl yu display-style
+			     modeline-window:update-display!)
+	   true)
+       (update-inferior! border-inferior screen x-start y-start
+			 xl xu yl yu display-style
+			 vertical-border-window:update-display!)))
 
 (define (initial-modeline! frame modeline?)
+  ;; **** Kludge: The text-inferior will generate modeline events, so
+  ;; if the modeline gets redisplayed first it will be left with its
+  ;; redisplay-flag set but its superior's redisplay-flag cleared.
   (with-instance-variables buffer-frame frame (modeline?)
     (if modeline?
 	(begin
@@ -90,55 +111,38 @@
 	  (set! inferiors
 		(append! (delq! modeline-inferior inferiors)
 			 (list modeline-inferior))))
-	(set! modeline-inferior false))
-    unspecific))
-
-(define-integrable (window-cursor frame)
-  (%window-cursor (frame-text-inferior frame)))
-
+	(set! modeline-inferior false))))
+
 (define-integrable (frame-text-inferior frame)
   (with-instance-variables buffer-frame frame ()
     (inferior-window text-inferior)))
 
-(define (frame-modeline-inferior frame)
-  (with-instance-variables buffer-frame frame ()
-    (and modeline-inferior
-	 (inferior-window modeline-inferior))))
-
-(define (window-select-time frame)
-  (with-instance-variables buffer-frame frame ()
-    last-select-time))
+(define-method buffer-frame (:set-size! window x y)
+  (set-buffer-frame-size! window x y))
 
-(define (set-window-select-time! frame time)
-  (with-instance-variables buffer-frame frame (time)
-    (set! last-select-time time)
-    unspecific))
+(define-method buffer-frame (:set-x-size! window x)
+  (set-buffer-frame-size! window x y-size))
+
+(define-method buffer-frame (:set-y-size! window y)
+  (set-buffer-frame-size! window x-size y))
 
 (define (set-buffer-frame-size! window x y)
   (with-instance-variables buffer-frame window (x y)
     (usual=> window :set-size! x y)
+    (if modeline-inferior
+	(begin
+	  (set! y (- y (inferior-y-size modeline-inferior)))
+	  (set-inferior-start! modeline-inferior 0 y)
+	  (set-inferior-x-size! modeline-inferior x)))
     (if (window-has-right-neighbor? window)
-	(let ((x* (- x (inferior-x-size border-inferior))))
-	  (set-inferior-start! border-inferior x* 0)
-	  (set-inferior-y-size! border-inferior y)
-	  (set! x x*))
+	(begin
+	  (set! x (- x (inferior-x-size border-inferior)))
+	  (set-inferior-start! border-inferior x 0)
+	  (set-inferior-y-size! border-inferior y))
 	(set-inferior-start! border-inferior false false))
-    (if modeline-inferior
-	(let ((y* (- y (inferior-y-size modeline-inferior))))
-	  (set-inferior-start! modeline-inferior 0 y*)
-	  (set-inferior-x-size! modeline-inferior x)
-	  (set! y y*)))
     (set-inferior-start! text-inferior 0 0)
-    (set-inferior-size! text-inferior x y)))
-
-(define-method buffer-frame :set-size!
-  set-buffer-frame-size!)
-
-(define-method buffer-frame (:set-x-size! window x)
-  (set-buffer-frame-size! window x y-size))
-
-(define-method buffer-frame (:set-y-size! window y)
-  (set-buffer-frame-size! window x-size y))
+    (set-inferior-size! text-inferior x y))
+  (window-setup-truncate-lines! window))
 
 (define-method buffer-frame (:minimum-x-size window)
   (if (window-has-right-neighbor? window)
@@ -151,170 +155,184 @@
       (+ (ref-variable window-minimum-height)
 	 (inferior-y-size modeline-inferior))
       (ref-variable window-minimum-height)))
+
+;;;; External Entries
 
-(define (buffer-frame-x-size frame)
+(define-integrable (buffer-frame? object)
+  (object-of-class? buffer-frame object))
+
+(define (make-buffer-frame superior new-buffer modeline?)
+  (let ((frame (=> superior :make-inferior buffer-frame)))
+    (set-window-buffer! frame new-buffer)
+    (initial-modeline! frame modeline?)
+    frame))
+
+(define-integrable (buffer-frame-x-size frame)
   (window-x-size (frame-text-inferior frame)))
 
-(define (buffer-frame-y-size frame)
+(define-integrable (buffer-frame-y-size frame)
   (window-y-size (frame-text-inferior frame)))
-
-;;;; External Entries
+
+(define-integrable (buffer-frame-needs-redisplay? frame)
+  (buffer-window/needs-redisplay? (frame-text-inferior frame)))
+
+(define-integrable (window-cursor-enable! frame)
+  (buffer-window/cursor-enable! (frame-text-inferior frame)))
+
+(define-integrable (window-cursor-disable! frame)
+  (buffer-window/cursor-disable! (frame-text-inferior frame)))
+
+(define-integrable (window-select-time frame)
+  (with-instance-variables buffer-frame frame ()
+    last-select-time))
+
+(define-integrable (set-window-select-time! frame time)
+  (with-instance-variables buffer-frame frame (time)
+    (set! last-select-time time)))
 
 (define-integrable (window-buffer frame)
-  (%window-buffer (frame-text-inferior frame)))
+  (buffer-window/buffer (frame-text-inferior frame)))
 
 (define (set-window-buffer! frame buffer)
-  (if (and (string-ci=? (buffer-name buffer) "Bluffer")
-	   (null? (buffer-windows buffer)))
-      (buffer-reset! buffer))
-  (%set-window-buffer! (frame-text-inferior frame) buffer))
+  ;; BUFFER-WINDOW/SET-BUFFER! expects to have interrupts locked here.
+  (without-interrupts
+   (lambda ()
+     ;; Someday this will bite someone...
+     (if (and (string-ci=? (buffer-name buffer) "bluffer")
+	      (null? (buffer-windows buffer)))
+	 (buffer-reset! buffer))
+     (if (window-buffer frame)
+	 (remove-buffer-window! (window-buffer frame) frame))
+     (buffer-window/set-buffer! (frame-text-inferior frame) buffer)
+     (add-buffer-window! buffer frame)
+     (window-setup-truncate-lines! frame))))
 
 (define-integrable (window-point frame)
-  (%window-point (frame-text-inferior frame)))
-
-(define (set-window-point! frame point)
-  (let ((window (frame-text-inferior frame)))
-    (%set-window-point! window (clip-mark-to-display window point))))
+  (buffer-window/point (frame-text-inferior frame)))
 
-(define (window-redraw! frame redraw-type)
-  (%window-force-redraw! (frame-text-inferior frame) redraw-type))
+(define-integrable (set-window-point! frame mark)
+  (buffer-window/set-point! (frame-text-inferior frame) mark))
 
-(define (window-redraw-preserving-point! frame)
-  (let ((window (frame-text-inferior frame)))
-    (%window-force-redraw! window (%window-point-y window))))
-
-(define-integrable (window-needs-redisplay? frame)
-  (with-instance-variables buffer-frame frame ()
-    (car (inferior-redisplay-flags text-inferior))))
+(define-integrable (window-redraw! frame)
+  (buffer-window/redraw! (frame-text-inferior frame)))
 
 (define (window-modeline-event! frame type)
   (with-instance-variables buffer-frame frame (type)
     (if modeline-inferior
 	(=> (inferior-window modeline-inferior) :event! type)))
   (screen-modeline-event! (window-screen frame) frame type))
+
+(define-integrable (window-override-message window)
+  (buffer-window/override-message (frame-text-inferior window)))
 
-(define (window-set-override-message! window message)
-  (with-instance-variables buffer-frame window (message)
-    (set! override-message message))
-  (set-override-message! (frame-text-inferior window) message))
+(define-integrable (window-set-override-message! window message)
+  (buffer-window/set-override-message! (frame-text-inferior window) message))
 
-(define (window-clear-override-message! window)
-  (clear-override-message! (frame-text-inferior window))
-  (with-instance-variables buffer-frame window ()
-    (set! override-message false)))
+(define-integrable (window-clear-override-message! window)
+  (buffer-window/clear-override-message! (frame-text-inferior window)))
 
-(define (window-override-message window)
-  (with-instance-variables buffer-frame window ()
-    override-message))
+(define-integrable (window-direct-update! frame display-style)
+  (buffer-window/direct-update! (frame-text-inferior frame) display-style))
 
 (define-integrable (window-home-cursor! window)
-  (home-cursor! (frame-text-inferior window)))
-
-(define-integrable (window-direct-update! frame display-style)
-  (%window-direct-update! (frame-text-inferior frame) display-style))
+  (buffer-window/home-cursor! (frame-text-inferior window)))
 
-(define (window-direct-output-insert-char! frame char)
-  (without-interrupts
-   (lambda ()
-     (let ((point (window-point frame)))
-       (%group-insert-char! (mark-group point) (mark-index point) char))
-     (%direct-output-insert-char! (frame-text-inferior frame) char))))
+(define-integrable (window-direct-output-forward-char! frame)
+  (buffer-window/direct-output-forward-char! (frame-text-inferior frame)))
 
-(define (window-direct-output-insert-newline! frame)
-  (without-interrupts
-   (lambda ()
-     (let ((point (window-point frame)))
-       (%group-insert-char! (mark-group point) (mark-index point) #\newline))
-     (%direct-output-insert-newline! (frame-text-inferior frame)))))
+(define-integrable (window-direct-output-backward-char! frame)
+  (buffer-window/direct-output-backward-char! (frame-text-inferior frame)))
 
-(define (window-direct-output-insert-substring! frame string start end)
-  (without-interrupts
-   (lambda ()
-     (let ((point (window-point frame)))
-       (%group-insert-substring! (mark-group point) (mark-index point)
-				 string start end))
-     (%direct-output-insert-substring! (frame-text-inferior frame)
-				       string start end))))
+(define-integrable (window-direct-output-insert-char! frame char)
+  (buffer-window/direct-output-insert-char! (frame-text-inferior frame) char))
 
-(define-integrable (window-direct-output-forward-char! frame)
-  (without-interrupts
-   (lambda ()
-     (%direct-output-forward-character! (frame-text-inferior frame)))))
+(define-integrable (window-direct-output-insert-newline! frame)
+  (buffer-window/direct-output-insert-newline! (frame-text-inferior frame)))
 
-(define-integrable (window-direct-output-backward-char! frame)
-  (without-interrupts
-   (lambda ()
-     (%direct-output-backward-character! (frame-text-inferior frame)))))
+(define-integrable (window-direct-output-insert-substring! frame
+							   string start end)
+  (buffer-window/direct-output-insert-substring! (frame-text-inferior frame)
+						 string start end))
 
-(define (window-scroll-y-absolute! frame y-point)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-scroll-y-absolute! window y-point)))
+(define-integrable (window-scroll-y-absolute! frame y-point)
+  (buffer-window/scroll-y-absolute! (frame-text-inferior frame) y-point))
 
-(define (window-scroll-y-relative! frame delta)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-scroll-y-relative! window delta)))
+(define-integrable (window-scroll-y-relative! frame delta)
+  (buffer-window/scroll-y-relative! (frame-text-inferior frame) delta))
 
-(define (set-window-start-mark! frame mark force?)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%set-window-start-mark! window
-			     (clip-mark-to-display window mark)
-			     force?)))
+(define-integrable (set-window-start-mark! frame mark force?)
+  (buffer-window/set-start-mark! (frame-text-inferior frame) mark force?))
 
 (define-integrable (window-y-center frame)
-  (%window-y-center (frame-text-inferior frame)))
+  (buffer-window/y-center (frame-text-inferior frame)))
 
-(define (window-start-index frame)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-start-index window)))
+(define-integrable (window-start-mark frame)
+  (buffer-window/start-mark (frame-text-inferior frame)))
 
-(define (window-end-index frame)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-end-index window)))
-
-(define (window-mark-visible? frame mark)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-mark-visible? window mark)))
-
-(define (window-mark->x frame mark)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-mark->x window (clip-mark-to-display window mark))))
-
-(define (window-mark->y frame mark)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-mark->y window (clip-mark-to-display window mark))))
-
-(define (window-mark->coordinates frame mark)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-mark->coordinates window (clip-mark-to-display window mark))))
-
-(define (window-point-x frame)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-point-x window)))
-
-(define (window-point-y frame)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-point-y window)))
-
-(define (window-point-coordinates frame)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-point-coordinates window)))
-
-(define (window-coordinates->mark frame x y)
-  (let ((window (frame-text-inferior frame)))
-    (maybe-recompute-image! window)
-    (%window-coordinates->mark window x y)))
+(define-integrable (window-mark-visible? frame mark)
+  (buffer-window/mark-visible? (frame-text-inferior frame) mark))
+
+(define-integrable (window-mark->x frame mark)
+  (buffer-window/mark->x (frame-text-inferior frame) mark))
+
+(define-integrable (window-mark->y frame mark)
+  (buffer-window/mark->y (frame-text-inferior frame) mark))
+
+(define-integrable (window-mark->coordinates frame mark)
+  (buffer-window/mark->coordinates (frame-text-inferior frame) mark))
 
+(define-integrable (window-point-x frame)
+  (buffer-window/point-x (frame-text-inferior frame)))
+
+(define-integrable (window-point-y frame)
+  (buffer-window/point-y (frame-text-inferior frame)))
+
+(define-integrable (window-point-coordinates frame)
+  (buffer-window/point-coordinates (frame-text-inferior frame)))
+
+(define-integrable (window-coordinates->mark frame x y)
+  (buffer-window/coordinates->mark (frame-text-inferior frame) x y))
+
+(define-integrable (set-window-debug-trace! frame debug-trace)
+  (%set-window-debug-trace! (frame-text-inferior frame) debug-trace))
+
 (define (window-setup-truncate-lines! frame)
-  (%window-setup-truncate-lines! (frame-text-inferior frame) 'START))
\ No newline at end of file
+  (let ((window (frame-text-inferior frame))
+	(truncate-lines?
+	 (let ((buffer (window-buffer frame)))
+	   (or (and (variable-local-value
+		     buffer
+		     (ref-variable-object truncate-partial-width-windows))
+		    (window-has-horizontal-neighbor? frame))
+	       (variable-local-value buffer
+				     (ref-variable-object truncate-lines))))))
+    (if (not (boolean=? (%window-truncate-lines? window) truncate-lines?))
+	(without-interrupts
+	 (lambda ()
+	   (%set-window-truncate-lines?! window truncate-lines?)
+	   (buffer-window/redraw! window))))))
+
+(define-variable-per-buffer truncate-lines
+  "*True means do not display continuation lines;
+give each line of text one screen line.
+Automatically becomes local when set in any fashion.
+
+Note that this is overridden by the variable
+truncate-partial-width-windows if that variable is true
+and this buffer is not full-screen width."
+  false)
+
+(define-variable truncate-partial-width-windows
+  "*True means truncate lines in all windows less than full screen wide."
+  true)
+
+(let ((setup-truncate-lines!
+       (lambda (variable)
+	 variable			;ignore
+	 (for-each window-setup-truncate-lines! (window-list)))))
+  (add-variable-assignment-daemon!
+   (ref-variable-object truncate-lines)
+   setup-truncate-lines!)
+  (add-variable-assignment-daemon!
+   (ref-variable-object truncate-partial-width-windows)
+   setup-truncate-lines!))
\ No newline at end of file
diff --git a/v7/src/edwin/bufwfs.scm b/v7/src/edwin/bufwfs.scm
index eda125866..7fa20358f 100644
--- a/v7/src/edwin/bufwfs.scm
+++ b/v7/src/edwin/bufwfs.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwfs.scm,v 1.8 1990/10/09 16:23:21 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwfs.scm,v 1.9 1990/11/02 03:22:42 cph Rel $
 ;;;
-;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -42,211 +42,184 @@
 ;;; of that license should have been included along with this file.
 ;;;
 
-;;;; Buffer Windows:  Fill and Scroll
+;;;; Buffer Windows: Fill and Scroll
 
 (declare (usual-integrations))
 
-;;;; Fill
+(define (fill-top window inferiors start)
+  ;; Assumes non-null INFERIORS.
+  (let loop
+      ((inferiors inferiors)
+       (start start)
+       (y-start (inferior-y-start (car inferiors))))
+    (if (fix:<= y-start 0)
+	inferiors
+	(let* ((end (fix:- start 1))
+	       (start (%window-line-start-index window end))
+	       (inferior (make-line-inferior window start end))
+	       (y-start (fix:- y-start (inferior-y-size inferior))))
+	  (%set-inferior-y-start! inferior y-start)
+	  (loop (cons inferior inferiors) start y-start)))))
 
-(define (fill-top! window inferiors start fill-bottom?)
-  (with-instance-variables buffer-window window (inferiors start fill-bottom?)
-    ;; INFERIORS is assumed to be not '(), and START is the start index
-    ;; of the first inferior in that list.  FILL-BOTTOM?, if true, means
-    ;; try to fill the bottom of INFERIORS after filling the top.
-    (let ((group (buffer-group buffer)))
-      (define (do-bottom! inferiors start)
-	(if (null? (cdr inferiors))
-	    (set-cdr! inferiors
-		      (fill-bottom window
-				   (inferior-y-end (car inferiors))
-				   (line-end-index group start)))
-	    (do-bottom! (cdr inferiors)
-			(fix:+ start (line-inferior-length inferiors)))))
-      (let loop
-	  ((y-start (inferior-y-start (car inferiors)))
-	   (start start)
-	   (inferiors inferiors))
-	(cond ((not (fix:positive? y-start))
-	       (if fill-bottom? (do-bottom! inferiors start))
-	       (set-line-inferiors! window inferiors start))
-	      ((group-start-index? group start)
-	       (set-line-inferiors! window
-				    (scroll-lines-up! window inferiors 0 start)
-				    start))
-	      (else
-	       (let ((end (fix:-1+ start)))
-		 (let ((start (line-start-index group end)))
+(define (fill-middle! window
+		      top-inferiors top-start
+		      bottom-inferiors bottom-start)
+  ;; Assumes non-null TOP-INFERIORS and BOTTOM-INFERIORS.
+  (let loop ((inferiors top-inferiors) (start top-start))
+    (let ((start (fix:+ start (line-inferior-length (car inferiors)))))
+      (if (not (null? (cdr inferiors)))
+	  (loop (cdr inferiors) start)
+	  (set-cdr!
+	   inferiors
+	   (let loop
+	       ((start start) (y-start (%inferior-y-end (car inferiors))))
+	     (if (fix:= start bottom-start)
+		 bottom-inferiors
+		 (let ((end (%window-line-end-index window start)))
 		   (let ((inferior (make-line-inferior window start end)))
-		     (let ((y-start
-			    (fix:- y-start (inferior-y-size inferior))))
-		       (set-inferior-start! inferior 0 y-start)
-		       (loop y-start start (cons inferior inferiors))))))))))))
-
-(define (fill-bottom window y-end end-index)
-  (with-instance-variables buffer-window window (y-end end-index)
-    ;; Generates a list of inferiors which will be appended to a list
-    ;; ending in Y-END and END-INDEX.
-    (let ((group (buffer-group buffer)))
-      (let loop ((y-start y-end) (end end-index))
-	(if (or (not (fix:< y-start y-size))
-		(group-end-index? group end))
-	    '()
-	    (let ((start (fix:1+ end)))
-	      (let ((end (line-end-index group start)))
-		(let ((inferior (make-line-inferior window start end)))
-		  (set-inferior-start! inferior 0 y-start)
-		  (cons inferior (loop (inferior-y-end inferior) end))))))))))
-
-(define (fill-middle! window y-end end-index tail tail-start-index)
-  (with-instance-variables buffer-window window
-			   (y-end end-index tail tail-start-index)
-    ;; Generates a list of inferiors which will be appended to a list
-    ;; ending in Y-END and END-INDEX.  TAIL will be appended to the
-    ;; generated list if it is visible, and scrolled up or down as
-    ;; needed.  TAIL-START-INDEX says where TAIL begins.  It is assumed
-    ;; that (> TAIL-START-INDEX END-INDEX), and that TAIL is non-'().
-    (let ((group (buffer-group buffer)))
-      (let loop ((y-end y-end) (end end-index))
-	(let ((start (fix:1+ end)))
-	  (cond ((fix:= start tail-start-index)
-		 (let ((old-y-end (inferior-y-start (car tail))))
-		   (cond ((fix:> y-end old-y-end)
-			  (scroll-lines-down! window tail y-end))
-			 ((fix:< y-end old-y-end)
-			  (scroll-lines-up! window tail y-end start))
-			 (else tail))))
-		((not (fix:< y-end y-size)) '())
-		(else
-		 (let ((end (line-end-index group start)))
-		   (let ((inferior (make-line-inferior window start end)))
-		     (set-inferior-start! inferior 0 y-end)
+		     (%set-inferior-y-start! inferior y-start)
 		     (cons inferior
-			   (loop (inferior-y-end inferior) end)))))))))))
-
-;;;; Scroll
+			   (loop (fix:+ end 1)
+				 (fix:+ y-start
+					(inferior-y-size inferior))))))))))))
+  top-inferiors)
 
-(define (%set-window-start-mark! window mark force?)
-  (let ((start-y (%window-mark->y window mark)))
-    (and (or force?
-	     (let ((point-y (fix:- (%window-point-y window) start-y)))
-	       (and (not (fix:negative? point-y))
-		    (fix:< point-y (window-y-size window)))))
-	 (begin
-	   (%window-scroll-y-relative! window start-y)
-	   true))))
+(define (fill-bottom! window inferiors start)
+  ;; Assumes non-null INFERIORS.
+  (let loop ((inferiors inferiors) (start start))
+    (let ((end
+	   (fix:+ start
+		  (line-window-length
+		   (inferior-window (car inferiors))))))
+      (if (not (null? (cdr inferiors)))
+	  (loop (cdr inferiors) (fix:+ end 1))
+	  (let ((y-start (%inferior-y-end (car inferiors))))
+	    (if (or (%window-group-end-index? window end)
+		    (fix:>= y-start (window-y-size window)))
+		(set-current-end-index! window end)
+		(set-cdr! inferiors
+			  (generate-line-inferiors window
+						   (fix:+ end 1)
+						   y-start)))))))
+  inferiors)
 
-(define (%window-scroll-y-absolute! window y-point)
-  (with-instance-variables buffer-window window (y-point)
-    (%window-scroll-y-relative! window
-				(fix:- (%window-point-y window) y-point))))
+(define (generate-line-inferiors window start y-start)
+  ;; Assumes (FIX:< Y-START (WINDOW-Y-SIZE WINDOW))
+  (let ((y-size (window-y-size window)))
+    (let loop ((y-start y-start) (start start))
+      (let ((end (%window-line-end-index window start)))
+	(let ((inferior (make-line-inferior window start end)))
+	  (%set-inferior-y-start! inferior y-start)
+	  (cons inferior
+		(let ((y-start (fix:+ y-start (inferior-y-size inferior))))
+		  (if (or (%window-group-end-index? window end)
+			  (fix:>= y-start y-size))
+		      (begin
+			(set-current-end-index! window end)
+			'())
+		      (loop y-start (fix:+ end 1))))))))))
+
+(define (scroll-lines! window inferiors start y-start)
+  (cond ((or (null? inferiors)
+	     (fix:= y-start (inferior-y-start (car inferiors))))
+	 (values inferiors start))
+	((fix:< y-start (inferior-y-start (car inferiors)))
+	 (scroll-lines-up! window inferiors start y-start))
+	(else
+	 (values (scroll-lines-down! window inferiors y-start) start))))
 
-(define (%window-scroll-y-relative! window y-delta)
-  (with-instance-variables buffer-window window (y-delta)
-    (cond ((fix:negative? y-delta)
-	   (let ((y-start
-		  (fix:- (inferior-y-start (car line-inferiors)) y-delta)))
-	     (if (fix:< y-start y-size)
-		 (fill-top! window
-			    (scroll-lines-down! window line-inferiors y-start)
-			    (mark-index start-line-mark)
-			    false)
-		 (redraw-at! window
-			     (or (%window-coordinates->mark window 0 y-delta)
-				 (buffer-start buffer))))))
-	  ((fix:positive? y-delta)
-	   (let ((inferiors (y->inferiors window y-delta)))
-	     (if inferiors
-		 (let ((start (inferiors->index window inferiors)))
-		   (set-line-inferiors!
-		    window
-		    (scroll-lines-up! window
-				      inferiors
-				      (fix:- (inferior-y-start (car inferiors))
-					     y-delta)
-				      start)
-		    start))
-		 (redraw-at! window
-			     (or (%window-coordinates->mark window 0 y-delta)
-				 (buffer-end buffer)))))))
-    (everything-changed!
-     window
-     (lambda (window)
-       (let ((y
-	      (if (fix:positive? y-delta)
-		  0
-		  (fix:-1+ (window-y-size window)))))
-	 (%set-buffer-point! buffer (%window-coordinates->mark window 0 y))
-	 (set! point (buffer-point buffer))
-	 (set-inferior-start! cursor-inferior 0 y)
-	 (set! point-moved? false)
-	 (window-modeline-event! superior 'WINDOW-SCROLLED))))))
+(define (scroll-lines-up! window inferiors start y-start)
+  (let ((do-scroll
+	 (lambda (inferiors start y-start)
+	   (%scroll-lines-up! window inferiors y-start)
+	   (values inferiors start))))
+    (if (fix:>= y-start 0)
+	(do-scroll inferiors start y-start)
+	(let loop ((inferiors inferiors) (start start) (y-start y-start))
+	  (cond ((null? inferiors)
+		 (values '() start))
+		((fix:= y-start 0)
+		 (do-scroll inferiors start y-start))
+		(else
+		 (let ((y-end
+			(fix:+ y-start (inferior-y-size (car inferiors)))))
+		   (if (fix:> y-end 0)
+		       (do-scroll inferiors start y-start)
+		       (loop (cdr inferiors)
+			     (fix:+ start
+				    (line-inferior-length (car inferiors)))
+			     y-end)))))))))
 
-(define (redraw-at! window mark)
-  (with-instance-variables buffer-window window (mark)
-    (%set-buffer-point! buffer mark)
-    (set! point (buffer-point buffer))
-    (redraw-screen! window 0)))
-
 (define (scroll-lines-down! window inferiors y-start)
-  ;; Returns new list of new inferiors.
-  (with-instance-variables buffer-window window (inferiors y-start)
-    (let ((scrolled?
-	   (let ((yl (inferior-y-start (car inferiors))))
-	     (let ((amount (fix:- y-start yl)))
-	       (and (fix:< yl saved-yu)
-		    (fix:< amount (fix:- saved-yu saved-yl))
-		    (screen-scroll-lines-down! saved-screen
-					       (fix:+ saved-xl saved-x-start)
-					       (fix:+ saved-xu saved-x-start)
-					       (fix:+ (fix:max yl saved-yl)
-						      saved-y-start)
-					       (fix:+ saved-yu saved-y-start)
-					       amount))))))
-      (let loop ((inferiors inferiors) (y-start y-start))
-	(%set-inferior-y-start! (car inferiors) y-start)
-	(if (not scrolled?)
-	    (inferior-needs-redisplay! (car inferiors)))
-	(cons (car inferiors)
-	      (let ((inferiors (cdr inferiors))
-		    (y-start (inferior-y-end (car inferiors))))
-		(if (or (null? inferiors)
-			(not (fix:< y-start y-size)))
-		    '()
-		    (loop inferiors y-start))))))))
+  (let ((y-size (window-y-size window)))
+    (if (or (null? inferiors)
+	    (fix:>= y-start y-size))
+	'()
+	(begin
+	  (let loop ((inferiors inferiors) (y-start y-start))
+	    (if (not (null? (cdr inferiors)))
+		(let ((y-end
+		       (fix:+ y-start (inferior-y-size (car inferiors)))))
+		  (if (fix:>= y-end y-size)
+		      (set-cdr! inferiors '())
+		      (loop (cdr inferiors) y-end)))))
+	  (%scroll-lines-down! window inferiors y-start)
+	  inferiors))))
+
+(define (%scroll-lines-down! window inferiors y-start)
+  (adjust-scrolled-inferiors!
+   window
+   inferiors
+   y-start
+   (let ((yl (inferior-y-start (car inferiors)))
+	 (yu (%inferior-y-end (car (last-pair inferiors)))))
+     (let ((amount (fix:- y-start yl)))
+       (and (fix:< yl (%window-saved-yu window))
+	    (fix:< (%window-saved-yl window) yu)
+	    (let ((yl (fix:max (%window-saved-yl window) yl))
+		  (yu (fix:min (%window-saved-yu window) (fix:+ yu amount))))
+	      (and (fix:< amount (fix:- yu yl))
+		   (screen-scroll-lines-down
+		    (%window-saved-screen window)
+		    (fix:+ (%window-saved-xl window)
+			   (%window-saved-x-start window))
+		    (fix:+ (%window-saved-xu window)
+			   (%window-saved-x-start window))
+		    (fix:+ yl (%window-saved-y-start window))
+		    (fix:+ yu (%window-saved-y-start window))
+		    amount))))))))
 
-(define (scroll-lines-up! window inferiors y-start start-index)
-  ;; Returns new list of new inferiors.
-  (with-instance-variables buffer-window window (inferiors y-start start-index)
-    (let ((scrolled?
-	   (let ((yl (inferior-y-start (car inferiors))))
-	     (let ((amount (fix:- yl y-start)))
-	       (and (fix:< yl saved-yu)
-		    (fix:< amount (fix:- saved-yu saved-yl))
-		    (screen-scroll-lines-up! saved-screen
-					     (fix:+ saved-xl saved-x-start)
-					     (fix:+ saved-xu saved-x-start)
-					     (fix:+ (fix:max y-start saved-yl)
-						    saved-y-start)
-					     (fix:+ saved-yu saved-y-start)
-					     amount))))))
-      (let loop
-	  ((inferiors inferiors) (y-start y-start) (start-index start-index))
-	(%set-inferior-y-start! (car inferiors) y-start)
-	(if (not scrolled?)
-	    (inferior-needs-redisplay! (car inferiors)))
-	(cons (car inferiors)
-	      (let ((y-start (inferior-y-end (car inferiors))))
-		(cond ((null? (cdr inferiors))
-		       (fill-bottom window
-				    y-start
-				    (line-end-index (buffer-group buffer)
-						    start-index)))
-		      ((fix:< y-start y-size)
-		       (loop (cdr inferiors)
-			     y-start
-			     (fix:+ start-index
-				    (line-inferior-length inferiors))))
-		      (else '()))))))))
+(define (%scroll-lines-up! window inferiors y-start)
+  (adjust-scrolled-inferiors!
+   window
+   inferiors
+   y-start
+   (let ((yl (inferior-y-start (car inferiors)))
+	 (yu (%inferior-y-end (car (last-pair inferiors)))))
+     (let ((amount (fix:- yl y-start)))
+       (and (fix:< yl (%window-saved-yu window))
+	    (fix:< (%window-saved-yl window) yu)
+	    (let ((yl (fix:max (%window-saved-yl window) y-start))
+		  (yu (fix:min (%window-saved-yu window) yu)))
+	      (and (fix:< amount (fix:- yu yl))
+		   (screen-scroll-lines-up
+		    (%window-saved-screen window)
+		    (fix:+ (%window-saved-xl window)
+			   (%window-saved-x-start window))
+		    (fix:+ (%window-saved-xu window)
+			   (%window-saved-x-start window))
+		    (fix:+ yl (%window-saved-y-start window))
+		    (fix:+ yu (%window-saved-y-start window))
+		    amount))))))))
 
-(define-integrable (fix:max x y)
-  (if (fix:> x y) x y))
\ No newline at end of file
+(define (adjust-scrolled-inferiors! window inferiors y-start scrolled?)
+  (let ((y-size (window-y-size window)))
+    (let loop ((inferiors inferiors) (y-start y-start))
+      (if (not (null? inferiors))
+	  (begin
+	    (%set-inferior-y-start! (car inferiors) y-start)
+	    (let ((y-end (fix:+ y-start (inferior-y-size (car inferiors)))))
+	      (if (or (not scrolled?)
+		      (fix:<= y-end y-size))
+		  (inferior-needs-redisplay! (car inferiors)))
+	      (loop (cdr inferiors) y-end)))))))
\ No newline at end of file
diff --git a/v7/src/edwin/bufwin.scm b/v7/src/edwin/bufwin.scm
index 41c1dbba1..d039ca2a2 100644
--- a/v7/src/edwin/bufwin.scm
+++ b/v7/src/edwin/bufwin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.285 1990/10/05 23:32:36 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.286 1990/11/02 03:22:50 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -42,616 +42,983 @@
 ;;; of that license should have been included along with this file.
 ;;;
 
-;;;; Buffer Windows:  Base
+;;;; Buffer Windows: Base
 
 (declare (usual-integrations))
 
-;;; The following instance variables contain marks which must -NEVER-
-;;; be passed to anyone who will keep a pointer to them.  The reason
-;;; is that the `mark-temporary!' operation is called on these marks,
-;;; which invalidates them as soon as some change happens to the
-;;; buffer.  Remember, you were warned!
+;;; The following instance variables contain permanent marks, which
+;;; must be copied if they are passed to someone outside the buffer
+;;; window abstraction, because they are modified by side-effect.
 ;;;
-;;; start-line-mark
+;;; current-start-mark
+;;; current-end-mark
 ;;; start-mark
-;;; end-mark
-;;; end-line-mark
+;;; start-line-mark
 ;;; start-changes-mark
 ;;; end-changes-mark
 ;;; start-clip-mark
 ;;; end-clip-mark
 
 (define-class buffer-window vanilla-window
-  (buffer point changes-daemon clip-daemon
-	  cursor-inferior blank-inferior
-	  line-inferiors last-line-inferior
-	  start-line-mark start-mark end-mark end-line-mark
-	  start-changes-mark end-changes-mark point-moved?
-	  start-clip-mark end-clip-mark
-	  saved-screen saved-x-start saved-y-start
-	  saved-xl saved-xu saved-yl saved-yu
-	  override-inferior truncate-lines? force-redraw?))
+  (
+   ;; The buffer being displayed in this window.
+   buffer
+
+   ;; The point marker in this window.
+   point
+
+   ;; If this flag is false, text lines that are too long to fit on
+   ;; a single window line are displayed with multiple window lines.
+   ;; If the flag is true, such text lines are truncated to single
+   ;; window lines.
+   truncate-lines?
+
+   ;; This is the inferior window (of class CURSOR-WINDOW) that
+   ;; displays the cursor for this window.
+   cursor-inferior
+
+   ;; This is the inferior window (of class BLANK-WINDOW) that keeps
+   ;; the bottom of the window clear when there is no text in it.
+   ;; This is only used when the end of the buffer is visible in the
+   ;; window.  When not in use, it is moved offscreen so the window
+   ;; clipping will prevent it from being updated.
+   blank-inferior
+
+   ;; This is normally #F.  However, when the normal display of the
+   ;; buffer is overridden by a one-line message, as is commonly done
+   ;; for the typein window, this variable contains the inferior
+   ;; window (of class LINE-WINDOW) that displays the message.
+   override-inferior
+
+   ;; A list of the inferior windows (of class LINE-WINDOW) that are
+   ;; currently displaying the portion of the buffer that is visible
+   ;; in this window.
+   line-inferiors
+
+   ;; This permanent mark records where the first line inferior
+   ;; starts.
+   current-start-mark
+
+   ;; This permanent mark records where the last line inferior ends.
+   current-end-mark
+
+   ;; This permanent mark is the smallest that is visible in the
+   ;; window.  If the window's start is not known, this is #F.
+   start-mark
+
+   ;; This permanent mark is at the beginning of the line containing
+   ;; START-MARK.  It is #F if START-MARK is.  Note that this is the
+   ;; same as CURRENT-START-MARK at the end of a display update, and
+   ;; is changed due to point motion and scrolling.
+   start-line-mark
+
+   ;; This is the Y coordinate of START-LINE-MARK.  It is undefined if
+   ;; START-LINE-MARK is #F, otherwise it is guaranteed to be
+   ;; non-positive.
+   start-line-y
+
+   ;; This contains the daemon that is invoked when insertions or
+   ;; deletions are performed on the buffer.
+   changes-daemon
+
+   ;; These variables delimit the region of the buffer that has been
+   ;; affected by insertions or deletions since the last display
+   ;; update.  If no changes have occurred, they are #F.
+   start-changes-mark
+   end-changes-mark
+
+   ;; This contains the daemon that is invoked when the buffer's
+   ;; display clipping is changed.
+   clip-daemon
+
+   ;; These variables delimit the region of the buffer that has been
+   ;; unaffected by clipping since the last display update.  If the
+   ;; clipping has not changed since then, they are #F.
+   start-clip-mark
+   end-clip-mark
+
+   ;; If true, this flag indicates that point has moved since the last
+   ;; time that START-LINE-MARK was set.
+   point-moved?
+
+   ;; If true, this flag indicates that the window should be entirely
+   ;; redrawn at the next display update.
+   force-redraw?
+
+   ;; These variables record where the last display update drew its
+   ;; output.  SAVED-SCREEN is the screen on which it occurred.
+   ;; SAVED-X-START and SAVED-Y-START is the position, in the screen's
+   ;; coordinates, at which the window was located.  SAVED-XL,
+   ;; SAVED-XU, SAVED-YL, and SAVED-YU (window's coordinates) delimit
+   ;; the rectangular portion of the window that was drawn.
+   saved-screen
+   saved-x-start
+   saved-y-start
+   saved-xl
+   saved-xu
+   saved-yl
+   saved-yu
+
+   ;; This variable, if not #F, is a procedure that is called at
+   ;; interesting times to generate a debugging trace.
+   debug-trace))
+
+;;;; Instance Variable Accessors
 
-(define-method buffer-window (:initialize! window window*)
-  (usual=> window :initialize! window*)
-  (set! cursor-inferior (make-inferior window cursor-window))
-  (set! blank-inferior (make-inferior window blank-window))
-  (set! changes-daemon (make-changes-daemon window))
-  (set! clip-daemon (make-clip-daemon window))
-  (set! override-inferior false)
-  (set! force-redraw? 'CENTER)
-  unspecific)
+(define-integrable (%window-buffer window)
+  (with-instance-variables buffer-window window () buffer))
 
-(define-method buffer-window (:kill! window)
-  (delete-window-buffer! window)
-  (usual=> window :kill!))
+(define-integrable (%window-group window)
+  (buffer-group (%window-buffer window)))
 
-(define-method buffer-window (:update-display! window screen x-start y-start
-					       xl xu yl yu display-style)
-  (set! saved-screen screen)
-  (set! saved-x-start x-start) (set! saved-y-start y-start)
-  (set! saved-xl xl) (set! saved-xu xu) (set! saved-yl yl) (set! saved-yu yu)
-  (update-buffer-window! window screen x-start y-start
-			 xl xu yl yu display-style))
+(define-integrable (%set-window-buffer! window buffer*)
+  (with-instance-variables buffer-window window (buffer*)
+    (set! buffer buffer*)))
 
-(define-method buffer-window (:salvage! window)
-  (%set-buffer-point! buffer
-		      (make-mark (buffer-group buffer)
-				 (group-start-index (buffer-group buffer))))
-  (set! point (buffer-point buffer))
-  (window-modeline-event! superior 'SALVAGE)
-  (%window-redraw! window false))
-
-(define (set-buffer-window-size! window x y)
-  (with-instance-variables buffer-window window (x y)
-    (set! saved-screen false)
-    (let ((old-y y-size))
-      (usual=> window :set-size! x y)
-      ;; Preserve point y unless it is offscreen now.
-      (%window-setup-truncate-lines! window false)
-      (%window-force-redraw! window (and old-y (%window-cursor-y window))))))
-
-(define-method buffer-window :set-size!
-  set-buffer-window-size!)
+(define-integrable (%window-point window)
+  (with-instance-variables buffer-window window () point))
 
-(define-method buffer-window (:set-x-size! window x)
-  (set-buffer-window-size! window x y-size))
+(define-integrable (%window-point-index window)
+  (mark-index-integrable (%window-point window)))
 
-(define-method buffer-window (:set-y-size! window y)
-  (set-buffer-window-size! window x-size y))
-
-(define (%window-setup-truncate-lines! window redraw-type)
-  (with-instance-variables buffer-window window ()
-    (if (not (within-editor?))
-	(begin
-	  (set! truncate-lines? (ref-variable truncate-lines))
-	  unspecific)
-	(let ((new-truncate-lines?
-	       (or (and (variable-local-value
-			 buffer
-			 (ref-variable-object truncate-partial-width-windows))
-			(window-has-horizontal-neighbor? superior))
-		   (variable-local-value
-		    buffer
-		    (ref-variable-object truncate-lines)))))
-	  (if (not (boolean=? truncate-lines? new-truncate-lines?))
-	      (begin
-		(set! truncate-lines? new-truncate-lines?)
-		(if (and redraw-type (not force-redraw?))
-		    (%window-force-redraw! window redraw-type))))))))
-
-(define-variable-per-buffer truncate-lines
-  "*True means do not display continuation lines;
-give each line of text one screen line.
-Automatically becomes local when set in any fashion.
-
-Note that this is overridden by the variable
-truncate-partial-width-windows if that variable is true
-and this buffer is not full-screen width."
-  false)
-
-(define-variable truncate-partial-width-windows
-  "*True means truncate lines in all windows less than full screen wide."
-  true)
-
-(let ((setup-truncate-lines!
-       (lambda (variable)
-	 variable			;ignore
-	 (for-each window-setup-truncate-lines! (window-list)))))
-  (add-variable-assignment-daemon!
-   (ref-variable-object truncate-lines)
-   setup-truncate-lines!)
-  (add-variable-assignment-daemon!
-   (ref-variable-object truncate-partial-width-windows)
-   setup-truncate-lines!))
+(define-integrable (%set-window-point! window point*)
+  (with-instance-variables buffer-window window (point*)
+    (set! point point*)))
+
+(define-integrable (%set-window-point-index! window index)
+  (%set-window-point! window
+		      (%make-permanent-mark (%window-group window)
+					    index
+					    true)))
+
+(define-integrable (%window-truncate-lines? window)
+  (with-instance-variables buffer-window window () truncate-lines?))
+
+(define-integrable (%set-window-truncate-lines?! window truncate-lines?*)
+  (with-instance-variables buffer-window window (truncate-lines?*)
+    (set! truncate-lines? truncate-lines?*)))
+
+(define-integrable (%window-cursor-inferior window)
+  (with-instance-variables buffer-window window () cursor-inferior))
+
+(define-integrable (%set-window-cursor-inferior! window inferior)
+  (with-instance-variables buffer-window window (inferior)
+    (set! cursor-inferior inferior)))
+
+(define-integrable (%window-blank-inferior window)
+  (with-instance-variables buffer-window window () blank-inferior))
+
+(define-integrable (%set-window-blank-inferior! window inferior)
+  (with-instance-variables buffer-window window (inferior)
+    (set! blank-inferior inferior)))
+
+(define-integrable (%window-override-inferior window)
+  (with-instance-variables buffer-window window () override-inferior))
+
+(define-integrable (%set-window-override-inferior! window inferior)
+  (with-instance-variables buffer-window window (inferior)
+    (set! override-inferior inferior)))
 
-;;;; Group Operations
+(define-integrable (%window-line-inferiors window)
+  (with-instance-variables buffer-window window () line-inferiors))
 
-;;; These are identical to the operations of the same name used
-;;; elsewhere in the editor, except that they clip at the display clip
-;;; limits rather than the text clip limits.
+(define-integrable (%set-window-line-inferiors! window inferiors)
+  (with-instance-variables buffer-window window (inferiors)
+    (set! line-inferiors inferiors)))
 
-(define-integrable (group-start-index group)
-  (mark-index (group-display-start group)))
+(define-integrable (%window-current-start-mark window)
+  (with-instance-variables buffer-window window () current-start-mark))
 
-(define-integrable (group-end-index group)
-  (mark-index (group-display-end group)))
+(define-integrable (%window-current-start-index window)
+  (mark-index-integrable (%window-current-start-mark window)))
 
-(define-integrable (group-start-index? group index)
-  (not (fix:> index (group-start-index group))))
+(define-integrable (%set-window-current-start-mark! window mark)
+  (with-instance-variables buffer-window window (mark)
+    (set! current-start-mark mark)))
 
-(define-integrable (group-end-index? group index)
-  (not (fix:< index (group-end-index group))))
+(define-integrable (%window-current-end-mark window)
+  (with-instance-variables buffer-window window () current-end-mark))
 
-(define (line-start-index group index)
-  (let ((limit (group-start-index group)))
-    (or (%find-previous-newline group index limit)
-	limit)))
+(define-integrable (%window-current-end-index window)
+  (mark-index-integrable (%window-current-end-mark window)))
 
-(define (line-end-index group index)
-  (let ((limit (group-end-index group)))
-    (or (%find-next-newline group index limit)
-	limit)))
+(define-integrable (%set-window-current-end-mark! window mark)
+  (with-instance-variables buffer-window window (mark)
+    (set! current-end-mark mark)))
 
-(define (line-start-index? group index)
-  (or (group-start-index? group index)
-      (char=? (group-left-char group index) #\newline)))
+(define-integrable (%window-start-mark window)
+  (with-instance-variables buffer-window window () start-mark))
 
-(define (line-end-index? group index)
-  (or (group-end-index? group index)
-      (char=? (group-right-char group index) #\newline)))
+(define-integrable (%window-start-index window)
+  (mark-index-integrable (%window-start-mark window)))
 
-(define (clip-mark-to-display window mark)
+(define-integrable (%set-window-start-mark! window mark)
   (with-instance-variables buffer-window window (mark)
-    (if (not (mark? mark))
-	(error "Argument not a mark" mark))
-    (if (not (mark~ point mark))
-	(error "Mark not within displayed buffer" mark))
-    (let ((group (mark-group mark))
-	  (index (mark-index mark)))
-      (cond ((group-start-index? group index) (group-display-start group))
-	    ((group-end-index? group index) (group-display-end group))
-	    (else mark)))))
+    (set! start-mark mark)))
+
+(define-integrable (%window-start-line-mark window)
+  (with-instance-variables buffer-window window () start-line-mark))
+
+(define-integrable (%window-start-line-index window)
+  (mark-index-integrable (%window-start-line-mark window)))
+
+(define-integrable (%set-window-start-line-mark! window mark)
+  (with-instance-variables buffer-window window (mark)
+    (set! start-line-mark mark)))
+
+(define-integrable (%window-start-line-y window)
+  (with-instance-variables buffer-window window () start-line-y))
+
+(define-integrable (%set-window-start-line-y! window y)
+  (with-instance-variables buffer-window window (y)
+    (set! start-line-y y)))
 
-;;;; Buffer and Point
+(define-integrable (%window-changes-daemon window)
+  (with-instance-variables buffer-window window () changes-daemon))
 
-(define-integrable (%window-buffer window)
-  (with-instance-variables buffer-window window ()
-    buffer))
-
-(define (%window-buffer-cursor-y window)
-  (with-instance-variables buffer-window window ()
-    (let ((py (buffer-cursor-y buffer)))
-      (and py
-	   (begin
-	     (set-buffer-cursor-y! buffer false)
-	     (and (fix:= (car py) (mark-index point))
-		  (fix:< (cdr py) y-size)
-		  (cdr py)))))))
-
-(define (%set-window-buffer! window new-buffer)
-  (with-instance-variables buffer-window window (new-buffer)
-    (if (not (buffer? new-buffer)) (error "Argument not a buffer" new-buffer))
-    (set-buffer-cursor-y! buffer
-			  (let ((y (%window-cursor-y window)))
-			    (and y (cons (mark-index point) y))))
-    (delete-window-buffer! window)
-    (initial-buffer! window new-buffer)
-    (window-modeline-event! superior 'NEW-BUFFER)
-    (%window-force-redraw! window (%window-buffer-cursor-y window))))
-
-(define (initial-buffer! window new-buffer)
-  (with-instance-variables buffer-window window (new-buffer)
-    (set! buffer new-buffer)
-    (add-buffer-window! buffer superior)
-    (let ((group (buffer-group buffer)))
-      (add-group-delete-daemon! group changes-daemon)
-      (add-group-insert-daemon! group changes-daemon)
-      (add-group-clip-daemon! group clip-daemon)
-      (let ((point (mark-index (buffer-point buffer)))
-	    (start (group-start-index group))
-	    (end (group-end-index group)))
-	(cond ((fix:< point start)
-	       (%set-buffer-point! buffer (make-mark group start)))
-	      ((fix:> point end)
-	       (%set-buffer-point! buffer (make-mark group end))))))
-    (set! point (buffer-point buffer))
-    unspecific))
-
-(define (delete-window-buffer! window)
-  (with-instance-variables buffer-window window ()
-    (let ((group (buffer-group buffer)))
-      (remove-group-delete-daemon! group changes-daemon)
-      (remove-group-insert-daemon! group changes-daemon)
-      (remove-group-clip-daemon! group clip-daemon))
-    (remove-buffer-window! buffer superior)))
+(define-integrable (%set-window-changes-daemon! window daemon)
+  (with-instance-variables buffer-window window (daemon)
+    (set! changes-daemon daemon)))
 
-(define-integrable (%window-point window)
-  (with-instance-variables buffer-window window ()
-    point))
+(define-integrable (%window-start-changes-mark window)
+  (with-instance-variables buffer-window window () start-changes-mark))
 
-(define (%set-window-point! window mark)
+(define-integrable (%window-start-changes-index window)
+  (mark-index-integrable (%window-start-changes-mark window)))
+
+(define-integrable (%set-window-start-changes-mark! window mark)
   (with-instance-variables buffer-window window (mark)
-    (%set-buffer-point! buffer mark)
-    (set! point (buffer-point buffer))
-    (set! point-moved? true)
-    (setup-redisplay-flags! redisplay-flags)))
-
-(define-integrable (%window-cursor window)
-  (with-instance-variables buffer-window window ()
-    (inferior-window cursor-inferior)))
-
-(define (%window-cursor-y window)
-  (with-instance-variables buffer-window window ()
-    (let ((y (inferior-y-start cursor-inferior)))
-      (and y (fix:< y y-size) y))))
+    (set! start-changes-mark mark)))
+
+(define-integrable (%window-end-changes-mark window)
+  (with-instance-variables buffer-window window () end-changes-mark))
+
+(define-integrable (%window-end-changes-index window)
+  (mark-index-integrable (%window-end-changes-mark window)))
+
+(define-integrable (%set-window-end-changes-mark! window mark)
+  (with-instance-variables buffer-window window (mark)
+    (set! end-changes-mark mark)))
+
+(define-integrable (%window-clip-daemon window)
+  (with-instance-variables buffer-window window () clip-daemon))
+
+(define-integrable (%set-window-clip-daemon! window daemon)
+  (with-instance-variables buffer-window window (daemon)
+    (set! clip-daemon daemon)))
+
+(define-integrable (%window-start-clip-mark window)
+  (with-instance-variables buffer-window window () start-clip-mark))
+
+(define-integrable (%window-start-clip-index window)
+  (mark-index-integrable (%window-start-clip-mark window)))
+
+(define-integrable (%set-window-start-clip-mark! window mark)
+  (with-instance-variables buffer-window window (mark)
+    (set! start-clip-mark mark)))
+
+(define-integrable (%window-end-clip-mark window)
+  (with-instance-variables buffer-window window () end-clip-mark))
+
+(define-integrable (%window-end-clip-index window)
+  (mark-index-integrable (%window-end-clip-mark window)))
+
+(define-integrable (%set-window-end-clip-mark! window mark)
+  (with-instance-variables buffer-window window (mark)
+    (set! end-clip-mark mark)))
+
+(define-integrable (%window-point-moved? window)
+  (with-instance-variables buffer-window window () point-moved?))
+
+(define-integrable (%set-window-point-moved?! window point-moved?*)
+  (with-instance-variables buffer-window window (point-moved?*)
+    (set! point-moved? point-moved?*)))
+
+(define-integrable (%window-force-redraw? window)
+  (with-instance-variables buffer-window window () force-redraw?))
+
+(define-integrable (%set-window-force-redraw?! window force-redraw?*)
+  (with-instance-variables buffer-window window (force-redraw?*)
+    (set! force-redraw? force-redraw?*)))
 
-;;;; Override Message
-
-;;; This is used to display messages over the typein window.
-
-(define (set-override-message! window message)
-  (with-instance-variables buffer-window window (message)
-    (if (not override-inferior)
-	(begin
-	  (set! override-inferior (make-inferior window line-window))
-	  (set! inferiors
-		(list override-inferior cursor-inferior blank-inferior))
-	  (set-inferior-start! override-inferior 0 0)))
-    (let ((override-window (inferior-window override-inferior)))
-      (set-line-window-string! override-window message truncate-lines?)
-      (set-inferior-position!
-       cursor-inferior
-       (string-base:index->coordinates override-window
-				       (string-length message))))
-    (set-blank-inferior-start! window (inferior-y-end override-inferior))))
-
-(define (clear-override-message! window)
-  (with-instance-variables buffer-window window ()
-    (if override-inferior
-	(begin
-	  (set! override-inferior false)
-	  (set! inferiors
-		(cons* cursor-inferior blank-inferior line-inferiors))
-	  (set-inferior-position! cursor-inferior
-				  (%window-mark->coordinates window point))
-	  (blank-inferior-changed! window)
-	  (for-each inferior-needs-redisplay! inferiors)))))
-
-(define (home-cursor! window)
-  (with-instance-variables buffer-window window ()
-    (screen-write-cursor! saved-screen saved-x-start saved-y-start)
-    (screen-flush! saved-screen)))
+(define-integrable (%window-saved-screen window)
+  (with-instance-variables buffer-window window () saved-screen))
+
+(define-integrable (%set-window-saved-screen! window screen)
+  (with-instance-variables buffer-window window (screen)
+    (set! saved-screen screen)))
+
+(define-integrable (%window-saved-x-start window)
+  (with-instance-variables buffer-window window () saved-x-start))
+
+(define-integrable (%set-window-saved-x-start! window x-start)
+  (with-instance-variables buffer-window window (x-start)
+    (set! saved-x-start x-start)))
+
+(define-integrable (%window-saved-y-start window)
+  (with-instance-variables buffer-window window () saved-y-start))
+
+(define-integrable (%set-window-saved-y-start! window y-start)
+  (with-instance-variables buffer-window window (y-start)
+    (set! saved-y-start y-start)))
+
+(define-integrable (%window-saved-xl window)
+  (with-instance-variables buffer-window window () saved-xl))
+
+(define-integrable (%set-window-saved-xl! window xl)
+  (with-instance-variables buffer-window window (xl)
+    (set! saved-xl xl)))
+
+(define-integrable (%window-saved-xu window)
+  (with-instance-variables buffer-window window () saved-xu))
+
+(define-integrable (%set-window-saved-xu! window xu)
+  (with-instance-variables buffer-window window (xu)
+    (set! saved-xu xu)))
+
+(define-integrable (%window-saved-yl window)
+  (with-instance-variables buffer-window window () saved-yl))
+
+(define-integrable (%set-window-saved-yl! window yl)
+  (with-instance-variables buffer-window window (yl)
+    (set! saved-yl yl)))
+
+(define-integrable (%window-saved-yu window)
+  (with-instance-variables buffer-window window () saved-yu))
+
+(define-integrable (%set-window-saved-yu! window yu)
+  (with-instance-variables buffer-window window (yu)
+    (set! saved-yu yu)))
+
+(define-integrable (%window-debug-trace window)
+  (with-instance-variables buffer-window window () debug-trace))
+
+(define-integrable (%set-window-debug-trace! window procedure)
+  (with-instance-variables buffer-window window (procedure)
+    (set! debug-trace procedure)))
 
-;;;; Inferiors
-
-(define (make-line-inferior window start end)
-  (with-instance-variables buffer-window window (start end)
-    (let ((inferior (make-inferior window line-window)))
-      (set-line-window-string! (inferior-window inferior)
-			       (group-extract-string (buffer-group buffer)
-						     start end)
-			       truncate-lines?)
-      inferior)))
+;;;; Narrowing
+
+(define-integrable (%window-group-start-mark window)
+  (group-display-start (%window-group window)))
+
+(define-integrable (%window-group-end-mark window)
+  (group-display-end (%window-group window)))
+
+(define-integrable (%window-group-start-index window)
+  (group-position->index-integrable
+   (%window-group window)
+   (mark-position (group-display-start (%window-group window)))))
+
+(define-integrable (%window-group-end-index window)
+  (group-position->index-integrable
+   (%window-group window)
+   (mark-position (group-display-end (%window-group window)))))
+
+(define-integrable (%window-group-start-index? window index)
+  (fix:<= index (%window-group-start-index window)))
+
+(define-integrable (%window-group-end-index? window index)
+  (fix:>= index (%window-group-end-index window)))
+
+(define-integrable (%window-line-start-index window index)
+  (let ((start (%window-group-start-index window)))
+    (or (%find-previous-newline (%window-group window) index start)
+	start)))
+
+(define-integrable (%window-line-end-index window index)
+  (let ((end (%window-group-end-index window)))
+    (or (%find-next-newline (%window-group window) index end)
+	end)))
+
+(define (%window-line-start-index? window index)
+  (or (%window-group-start-index? window index)
+      (char=? (string-ref (group-text (%window-group window))
+			  (fix:-1+ (group-index->position-integrable
+				    (%window-group window)
+				    index
+				    false)))
+	      #\newline)))
+
+(define (%window-line-end-index? window index)
+  (or (%window-group-end-index? window index)
+      (char=? (string-ref (group-text (%window-group window))
+			  (group-index->position-integrable
+			   (%window-group window)
+			   index
+			   true))
+	      #\newline)))
 
-(define-integrable (first-line-inferior window)
-  (with-instance-variables buffer-window window ()
-    (car line-inferiors)))
-
-(define-integrable (line-inferior-length inferiors)
-  (fix:1+ (line-window-length (inferior-window (car inferiors)))))
-
-(define-integrable (blank-inferior-changed! window)
-  (with-instance-variables buffer-window window ()
-    (if (not override-inferior)
-	(set-blank-inferior-start! window
-				   (inferior-y-end last-line-inferior)))))
-
-(define-integrable (set-blank-inferior-start! window y-end)
-  (with-instance-variables buffer-window window (y-end)
-    (if (fix:< y-end y-size)
-	(begin
-	  (set-inferior-size! blank-inferior x-size (fix:- y-size y-end))
-	  (set-inferior-start! blank-inferior 0 y-end))
-	(set-inferior-start! blank-inferior false false))))
-
-(define-integrable (set-line-inferiors! window inferiors start)
-  (with-instance-variables buffer-window window (inferiors start)
-    (set! line-inferiors inferiors)
-    (destroy-mark! start-line-mark)
-    (set! start-line-mark
-	  (%make-permanent-mark (buffer-group buffer) start false))
-    unspecific))
-
-(define (line-inferiors-changed! window)
-  (with-instance-variables buffer-window window ()
-    (let loop ((inferiors line-inferiors) (start (mark-index start-line-mark)))
-      (if (null? (cdr inferiors))
-	  (begin
-	    (set! last-line-inferior (car inferiors))
-	    (destroy-mark! end-line-mark)
-	    (set! end-line-mark
-		  (let ((group (buffer-group buffer)))
-		    (%make-permanent-mark group
-					  (line-end-index group start)
-					  true))))
-	  (loop (cdr inferiors)
-		(fix:+ start (line-inferior-length inferiors)))))
-    (set! inferiors
-	  (if override-inferior
-	      (list override-inferior cursor-inferior blank-inferior)
-	      (cons* cursor-inferior blank-inferior line-inferiors)))
-    unspecific))
+(define (clip-mark-to-display window mark)
+  (if (not (mark? mark))
+      (error:illegal-datum mark 'CLIP-MARK-TO-DISPLAY))
+  (if (and (%window-point window)
+	   (not (mark~ (%window-point window) mark)))
+      (error:datum-out-of-range mark 'CLIP-MARK-TO-DISPLAY))
+  (cond ((group-display-start-index? (mark-group mark) (mark-index mark))
+	 (group-display-start (mark-group mark)))
+	((group-display-end-index? (mark-group mark) (mark-index mark))
+	 (group-display-end (mark-group mark)))
+	(else
+	 mark)))
 
-(define (y->inferiors window y)
-  (with-instance-variables buffer-window window (y)
-    (define (loop previous-inferiors inferiors)
-      (cond ((fix:< y (inferior-y-start (car inferiors))) previous-inferiors)
-	    ((null? (cdr inferiors))
-	     (and (fix:< y (inferior-y-end (car inferiors)))
-		  inferiors))
-	    (else (loop inferiors (cdr inferiors)))))
-    (loop false line-inferiors)))
-
-(define (index->inferiors window index)
-  (with-instance-variables buffer-window window (index)
-    ;; Assumes that (>= INDEX (MARK-INDEX START-LINE-MARK)).
-    (define (loop inferiors start)
-      (let ((new-start (fix:+ start (line-inferior-length inferiors))))
-	(if (fix:< index new-start)
-	    inferiors
-	    (and (not (null? (cdr inferiors)))
-		 (loop (cdr inferiors) new-start)))))
-    (loop line-inferiors (mark-index start-line-mark))))
-
-(define (inferiors->index window inferiors)
-  (with-instance-variables buffer-window window (inferiors)
-    ;; Assumes that INFERIORS is a tail of LINE-INFERIORS.
-    (define (loop inferiors* start)
-      (if (eq? inferiors inferiors*)
-	  start
-	  (loop (cdr inferiors*)
-		(fix:+ start (line-inferior-length inferiors*)))))
-    (loop line-inferiors (mark-index start-line-mark))))
-
-(define (y->inferiors&index window y receiver)
-  (with-instance-variables buffer-window window (y receiver)
-    ;; This is used for scrolling.
-    (define (loop inferiors start previous-inferiors previous-start)
-      (cond ((fix:< y (inferior-y-start (car inferiors)))
-	     (receiver previous-inferiors previous-start))
-	    ((null? (cdr inferiors))
-	     (and (fix:< y (inferior-y-end (car inferiors)))
-		  (receiver inferiors start)))
-	    (else
-	     (loop (cdr inferiors)
-		   (fix:+ start (line-inferior-length inferiors))
-		   inferiors
-		   start))))
-    (loop line-inferiors (mark-index start-line-mark) false false)))
-
-(define (start-changes-inferiors window)
-  (with-instance-variables buffer-window window ()
-    ;; Assumes that (MARK<= START-LINE-MARK START-CHANGES-MARK).
-    ;; Guarantees to return non-'() result.
-    (or (index->inferiors window (mark-index start-changes-mark))
-	(error "Can't find START-CHANGES"))))
-
-(define (end-changes-inferiors window)
-  (with-instance-variables buffer-window window ()
-    ;; Assumes that (MARK<= END-CHANGES-MARK END-LINE-MARK).
-    ;; Guarantees to return non-'() result.
-    (let ((index (mark-index end-changes-mark)))
-      (define (loop inferiors not-found)
-	(if (null? inferiors)
-	    (not-found (mark-index end-line-mark))
-	    (loop (cdr inferiors)
-	      (lambda (end)
-		(let ((new-end (fix:- end (line-inferior-length inferiors))))
-		  (if (fix:< new-end index)
-		      inferiors
-		      (not-found new-end)))))))
-      (loop line-inferiors
-	(lambda (end)
-	  end				;ignore
-	  (error "Can't find END-CHANGES"))))))
+;;;; Utilities
+
+(define-integrable (%window-extract-string window start end)
+  (group-extract-string (%window-group window) start end))
+
+(define-integrable (%window-modeline-event! window type)
+  (window-modeline-event! (window-superior window) type))
+
+(define-integrable (set-mark-index! mark index)
+  (set-mark-position!
+   mark
+   (group-index->position-integrable (mark-group mark)
+				     index
+				     (mark-left-inserting? mark))))
+
+(define-integrable (fix:max x y)
+  (if (fix:> x y) x y))
+
+(define-integrable (fix:min x y)
+  (if (fix:< x y) x y))
 
-;;;; Changes
-
-(define (update-cursor! window if-not-visible)
-  (with-instance-variables buffer-window window (if-not-invisible)
-    (if (%window-mark-visible? window point)
-	(begin
-	  (set-inferior-position! cursor-inferior
-				  (%window-mark->coordinates window point))
-	  (set! point-moved? false))
-	(if-not-visible window))))
-
-(define (maybe-recenter! window)
-  (with-instance-variables buffer-window window ()
-    (let ((threshold (ref-variable scroll-step))
-	  (recenter!
-	   (lambda ()
-	     (%window-redraw! window (%window-y-center window)))))
-      (if (not (object-type? (ucode-type fixnum) threshold))
-	  (error "Not a small integer" threshold))
-      (if (fix:zero? threshold)
-	  (recenter!)
-	  (if (fix:< (mark-index point) (mark-index start-mark))
-	      (let ((limit
-		     (%window-coordinates->index window
-						 0
-						 (fix:- 0 threshold))))
-		(if (or (not limit)
-			(not (fix:< (mark-index point) limit)))
-		    (%window-scroll-y-relative! window
-						(%window-point-y window))
-		    (recenter!)))
-	      (let ((limit
-		     (%window-coordinates->index window
-						 0
-						 (fix:+ (window-y-size window)
-							threshold))))
-		(if (or (not limit) (fix:< (mark-index point) limit))
-		    (%window-scroll-y-relative!
-		     window
-		     (fix:- (%window-point-y window)
-			    (fix:-1+ (window-y-size window))))
-		    (recenter!))))))))
+;;;; Standard Methods
 
-(define-variable scroll-step
-  "*The number of lines to try scrolling a window by when point moves out.
-If that fails to bring point back on screen, point is centered instead.
-If this is zero, point is always centered after it moves off screen."
-  0)
+(define-method buffer-window (:initialize! window window*)
+  (usual=> window :initialize! window*)
+  (%reset-window-structures! window)
+  (%clear-window-buffer-state! window))
+
+(define-method buffer-window (:kill! window)
+  (without-interrupts (lambda () (%unset-window-buffer! window)))
+  (usual=> window :kill!))
+
+(define-method buffer-window (:salvage! window)
+  (without-interrupts
+   (lambda ()
+     (%set-window-point-index! window (%window-group-start-index window))
+     (%set-window-point-moved?! window 'SINCE-START-SET)
+     (%reset-window-structures! window)
+     (buffer-window/redraw! window))))
+
+(define-method buffer-window (:set-size! window x y)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'set-size! x y))
+  (buffer-window/redraw! window)
+  (set-window-size! window x y)
+  (%set-window-point-moved?! window 'SINCE-START-SET))
+
+(define-method buffer-window (:set-x-size! window x)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'set-x-size! x))
+  (buffer-window/redraw! window)
+  (set-window-x-size! window x)
+  (%set-window-point-moved?! window 'SINCE-START-SET))
 
-(define (%window-force-redraw! window redraw-type)
-  (with-instance-variables buffer-window window ()
-    (set! force-redraw? (or redraw-type 'CENTER))
-    (setup-redisplay-flags! redisplay-flags)))
-
-(define (%window-redraw-preserving-start! window)
-  (with-instance-variables buffer-window window ()
-    (let ((group (mark-group start-mark))
-	  (start-line (mark-index start-line-mark)))
-      (let ((start (if truncate-lines? start-line (mark-index start-mark)))
-	    (end (line-end-index group start-line)))
-	(let ((inferior (make-line-inferior window start-line end)))
-	  (set-inferior-start!
-	   inferior
-	   0
-	   (fix:- 0
-		  (string-base:index->y (inferior-window inferior)
-					(fix:- start start-line))))
-	  (set-line-inferiors!
-	   window
-	   (cons inferior (fill-bottom window (inferior-y-end inferior) end))
-	   start)))))
-  (everything-changed! window maybe-recenter!))
+(define-method buffer-window (:set-y-size! window y)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'set-y-size! y))
+  (buffer-window/redraw! window)
+  (set-window-y-size! window y)
+  (%set-window-point-moved?! window 'SINCE-START-SET))
 
-(define (%window-redraw! window y)
-  (with-instance-variables buffer-window window (y)
-    (redraw-screen! window
-		    (if (not y)
-			(%window-y-center window)
-			(begin
-			  (if (or (fix:< y 0)
-				  (not (fix:< y y-size)))
-			      (error "Attempt to scroll point off window" y))
-			  y))))
-  (everything-changed! window
-    (lambda (w)
-      (error "%WINDOW-REDRAW! left point offscreen -- get a wizard" w))))
-
-(define (redraw-screen! window y)
-  (with-instance-variables buffer-window window (y)
-    (let ((group (mark-group point))
-	  (index (mark-index point)))
-      (let ((start (line-start-index group index)))
-	(let ((inferior
-	       (make-line-inferior window start (line-end-index group index))))
-	  (set-inferior-start!
-	   inferior
-	   0
-	   (fix:- y
-		  (string-base:index->y (inferior-window inferior)
-					(fix:- index start))))
-	  (fill-top! window (list inferior) start true))))))
-
-(define (everything-changed! window if-not-visible)
-  (with-instance-variables buffer-window window (if-not-visible)
-    (no-outstanding-changes! window)
-    (line-inferiors-changed! window)
-    (blank-inferior-changed! window)
-    (start-mark-changed! window)
-    (end-mark-changed! window)
-    (update-cursor! window if-not-visible)))
-
-(define (maybe-marks-changed! window inferiors y-end)
-  (with-instance-variables buffer-window window (inferiors y-end)
-    (no-outstanding-changes! window)
-    (if (and (eq? inferiors line-inferiors)
-	     (fix:negative? (inferior-y-start (car inferiors))))
-	(start-mark-changed! window))
-    (if (and (null? (cdr inferiors))
-	     (fix:> y-end y-size))
-	(end-mark-changed! window))
-    (update-cursor! window maybe-recenter!)))
-
-(define (no-outstanding-changes! window)
-  (with-instance-variables buffer-window window ()
-    (destroy-mark! start-changes-mark)
-    (set! start-changes-mark false)
-    (destroy-mark! end-changes-mark)
-    (set! end-changes-mark false)
-    (destroy-mark! start-clip-mark)
-    (set! start-clip-mark false)
-    (destroy-mark! end-clip-mark)
-    (set! end-clip-mark false)
-    (set! force-redraw? false)
-    unspecific))
+;;;; Update
+
+(define (buffer-window:update-display! window screen x-start y-start
+				       xl xu yl yu display-style)
+  ;; Assumes that interrupts are disabled.
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window ':update-display!
+				    screen x-start y-start xl xu yl yu
+				    display-style))
+  (%set-window-saved-screen! window screen)
+  (%set-window-saved-x-start! window x-start)
+  (%set-window-saved-y-start! window y-start)
+  (%set-window-saved-xl! window xl)
+  (%set-window-saved-xu! window xu)
+  (%set-window-saved-yl! window yl)
+  (%set-window-saved-yu! window yu)
+  (update-buffer-window! window screen x-start y-start xl xu yl yu
+			 display-style))
+
+(define-method buffer-window :update-display!
+  buffer-window:update-display!)
+
+(define (buffer-window/direct-update! window display-style)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'direct-update!
+				    display-style))
+  (and (%window-saved-screen window)
+       (with-screen-in-update (%window-saved-screen window) display-style
+	 (lambda ()
+	   (let ((finished?
+		  (update-buffer-window! window
+					 (%window-saved-screen window)
+					 (%window-saved-x-start window)
+					 (%window-saved-y-start window)
+					 (%window-saved-xl window)
+					 (%window-saved-xu window)
+					 (%window-saved-yl window)
+					 (%window-saved-yu window)
+					 display-style)))
+	     (if finished?
+		 (set-car! (window-redisplay-flags window) false))
+	     finished?)))))
+
+(define (update-buffer-window! window screen x-start y-start xl xu yl yu
+			       display-style)
+  (recompute-image! window)
+  (and (if (%window-override-inferior window)
+	   (update-inferior! (%window-override-inferior window)
+			     screen x-start y-start xl xu yl yu display-style
+			     string-base:update-display!)
+	   (update-inferiors! (%window-line-inferiors window)
+			      screen x-start y-start xl xu yl yu
+			      display-style string-base:update-display!))
+       (update-inferior! (%window-blank-inferior window)
+			 screen x-start y-start xl xu yl yu display-style
+			 blank-window:update-display!)
+       (update-inferior! (%window-cursor-inferior window)
+			 screen x-start y-start xl xu yl yu display-style
+			 cursor-window:update-display!)))
+
+(define (buffer-window/redraw! window)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'force-redraw!))
+  (without-interrupts
+   (lambda ()
+     (%set-window-force-redraw?! window true)
+     (%clear-window-incremental-redisplay-state! window)
+     (window-needs-redisplay! window))))
+
+(define (buffer-window/cursor-enable! window)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'cursor-enable!))
+  (=> (inferior-window (%window-cursor-inferior window)) :enable!))
+
+(define (buffer-window/cursor-disable! window)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'cursor-disable!))
+  (=> (inferior-window (%window-cursor-inferior window)) :disable!))
+
+;;;; Window State
+
+(define (%reset-window-structures! window)
+  (set-window-inferiors! window '())
+  (%set-window-cursor-inferior! window (make-inferior window cursor-window))
+  (%set-window-blank-inferior! window (make-inferior window blank-window))
+  (%set-window-override-inferior! window false)
+  (%set-window-changes-daemon! window (make-changes-daemon window))
+  (%set-window-clip-daemon! window (make-clip-daemon window))
+  (%set-window-debug-trace! window false))
+
+(define (%clear-window-buffer-state! window)
+  (%set-window-buffer! window false)
+  (%set-window-point! window false)
+  (%set-window-truncate-lines?! window false)
+  (if (%window-start-line-mark window)
+      (clear-start-mark! window))
+  (%set-window-point-moved?! window false)
+  (%clear-window-incremental-redisplay-state! window))
+
+(define (%clear-window-incremental-redisplay-state! window)
+  (%set-window-line-inferiors! window '())
+  (set-window-inferiors! window
+			 (if (%window-override-inferior window)
+			     (list (%window-override-inferior window)
+				   (%window-cursor-inferior window)
+				   (%window-blank-inferior window))
+			     (list (%window-cursor-inferior window)
+				   (%window-blank-inferior window))))
+  (if (%window-current-start-mark window)
+      (begin
+	(mark-temporary! (%window-current-start-mark window))
+	(mark-temporary! (%window-current-end-mark window))
+	(%set-window-current-start-mark! window false)
+	(%set-window-current-end-mark! window false)))
+  (%set-window-saved-screen! window false)
+  (%clear-window-outstanding-changes! window))
+
+(define-integrable (%clear-window-outstanding-changes! window)
+  (if (%window-start-changes-mark window)
+      (begin
+	(mark-temporary! (%window-start-changes-mark window))
+	(mark-temporary! (%window-end-changes-mark window))
+	(%set-window-start-changes-mark! window false)
+	(%set-window-end-changes-mark! window false)))
+  (if (%window-start-clip-mark window)
+      (begin
+	(mark-temporary! (%window-start-clip-mark window))
+	(mark-temporary! (%window-end-clip-mark window))
+	(%set-window-start-clip-mark! window false)
+	(%set-window-end-clip-mark! window false))))
 
-(define (start-mark-changed! window)
-  (with-instance-variables buffer-window window ()
-    (destroy-mark! start-mark)
-    (set! start-mark
-	  (%make-permanent-mark
-	   (buffer-group buffer)
-	   (fix:+ (mark-index start-line-mark)
-		  (let ((inferior (first-line-inferior window)))
-		    (string-base:coordinates->index
-		     (inferior-window inferior)
-		     0
-		     (fix:- 0 (inferior-y-start inferior)))))
-	   false))
-    (window-modeline-event! superior 'START-MARK-CHANGED!)))
-
-(define (end-mark-changed! window)
-  (with-instance-variables buffer-window window ()
-    (destroy-mark! end-mark)
-    (set! end-mark
-	  (let ((group (buffer-group buffer)))
-	    (%make-permanent-mark
-	     group
-	     (fix:+ (line-start-index group (mark-index end-line-mark))
-		    (string-base:coordinates->index
-		     (inferior-window last-line-inferior)
-		     (fix:-1+ x-size)
-		     (fix:-1+
-		      (fix:- (min y-size (inferior-y-end last-line-inferior))
-			     (inferior-y-start last-line-inferior)))))
-	     true)))
-    (window-modeline-event! superior 'END-MARK-CHANGED!)))
-
-(define (destroy-mark! mark)
-  (if mark
-      (mark-temporary! mark)))
+;;;; Buffer and Point
 
-(define-integrable (%window-start-index window)
-  (with-instance-variables buffer-window window ()
-    (mark-index start-mark)))
+(define-integrable (buffer-window/buffer window)
+  (%window-buffer window))
+
+(define (buffer-window/set-buffer! window new-buffer)
+  ;; Interrupts must be disabled when this is called.
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'set-buffer! new-buffer))
+  (if (not (buffer? new-buffer))
+      (error:illegal-datum new-buffer 'set-window-buffer!))
+  (if (%window-buffer window)
+      (%unset-window-buffer! window))
+  (%set-window-buffer! window new-buffer)
+  (let ((group (%window-group window))
+	(changes-daemon (%window-changes-daemon window)))
+    (add-group-delete-daemon! group changes-daemon)
+    (add-group-insert-daemon! group changes-daemon)
+    (add-group-clip-daemon! group (%window-clip-daemon window))
+    (%set-window-point-index! window (mark-index (group-point group))))
+  (if (buffer-display-start new-buffer)
+      (set-new-coordinates! window
+			    (mark-index (buffer-display-start new-buffer))
+			    0
+			    false))
+  (buffer-window/redraw! window))
+
+(define (%unset-window-buffer! window)
+  ;; Interrupts must be disabled when this is called.
+  (let ((buffer (%window-buffer window)))
+    (if (%window-debug-trace window)
+	((%window-debug-trace window) 'window window 'unset-buffer! buffer))
+    (set-buffer-display-start!
+     buffer
+     (mark-permanent! (buffer-window/start-mark window)))
+    (%set-buffer-point! buffer (buffer-window/point window)))
+  (let ((group (%window-group window))
+	(changes-daemon (%window-changes-daemon window)))
+    (remove-group-delete-daemon! group changes-daemon)
+    (remove-group-insert-daemon! group changes-daemon)
+    (remove-group-clip-daemon! group (%window-clip-daemon window)))
+  (%clear-window-buffer-state! window))
+
+(define-integrable (buffer-window/point window)
+  (%window-point window))
+
+(define (buffer-window/set-point! window mark)
+  (let ((mark (clip-mark-to-display window mark)))
+    (if (%window-debug-trace window)
+	((%window-debug-trace window) 'window window 'set-point! mark))
+    (without-interrupts
+     (lambda ()
+       (%set-window-point-index! window (mark-index mark))
+       (%set-window-point-moved?! window 'SINCE-START-SET)
+       (%set-buffer-point! (%window-buffer window) mark)
+       (window-needs-redisplay! window)))))
+
+;;;; Start Mark
+
+(define (buffer-window/start-mark window)
+  (guarantee-start-mark! window)
+  (mark-temporary-copy (%window-start-mark window)))
+
+(define (buffer-window/set-start-mark! window mark force?)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'set-start-mark! mark))
+  (set-new-coordinates! window
+			(mark-index (clip-mark-to-display window mark))
+			0
+			(and force? (buffer-window/y-center window))))
+
+(define (buffer-window/scroll-y-relative! window y-delta)
+  (if (not (fix:= y-delta 0))
+      (begin
+	(if (%window-debug-trace window)
+	    ((%window-debug-trace window) 'window window 'scroll-y-relative!
+					  y-delta))
+	(guarantee-start-mark! window)
+	;; if (> Y-DELTA 0) and line inferiors valid, use them.
+	(set-new-coordinates! window
+			      (%window-start-line-index window)
+			      (fix:- (%window-start-line-y window) y-delta)
+			      (if (fix:> y-delta 0)
+				  0
+				  (fix:- (window-y-size window) 1))))))
+
+(define (set-new-coordinates! window index y point-y)
+  (with-values (lambda () (predict-start-line window index y))
+    (lambda (start y-start)
+      (cond ((predict-index-visible? window start y-start
+				     (%window-point-index window))
+	     (without-interrupts
+	      (lambda ()
+		(set-start-mark! window start y-start))))
+	    (point-y
+	     (without-interrupts
+	      (lambda ()
+		(%set-window-point-index!
+		 window
+		 (or (predict-index window start y-start 0 point-y)
+		     (%window-group-end-index window)))
+		(set-start-mark! window start y-start))))))))
+
+(define (buffer-window/scroll-y-absolute! window y-point)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'scroll-y-absolute!
+				    y-point))
+  (if (not (and (fix:<= 0 y-point)
+		(fix:< y-point (window-y-size window))))
+      (error:datum-out-of-range y-point 'window-scroll-y-absolute!))
+  (with-values
+      (lambda ()
+	(predict-start-line window (%window-point-index window) y-point))
+    (lambda (start y-start)
+      (without-interrupts
+       (lambda ()
+	 (set-start-mark! window start y-start))))))
+
+(define (set-start-mark! window start-line y-start)
+  (if (fix:= y-start 0)
+      (if (%window-start-line-mark window)
+	  (begin
+	    (set-mark-index! (%window-start-line-mark window) start-line)
+	    (if (not (eq? (%window-start-line-mark window)
+			  (%window-start-mark window)))
+		(begin
+		  (mark-temporary! (%window-start-mark window))
+		  (%set-window-start-mark! window
+					   (%window-start-line-mark window)))))
+	  (let ((mark
+		 (%make-permanent-mark (%window-group window)
+				       start-line
+				       false)))
+	    (%set-window-start-line-mark! window mark)
+	    (%set-window-start-mark! window mark)))
+      (let ((start (predict-start-index window start-line y-start)))
+	(if (%window-start-line-mark window)
+	    (begin
+	      (set-mark-index! (%window-start-line-mark window) start-line)
+	      (if (eq? (%window-start-line-mark window)
+		       (%window-start-mark window))
+		  (%set-window-start-mark!
+		   window
+		   (%make-permanent-mark (%window-group window) start false))
+		  (set-mark-index! (%window-start-mark window) start)))
+	    (let ((group (%window-group window)))
+	      (%set-window-start-line-mark!
+	       window
+	       (%make-permanent-mark group start-line false))
+	      (%set-window-start-mark!
+	       window
+	       (%make-permanent-mark group start false))))))
+  (%set-window-start-line-y! window y-start)
+  (if (eq? (%window-point-moved? window) 'SINCE-START-SET)
+      (%set-window-point-moved?! window true))
+  (window-needs-redisplay! window))
+
+(define-integrable (clear-start-mark! window)
+  (mark-temporary! (%window-start-line-mark window))
+  (mark-temporary! (%window-start-mark window))
+  (%set-window-start-line-mark! window false)
+  (%set-window-start-mark! window false)
+  (%set-window-start-line-y! window 0))
+
+(define (guarantee-start-mark! window)
+  (without-interrupts (lambda () (%guarantee-start-mark! window))))
+
+(define (%guarantee-start-mark! window)
+  (let ((point-at!
+	 (lambda (y)
+	   (with-values
+	       (lambda ()
+		 (predict-start-line window (%window-point-index window) y))
+	     (lambda (start y-start)
+	       (set-start-mark! window start y-start))))))
+    (let ((recenter! (lambda () (point-at! (buffer-window/y-center window)))))
+      (cond ((not (%window-start-line-mark window))
+	     (recenter!))
+	    ((eq? (%window-point-moved? window) 'SINCE-START-SET)
+	     (let ((y
+		    (predict-y window
+			       (%window-start-line-index window)
+			       (%window-start-line-y window)
+			       (%window-point-index window))))
+	       (cond ((fix:< y 0)
+		      (let ((y (fix:+ y (ref-variable scroll-step))))
+			(if (fix:< y 0)
+			    (recenter!)
+			    (point-at! y))))
+		     ((fix:>= y (window-y-size window))
+		      (let ((y (fix:- y (ref-variable scroll-step))))
+			(if (fix:>= y (window-y-size window))
+			    (recenter!)
+			    (point-at! y)))))))))))
 
-(define-integrable (%window-end-index window)
-  (with-instance-variables buffer-window window ()
-    (mark-index end-mark)))
+(define-variable scroll-step
+  "*The number of lines to try scrolling a window by when point moves out.
+If that fails to bring point back on screen, point is centered instead.
+If this is zero, point is always centered after it moves off screen."
+  0)
 
-(define-integrable (%window-mark-visible? window mark)
-  (with-instance-variables buffer-window window (mark)
-    (and (mark<= start-mark mark)
-	 (mark<= mark end-mark))))
+(define-variable-value-validity-test (ref-variable-object scroll-step)
+  (lambda (scroll-step)
+    (and (fix:fixnum? scroll-step)
+	 (fix:>= scroll-step 0))))
 
-(define (%window-y-center window)
-  (with-instance-variables buffer-window window ()
+(define (buffer-window/y-center window)
+  (let ((y-size (window-y-size window)))
     (let ((result
-	   (integer-round
-	    (* y-size
-	       (inexact->exact (round (ref-variable cursor-centering-point))))
-	    100)))
-      (cond ((fix:< result 0) 0)
-	    ((fix:< result y-size) result)
-	    (else (fix:-1+ y-size))))))
+	   (round->exact
+	    (* y-size (/ (ref-variable cursor-centering-point) 100)))))
+      (if (< result y-size)
+	  result
+	  (- y-size 1)))))
 
 (define-variable cursor-centering-point
   "The distance from the top of the window at which to center the point.
 This number is a percentage, where 0 is the window's top and 100 the bottom."
-  50)
\ No newline at end of file
+  50)
+
+(define-variable-value-validity-test
+  (ref-variable-object cursor-centering-point)
+  (lambda (value)
+    (and (real? value)
+	 (<= 0 value 100))))
+
+;;;; Line Inferiors
+
+(define-class line-window string-base
+  ())
+
+(define-integrable (make-line-inferior window start end)
+  (%make-line-inferior window (%window-extract-string window start end)))
+
+(define (%make-line-inferior window string)
+  (let ((window* (make-object line-window))
+	(flags (cons false (window-redisplay-flags window))))
+    (let ((inferior (%make-inferior window* false false flags)))
+      (set-window-inferiors! window (cons inferior (window-inferiors window)))
+      (%set-window-superior! window* window)
+      (set-window-inferiors! window* '())
+      (%set-window-redisplay-flags! window* flags)
+      (%set-window-x-size! window* (window-x-size window))
+      (let ((*image (string->image string 0)))
+	(%set-window-y-size! window*
+			     (column->y-size (image-column-size *image)
+					     (window-x-size window)
+					     (%window-truncate-lines? window)))
+	(with-instance-variables line-window window*
+				 (*image %window-truncate-lines? window)
+	  (set! image *image)
+	  (set! truncate-lines? (%window-truncate-lines? window))))
+      (string-base:refresh! window*)
+      (%set-inferior-x-start! inferior 0)
+      inferior)))
+
+(define-integrable (line-window-image window)
+  (with-instance-variables line-window window () image))
+
+(define-integrable (line-window-string window)
+  (image-string (line-window-image window)))
+
+(define-integrable (line-window-length window)
+  (string-length (line-window-string window)))
+
+(define-integrable (line-inferior-length inferior)
+  (fix:+ (line-window-length (inferior-window inferior)) 1))
+
+(define (buffer-window/override-message window)
+  (let ((inferior (%window-override-inferior window)))
+    (and inferior
+	 (line-window-string (inferior-window inferior)))))
+
+(define (buffer-window/set-override-message! window message)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'set-override-message!
+				    message))
+  (without-interrupts
+   (lambda ()
+     (let ((inferior (%make-line-inferior window message)))
+       (%set-window-override-inferior! window inferior)
+       (set-inferior-start! inferior 0 0)
+       (set-inferior-position!
+	(%window-cursor-inferior window)
+	(string-base:index->coordinates (inferior-window inferior)
+					(string-length message))))
+     (inferiors-changed! window))))
+
+(define (buffer-window/clear-override-message! window)
+  (if (%window-override-inferior window)
+      (begin
+	(if (%window-debug-trace window)
+	    ((%window-debug-trace window) 'window window
+					  'clear-override-message!))
+	(without-interrupts
+	 (lambda ()
+	   (%set-window-override-inferior! window false)
+	   (update-cursor! window)
+	   (inferiors-changed! window)
+	   (for-each-inferior window inferior-needs-redisplay!))))))
+
+;;;; Update Finalization
+
+(define (set-line-inferiors! window inferiors)
+  (%set-window-line-inferiors! window inferiors)
+  (inferiors-changed! window)
+  (%clear-window-outstanding-changes! window)
+  (update-cursor! window)
+  (%window-modeline-event! window 'SET-LINE-INFERIORS))
+
+(define-integrable (set-current-end-index! window end)
+  (if (%window-current-start-mark window)
+      (begin
+	(set-mark-position! (%window-current-start-mark window)
+			    (mark-position (%window-start-line-mark window)))
+	(set-mark-index! (%window-current-end-mark window) end))
+      (begin
+	(%set-window-current-start-mark!
+	 window
+	 (mark-permanent-copy (%window-start-line-mark window)))
+	(%set-window-current-end-mark!
+	 window
+	 (%make-permanent-mark (%window-group window) end true)))))
+
+(define (inferiors-changed! window)
+  (let ((update-blank-inferior
+	 (lambda (last-inferior)
+	   (let ((y-end (%inferior-y-end last-inferior))
+		 (inferior (%window-blank-inferior window)))
+	     (if (fix:< y-end (window-y-size window))
+		 (begin
+		   (%set-window-x-size! (inferior-window inferior)
+					(window-x-size window))
+		   (%set-window-y-size! (inferior-window inferior)
+					(fix:- (window-y-size window) y-end))
+		   (%set-inferior-x-start! inferior 0)
+		   (%set-inferior-y-start! inferior y-end)
+		   (setup-redisplay-flags!
+		    (inferior-redisplay-flags inferior)))
+		 (begin
+		   (%set-inferior-x-start! inferior false)
+		   (%set-inferior-y-start! inferior false)))))))
+    (cond ((%window-override-inferior window)
+	   (set-window-inferiors! window
+				  (list (%window-override-inferior window)
+					(%window-cursor-inferior window)
+					(%window-blank-inferior window)))
+	   (update-blank-inferior (%window-override-inferior window)))
+	  ((not (null? (%window-line-inferiors window)))
+	   (set-window-inferiors! window
+				  (cons* (%window-cursor-inferior window)
+					 (%window-blank-inferior window)
+					 (%window-line-inferiors window)))
+	   (update-blank-inferior
+	    (car (last-pair (%window-line-inferiors window)))))
+	  (else
+	   (set-window-inferiors! window
+				  (list (%window-cursor-inferior window)
+					(%window-blank-inferior window)))))))
+
+(define (update-cursor! window)
+  (let ((xy (buffer-window/point-coordinates window)))
+    (if (not (and (fix:<= 0 (car xy))
+		  (fix:< (car xy) (window-x-size window))
+		  (fix:<= 0 (cdr xy))
+		  (fix:< (cdr xy) (window-y-size window))))
+	(error "point not visible at end of redisplay"))
+    (set-inferior-position! (%window-cursor-inferior window) xy)))
\ No newline at end of file
diff --git a/v7/src/edwin/bufwiu.scm b/v7/src/edwin/bufwiu.scm
index 18ddf231f..fafe8a40f 100644
--- a/v7/src/edwin/bufwiu.scm
+++ b/v7/src/edwin/bufwiu.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.12 1989/08/14 09:22:07 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.13 1990/11/02 03:23:02 cph Rel $
 ;;;
-;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -42,285 +42,320 @@
 ;;; of that license should have been included along with this file.
 ;;;
 
-;;;; Buffer Windows:  Image Update
+;;;; Buffer Windows: Image Update
 
 (declare (usual-integrations))
 
-;;;; Insert/Delete/Clip
-
-;;; It is assumed that the insert daemon is called after the insertion
-;;; has been performed, and the delete daemon before the deletion has
-;;; been performed.  It is also assumed that interrupts are disabled.
+;;;; Insert/Delete
 
 (define (make-changes-daemon window)
+  ;; It is assumed that the insert daemon is called after the
+  ;; insertion has been performed, and the delete daemon before the
+  ;; deletion has been performed.  It is also assumed that interrupts
+  ;; are disabled.
   (lambda (group start end)
-    (with-instance-variables buffer-window window (group start end)
-      (let ((start (group-index->position group start false))
-	    (end (group-index->position group end true)))
-	(cond ((not start-changes-mark)
-	       (set! start-changes-mark
-		     (%make-permanent-mark group start false))
-	       (set! end-changes-mark (%make-permanent-mark group end true)))
-	      ((fix:< start (mark-position start-changes-mark))
-	       (set-mark-position! start-changes-mark start))
-	      ((fix:> end (mark-position end-changes-mark))
-	       (set-mark-position! end-changes-mark end)))
-	(if (and (not (car redisplay-flags))
-		 (not (fix:< end (mark-position start-line-mark)))
-		 (not (fix:> start (mark-position end-mark))))
-	    (setup-redisplay-flags! redisplay-flags))))))
-
-;;; It is assumed that the clip daemon is called before the clipping
-;;; has been performed, so that we can get the old clipping limits.
+    (if (%window-debug-trace window)
+	((%window-debug-trace window) 'window window 'change-daemon
+				      group start end))
+    ;; Record changes that intersect the current line inferiors.
+    (if (and (not (%window-force-redraw? window))
+	     (fix:<= (%window-current-start-index window) end)
+	     (fix:<= start (%window-current-end-index window)))
+	;; We can compare marks by their positions here because
+	;; the marks being compared have the same
+	;; LEFT-INSERTING? flag.
+	(let ((start
+	       (group-index->position-integrable group start false))
+	      (end (group-index->position-integrable group end true)))
+	  (if (not (%window-start-changes-mark window))
+	      (begin
+		(%set-window-start-changes-mark!
+		 window
+		 (%%make-permanent-mark group start false))
+		(%set-window-end-changes-mark!
+		 window
+		 (%%make-permanent-mark group end true)))
+	      (begin
+		(if (fix:< start
+			   (mark-position
+			    (%window-start-changes-mark window)))
+		    (set-mark-position!
+		     (%window-start-changes-mark window)
+		     start))
+		(if (fix:> end
+			   (mark-position
+			    (%window-end-changes-mark window)))
+		    (set-mark-position! (%window-end-changes-mark window)
+					end))))
+	  (window-needs-redisplay! window)))
+    ;; If this change affects where the window starts, choose a
+    ;; new place to start it.
+    (if (%window-start-line-mark window)
+	(begin
+	  (if (let ((wlstart (%window-start-line-index window))
+		    (wstart (%window-start-index window)))
+		(and (if (fix:= wlstart wstart)
+			 (fix:< start wstart)
+			 (fix:<= start wstart))
+		     (fix:<= wlstart end)))
+	      (begin
+		(clear-start-mark! window)
+		(window-needs-redisplay! window)))
+	  (if (and (not (eq? (%window-point-moved? window)
+			     'SINCE-START-SET))
+		   (let ((point (%window-point-index window)))
+		     (and (fix:<= start point)
+			  (fix:<= point end))))
+	      (%set-window-point-moved?! window 'SINCE-START-SET))))))
+
+;;;; Clip
 
 (define (make-clip-daemon window)
+  ;; It is assumed that the clip daemon is called before the clipping
+  ;; has been performed.  It is also assumed that interrupts are
+  ;; disabled.
   (lambda (group start end)
-    (with-instance-variables buffer-window window (group start end)
-      (if (not start-clip-mark)
-	  (begin
-	    (set! start-clip-mark (group-display-start group))
-	    (set! end-clip-mark (group-display-end group))))
-      (if (not (car redisplay-flags))
-	  (let ((start (group-index->position group start false))
-		(end (group-index->position group end true))
-		(window-start (mark-position start-line-mark))
-		(window-end (mark-position end-mark)))
-	    (if (or (fix:> start window-start)
-		    (fix:< end window-end)
-		    (and (fix:< start window-start)
-			 (fix:= window-start (mark-position start-clip-mark)))
-		    (and (fix:> end window-end)
-			 (fix:= window-end (mark-position end-clip-mark))))
-		(setup-redisplay-flags! redisplay-flags)))))))
-
-(define (update-buffer-window! window screen x-start y-start
-			       xl xu yl yu display-style)
-  ;; The primary update entry.
-  (recompute-image! window)
-  (update-inferiors! window screen x-start y-start xl xu yl yu display-style))
-
-(define (maybe-recompute-image! window)
-  (with-instance-variables buffer-window window ()
-    ;; Used to guarantee everything updated before certain operations.
-    (if (car redisplay-flags)
-	(recompute-image! window))))
+    (if (not (%window-force-redraw? window))
+	(begin
+	  (if (%window-debug-trace window)
+	      ((%window-debug-trace window) 'window window 'clip-daemon
+					    group start end))
+	  (if (not (%window-start-clip-mark window))
+	      (begin
+		(%set-window-start-clip-mark!
+		 window
+		 (%make-permanent-mark group
+				       (group-display-start-index group)
+				       true))
+		(%set-window-end-clip-mark!
+		 window
+		 (%make-permanent-mark group
+				       (group-display-end-index group)
+				       false))))
+	  (let ((start (group-index->position-integrable group start true))
+		(end (group-index->position-integrable group end false)))
+	    ;; We can compare marks by their positions here because the
+	    ;; marks being compared have the same LEFT-INSERTING? flag.
+	    (if (fix:> start (mark-position (%window-start-clip-mark window)))
+		(set-mark-position! (%window-start-clip-mark window) start))
+	    (if (fix:< end (mark-position (%window-end-clip-mark window)))
+		(set-mark-position! (%window-end-clip-mark window) end)))
+	  (if (and (not (window-needs-redisplay? window))
+		   (or (fix:>= (%window-start-clip-index window)
+			       (%window-current-start-index window))
+		       (fix:<= (%window-end-clip-index window)
+			       (%window-current-end-index window))))
+	      (window-needs-redisplay! window))))
+    (if (and (%window-start-line-mark window)
+	     (or (fix:>= start (%window-start-line-index window))
+		 (fix:< end (%window-start-index window))))
+	(begin
+	  (clear-start-mark! window)
+	  (window-needs-redisplay! window)))))
 
-(define (recompute-image! window)
-  (with-instance-variables buffer-window window ()
-    (without-interrupts (lambda () (%recompute-image! window)))))
+;;;; Update
 
-(define (%recompute-image! window)
-  (with-instance-variables buffer-window window ()
-    (cond ((not force-redraw?)
-	   (let ((group (mark-group start-mark))
-		 (start-line (mark-index start-line-mark))
-		 (start (mark-index start-mark))
-		 (end (mark-index end-mark))
-		 (point-index (mark-index point)))
-	     (if start-clip-mark
-		 (let ((new-clip-start (group-start-index group))
-		       (new-clip-end (group-end-index group)))
-		   (cond ((fix:< point-index new-clip-start)
-			  (%set-buffer-point! buffer
-					      (group-display-start group))
-			  (set! point (buffer-point buffer)))
-			 ((fix:> point-index new-clip-end)
-			  (%set-buffer-point! buffer (group-display-end group))
-			  (set! point (buffer-point buffer))))
-		   (cond ((fix:> new-clip-start start-line)
-			  (%window-redraw! window false))
-			 ((or (fix:< new-clip-end end)
-			      (and (fix:< new-clip-start start-line)
-				   (fix:= start-line
-					  (mark-index start-clip-mark)))
-			      (and (fix:> new-clip-end end)
-				   (fix:= end (mark-index end-clip-mark))))
-			  (%window-redraw! window
-					   (and (not start-changes-mark)
-						(not (fix:< point-index start))
-						(not (fix:> point-index end))
-						(%window-point-y window))))
-			 (else
-			  (destroy-mark! start-clip-mark)
-			  (set! start-clip-mark false)
-			  (destroy-mark! end-clip-mark)
-			  (set! end-clip-mark false)))))
-	     (if start-changes-mark
-		 (let ((start-changes (mark-index start-changes-mark))
-		       (end-changes (mark-index end-changes-mark)))
-		   (if (and (not (fix:< end-changes start-line))
-			    (not (fix:> start-changes end)))
-		       (if (not (fix:> start-changes start))
-			   (if (fix:< end-changes end)
-			       (recompute-image!:top-changed window)
-			       (%window-redraw! window false))
-			   (if (not (fix:< end-changes end))
-			       (recompute-image!:bottom-changed window)
-			       (recompute-image!:middle-changed window)))
-		       (begin
-			 (destroy-mark! start-changes-mark)
-			 (set! start-changes-mark false)
-			 (destroy-mark! end-changes-mark)
-			 (set! end-changes-mark false))))))
-	   (if point-moved?
-	       (update-cursor! window maybe-recenter!)))
-	  ((eq? 'START force-redraw?)
-	   (%window-redraw-preserving-start! window))
-	  ((eq? 'POINT force-redraw?)
-	   (%window-redraw! window (%window-point-y window)))
-	  ((eq? 'BUFFER-CURSOR-Y force-redraw?)
-	   (%window-redraw! window (%window-buffer-cursor-y window)))
-	  ((eq? 'CENTER force-redraw?)
-	   (%window-redraw! window (%window-y-center window)))
-	  ((and (object-type? (ucode-type fixnum) force-redraw?)
-		(not (fix:negative? force-redraw?))
-		(fix:< force-redraw? y-size))
-	   (%window-redraw! window force-redraw?))
-	  (else
-	   (%window-redraw! window (%window-y-center window))))))
-
-(define (recompute-image!:top-changed window)
-  (with-instance-variables buffer-window window ()
-    (let ((inferiors (end-changes-inferiors window))
-	  (group (mark-group end-changes-mark))
-	  (index (mark-index end-changes-mark)))
-      (let ((start-index (line-start-index group index)))
-	(set-line-window-string!
-	 (inferior-window (car inferiors))
-	 (group-extract-string group start-index (line-end-index group index))
-	 truncate-lines?)
-	(fill-top! window inferiors start-index true)))
-    (everything-changed! window maybe-recenter!)))
+(define (recompute-image! window)
+  (%guarantee-start-mark! window)
+  (if (%window-force-redraw? window)
+      (begin
+	(%set-window-force-redraw?! window false)
+	(preserve-nothing! window))
+      (let ((start (%window-current-start-index window))
+	    (end (%window-current-end-index window)))
+	(cond ((and (%window-start-clip-mark window)
+		    (let ((start-clip (%window-start-clip-index window))
+			  (end-clip (%window-end-clip-index window)))
+		      (or (and (fix:<= start start-clip)
+			       (fix:<= (%window-group-start-index window)
+				       end))
+			  (and (fix:<= end-clip end)
+			       (fix:<= start
+				       (%window-group-end-index window))))))
+	       (preserve-nothing! window))
+	      ((%window-start-changes-mark window)
+	       (let ((start-changes
+		      (let ((start-changes
+			     (%window-start-changes-index window)))
+			(%window-line-start-index window start-changes)))
+		     (end-changes
+		      (let ((end-changes (%window-end-changes-index window)))
+			(%window-line-end-index window end-changes))))
+		 (if (fix:<= start-changes start)
+		     (if (fix:< end-changes end)
+			 (preserve-contiguous-region!
+			  window
+			  (cdr
+			   (changed-inferiors-tail
+			    (%window-line-inferiors window)
+			    end
+			    end-changes))
+			  (fix:+ end-changes 1))
+			 (preserve-nothing! window))
+		     (if (fix:< end-changes end)
+			 (preserve-top-and-bottom! window
+						   start start-changes
+						   end-changes end)
+			 (let ((inferiors (%window-line-inferiors window)))
+			   (set-cdr! (unchanged-inferiors-tail inferiors
+							       start
+							       start-changes)
+				     '())
+			   (preserve-contiguous-region! window
+							inferiors
+							start))))))
+	      (else
+	       (preserve-all! window start))))))
 
-(define (recompute-image!:bottom-changed window)
-  (with-instance-variables buffer-window window ()
-    (let ((inferiors (start-changes-inferiors window))
-	  (group (mark-group start-changes-mark))
-	  (index (mark-index start-changes-mark)))
-      (let ((end-index (line-end-index group index)))
-	(set-line-window-string!
-	 (inferior-window (car inferiors))
-	 (group-extract-string group (line-start-index group index) end-index)
-	 truncate-lines?)
-	(set-cdr! inferiors
-		  (fill-bottom window
-			       (inferior-y-end (car inferiors))
-			       end-index))))
-    (everything-changed! window maybe-recenter!)))
+(define-integrable (preserve-nothing! window)
+  (set-line-inferiors!
+   window
+   (generate-line-inferiors window
+			    (%window-start-line-index window)
+			    (%window-start-line-y window))))
 
-(define (recompute-image!:middle-changed window)
-  (with-instance-variables buffer-window window ()
-    (let ((start-inferiors (start-changes-inferiors window))
-	  (end-inferiors (end-changes-inferiors window))
-	  (group (buffer-group buffer))
-	  (start-index (mark-index start-changes-mark))
-	  (end-index (mark-index end-changes-mark)))
-      (let ((start-start (line-start-index group start-index))
-	    (start-end (line-end-index group start-index))
-	    (end-start (line-start-index group end-index))
-	    (end-end (line-end-index group end-index)))
-	(if (eq? start-inferiors end-inferiors)
-	    (if (fix:= start-start end-start)
+(define (preserve-contiguous-region! window inferiors start)
+  (let ((wlstart (%window-start-line-index window))
+	(wlsy (%window-start-line-y window)))
+    (set-line-inferiors!
+     window
+     (with-values
+	 (lambda ()
+	   (scroll-lines! window
+			  inferiors
+			  start
+			  (predict-y window wlstart wlsy start)))
+       (lambda (inferiors start)
+	 (if (null? inferiors)
+	     (generate-line-inferiors window wlstart wlsy)
+	     (fill-edges! window inferiors start)))))))
 
-  ;; In this case, the changed region was a single line before the
-  ;; changes, and is still a single line now.  All we need do is redraw
-  ;; the line and then scroll the rest up or down if the y-size of the
-  ;; line has been changed.
-  (let ((y-end (inferior-y-end (car start-inferiors))))
-    (set-line-window-string!
-     (inferior-window (car start-inferiors))
-     (group-extract-string group start-start start-end)
-     truncate-lines?)
-    (let ((y-end* (inferior-y-end (car start-inferiors))))
-      (if (fix:= y-end y-end*)
-	  (maybe-marks-changed! window start-inferiors y-end*)
-	  (begin
-	    (set-cdr! start-inferiors
-		      (cond ((fix:< y-end y-end*)
-			     (scroll-lines-down! window
-						 (cdr start-inferiors)
-						 y-end*))
-			    ((not (null? (cdr start-inferiors)))
-			     (scroll-lines-up! window
-					       (cdr start-inferiors)
-					       y-end*
-					       (fix:1+ start-end)))
-			    (else
-			     (fill-bottom window y-end* start-end))))
-	    (everything-changed! window maybe-recenter!)))))
+(define-integrable (fill-edges! window inferiors start)
+  (fill-top window (fill-bottom! window inferiors start) start))
 
-  ;; Here, the changed region used to be a single line, and now is
-  ;; several, so we need to insert a bunch of new lines.
-  (begin
-   (set-line-window-string! (inferior-window (car start-inferiors))
-			    (group-extract-string group start-start start-end)
-			    truncate-lines?)
-   (set-cdr! start-inferiors
-	     (if (null? (cdr start-inferiors))
-		 (fill-bottom window
-			      (inferior-y-end (car start-inferiors))
-			      start-end)
-		 (fill-middle! window
-			       (inferior-y-end (car start-inferiors))
-			       start-end
-			       (cdr start-inferiors)
-			       (fix:1+ end-end))))
-   (everything-changed! window maybe-recenter!))
-  )
-;;; continued on next page...
+(define (preserve-all! window start)
+  (let ((wlstart (%window-start-line-index window))
+	(wlsy (%window-start-line-y window))
+	(inferiors (%window-line-inferiors window)))
+    (let ((scroll-down
+	   (lambda (y-start)
+	     (set-line-inferiors!
+	      window
+	      (let ((inferiors (scroll-lines-down! window inferiors y-start)))
+		(if (null? inferiors)
+		    (generate-line-inferiors window wlstart wlsy)
+		    (begin
+		      (let ((end
+			     (let loop ((inferiors inferiors) (start start))
+			       (if (null? (cdr inferiors))
+				   (%window-line-end-index window start)
+				   (loop (cdr inferiors)
+					 (fix:+ start
+						(line-inferior-length
+						 (car inferiors))))))))
+			;; SET-CURRENT-END-INDEX! is integrable
+			(set-current-end-index! window end))
+		      (fill-top window inferiors start)))))))
+	  (scroll-up
+	   (lambda (y-start)
+	     (set-line-inferiors!
+	      window
+	      (with-values
+		  (lambda () (scroll-lines-up! window inferiors start y-start))
+		(lambda (inferiors start)
+		  (if (null? inferiors)
+		      (generate-line-inferiors window wlstart wlsy)
+		      (fill-bottom! window inferiors start))))))))
+      (cond ((fix:= wlstart start)
+	     (let ((y-start (inferior-y-start (car inferiors))))
+	       (cond ((fix:= wlsy y-start)
+		      (%clear-window-outstanding-changes! window)
+		      (if (%window-point-moved? window)
+			  (begin
+			    (%set-window-point-moved?! window false)
+			    (update-cursor! window))))
+		     ((fix:< wlsy y-start)
+		      (scroll-up wlsy))
+		     (else
+		      (scroll-down wlsy)))))
+	    ((fix:< wlstart start)
+	     (scroll-down (predict-y window wlstart wlsy start)))
+	    (else
+	     (scroll-up (predict-y window wlstart wlsy start)))))))
 
-;;; ...continued from previous page
-
-  (if (fix:= start-start end-start)
+(define (preserve-top-and-bottom! window start start-changes end-changes end)
+  (let ((wlstart (%window-start-line-index window))
+	(wlsy (%window-start-line-y window))
+	(top-inferiors (%window-line-inferiors window)))
+    (let* ((top-tail
+	    (unchanged-inferiors-tail top-inferiors start start-changes))
+	   (middle-tail
+	    (changed-inferiors-tail (cdr top-tail) end end-changes))
+	   (bottom-inferiors (cdr middle-tail)))
+      (set-cdr! top-tail '())
+      (set-cdr! middle-tail '())
+      (with-values
+	  (lambda ()
+	    (scroll-lines! window
+			   top-inferiors
+			   start
+			   (predict-y window wlstart wlsy start)))
+	(lambda (top-inferiors top-start)
+	  (with-values
+	      (lambda ()
+		(let ((bottom-start (fix:+ end-changes 1)))
+		  (scroll-lines! window
+				 bottom-inferiors
+				 bottom-start
+				 (predict-y window wlstart wlsy
+					    bottom-start))))
+	    (lambda (bottom-inferiors bottom-start)
+	      (set-line-inferiors!
+	       window
+	       (if (null? top-inferiors)
+		   (if (null? bottom-inferiors)
+		       (generate-line-inferiors window wlstart wlsy)
+		       (fill-edges! window bottom-inferiors bottom-start))
+		   (if (null? bottom-inferiors)
+		       (fill-edges! window top-inferiors top-start)
+		       (fill-top window
+				 (fill-middle! window
+					       top-inferiors
+					       top-start
+					       (fill-bottom! window
+							     bottom-inferiors
+							     bottom-start)
+					       bottom-start)
+				 top-start)))))))))))
 
-  ;; The changed region used to be multiple lines and is now just one.
-  ;; We must scroll the bottom of the screen up to fill in.
-  (begin
-   (set-line-window-string! (inferior-window (car start-inferiors))
-			    (group-extract-string group start-start start-end)
-			    truncate-lines?)
-   (set-cdr! start-inferiors
-	     (if (null? (cdr end-inferiors))
-		 (fill-bottom window
-			      (inferior-y-end (car start-inferiors))
-			      start-end)
-		 (scroll-lines-up! window
-				   (cdr end-inferiors)
-				   (inferior-y-end (car start-inferiors))
-				   (fix:1+ start-end))))
-   (everything-changed! window maybe-recenter!))
+(define (changed-inferiors-tail inferiors end end-changes)
+  (let find-end
+      ((inferiors inferiors)
+       (find-end-changes
+	(lambda (end)
+	  end
+	  (error "can't find END-CHANGES"))))
+    (if (null? inferiors)
+	(find-end-changes end)
+	(find-end (cdr inferiors)
+		  (lambda (end)
+		    (if (fix:= end end-changes)
+			inferiors
+			(find-end-changes
+			 (fix:- end
+				(line-inferior-length (car inferiors))))))))))
 
-  ;; The most general case, we must refill the center of the screen.
-  (begin
-    (set-line-window-string!
-     (inferior-window (car start-inferiors))
-     (group-extract-string group start-start start-end)
-     truncate-lines?)
-    (let ((old-y-end (inferior-y-end (car end-inferiors))))
-      (set-line-window-string! (inferior-window (car end-inferiors))
-			       (group-extract-string group end-start end-end)
-			       truncate-lines?)
-      (let ((y-end (inferior-y-end (car end-inferiors)))
-	    (tail (cdr end-inferiors)))
-	(cond ((fix:> y-end old-y-end)
-	       (set-cdr! end-inferiors (scroll-lines-down! window tail y-end)))
-	      ((fix:< y-end old-y-end)
-	       (set-cdr! end-inferiors
-			 (scroll-lines-up! window
-					   tail
-					   y-end
-					   (fix:1+ end-end)))))))
-    (set-cdr! start-inferiors
-	      (fill-middle! window
-			    (inferior-y-end (car start-inferiors))
-			    start-end
-			    end-inferiors
-			    end-start))
-    (everything-changed! window maybe-recenter!))
-
-  ))))))
+(define (unchanged-inferiors-tail inferiors start start-changes)
+  (let loop ((inferiors inferiors) (start start))
+    (let ((start-next (fix:+ start (line-inferior-length (car inferiors)))))
+      (cond ((fix:>= start-next start-changes)
+	     inferiors)
+	    ((null? (cdr inferiors))
+	     (error "can't find START-CHANGES"))
+	    (else
+	     (loop (cdr inferiors) start-next))))))
 
-;;;; Direct Update/Output Support
+;;;; Direct Output
 
 ;;; The direct output procedures are hairy and should be used only
 ;;; under restricted conditions.  In particular, the cursor may not be
@@ -330,98 +365,148 @@
 ;;; modifiable, and the modeline must already show that it has been
 ;;; modified.  None of the procedures may be used if the window needs
 ;;; redisplay.
-;;; They must be called without interrupts.
 
-(define (%window-direct-update! window display-style)
-  (with-instance-variables buffer-window window (display-style)
-    (if (not saved-screen)
-	(error "Window needs normal redisplay -- can't direct update" window))
-    (and (with-screen-in-update! saved-screen
-	   (lambda ()
-	     (update-buffer-window! window saved-screen
-				    saved-x-start saved-y-start
-				    saved-xl saved-xu saved-yl saved-yu
-				    display-style)))
-	 (begin
-	   (set-car! redisplay-flags false)
-	   true))))
+(define (buffer-window/needs-redisplay? window)
+  (if (or (window-needs-redisplay? window)
+	  (not (%window-saved-screen window))
+	  (screen-needs-update? (%window-saved-screen window)))
+      true
+      false))
+
+(define (buffer-window/direct-output-forward-char! window)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window
+				    'direct-output-forward-char!))
+  (without-interrupts
+   (lambda ()
+     (%set-window-point-index! window (fix:+ (%window-point-index window) 1))
+     (let ((x-start
+	    (fix:1+ (inferior-x-start (%window-cursor-inferior window))))
+	   (y-start (inferior-y-start (%window-cursor-inferior window))))
+       (screen-direct-output-move-cursor
+	(%window-saved-screen window)
+	(fix:+ (%window-saved-x-start window) x-start)
+	(fix:+ (%window-saved-y-start window) y-start))
+       (%set-inferior-x-start! (%window-cursor-inferior window) x-start)))))
 
-(define (%direct-output-forward-character! window)
-  (with-instance-variables buffer-window window ()
-   (%set-buffer-point! buffer (mark1+ point))
-   (set! point (buffer-point buffer))
-   (let ((x-start (fix:1+ (inferior-x-start cursor-inferior)))
-	 (y-start (inferior-y-start cursor-inferior)))
-     (screen-write-cursor! saved-screen
-			   (fix:+ saved-x-start x-start)
-			   (fix:+ saved-y-start y-start))
-     (screen-flush! saved-screen)
-     (%set-inferior-x-start! cursor-inferior x-start))))
+(define (buffer-window/direct-output-backward-char! window)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window
+				    'direct-output-backward-char!))
+  (without-interrupts
+   (lambda ()
+     (%set-window-point-index! window (fix:- (%window-point-index window) 1))
+     (let ((x-start
+	    (fix:-1+ (inferior-x-start (%window-cursor-inferior window))))
+	   (y-start (inferior-y-start (%window-cursor-inferior window))))
+       (screen-direct-output-move-cursor
+	(%window-saved-screen window)
+	(fix:+ (%window-saved-x-start window) x-start)
+	(fix:+ (%window-saved-y-start window) y-start))
+       (%set-inferior-x-start! (%window-cursor-inferior window) x-start)))))
 
-(define (%direct-output-backward-character! window)
-  (with-instance-variables buffer-window window ()
-   (%set-buffer-point! buffer (mark-1+ point))
-   (set! point (buffer-point buffer))
-   (let ((x-start (fix:-1+ (inferior-x-start cursor-inferior)))
-	 (y-start (inferior-y-start cursor-inferior)))
-     (screen-write-cursor! saved-screen
-			   (fix:+ saved-x-start x-start)
-			   (fix:+ saved-y-start y-start))
-     (screen-flush! saved-screen)
-     (%set-inferior-x-start! cursor-inferior x-start))))
+(define (buffer-window/home-cursor! window)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window 'home-cursor!))
+  (if (and (%window-saved-screen window)
+	   (fix:<= (%window-saved-xl window) 0)
+	   (fix:< 0 (%window-saved-xu window))
+	   (fix:<= (%window-saved-yl window) 0)
+	   (fix:< 0 (%window-saved-yu window)))
+      (without-interrupts
+       (lambda ()
+	 (screen-direct-output-move-cursor (%window-saved-screen window)
+					   (%window-saved-x-start window)
+					   (%window-saved-y-start window))))))
 
-(define (%direct-output-insert-char! window char)
-  (with-instance-variables buffer-window window (char)
-   (let ((x-start (inferior-x-start cursor-inferior))
-	 (y-start (inferior-y-start cursor-inferior)))
-     (let ((x (fix:+ saved-x-start x-start))
-	   (y (fix:+ saved-y-start y-start)))
-       (screen-write-char! saved-screen x y char)
-       (screen-write-cursor! saved-screen (fix:1+ x) y)
-       (screen-flush! saved-screen))
-     (line-window-direct-output-insert-char!
-      (inferior-window (car (y->inferiors window y-start)))
-      x-start
-      char)
-     (%set-inferior-x-start! cursor-inferior (fix:1+ x-start)))))
+(define (buffer-window/direct-output-insert-char! window char)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window
+				    'direct-output-insert-char! char))
+  (without-interrupts
+   (lambda ()
+     (%group-insert-char! (%window-group window)
+			  (%window-point-index window)
+			  char)
+     (let ((x-start (inferior-x-start (%window-cursor-inferior window)))
+	   (y-start (inferior-y-start (%window-cursor-inferior window))))
+       (screen-direct-output-char
+	(%window-saved-screen window)
+	(fix:+ (%window-saved-x-start window) x-start)
+	(fix:+ (%window-saved-y-start window) y-start)
+	char
+	false)
+       (string-base:direct-output-insert-char!
+	(direct-output-line-window window y-start)
+	x-start
+	char)
+       (%set-inferior-x-start! (%window-cursor-inferior window)
+			       (fix:+ x-start 1))))))
 
-(define (%direct-output-insert-newline! window)
-  (with-instance-variables buffer-window window ()
-   (let ((y-start (fix:1+ (inferior-y-start cursor-inferior))))
-     (let ((inferior (make-inferior window line-window)))
-       (%set-inferior-x-start! inferior 0)
-       (%set-inferior-y-start! inferior y-start)
-       (set-cdr! (last-pair line-inferiors) (list inferior))
-       (set! last-line-inferior inferior)
-       (line-window-direct-output-insert-newline!
-	(inferior-window inferior)))
-     (let ((y-end (fix:1+ y-start)))
-       (if (fix:< y-end y-size)
-	   (begin
-	     (%set-inferior-y-size! blank-inferior (fix:- y-size y-end))
-	     (%set-inferior-y-start! blank-inferior y-end))
-	   (begin
-	     (%set-inferior-x-start! blank-inferior false)
-	     (%set-inferior-y-start! blank-inferior false))))
-     (%set-inferior-x-start! cursor-inferior 0)
-     (%set-inferior-y-start! cursor-inferior y-start)
-     (screen-write-cursor! saved-screen
-			   saved-x-start
-			   (fix:+ saved-y-start y-start))
-     (screen-flush! saved-screen))))
+(define (buffer-window/direct-output-insert-substring! window string start end)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window
+				    'direct-output-insert-substring!
+				    (string-copy string) start end))
+  (without-interrupts
+   (lambda ()
+     (%group-insert-substring! (%window-group window)
+			       (%window-point-index window)
+			       string start end)
+     (let ((x-start (inferior-x-start (%window-cursor-inferior window)))
+	   (y-start (inferior-y-start (%window-cursor-inferior window)))
+	   (length (fix:- end start)))
+       (screen-direct-output-substring
+	(%window-saved-screen window)
+	(fix:+ (%window-saved-x-start window) x-start)
+	(fix:+ (%window-saved-y-start window) y-start)
+	string start end
+	false)
+       (string-base:direct-output-insert-substring!
+	(direct-output-line-window window y-start)
+	x-start
+	string start end)
+       (%set-inferior-x-start! (%window-cursor-inferior window)
+			       (fix:+ x-start length))))))
 
-(define (%direct-output-insert-substring! window string start end)
-  (with-instance-variables buffer-window window (string start end)
-   (let ((x-start (inferior-x-start cursor-inferior))
-	 (y-start (inferior-y-start cursor-inferior))
-	 (length (fix:- end start)))
-     (let ((x (fix:+ saved-x-start x-start))
-	   (y (fix:+ saved-y-start y-start)))
-       (screen-write-substring! saved-screen x y string start end)
-       (screen-write-cursor! saved-screen (fix:+ x length) y)
-       (screen-flush! saved-screen))
-     (line-window-direct-output-insert-substring!
-      (inferior-window (car (y->inferiors window y-start)))
-      x-start
-      string start end)
-     (%set-inferior-x-start! cursor-inferior (fix:+ x-start length)))))
\ No newline at end of file
+(define (direct-output-line-window window y)
+  (let loop ((inferiors (%window-line-inferiors window)))
+    (if (fix:< y (%inferior-y-end (car inferiors)))
+	(inferior-window (car inferiors))
+	(loop (cdr inferiors)))))
+
+(define (buffer-window/direct-output-insert-newline! window)
+  (if (%window-debug-trace window)
+      ((%window-debug-trace window) 'window window
+				    'direct-output-insert-newline!))
+  (without-interrupts
+   (lambda ()
+     (%group-insert-char! (%window-group window)
+			  (%window-point-index window)
+			  #\newline)
+     (let ((y-start
+	    (fix:+ (inferior-y-start (%window-cursor-inferior window)) 1)))
+       (let ((inferior (make-inferior window line-window)))
+	 (%set-inferior-x-start! inferior 0)
+	 (%set-inferior-y-start! inferior y-start)
+	 (%set-window-x-size! (inferior-window inferior)
+			      (window-x-size window))
+	 (set-cdr! (last-pair (%window-line-inferiors window)) (list inferior))
+	 (string-base:direct-output-insert-newline!
+	  (inferior-window inferior)))
+       (let ((inferior (%window-blank-inferior window))
+	     (y-end (fix:+ y-start 1)))
+	 (if (fix:< y-end (window-y-size window))
+	     (begin
+	       (%set-inferior-y-size! inferior
+				      (fix:- (window-y-size window) y-end))
+	       (%set-inferior-y-start! inferior y-end))
+	     (begin
+	       (%set-inferior-x-start! inferior false)
+	       (%set-inferior-y-start! inferior false))))
+       (%set-inferior-x-start! (%window-cursor-inferior window) 0)
+       (%set-inferior-y-start! (%window-cursor-inferior window) y-start)
+       (screen-direct-output-move-cursor (%window-saved-screen window)
+					 (%window-saved-x-start window)
+					 (fix:+ (%window-saved-y-start window)
+						y-start))))))
\ No newline at end of file
diff --git a/v7/src/edwin/bufwmc.scm b/v7/src/edwin/bufwmc.scm
index 6ca54950b..dcc3da2c6 100644
--- a/v7/src/edwin/bufwmc.scm
+++ b/v7/src/edwin/bufwmc.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwmc.scm,v 1.7 1989/08/14 09:22:12 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwmc.scm,v 1.8 1990/11/02 03:23:08 cph Rel $
 ;;;
-;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -42,133 +42,342 @@
 ;;; of that license should have been included along with this file.
 ;;;
 
-;;;; Buffer Windows:  Mark <-> Coordinate Maps
+;;;; Buffer Windows: Mark <-> Coordinate Maps
 
 (declare (usual-integrations))
 
-(define-integrable (%window-mark->x window mark)
-  (car (%window-mark->coordinates window mark)))
-
-(define-integrable (%window-mark->y window mark)
-  (cdr (%window-mark->coordinates window mark)))
-
-(define (%window-point-x window)
-  (with-instance-variables buffer-window window ()
-    (car (%window-mark->coordinates window point))))
-
-(define (%window-point-y window)
-  (with-instance-variables buffer-window window ()
-    (cdr (%window-mark->coordinates window point))))
-
-(define (%window-point-coordinates window)
-  (with-instance-variables buffer-window window ()
-    (%window-mark->coordinates window point)))
-
-(define-integrable (%window-mark->coordinates window mark)
-  (%window-index->coordinates window (mark-index mark)))
-
-(define (%window-coordinates->mark window x y)
-  (with-instance-variables buffer-window window (x y)
-    (let ((index (%window-coordinates->index window x y)))
-      (and index (make-mark (buffer-group buffer) index)))))
-
-(define (%window-index->coordinates window index)
-  (with-instance-variables buffer-window window (index)
-    (let ((group (buffer-group buffer)))
-      (define (search-upwards end y-end)
-	(let ((start (line-start-index group end)))
-	  (let ((columns (group-column-length group start end 0)))
-	    (let ((y-start
-		   (fix:- y-end
-			  (column->y-size columns x-size truncate-lines?))))
-	      (if (fix:> start index)
-		  (search-upwards (fix:-1+ start) y-start)
-		  (done start columns y-start))))))
-
-      (define (search-downwards start y-start)
-	(let ((end (line-end-index group start)))
-	  (let ((columns (group-column-length group start end 0)))
-	    (if (fix:> index end)
-		(search-downwards (fix:1+ end)
-				  (fix:+ y-start
-					 (column->y-size columns
-							 x-size
-							 truncate-lines?)))
-		(done start columns y-start)))))
-
-      (define-integrable (done start columns y-start)
-	(let ((xy
-	       (column->coordinates columns
-				    x-size
-				    truncate-lines?
-				    (group-column-length group
-							 start
-							 index
-							 0))))
-	  (cons (car xy) (fix:+ (cdr xy) y-start))))
-
-      (let ((start (mark-index start-line-mark))
-	    (end (mark-index end-line-mark)))
-	(cond ((fix:< index start)
-	       (search-upwards (fix:-1+ start)
-			       (inferior-y-start
-				(first-line-inferior window))))
-	      ((fix:> index end)
-	       (search-downwards (fix:1+ end)
-				 (inferior-y-end last-line-inferior)))
-	      (else
-	       (let ((start (line-start-index group index)))
-		 (done start
-		       (group-column-length group start
-					    (line-end-index group index) 0)
-		       (inferior-y-start
-			(car (index->inferiors window index)))))))))))
+(define-integrable (buffer-window/mark->x window mark)
+  (buffer-window/index->x window (mark-index mark)))
+
+(define-integrable (buffer-window/mark->y window mark)
+  (buffer-window/index->y window (mark-index mark)))
+
+(define-integrable (buffer-window/mark->coordinates window mark)
+  (buffer-window/index->coordinates window (mark-index mark)))
+
+(define-integrable (buffer-window/point-x window)
+  (buffer-window/index->x window (%window-point-index window)))
+
+(define-integrable (buffer-window/point-y window)
+  (buffer-window/index->y window (%window-point-index window)))
+
+(define-integrable (buffer-window/point-coordinates window)
+  (buffer-window/index->coordinates window (%window-point-index window)))
+
+(define (buffer-window/index->x window index)
+  (if (and (line-inferiors-valid? window)
+	   (line-inferiors-contain-index? window index))
+      (with-values (lambda () (find-inferior-containing-index window index))
+	(lambda (inferior start)
+	  (fix:+ (inferior-x-start inferior)
+		 (string-base:index->x (inferior-window inferior)
+				       (fix:- index start)))))
+      (let ((start (%window-line-start-index window index)))
+	(%window-column->x window
+			   (%window-line-columns window start index)
+			   (%window-column-length window start index 0)))))
+
+(define (buffer-window/index->y window index)
+  (if (and (line-inferiors-valid? window)
+	   (line-inferiors-contain-index? window index))
+      (with-values (lambda () (find-inferior-containing-index window index))
+	(lambda (inferior start)
+	  (fix:+ (inferior-y-start inferior)
+		 (string-base:index->y (inferior-window inferior)
+				       (fix:- index start)))))
+      (begin
+	(guarantee-start-mark! window)
+	(predict-y window
+		   (%window-start-line-index window)
+		   (%window-start-line-y window)
+		   index))))
+
+(define (buffer-window/index->coordinates window index)
+  (if (and (line-inferiors-valid? window)
+	   (line-inferiors-contain-index? window index))
+      (with-values (lambda () (find-inferior-containing-index window index))
+	(lambda (inferior start)
+	  (let ((xy
+		 (string-base:index->coordinates (inferior-window inferior)
+						 (fix:- index start))))
+	    (cons (fix:+ (car xy) (inferior-x-start inferior))
+		  (fix:+ (cdr xy) (inferior-y-start inferior))))))
+      (begin
+	(guarantee-start-mark! window)
+	(let ((start (%window-line-start-index window index)))
+	  (let ((xy
+		 (%window-column->coordinates
+		  window
+		  (%window-line-columns window start index)
+		  (%window-column-length window start index 0))))
+	    (cons (car xy)
+		  (fix:+ (cdr xy)
+			 (predict-y window
+				    (%window-start-line-index window)
+				    (%window-start-line-y window)
+				    start))))))))
+
+(define (buffer-window/coordinates->mark window x y)
+  (let ((index (buffer-window/coordinates->index window x y)))
+    (and index
+	 (make-mark (%window-group window) index))))
+
+(define (buffer-window/coordinates->index window x y)
+  (with-values
+      (lambda ()
+	(if (line-inferiors-valid? window)
+	    (find-inferior-containing-y window y)
+	    (values false false)))
+    (lambda (inferior start)
+      (if inferior
+	  (fix:+ start
+		 (string-base:coordinates->index
+		  (inferior-window inferior)
+		  x
+		  (fix:- y (inferior-y-start inferior))))
+	  (begin
+	    (guarantee-start-mark! window)
+	    (predict-index window
+			   (%window-start-line-index window)
+			   (%window-start-line-y window)
+			   x
+			   y))))))
+
+(define (buffer-window/mark-visible? window mark)
+  ;; True iff cursor at this position would be on-screen.
+  (let ((index (mark-index mark)))
+    (if (line-inferiors-valid? window)
+	(and (line-inferiors-contain-index? window index)
+	     (fix:<= (%window-start-index window) index)
+	     (with-values
+		 (lambda () (find-inferior-containing-index window index))
+	       (lambda (inferior start)
+		 (let ((limit
+			(fix:- (window-y-size window)
+			       (inferior-y-start inferior))))
+		   (or (fix:< (inferior-y-size inferior) limit)
+		       (fix:< (string-base:index->y (inferior-window inferior)
+						    (fix:- index start))
+			      limit))))))
+	(begin
+	  (guarantee-start-mark! window)
+	  (predict-index-visible? window
+				  (%window-start-line-index window)
+				  (%window-start-line-y window)
+				  index)))))
+
+(define-integrable (line-inferiors-valid? window)
+  (and (not (%window-start-changes-mark window))
+       (not (%window-start-clip-mark window))
+       (not (%window-point-moved? window))
+       (not (%window-force-redraw? window))
+       (%window-start-line-mark window)
+       (fix:= (mark-position (%window-start-line-mark window))
+	      (mark-position (%window-current-start-mark window)))))
+
+(define-integrable (line-inferiors-contain-index? window index)
+  (and (fix:<= (%window-current-start-index window) index)
+       (fix:<= index (%window-current-end-index window))))
+
+(define (find-inferior-containing-index window index)
+  (let loop
+      ((inferiors (%window-line-inferiors window))
+       (start (%window-current-start-index window)))
+    (let ((start* (fix:+ start (line-inferior-length (car inferiors)))))
+      (if (fix:< index start*)
+	  (values (car inferiors) start)
+	  (loop (cdr inferiors) start*)))))
+
+(define (find-inferior-containing-y window y)
+  (let ((inferiors (%window-line-inferiors window)))
+    (if (fix:< y (inferior-y-start (car inferiors)))
+	(values false false)
+	(let loop
+	    ((inferiors inferiors)
+	     (start (%window-current-start-index window)))
+	  (cond ((fix:< y (%inferior-y-end (car inferiors)))
+		 (values (car inferiors) start))
+		((null? (cdr inferiors))
+		 (values false false))
+		(else
+		 (loop (cdr inferiors)
+		       (fix:+ start
+			      (line-inferior-length (car inferiors))))))))))
 
-(define (%window-coordinates->index window x y)
-  (with-instance-variables buffer-window window (x y)
-    (let ((group (buffer-group buffer)))
-      (define (search-upwards start y-end)
-	(and (not (group-start-index? group start))
-	     (let ((end (fix:-1+ start)))
-	       (let ((start (line-start-index group end)))
-		 (let ((y-start (fix:- y-end (y-delta start end))))
-		   (if (fix:> y-start y)
-		       (search-upwards start y-start)
-		       (done start end y-start)))))))
-
-      (define (search-downwards end y-start)
-	(and (not (group-end-index? group end))
-	     (let ((start (fix:1+ end)))
-	       (let ((end (line-end-index group start)))
-		 (let ((y-end (fix:+ y-start (y-delta start end))))
-		   (if (fix:< y y-end)
-		       (done start end y-start)
-		       (search-downwards end y-end)))))))
-
-      (define-integrable (y-delta start end)
-	(column->y-size (group-column-length group start end 0)
-			x-size
-			truncate-lines?))
-
-      (define (done start end y-start)
-	(let ((column-size (group-column-length group start end 0)))
-	  (if (and truncate-lines? (fix:= x (fix:-1+ x-size)))
-	      column-size
-	      (group-column->index group start end 0
-				   (min (coordinates->column x
-							     (fix:- y y-start)
-							     x-size)
-					column-size)))))
-
-      (let ((start (inferior-y-start (first-line-inferior window)))
-	    (end (inferior-y-end last-line-inferior)))
-	(cond ((fix:< y start)
-	       (search-upwards (mark-index start-line-mark) start))
-	      ((not (fix:< y end))
-	       (search-downwards (mark-index end-line-mark) end))
-	      (else
-	       (y->inferiors&index window y
-		 (lambda (inferiors index)
-		   (done index
-			 (line-end-index group index)
-			 (inferior-y-start (car inferiors)))))))))))
\ No newline at end of file
+(define (predict-y window start y index)
+  ;; Assuming that the character at index START appears at coordinate
+  ;; Y, return the coordinate for the character at INDEX.  START is
+  ;; assumed to be a line start.
+  (cond ((fix:= index start)
+	 y)
+	((fix:< index start)
+	 (let loop ((start start) (y y))
+	   (let* ((end (fix:- start 1))
+		  (start (%window-line-start-index window end))
+		  (columns (%window-column-length window start end 0))
+		  (y (fix:- y (%window-column->y-size window columns))))
+	     (if (fix:< index start)
+		 (loop start y)
+		 (fix:+ y (%window-line-y window columns start index))))))
+	(else
+	 (let loop ((start start) (y y))
+	   (let* ((end (%window-line-end-index window start))
+		  (columns (%window-column-length window start end 0)))
+	     (if (fix:> index end)
+		 (loop (fix:+ end 1)
+		       (fix:+ y (%window-column->y-size window columns)))
+		 (fix:+ y (%window-line-y window columns start index))))))))
+
+(define (predict-index-visible? window start y index)
+  (and (fix:>= index start)
+       (let ((y-size (window-y-size window)))
+	 (let loop ((start start) (y y))
+	   (and (fix:< y y-size)
+		(let* ((end (%window-line-end-index window start))
+		       (columns (%window-column-length window start end 0)))
+		  (if (fix:> index end)
+		      (loop (fix:+ end 1)
+			    (fix:+ y (%window-column->y-size window columns)))
+		      (let ((y
+			     (fix:+
+			      y
+			      (%window-line-y window columns start index))))
+			(and (fix:<= 0 y) (fix:< y y-size))))))))))
+
+(define (predict-index window start y-start x y)
+  ;; Assumes that START is a line start.
+  (if (fix:< y y-start)
+      (let loop ((start start) (y-start y-start))
+	(and (not (%window-group-start-index? window start))
+	     (let* ((end (fix:- start 1))
+		    (start (%window-line-start-index window end))
+		    (columns (%window-column-length window start end 0))
+		    (y-start
+		     (fix:- y-start (%window-column->y-size window columns))))
+	       (if (fix:< y y-start)
+		   (loop start y-start)
+		   (%window-coordinates->index window start end columns
+					       x (fix:- y y-start))))))
+      (let loop ((start start) (y-start y-start))
+	(let* ((end (%window-line-end-index window start))
+	       (columns (%window-column-length window start end 0))
+	       (y-end
+		(fix:+ y-start (%window-column->y-size window columns))))
+	  (if (fix:>= y y-end)
+	      (and (not (%window-group-end-index? window end))
+		   (loop (fix:+ end 1) y-end))
+	      (%window-coordinates->index window start end columns
+					  x (fix:- y y-start)))))))
+
+(define (predict-start-line window index y)
+  (let ((start (%window-line-start-index window index)))
+    (let ((y
+	   (fix:- y
+		  (%window-line-y window
+				  (%window-line-columns window start index)
+				  start
+				  index))))
+      (cond ((fix:= y 0)
+	     (values start y))
+	    ((fix:< y 0)
+	     (let loop ((start start) (y y))
+	       (let* ((end (%window-line-end-index window start))
+		      (columns (%window-column-length window start end 0))
+		      (y-end
+		       (fix:+ y (%window-column->y-size window columns))))
+		 (if (and (fix:<= y-end 0)
+			  (not (%window-group-end-index? window end)))
+		     (loop (fix:+ end 1) y-end)
+		     (values start y)))))
+	    (else
+	     (let loop ((start start) (y y))
+	       (if (%window-group-start-index? window start)
+		   (values start 0)
+		   (let* ((end (fix:- start 1))
+			  (start (%window-line-start-index window end))
+			  (columns (%window-column-length window start end 0))
+			  (y-start
+			   (fix:- y (%window-column->y-size window columns))))
+		     (if (fix:<= y-start 0)
+			 (values start y-start)
+			 (loop start y-start))))))))))
+
+(define (predict-start-index window start y-start)
+  ;; Assumes (AND (%WINDOW-LINE-START-INDEX? WINDOW START) (<= Y-START 0))
+  (if (fix:= 0 y-start)
+      start
+      (let ((end (%window-line-end-index window start))
+	    (y (fix:- 0 y-start)))
+	(let ((length (%window-column-length window start end 0)))
+	  (let ((index
+		 (%window-coordinates->index window start end length 0 y)))
+	    (if (let ((xy
+		       (%window-index->coordinates window start length index)))
+		  (and (fix:= (car xy) 0)
+		       (fix:= (cdr xy) y)))
+		index
+		(fix:+ index 1)))))))
+
+(define (compute-start-index inferior start)
+  (let ((y-start (inferior-y-start inferior)))
+    (if (fix:= 0 y-start)
+	start
+	(let ((window (inferior-window inferior))
+	      (y (fix:- 0 y-start)))
+	  (let ((index (string-base:coordinates->index window 0 y)))
+	    (if (let ((xy (string-base:index->coordinates window index)))
+		  (and (fix:= (car xy) 0)
+		       (fix:= (cdr xy) y)))
+		(fix:+ start index)
+		(fix:+ (fix:+ start index) 1)))))))
+
+(define-integrable (%window-column-length window start end column)
+  (group-column-length (%window-group window) start end column))
+
+(define-integrable (%window-column->index window start end column-start column)
+  (group-column->index (%window-group window) start end column-start column))
+
+(define-integrable (%window-line-columns window start index)
+  (%window-column-length window start (%window-line-end-index window index) 0))
+
+(define-integrable (%window-line-y window columns start index)
+  (%window-column->y window
+		     columns
+		     (%window-column-length window start index 0)))
+
+(define-integrable (%window-column->y-size window column-size)
+  (column->y-size column-size
+		  (window-x-size window)
+		  (%window-truncate-lines? window)))
+
+(define-integrable (%window-column->x window column-size column)
+  (column->x column-size
+	     (window-x-size window)
+	     (%window-truncate-lines? window)
+	     column))
+
+(define-integrable (%window-column->y window column-size column)
+  (column->y column-size
+	     (window-x-size window)
+	     (%window-truncate-lines? window)
+	     column))
+
+(define-integrable (%window-column->coordinates window column-size column)
+  (column->coordinates column-size
+		       (window-x-size window)
+		       (%window-truncate-lines? window)
+		       column))
+
+(define (%window-coordinates->index window start end column-length x y)
+  (%window-column->index
+   window start end 0
+   (let ((column (coordinates->column x y (window-x-size window))))
+     (if (fix:< column column-length)
+	 column
+	 column-length))))
+
+(define-integrable (%window-index->coordinates window start column-length
+					       index)
+  (%window-column->coordinates window
+			       column-length
+			       (%window-column-length window start index 0)))
\ No newline at end of file
diff --git a/v7/src/edwin/comman.scm b/v7/src/edwin/comman.scm
index d6f8db7b0..6999c4275 100644
--- a/v7/src/edwin/comman.scm
+++ b/v7/src/edwin/comman.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comman.scm,v 1.62 1989/08/11 11:50:16 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comman.scm,v 1.63 1990/11/02 03:23:13 cph Rel $
 ;;;
-;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -104,7 +104,8 @@
   value
   buffer-local?
   initial-value
-  assignment-daemons)
+  assignment-daemons
+  value-validity-test)
 
 (unparser/set-tagged-vector-method!
  %variable-tag
@@ -128,24 +129,32 @@
     (vector-set! variable variable-index:buffer-local? buffer-local?)
     (vector-set! variable variable-index:initial-value value)
     (vector-set! variable variable-index:assignment-daemons '())
+    (vector-set! variable variable-index:value-validity-test false)
     variable))
 
 (define-integrable (%set-variable-value! variable value)
-  (vector-set! variable variable-index:value value)
-  unspecific)
+  (vector-set! variable variable-index:value value))
 
 (define-integrable (make-variable-buffer-local! variable)
-  (vector-set! variable variable-index:buffer-local? true)
-  unspecific)
+  (vector-set! variable variable-index:buffer-local? true))
 
+(define (define-variable-value-validity-test variable test)
+  (vector-set! variable variable-index:value-validity-test test))
+
+(define (check-variable-value-validity! variable value)
+  (if (not (variable-value-valid? variable value))
+      (error:illegal-datum value 'CHECK-VARIABLE-VALUE-VALIDITY)))
+
+(define (variable-value-valid? variable value)
+  (or (not (variable-value-validity-test variable))
+      ((variable-value-validity-test variable) value)))
+
 (define (add-variable-assignment-daemon! variable daemon)
   (let ((daemons (variable-assignment-daemons variable)))
     (if (not (memq daemon daemons))
-	(begin
-	  (vector-set! variable
-		       variable-index:assignment-daemons
-		       (cons daemon daemons))
-	  unspecific))))
+	(vector-set! variable
+		     variable-index:assignment-daemons
+		     (cons daemon daemons)))))
 
 (define (invoke-variable-assignment-daemons! variable)
   (for-each (lambda (daemon) (daemon variable))
@@ -166,6 +175,7 @@
       (make-local-binding! variable value)
       (without-interrupts
        (lambda ()
+	 (check-variable-value-validity! variable value)
 	 (%set-variable-value! variable value)
 	 (invoke-variable-assignment-daemons! variable)))))
 
diff --git a/v7/src/edwin/comwin.scm b/v7/src/edwin/comwin.scm
index 25fe0fed3..044bc9ec8 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.138 1989/06/21 10:31:40 cph Rel $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/comwin.scm,v 1.139 1990/11/02 03:23:19 cph Rel $
 ;;;
-;;;	Copyright (c) 1985, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1985, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -104,8 +104,7 @@
 
 (define-integrable (set-window-next! window window*)
   (with-instance-variables combination-leaf-window window (window*)
-    (set! next-window window*)
-    unspecific))
+    (set! next-window window*)))
 
 (define-integrable (window-previous window)
   (with-instance-variables combination-leaf-window window ()
@@ -113,13 +112,12 @@
 
 (define-integrable (set-window-previous! window window*)
   (with-instance-variables combination-leaf-window window (window*)
-    (set! previous-window window*)
-    unspecific))
+    (set! previous-window window*)))
 
 (define (link-windows! previous next)
   (set-window-previous! next previous)
   (set-window-next! previous next))
-
+
 (define-class combination-window combination-leaf-window
   (vertical? child))
 
@@ -129,8 +127,7 @@
 
 (define-integrable (set-combination-vertical! window v)
   (with-instance-variables combination-window window (v)
-    (set! vertical? v)
-    unspecific))
+    (set! vertical? v)))
 
 (define-integrable (combination-child window)
   (with-instance-variables combination-window window ()
@@ -151,7 +148,7 @@
 
 (define-integrable (check-leaf-window window name)
   (if (not (leaf? window))
-      (error "Not a leaf window" name window)))
+      (error:illegal-datum window name)))
 
 ;;;; Leaf Ordering
 
@@ -188,7 +185,7 @@
 (define (window0 window)
   (if (not (and (object? window)
 		(subclass? (object-class window) combination-leaf-window)))
-      (error "WINDOW0: Window neither combination nor leaf" window))
+      (error:illegal-datum window 'WINDOW0))
   (window-leftmost-leaf (window-root window)))
 
 (define (%window1+ leaf)
@@ -310,55 +307,59 @@
 
 (define (window-split-horizontally! leaf #!optional n)
   (check-leaf-window leaf 'WINDOW-SPLIT-HORIZONTALLY!)
-  (let ((n
-	 (if (or (default-object? n) (not n))
-	     (quotient (window-x-size leaf) 2)
-	     n))
-	(x (window-x-size leaf))
-	(y (window-y-size leaf)))
-    (let ((n* (- x n))
-	  (new (allocate-leaf! leaf false)))
-      (let ((combination (window-superior leaf)))
-	(inferior-start (window-inferior combination leaf)
-	  (lambda (x y)
-	    (set-inferior-start! (window-inferior combination new)
-				 (+ x n)
-				 y))))
-      (if (or (< n (=> leaf :minimum-x-size))
-	      (< n* (=> new :minimum-x-size)))
-	  (begin
-	    (deallocate-leaf! new)
-	    false)
-	  (begin
-	    (=> leaf :set-x-size! n)
-	    (=> new :set-size! n* y)
-	    new)))))
+  (without-interrupts
+   (lambda ()
+     (let ((n
+	    (if (or (default-object? n) (not n))
+		(quotient (window-x-size leaf) 2)
+		n))
+	   (x (window-x-size leaf))
+	   (y (window-y-size leaf)))
+       (let ((n* (- x n))
+	     (new (allocate-leaf! leaf false)))
+	 (let ((combination (window-superior leaf)))
+	   (inferior-start (window-inferior combination leaf)
+	     (lambda (x y)
+	       (set-inferior-start! (window-inferior combination new)
+				    (+ x n)
+				    y))))
+	 (if (or (< n (=> leaf :minimum-x-size))
+		 (< n* (=> new :minimum-x-size)))
+	     (begin
+	       (deallocate-leaf! new)
+	       false)
+	     (begin
+	       (=> leaf :set-x-size! n)
+	       (=> new :set-size! n* y)
+	       new)))))))
 
 (define (window-split-vertically! leaf #!optional n)
   (check-leaf-window leaf 'WINDOW-SPLIT-VERTICALLY!)
-  (let ((n
-	 (if (or (default-object? n) (not n))
-	     (quotient (window-y-size leaf) 2)
-	     n))
-	(x (window-x-size leaf))
-	(y (window-y-size leaf)))
-    (let ((n* (- y n))
-	  (new (allocate-leaf! leaf true)))
-      (let ((combination (window-superior leaf)))
-	(inferior-start (window-inferior combination leaf)
-	  (lambda (x y)
-	    (set-inferior-start! (window-inferior combination new)
-				 x
-				 (+ y n)))))
-      (if (or (< n (=> leaf :minimum-y-size))
-	      (< n* (=> new :minimum-y-size)))
-	  (begin
-	    (deallocate-leaf! new)
-	    false)
-	  (begin
-	    (=> leaf :set-y-size! n)
-	    (=> new :set-size! x n*)
-	    new)))))
+  (without-interrupts
+   (lambda ()
+     (let ((n
+	    (if (or (default-object? n) (not n))
+		(quotient (window-y-size leaf) 2)
+		n))
+	   (x (window-x-size leaf))
+	   (y (window-y-size leaf)))
+       (let ((n* (- y n))
+	     (new (allocate-leaf! leaf true)))
+	 (let ((combination (window-superior leaf)))
+	   (inferior-start (window-inferior combination leaf)
+	     (lambda (x y)
+	       (set-inferior-start! (window-inferior combination new)
+				    x
+				    (+ y n)))))
+	 (if (or (< n (=> leaf :minimum-y-size))
+		 (< n* (=> new :minimum-y-size)))
+	     (begin
+	       (deallocate-leaf! new)
+	       false)
+	     (begin
+	       (=> leaf :set-y-size! n)
+	       (=> new :set-size! x n*)
+	       new)))))))
 
 (define (allocate-leaf! leaf v)
   (let ((superior (window-superior leaf)))
@@ -391,48 +392,47 @@
 
 (define (window-delete! leaf)
   (check-leaf-window leaf 'WINDOW-DELETE!)
-  (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"))
-    (unlink-leaf! leaf)
-    (let ((value
-	   (let ((adjust-size!
-		  (lambda (window)
-		    (if (combination-vertical? superior)
-			(=> window :set-y-size!
-			    (+ (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))))
-		    next)
-		   (previous
-		    (adjust-size! previous)
-		    previous)
-		   (else
-		    (error "combination with single child" superior))))))
-      (maybe-delete-combination! superior)
-      (if (current-window? leaf)
-	  (select-window value)))))
+  (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 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))))))
+	 (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))))
+       (maybe-delete-combination! superior)))))
 
 (define (unlink-leaf! leaf)
   (let ((combination (window-superior leaf))
 	(next (window-next leaf))
 	(previous (window-previous leaf)))
-    (delete-inferior! combination leaf)
     (=> leaf :kill!)
+    (delete-inferior! combination leaf)
     (if previous
 	(set-window-next! previous next)
 	(set-combination-child! combination next))
@@ -484,73 +484,151 @@
 
 ;;;; Sizing
 
-(define (window-grow! leaf delta
-		      vertical? size min-size
-		      set-w-size! start set-start!)
-  (check-leaf-window leaf 'WINDOW-GROW!)
-  (let ((leaf
-	 (let loop ((leaf leaf))
-	   (let ((combination (window-superior leaf)))
-	     (cond ((not (combination? combination))
-		    (editor-error "Can't grow this window "
-				  (if vertical? "vertically" "horizontally")))
-		   ((boolean=? vertical? (combination-vertical? combination))
-		    leaf)
-		   (else
-		    (loop combination)))))))
-    (let ((new-size (+ (size leaf) delta))
-	  (combination (window-superior leaf))
-	  (next (window-next leaf))
-	  (previous (window-previous leaf)))
-      (if (> new-size (size combination))
-	  (begin
-	    (set! new-size (size combination))
-	    (set! delta (- new-size (size leaf)))))
-      (cond ((< new-size (min-size leaf))
-	     (window-delete! leaf))
-	    ((and next (>= (- (size next) delta) (min-size next)))
-	     (let ((inferior (window-inferior combination next)))
-	       (set-start! inferior (+ (start inferior) delta)))
-	     (set-w-size! next (- (size next) delta))
-	     (set-w-size! leaf new-size))
-	    ((and previous
-		  (>= (- (size previous) delta) (min-size previous)))
-	     (let ((inferior (window-inferior combination leaf)))
-	       (set-start! inferior (- (start inferior) delta)))
-	     (set-w-size! previous (- (size previous) delta))
-	     (set-w-size! leaf new-size))
-	    (else
-	     (scale-combination-inferiors! combination
-					   (- (size combination) new-size)
-					   leaf vertical? size min-size
-					   set-w-size! set-start!)
-	     ;; Scaling may have deleted all other inferiors.
-	     ;; If so, leaf has replaced combination.
-	     (set-w-size! leaf
-			  (if (eq? combination (window-superior leaf))
-			      new-size
-			      (size combination))))))))
+(define (window-grow! vertical? size min-size set-w-size! start set-start!
+		      scale-combination-inferiors!)
+  (lambda (leaf delta)
+    (check-leaf-window leaf 'WINDOW-GROW!)
+    (without-interrupts
+     (lambda ()
+       (let ((leaf
+	      (let loop ((leaf leaf))
+		(let ((combination (window-superior leaf)))
+		  (if (not (combination? combination))
+		      (editor-error "Can't grow this window "
+				    (if vertical?
+					"vertically"
+					"horizontally")))
+		  (if (boolean=? vertical? (combination-vertical? combination))
+		      leaf
+		      (loop combination))))))
+	 (let ((new-size (+ (size leaf) delta))
+	       (combination (window-superior leaf))
+	       (next (window-next leaf))
+	       (previous (window-previous leaf)))
+	   (if (> new-size (size combination))
+	       (begin
+		 (set! new-size (size combination))
+		 (set! delta (- new-size (size leaf)))))
+	   (cond ((< new-size (min-size leaf))
+		  (window-delete! leaf))
+		 ((and next (>= (- (size next) delta) (min-size next)))
+		  (let ((inferior (window-inferior combination next)))
+		    (set-start! inferior (+ (start inferior) delta)))
+		  (set-w-size! next (- (size next) delta))
+		  (set-w-size! leaf new-size))
+		 ((and previous
+		       (>= (- (size previous) delta) (min-size previous)))
+		  (let ((inferior (window-inferior combination leaf)))
+		    (set-start! inferior (- (start inferior) delta)))
+		  (set-w-size! previous (- (size previous) delta))
+		  (set-w-size! leaf new-size))
+		 (else
+		  (scale-combination-inferiors! combination
+						(- (size combination) new-size)
+						leaf)
+		  ;; Scaling may have deleted all other inferiors.
+		  ;; If so, leaf has replaced combination.
+		  (set-w-size! leaf
+			       (if (eq? combination (window-superior leaf))
+				   new-size
+				   (size combination)))))))))))
+
+;;; (SCALE-COMBINATION-INFERIORS! COMBINATION NEW-ROOM EXCEPT)
+
+;;; Change all of the inferiors of COMBINATION (except EXCEPT) to use
+;;; NEW-ROOM's worth of space.  EXCEPT, if given, should not be
+;;; changed in size, but should be moved if its neighbors change.  It
+;;; is assumed that EXCEPT is given only for case where the
+;;; combination's VERTICAL? flag is the same as V.
+
+;;; General strategy:
+
+;;; If the window is growing, we can simply change the sizes of the
+;;; inferiors.  However, if it is shrinking, we must be more careful
+;;; because some or all of the inferiors can be deleted.  So in that
+;;; case, before any sizes are changed, we find those inferiors that
+;;; will be deleted and delete them.  If we delete all of the
+;;; inferiors, then we are done: this window has also been deleted.
+;;; Otherwise, we can then perform all of the changes, knowing that no
+;;; window will grow too small.
+
+(define (scale-combination-inferiors! v size min-size set-w-size! set-start!)
+  (lambda (combination new-room except)
+    (let ((kernel
+	   (lambda (old-room collect-deletions change-inferiors)
+	     (cond ((< old-room new-room)
+		    (change-inferiors))
+		   ((> old-room new-room)
+		    (for-each window-delete! (collect-deletions))
+		    (if (not (null? (window-inferiors combination)))
+			(change-inferiors))))))
+	  (child (combination-child combination))
+	  (c-size (size combination)))
+      (if (not (eq? (combination-vertical? combination) v))
+	  (kernel
+	   c-size
+	   (lambda ()
+	     (let loop ((window child))
+	       (let ((deletions
+		      (if (window-next window)
+			  (loop (window-next window))
+			  '())))
+		 (if (< new-room (min-size window))
+		     (cons window deletions)
+		     deletions))))
+	   (lambda ()
+	     (let loop ((window child))
+	       (set-w-size! window new-room)
+	       (if (window-next window)
+		   (loop (window-next window))))))
+	  (let ((old-room (if except (- c-size (size except)) c-size)))
+	    (kernel
+	     old-room
+	     (lambda ()
+	       (let loop
+		   ((window child) (old-room old-room) (new-room new-room))
+		 (cond ((eq? window except)
+			(if (window-next window)
+			    (loop (window-next window) old-room new-room)
+			    '()))
+		       ((not (window-next window))
+			(if (< new-room (min-size window))
+			    (list window)
+			    '()))
+		       (else
+			(let* ((old-s (size window))
+			       (new-s (quotient (* old-s new-room) old-room))
+			       (deletions
+				(loop (window-next window)
+				      (- old-room old-s)
+				      (- new-room new-s))))
+			  (if (< new-s (min-size window))
+			      (cons window deletions)
+			      deletions))))))
+	     (lambda ()
+	       (let loop
+		   ((window child)
+		    (start 0)
+		    (old-room old-room)
+		    (new-room new-room))
+		 (set-start! (window-inferior combination window) start)
+		 (cond ((eq? window except)
+			(if (window-next window)
+			    (loop (window-next window)
+				  start
+				  old-room
+				  new-room)))
+		       ((not (window-next window))
+			(set-w-size! window new-room))
+		       (else
+			(let* ((old-s (size window))
+			       (new-s (quotient (* old-s new-room) old-room)))
+			  (set-w-size! window new-s)
+			  (loop (window-next window)
+				(+ start new-s)
+				(- old-room old-s)
+				(- new-room new-s)))))))))))))
 
-(define (window-grow-horizontally! leaf delta)
-  (window-grow! leaf delta false
-		window-x-size window-min-x-size
-		send-window-x-size! inferior-x-start set-inferior-x-start!))
-
-(define (window-grow-vertically! leaf delta)
-  (window-grow! leaf delta true
-		window-y-size window-min-y-size
-		send-window-y-size! inferior-y-start set-inferior-y-start!))
-
-(define (scale-combination-inferiors-x! combination x except)
-  (scale-combination-inferiors! combination x except false
-				window-x-size window-min-x-size
-				send-window-x-size! set-inferior-x-start!))
-
-(define (scale-combination-inferiors-y! combination y except)
-  (scale-combination-inferiors! combination y except true
-				window-y-size window-min-y-size
-				send-window-y-size! set-inferior-y-start!))
-
 (define (window-min-x-size window)
   (=> window :minimum-x-size))
 
@@ -563,6 +641,24 @@
 (define (send-window-y-size! window y)
   (=> window :set-y-size! y))
 
+(define scale-combination-inferiors-x!
+  (scale-combination-inferiors! false window-x-size window-min-x-size
+				send-window-x-size! set-inferior-x-start!))
+
+(define scale-combination-inferiors-y!
+  (scale-combination-inferiors! true window-y-size window-min-y-size
+				send-window-y-size! set-inferior-y-start!))
+
+(define window-grow-horizontally!
+  (window-grow! false window-x-size window-min-x-size send-window-x-size!
+		inferior-x-start set-inferior-x-start!
+		scale-combination-inferiors-x!))
+
+(define window-grow-vertically!
+  (window-grow! true window-y-size window-min-y-size send-window-y-size!
+		inferior-y-start set-inferior-y-start!
+		scale-combination-inferiors-y!))
+
 (define-method combination-window (:minimum-x-size combination)
   (=> (window-leftmost-leaf combination) :minimum-x-size))
 
@@ -591,93 +687,4 @@
   (inferior-containing-coordinates combination x y leaf?))
 
 (define-method combination-leaf-window (:leaf-containing-coordinates leaf x y)
-  (values leaf x y))
-
-(define (scale-combination-inferiors! combination new-room except
-				      v size min-size set-w-size! set-start!)
-  ;; Change all of the inferiors of COMBINATION (except EXCEPT) to
-  ;; use NEW-ROOM's worth of space.  EXCEPT, if given, should not be
-  ;; changed in size, but should be moved if its neighbors change.
-  ;; It is assumed that EXCEPT is given only for case where the
-  ;; combination's VERTICAL? flag is the same as V.
-
-  ;; General strategy:
-  ;; If the window is growing, we can simply change the sizes of the
-  ;; inferiors.  However, if it is shrinking, we must be more careful
-  ;; because some or all of the inferiors can be deleted.  So in that
-  ;; case, before any sizes are changed, we find those inferiors that
-  ;; will be deleted and delete them.  If we delete all of the
-  ;; inferiors, then we are done: this window has also been deleted.
-  ;; Otherwise, we can then perform all of the changes, knowing that
-  ;; no window will grow too small.
-
-  (let ((kernel
-	 (lambda (old-room collect-deletions change-inferiors)
-	   (cond ((< old-room new-room)
-		  (change-inferiors))
-		 ((> old-room new-room)
-		  (for-each window-delete! (collect-deletions))
-		  (if (not (null? (window-inferiors combination)))
-		      (change-inferiors))))))
-	(child (combination-child combination))
-	(c-size (size combination)))
-    (if (not (eq? (combination-vertical? combination) v))
-	(kernel
-	 c-size
-	 (lambda ()
-	   (let loop ((window child))
-	     (let ((deletions
-		    (if (window-next window)
-			(loop (window-next window))
-			'())))
-	       (if (< new-room (min-size window))
-		   (cons window deletions)
-		   deletions))))
-	 (lambda ()
-	   (let loop ((window child))
-	     (set-w-size! window new-room)
-	     (if (window-next window)
-		 (loop (window-next window))))))
-	(let ((old-room (if except (- c-size (size except)) c-size)))
-	  (kernel
-	   old-room
-	   (lambda ()
-	     (let loop ((window child) (old-room old-room) (new-room new-room))
-	       (cond ((eq? window except)
-		      (if (window-next window)
-			  (loop (window-next window) old-room new-room)
-			  '()))
-		     ((not (window-next window))
-		      (if (< new-room (min-size window))
-			  (list window)
-			  '()))
-		     (else
-		      (let* ((old-s (size window))
-			     (new-s (quotient (* old-s new-room) old-room))
-			     (deletions
-			      (loop (window-next window)
-				    (- old-room old-s)
-				    (- new-room new-s))))
-			(if (< new-s (min-size window))
-			    (cons window deletions)
-			    deletions))))))
-	   (lambda ()
-	     (let loop
-		 ((window child)
-		  (start 0)
-		  (old-room old-room)
-		  (new-room new-room))
-	       (set-start! (window-inferior combination window) start)
-	       (cond ((eq? window except)
-		      (if (window-next window)
-			  (loop (window-next window) start old-room new-room)))
-		     ((not (window-next window))
-		      (set-w-size! window new-room))
-		     (else
-		      (let* ((old-s (size window))
-			     (new-s (quotient (* old-s new-room) old-room)))
-			(set-w-size! window new-s)
-			(loop (window-next window)
-			      (+ start new-s)
-			      (- old-room old-s)
-			      (- new-room new-s))))))))))))
\ No newline at end of file
+  (values leaf x y))
\ No newline at end of file
diff --git a/v7/src/edwin/debuge.scm b/v7/src/edwin/debuge.scm
index 391d8dafc..f9a661dc5 100644
--- a/v7/src/edwin/debuge.scm
+++ b/v7/src/edwin/debuge.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/debuge.scm,v 1.39 1990/06/20 23:02:09 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/debuge.scm,v 1.40 1990/11/02 03:23:28 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -59,12 +59,7 @@
 		      (and (y-or-n? "Save buffer "
 				    (buffer-name buffer)
 				    " (Y or N)? ")
-			   (begin
-			     (newline)
-			     (write-string "Filename: ")
-			     (->pathname
-			      (input-port/normal-mode (current-input-port)
-						      read)))))
+			   (->pathname (prompt-for-expression "Filename"))))
 		     ((integer? (pathname-version pathname))
 		      (pathname-new-version pathname 'NEWEST))
 		     (else
@@ -184,4 +179,42 @@
   (let ((entry (assq name (class-instance-transforms (object-class object)))))
     (if entry
 	(vector-set! object (cdr entry) value)
-	(error "Not a valid instance-variable name" name))))
\ No newline at end of file
+	(error "Not a valid instance-variable name" name))))
+
+;;;; Screen Trace
+
+(define trace-output '())
+
+(define (debug-tracer . args)
+  (set! trace-output (cons args trace-output))
+  unspecific)
+
+(define (screen-trace #!optional screen)
+  (let ((screen
+	 (if (default-object? screen)
+	     (begin
+	       (if (not edwin-editor)
+		   (error "no screen to trace"))
+	       (editor-selected-screen edwin-editor))
+	     screen)))
+    (set! trace-output '())
+    (for-each (lambda (window)
+		(set-window-debug-trace! window debug-tracer))
+	      (screen-window-list screen))
+    (set-screen-debug-trace! screen debug-tracer)))
+
+(define (screen-untrace #!optional screen)
+  (let ((screen
+	 (if (default-object? screen)
+	     (begin
+	       (if (not edwin-editor)
+		   (error "no screen to trace"))
+	       (editor-selected-screen edwin-editor))
+	     screen)))
+    (for-each (lambda (window)
+		(set-window-debug-trace! window false))
+	      (screen-window-list screen))
+    (set-screen-debug-trace! screen false)
+    (let ((result trace-output))
+      (set! trace-output '())
+      (map list->vector (reverse! result)))))
\ No newline at end of file
diff --git a/v7/src/edwin/decls.scm b/v7/src/edwin/decls.scm
index ed9770d97..88009e0f6 100644
--- a/v7/src/edwin/decls.scm
+++ b/v7/src/edwin/decls.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/decls.scm,v 1.14 1990/10/09 16:23:47 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/decls.scm,v 1.15 1990/11/02 03:23:33 cph Rel $
 
 Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 
@@ -85,7 +85,6 @@ MIT in each case. |#
 	      "clscon"
 	      "clsmac"
 	      "comtab"
-	      "cterm"
 	      "display"
 	      "image"
 	      "macros"
@@ -99,11 +98,13 @@ MIT in each case. |#
 	      "simple"
 	      "strpad"
 	      "strtab"
+	      "termcap"
 	      "utils"
 	      "winout"
 	      "winren"
 	      "xform"
 	      "xterm"))
+  (sf-global "tterm" "termcap")
   (for-each sf-edwin
 	    '("argred"
 	      "autold"
@@ -170,15 +171,14 @@ MIT in each case. |#
   (for-each sf-class
 	    '("comwin"
 	      "modwin"
-	      "buffrm"
 	      "edtfrm"))
   (sf-edwin "grpops" "struct")
   (sf-edwin "regops" "struct")
   (sf-edwin "motion" "struct")
   (sf-class "window" "class")
   (sf-class "utlwin" "window" "class")
-  (sf-class "linwin" "window" "class")
-  (sf-class "bufwin" "window" "class" "struct")
-  (sf-class "bufwfs" "bufwin" "window" "class" "struct")
-  (sf-class "bufwiu" "bufwin" "window" "class" "struct")
-  (sf-class "bufwmc" "bufwin" "window" "class" "struct"))
\ No newline at end of file
+  (sf-class "bufwin" "window" "class" "buffer" "struct")
+  (sf-class "bufwfs" "bufwin" "window" "class" "buffer" "struct")
+  (sf-class "bufwiu" "bufwin" "window" "class" "buffer" "struct")
+  (sf-class "bufwmc" "bufwin" "window" "class" "buffer" "struct")
+  (sf-class "buffrm" "bufwin" "window" "class" "struct"))
\ No newline at end of file
diff --git a/v7/src/edwin/display.scm b/v7/src/edwin/display.scm
index f3fa0340b..69bf51de1 100644
--- a/v7/src/edwin/display.scm
+++ b/v7/src/edwin/display.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/display.scm,v 1.2 1990/10/09 16:23:54 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/display.scm,v 1.3 1990/11/02 03:23:38 cph Rel $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -60,7 +60,7 @@
   (operation/available? false read-only true)
   (operation/make-screen false read-only true)
   (operation/make-input-port false read-only true)
-  (operation/with-interrupt-source false read-only true)
+  (operation/with-display-grabbed false read-only true)
   (operation/with-interrupts-enabled false read-only true)
   (operation/with-interrupts-disabled false read-only true))
 
@@ -69,7 +69,7 @@
 			   available?
 			   make-screen
 			   make-input-port
-			   with-interrupt-source
+			   with-display-grabbed
 			   with-interrupts-enabled
 			   with-interrupts-disabled)
   (let ((display-type
@@ -78,7 +78,7 @@
 			     available?
 			     make-screen
 			     make-input-port
-			     with-interrupt-source
+			     with-display-grabbed
 			     with-interrupts-enabled
 			     with-interrupts-disabled)))
     (set! display-types (cons display-type display-types))
@@ -95,8 +95,8 @@
 (define (display-type/make-input-port display-type screen)
   ((display-type/operation/make-input-port display-type) screen))
 
-(define (display-type/with-interrupt-source display-type thunk)
-  ((display-type/operation/with-interrupt-source display-type) thunk))
+(define (display-type/with-display-grabbed display-type thunk)
+  ((display-type/operation/with-display-grabbed display-type) thunk))
 
 (define (display-type/with-interrupts-enabled display-type thunk)
   ((display-type/operation/with-interrupts-enabled display-type) thunk))
diff --git a/v7/src/edwin/ed-ffi.scm b/v7/src/edwin/ed-ffi.scm
index 7669738e4..5d5f4cd7b 100644
--- a/v7/src/edwin/ed-ffi.scm
+++ b/v7/src/edwin/ed-ffi.scm
@@ -51,8 +51,6 @@
 	       syntax-table/system-internal)
     ("comwin"  (edwin window combination)
 	       class-syntax-table)
-    ("cterm"   (edwin console-screen)
-	       syntax-table/system-internal)
     ("curren"  (edwin)
 	       edwin-syntax-table)
     ("debug"   (edwin debugger)
@@ -103,8 +101,6 @@
 	       edwin-syntax-table)
     ("linden"  (edwin lisp-indentation)
 	       edwin-syntax-table)
-    ("linwin"  (edwin window)
-	       class-syntax-table)
     ("loadef"  (edwin)
 	       edwin-syntax-table)
     ("lspcom"  (edwin)
@@ -173,12 +169,16 @@
 	       edwin-syntax-table)
     ("tags"    (edwin tags)
 	       edwin-syntax-table)
+    ("termcap" (edwin console-screen)
+	       syntax-table/system-internal)
     ("texcom"  (edwin)
 	       edwin-syntax-table)
     ("things"  (edwin)
 	       edwin-syntax-table)
     ("tparse"  (edwin)
 	       edwin-syntax-table)
+    ("tterm"   (edwin console-screen)
+	       syntax-table/system-internal)
     ("tximod"  (edwin)
 	       edwin-syntax-table)
     ("undo"    (edwin undo)
diff --git a/v7/src/edwin/editor.scm b/v7/src/edwin/editor.scm
index 6195c6bf7..d5a719ad3 100644
--- a/v7/src/edwin/editor.scm
+++ b/v7/src/edwin/editor.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.197 1990/10/09 16:24:08 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/editor.scm,v 1.198 1990/11/02 03:23:48 cph Exp $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -48,42 +48,70 @@
 
 (define (edit)
   (if (not edwin-editor)
-      (apply create-editor create-editor-args))
+      (create-editor))
   (call-with-current-continuation
    (lambda (continuation)
      (fluid-let ((editor-abort continuation)
-		 (*auto-save-keystroke-count* 0))
-       (within-editor edwin-editor
-	 (lambda ()
-	   (with-current-local-bindings!
-	     (lambda ()
-	       (bind-condition-handler '() internal-error-handler
-		 (lambda ()
-		   (dynamic-wind
-		    (lambda () (update-screens! true))
-		    (lambda ()
-		      (let ((cmdl (nearest-cmdl))
-			    (message (cmdl-message/null)))
-			(let ((input-port (cmdl/input-port cmdl)))
-			  (input-port/immediate-mode input-port
-			    (lambda ()
-			      (make-cmdl cmdl
-					 input-port
-					 (cmdl/output-port cmdl)
-					 (lambda (cmdl)
-					   cmdl ;ignore
-					   (top-level-command-reader
-					    edwin-initialization)
-					   message)
-					 false
-					 message))))))
-		    (lambda () unspecific)))))))))))
+		 (*auto-save-keystroke-count* 0)
+		 (current-editor edwin-editor)
+		 (recursive-edit-continuation false)
+		 (recursive-edit-level 0))
+       (editor-grab-display edwin-editor
+	 (lambda (with-editor-ungrabbed)
+	   (let ((message (cmdl-message/null)))
+	     (push-cmdl (lambda (cmdl)
+			  cmdl ;ignore
+			  (top-level-command-reader edwin-initialization)
+			  message)
+			false
+			message
+			(editor-spawn-child-cmdl with-editor-ungrabbed))))))))
   (if edwin-finalization (edwin-finalization))
   unspecific)
 
-(define create-editor-args (list 'X))
+(define (editor-grab-display editor receiver)
+  (display-type/with-display-grabbed (editor-display-type editor)
+    (lambda (with-display-ungrabbed)
+      (with-current-local-bindings!
+	(lambda ()
+	  (let ((enter
+		 (lambda ()
+		   (let ((screen (selected-screen)))
+		     (screen-enter! screen)
+		     (update-screen! screen true))))
+		(exit (lambda () (screen-exit! (selected-screen)))))
+	    (dynamic-wind enter
+			  (lambda ()
+			    (receiver
+			     (lambda (thunk)
+			       (dynamic-wind exit
+					     (lambda ()
+					       (with-display-ungrabbed thunk))
+					     enter))))
+			  exit)))))))
+
+(define (editor-spawn-child-cmdl with-editor-ungrabbed)
+  (lambda (editor-cmdl input-port output-port driver state message spawn-child)
+    (with-editor-ungrabbed
+     (lambda ()
+       (make-cmdl editor-cmdl
+		  (if (eq? input-port (cmdl/input-port editor-cmdl))
+		      (cmdl/input-port (cmdl/parent editor-cmdl))
+		      input-port)
+		  (if (eq? output-port (cmdl/output-port editor-cmdl))
+		      (cmdl/output-port (cmdl/parent editor-cmdl))
+		      output-port)
+		  driver
+		  state
+		  message
+		  spawn-child)))))
+
+(define (within-editor?)
+  (not (unassigned? current-editor)))
+
 (define editor-abort)
 (define edwin-editor false)
+(define current-editor)
 
 ;; Set this before entering the editor to get something done after the
 ;; editor's dynamic environment is initialized, but before the command
@@ -95,39 +123,38 @@
 ;; reset and then reenter the editor.
 (define edwin-finalization false)
 
-(define (create-editor display-type-name . make-screen-args)
-  (reset-editor)
-  (initialize-typein!)
-  (initialize-typeout!)
-  (initialize-syntax-table!)
-  (initialize-command-reader!)
-  (set! edwin-editor
-	(make-editor "Edwin"
-		     (name->display-type display-type-name)
-		     make-screen-args))
-  (set! edwin-initialization
-	(lambda ()
-	  (set! edwin-initialization false)
-	  (with-editor-interrupts-disabled standard-editor-initialization)))
-  unspecific)
-
-(define (reset-editor)
-  (without-interrupts
-   (lambda ()
-     (if edwin-editor
-	 (begin
-	   (for-each (lambda (screen)
-		       (screen-discard! screen))
-		     (editor-screens edwin-editor))
-	   (set! edwin-editor false)
-	   (set! *previous-popped-up-buffer* (object-hash false))
-	   (set! *previous-popped-up-window* (object-hash false))
-	   unspecific)))))
+(define create-editor-args
+  (list false))
 
-(define (reset-editor-windows)
-  (for-each (lambda (screen)
-	      (send (screen-root-window screen) ':salvage!))
-	    (editor-screens edwin-editor)))
+(define (create-editor . args)
+  (let ((args
+	 (if (null? args)
+	     create-editor-args
+	     (begin
+	       (set! create-editor-args args)
+	       args))))
+    (reset-editor)
+    (initialize-typein!)
+    (initialize-typeout!)
+    (initialize-syntax-table!)
+    (initialize-command-reader!)
+    (set! edwin-editor
+	  (make-editor "Edwin"
+		       (let ((name (car args)))
+			 (cond (name
+				(name->display-type name))
+			       ((display-type/available? console-display-type)
+				console-display-type)
+			       ((display-type/available? x-display-type)
+				x-display-type)
+			       (else
+				(error "can't find usable display type"))))
+		       (cdr args)))
+    (set! edwin-initialization
+	  (lambda ()
+	    (set! edwin-initialization false)
+	    (with-editor-interrupts-disabled standard-editor-initialization)))
+    unspecific))
 
 (define (standard-editor-initialization)
   (if (not init-file-loaded?)
@@ -135,8 +162,7 @@
 	(let ((filename (os/init-file-name)))
 	  (if (file-exists? filename)
 	      (load-edwin-file filename '(EDWIN) true)))
-	(set! init-file-loaded? true)
-	unspecific))
+	(set! init-file-loaded? true)))
   (if (not (ref-variable inhibit-startup-message))
       (let ((window (current-window)))
 	(let ((buffer (window-buffer window)))
@@ -173,23 +199,24 @@ with the contents of the startup message."
 
 ")
 
-;;;; Recursive Edit Levels
-
-(define (within-editor editor thunk)
-  (fluid-let ((current-editor editor)
-	      (recursive-edit-continuation false)
-	      (recursive-edit-level 0))
-    (dynamic-wind
-     (lambda ()
-       (screen-enter! (selected-screen)))
-     (lambda ()
-       (display-type/with-interrupt-source (editor-display-type editor)
-					   thunk))
-     (lambda ()
-       (screen-exit! (selected-screen))))))
+(define (reset-editor)
+  (without-interrupts
+   (lambda ()
+     (if edwin-editor
+	 (begin
+	   (for-each (lambda (screen)
+		       (screen-discard! screen))
+		     (editor-screens edwin-editor))
+	   (set! edwin-editor false)
+	   (set! init-file-loaded? false)
+	   (set! *previous-popped-up-buffer* (object-hash false))
+	   (set! *previous-popped-up-window* (object-hash false))
+	   unspecific)))))
 
-(define (within-editor?)
-  (not (unassigned? current-editor)))
+(define (reset-editor-windows)
+  (for-each (lambda (screen)
+	      (send (screen-root-window screen) ':salvage!))
+	    (editor-screens edwin-editor)))
 
 ;;; There is a problem with recursive edits and multiple screens.
 ;;; When you switch screens the recursive edit aborts. The problem
@@ -225,32 +252,32 @@ with the contents of the startup message."
 
 (define recursive-edit-continuation)
 (define recursive-edit-level)
-(define current-editor)
 
-;;;; Internal Errors
-
 (define (internal-error-handler condition)
   (and (not (condition/internal? condition))
        (error? condition)
-       (if (ref-variable debug-on-internal-error)
-	   (begin
-	     (debug-scheme-error condition)
-	     (message "Scheme error")
-	     (%editor-error))
-	   (exit-editor-and-signal-error condition))))
+       (cond ((ref-variable debug-on-internal-error)
+	      (debug-scheme-error condition)
+	      (message "Scheme error")
+	      (%editor-error))
+	     (debug-internal-errors?
+	      (signal-error condition))
+	     (else
+	      (exit-editor-and-signal-error condition)))))
 
 (define-variable debug-on-internal-error
   "True means enter debugger if error is signalled while the editor is running.
 This does not affect editor errors or evaluation errors."
   false)
 
+(define debug-internal-errors?
+  false)
+
 (define (exit-editor-and-signal-error condition)
   (within-continuation editor-abort
     (lambda ()
       (signal-error condition))))
 
-;;;; C-g Interrupts
-
 (define (^G-signal)
   (let ((continuations *^G-interrupt-continuations*))
     (if (not (pair? continuations))
diff --git a/v7/src/edwin/edtfrm.scm b/v7/src/edwin/edtfrm.scm
index 78b6f13f9..8a03c9c06 100644
--- a/v7/src/edwin/edtfrm.scm
+++ b/v7/src/edwin/edtfrm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtfrm.scm,v 1.82 1990/10/06 00:15:44 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtfrm.scm,v 1.83 1990/11/02 03:23:54 cph Rel $
 ;;;
 ;;;	Copyright (c) 1985, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -54,7 +54,6 @@
    typein-inferior
    selected-window
    cursor-window
-   select-time
    properties))
 
 (define (make-editor-frame root-screen main-buffer typein-buffer)
@@ -75,27 +74,23 @@
 	(set! typein-inferior (find-inferior inferiors typein-window))
 	(set! selected-window main-window)
 	(set! cursor-window main-window)
-	(set! select-time 2)
-	(set-window-select-time! main-window 1)
-	(=> (window-cursor main-window) :enable!))
+	(window-cursor-enable! main-window))
       (set-editor-frame-size! window x-size y-size))
     window))
 
 (define (editor-frame-update-display! window display-style)
   ;; Returns true if update is successfully completed (or unnecessary).
+  ;; Assumes that interrupts are disabled.
   (with-instance-variables editor-frame window (display-style)
-    (with-screen-in-update! screen
-      (lambda ()
-	(if (and (not display-style)
-		 (not (car redisplay-flags)))
-	    true
-	    (let ((finished?
-		   (update-inferiors! window screen 0 0
-				      0 x-size 0 y-size
-				      display-style)))
-	      (if finished?
-		  (set-car! redisplay-flags false))
-	      finished?))))))
+    (if (and (not display-style)
+	     (not (car redisplay-flags)))
+	true
+	(let ((finished?
+	       (window-update-display! window screen 0 0 0 x-size 0 y-size
+				       display-style)))
+	  (if finished?
+	      (set-car! redisplay-flags false))
+	  finished?))))
 
 (define (set-editor-frame-size! window x y)
   (with-instance-variables editor-frame window (x y)
@@ -157,20 +152,19 @@
   (with-instance-variables editor-frame window (window*)
     (if (not (buffer-frame? window*))
 	(error "Attempt to select non-window" window*))
-    (=> (window-cursor cursor-window) :disable!)
+    (window-cursor-disable! cursor-window)
     (set! selected-window window*)
-    (set-window-select-time! window* select-time)
-    (set! select-time (1+ select-time))
+    (set-window-select-time! window* (increment-select-time!))
     (set! cursor-window window*)
-    (=> (window-cursor cursor-window) :enable!)))
+    (window-cursor-enable! window*)))
 
 (define (editor-frame-select-cursor! window window*)
   (with-instance-variables editor-frame window (window*)
     (if (not (buffer-frame? window*))
 	(error "Attempt to select non-window" window*))
-    (=> (window-cursor cursor-window) :disable!)
+    (window-cursor-disable! cursor-window)
     (set! cursor-window window*)
-    (=> (window-cursor cursor-window) :enable!)))
+    (window-cursor-enable! cursor-window)))
 
 (define-method editor-frame (:button-event! editor-frame button x y)
   (with-values
diff --git a/v7/src/edwin/edtstr.scm b/v7/src/edwin/edtstr.scm
index 2b52f962e..d92124360 100644
--- a/v7/src/edwin/edtstr.scm
+++ b/v7/src/edwin/edtstr.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtstr.scm,v 1.11 1990/10/09 16:24:14 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edtstr.scm,v 1.12 1990/11/02 03:23:59 cph Rel $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -49,13 +49,14 @@
 (define-structure (editor (constructor %make-editor))
   (name false read-only true)
   (display-type false read-only true)
-  (screens false)
+  (screens '())
   (selected-screen false)
   (bufferset false read-only true)
   (kill-ring false read-only true)
   (char-history false read-only true)
   (input-port false read-only true)
-  (button-event false))
+  (button-event false)
+  (select-time 1))
 
 (define (make-editor name display-type make-screen-args)
   (let ((initial-buffer (make-buffer initial-buffer-name initial-buffer-mode)))
@@ -70,7 +71,8 @@
 		    (make-ring 10)
 		    (make-ring 100)
 		    (display-type/make-input-port display-type screen)
-		    false))))
+		    false
+		    1))))
 
 (define-integrable (current-display-type)
   (editor-display-type current-editor))
@@ -89,6 +91,11 @@
 
 (define-integrable (current-char-history)
   (editor-char-history current-editor))
+
+(define (increment-select-time!)
+  (let ((time (editor-select-time current-editor)))
+    (set-editor-select-time! current-editor (1+ time))
+    time))
 
 (define-structure (button-event (conc-name button-event/))
   (window false read-only true)
diff --git a/v7/src/edwin/edwin.ldr b/v7/src/edwin/edwin.ldr
index 9b7628ce3..78e961dd4 100644
--- a/v7/src/edwin/edwin.ldr
+++ b/v7/src/edwin/edwin.ldr
@@ -1,5 +1,5 @@
 ;;; -*-Scheme-*-
-;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.ldr,v 1.10 1990/10/09 16:24:19 cph Exp $
+;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.ldr,v 1.11 1990/11/02 03:24:04 cph Rel $
 ;;; program to load package contents
 ;;; **** This program (unlike most .ldr files) is not generated by a program.
 
@@ -38,7 +38,6 @@
     (let ((environment (->environment '(EDWIN WINDOW))))
       (load "window" environment)
       (load "utlwin" environment)
-      (load "linwin" environment)
       (load "bufwin" environment)
       (load "bufwfs" environment)
       (load "bufwiu" environment)
@@ -51,7 +50,8 @@
       (load "xterm" env)
       ((access initialize-package! env)))
     (let ((env (->environment '(EDWIN CONSOLE-SCREEN))))
-      (load "cterm" env)
+      (load "termcap" env)
+      (load "tterm" env)
       ((access initialize-package! env)))    
     (load "edtstr" environment)
     (load "editor" environment)
diff --git a/v7/src/edwin/edwin.pkg b/v7/src/edwin/edwin.pkg
index 41efac4ed..d8426d5ea 100644
--- a/v7/src/edwin/edwin.pkg
+++ b/v7/src/edwin/edwin.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.20 1990/10/09 16:24:23 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/edwin.pkg,v 1.21 1990/11/02 03:24:09 cph Exp $
 
 Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 
@@ -192,11 +192,12 @@ MIT in each case. |#
 	  editor-display-types)
   (export (edwin)
 	  display-type?
+	  display-type/available?
 	  display-type/make-input-port
 	  display-type/make-screen
 	  display-type/multiple-screens?
 	  display-type/name
-	  display-type/with-interrupt-source
+	  display-type/with-display-grabbed
 	  display-type/with-interrupts-disabled
 	  display-type/with-interrupts-enabled
 	  make-display-type
@@ -208,41 +209,41 @@ MIT in each case. |#
   (export (edwin)
 	  initialize-screen-root-window!
 	  screen-beep
+	  screen-clear-rectangle
+	  screen-direct-output-char
+	  screen-direct-output-move-cursor
+	  screen-direct-output-substring
 	  screen-discard!
 	  screen-enter!
 	  screen-exit!
-	  screen-flush!
-	  screen-highlight?
 	  screen-in-update?
 	  screen-modeline-event!
+	  screen-move-cursor
+	  screen-needs-update?
+	  screen-output-char
+	  screen-output-substring
 	  screen-root-window
+	  screen-scroll-lines-down
+	  screen-scroll-lines-up
 	  screen-select-cursor!
 	  screen-select-window!
 	  screen-selected-window
-	  screen-scroll-lines-down!
-	  screen-scroll-lines-up!
 	  screen-state
 	  screen-typein-window
 	  screen-window-list
 	  screen-window0
-	  screen-write-char!
-	  screen-write-cursor!
-	  screen-write-substring!
-	  screen-write-substrings!
 	  screen-x-size
 	  screen-y-size
+	  set-screen-debug-trace!
 	  set-screen-root-window!
-	  subscreen-clear!
 	  update-screen!
 	  window-screen
-	  with-screen-in-update!
-	  with-screen-inverse-video!)
+	  with-screen-in-update)
   (export (edwin console-screen)
 	  make-screen)
   (export (edwin x-screen)
 	  make-screen
-	  set-screen-x-size!
-	  set-screen-y-size!))
+	  set-screen-size!))
 
 (define-package (edwin x-screen)
   (files "xterm")
@@ -271,10 +272,17 @@ MIT in each case. |#
 	  update-xterm-screen-names!))
 
 (define-package (edwin console-screen)
-  (files "cterm")
+  (files "termcap" "tterm")
   (parent (edwin))
   (export (edwin)
 	  console-display-type)
+  (import (runtime primitive-io)
+	  channel-type=terminal?
+	  terminal-get-state
+	  terminal-output-baud-rate
+	  terminal-raw-input
+	  terminal-raw-output
+	  terminal-set-state)
   (import (runtime interrupt-handler)
 	  hook/^g-interrupt)
   (initialization (initialize-package!)))
@@ -282,7 +290,6 @@ MIT in each case. |#
 (define-package (edwin window)
   (files "window"
 	 "utlwin"
-	 "linwin"
 	 "bufwin"
 	 "bufwfs"
 	 "bufwiu"
@@ -297,6 +304,7 @@ MIT in each case. |#
 	  edwin-variable$scroll-step
 	  edwin-variable$truncate-lines
 	  edwin-variable$truncate-partial-width-windows
+	  set-window-debug-trace!
 	  set-window-point!
 	  set-window-start-mark!
 	  window-buffer
@@ -308,14 +316,12 @@ MIT in each case. |#
 	  window-direct-output-insert-newline!
 	  window-direct-output-insert-substring!
 	  window-direct-update!
-	  window-end-index
 	  window-home-cursor!
 	  window-mark->coordinates
 	  window-mark->x
 	  window-mark->y
 	  window-mark-visible?
 	  window-modeline-event!
-	  window-needs-redisplay?
 	  window-override-message
 	  window-point
 	  window-point-coordinates
@@ -323,13 +329,12 @@ MIT in each case. |#
 	  window-point-y
 	  window-root-window
 	  window-redraw!
-	  window-redraw-preserving-point!
 	  window-scroll-y-absolute!
 	  window-scroll-y-relative!
 	  window-select-time
 	  window-set-override-message!
 	  window-setup-truncate-lines!
-	  window-start-index
+	  window-start-mark
 	  window-y-center)
   (export (edwin screen)
 	  editor-frame-screen
diff --git a/v7/src/edwin/edwin.sf b/v7/src/edwin/edwin.sf
index 279451f46..f1060aaa1 100644
--- a/v7/src/edwin/edwin.sf
+++ b/v7/src/edwin/edwin.sf
@@ -43,7 +43,6 @@
   (read-class-definitions "window")
   (read-class-definitions "utlwin")
   (read-class-definitions "modwin")
-  (read-class-definitions "linwin")
   (read-class-definitions "bufwin")
   (read-class-definitions "comwin")
   (read-class-definitions "buffrm")
diff --git a/v7/src/edwin/hlpcom.scm b/v7/src/edwin/hlpcom.scm
index 6f2eb6711..8cedd5d46 100644
--- a/v7/src/edwin/hlpcom.scm
+++ b/v7/src/edwin/hlpcom.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/hlpcom.scm,v 1.92 1989/08/14 09:30:57 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/hlpcom.scm,v 1.93 1990/11/02 03:24:19 cph Exp $
 ;;;
-;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -216,7 +216,10 @@ If you want VALUE to be a string, you must surround it with doublequotes."
 	     (string-append "Set " (variable-name-string variable) " to value")
 	     (variable-value variable)))))
   (lambda (variable value)
-    (set-variable-value! (name->variable variable) value)))
+    (let ((variable (name->variable variable)))
+      (if (not (variable-value-valid? variable value))
+	  (editor-error "illegal value for variable:" value))
+      (set-variable-value! variable value))))
 
 (define-command make-local-variable
   "Make a variable have a local value in the current buffer."
@@ -227,7 +230,10 @@ If you want VALUE to be a string, you must surround it with doublequotes."
 	     (string-append "Set " (variable-name-string variable) " to value")
 	     (variable-value variable)))))
   (lambda (variable value)
-    (make-local-binding! (name->variable variable) value)))
+    (let ((variable (name->variable variable)))
+      (if (not (variable-value-valid? variable value))
+	  (editor-error "illegal value for variable:" value))
+      (make-local-binding! variable value))))
 
 (define-command kill-local-variable
   "Make a variable use its global value in the current buffer."
diff --git a/v7/src/edwin/image.scm b/v7/src/edwin/image.scm
index 30d202c16..d762b80eb 100644
--- a/v7/src/edwin/image.scm
+++ b/v7/src/edwin/image.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/image.scm,v 1.125 1989/08/14 09:22:37 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/image.scm,v 1.126 1990/11/02 03:24:25 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
 ;;;
@@ -110,15 +110,13 @@
 
 (define (image-direct-output-insert-char! image char)
   (vector-set! image 0 (string-append-char (vector-ref image 0) char))
-  (vector-set! image 4 (fix:1+ (vector-ref image 4)))
-  unspecific)
+  (vector-set! image 4 (fix:1+ (vector-ref image 4))))
 
 (define (image-direct-output-insert-substring! image string start end)
   (vector-set! image 0
 	       (string-append-substring (vector-ref image 0)
 					string start end))
-  (vector-set! image 4 (fix:+ (vector-ref image 4) (fix:- end start)))
-  unspecific)
+  (vector-set! image 4 (fix:+ (vector-ref image 4) (fix:- end start))))
 
 (define (image-representation image)
   (let ((string (image-string image))
@@ -129,23 +127,23 @@
 	   (string-start (image-start-index image))
 	   (result-start 0))
 	(cond ((null? parse)
-	       (substring-move-right! string string-start string-end
-				      result result-start))
+	       (substring-move-left! string string-start string-end
+				     result result-start))
 	      ((string? (car parse))
 	       (let ((size (string-length (car parse))))
-		 (substring-move-right! (car parse) 0 size result result-start)
+		 (substring-move-left! (car parse) 0 size result result-start)
 		 (loop (cdr parse)
 		       (fix:1+ string-start)
 		       (fix:+ result-start size))))
 	      ((number? (car parse))
-	       (substring-move-right! string string-start (car parse)
-				      result result-start)
+	       (substring-move-left! string string-start (car parse)
+				     result result-start)
 	       (loop (cdr parse)
 		     (car parse)
 		     (fix:+ result-start (fix:- (car parse) string-start))))
 	      (else
-	       (error "Bad parse element" (car parse)))))
-      result)))
+	       (error "Bad parse element" (car parse))))))
+    result))
 
 (define (image-index->column image index)
   (let loop
@@ -170,6 +168,12 @@
 	   (error "Bad parse element" (car parse))))))
 
 (define (image-column->index image column)
+  ;; If COLUMN falls in the middle of a multi-column character, the
+  ;; index returned is that of the character.  Thinking of the index
+  ;; as a pointer between characters, the value is the pointer to the
+  ;; left of the multi-column character.  Only if COLUMN reaches
+  ;; across the character will the right-hand pointer be returned.
+  ;; Various things depend on this.
   (let loop
       ((parse (image-parse image))
        (start (image-start-index image))
@@ -248,6 +252,12 @@
 
 (define (substring-column->index string start end start-column column
 				 #!optional if-lose)
+  ;; If COLUMN falls in the middle of a multi-column character, the
+  ;; index returned is that of the character.  Thinking of the index
+  ;; as a pointer between characters, the value is the pointer to the
+  ;; left of the multi-column character.  Only if COLUMN reaches
+  ;; across the character will the right-hand pointer be returned.
+  ;; Various things depend on this.
   (if (fix:zero? column)
       start
       (let loop ((i start) (c start-column) (left (fix:- column start-column)))
@@ -276,22 +286,28 @@
 ;;;; Parsing
 
 (define (parse-substring-for-image string start end start-column receiver)
-  (let loop ((start start) (column start-column) (receiver receiver))
-    (let ((index
-	   (substring-find-next-char-in-set string start end
-					    char-set:not-graphic)))
-      (if (not index)
-	  (receiver '() (fix:+ column (fix:- end start)))
-	  (let ((column (fix:+ column (fix:- index start))))
-	    (let ((representation
-		   (char-representation (string-ref string index) column)))
-	      (loop (fix:1+ index)
-		    (fix:+ column (string-length representation))
-		    (lambda (parse column-size)
-		      (receiver (if (fix:= index start)
-				    (cons representation parse)
-				    (cons index (cons representation parse)))
-				column-size)))))))))
+  (let ((column-size))
+    (let ((parse
+	   (let loop ((start start) (column start-column))
+	     (let ((index
+		    (substring-find-next-char-in-set string start end
+						     char-set:not-graphic)))
+	       (if (not index)
+		   (begin
+		     (set! column-size (fix:+ column (fix:- end start)))
+		     '())
+		   (let ((column (fix:+ column (fix:- index start))))
+		     (let ((representation
+			    (char-representation (string-ref string index)
+						 column)))
+		       (let ((parse
+			      (loop (fix:1+ index)
+				    (fix:+ column
+					   (string-length representation)))))
+			 (if (fix:= index start)
+			     (cons representation parse)
+			     (cons index (cons representation parse)))))))))))
+      (receiver parse column-size))))
 
 (define char-column-length)
 (define char-representation)
@@ -326,14 +342,14 @@
 	 "\370" "\371" "\372" "\373" "\374" "\375" "\376" "\377")))
   (set! char-representation
 	(lambda (char column)
-	  (if (char=? char #\Tab)
-	      (vector-ref tab-display-images (remainder column 8))
-	      (vector-ref display-images (char->ascii char)))))
+	  (if (char=? char #\tab)
+	      (vector-ref tab-display-images (fix:remainder column 8))
+	      (vector-ref display-images (char->integer char)))))
   (let ((tab-display-lengths (vector-map tab-display-images string-length))
 	(display-lengths (vector-map display-images string-length)))
     (set! char-column-length
 	  (lambda (char column)
-	    (if (char=? char #\Tab)
-		(vector-ref tab-display-lengths (remainder column 8))
-		(vector-ref display-lengths (char->ascii char)))))
+	    (if (char=? char #\tab)
+		(vector-ref tab-display-lengths (fix:remainder column 8))
+		(vector-ref display-lengths (char->integer char)))))
     unspecific))
\ No newline at end of file
diff --git a/v7/src/edwin/modlin.scm b/v7/src/edwin/modlin.scm
index 5c5b222bb..f665d00cd 100644
--- a/v7/src/edwin/modlin.scm
+++ b/v7/src/edwin/modlin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modlin.scm,v 1.4 1990/10/09 16:24:36 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modlin.scm,v 1.5 1990/11/02 03:24:31 cph Rel $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -266,18 +266,23 @@ If #F, the normal method is used."
       ((#\s)
        "no processes")
       ((#\p)
-       (if (window-mark-visible? window (buffer-start buffer))
-	   (if (window-mark-visible? window (buffer-end buffer))
-	       "All" "Top")
-	   (if (window-mark-visible? window (buffer-end buffer))
-	       "Bottom"
+       (if (let ((end (buffer-end buffer)))
+	     (or (window-mark-visible? window end)
+		 (and (line-start? end)
+		      (not (group-start? end))
+		      (window-mark-visible? window (mark-1+ end)))))
+	   (if (window-mark-visible? window (buffer-start buffer))
+	       "All"
+	       "Bottom")
+	   (if (window-mark-visible? window (buffer-start buffer))
+	       "Top"
 	       (string-append
 		(string-pad-left
 		 (number->string
 		  (min
 		   (let ((start (mark-index (buffer-start buffer))))
 		     (integer-round
-		      (* 100 (- (window-start-index window) start))
+		      (* 100 (- (mark-index (window-start-mark window)) start))
 		      (- (mark-index (buffer-end buffer)) start)))
 		   99))
 		 2)
diff --git a/v7/src/edwin/modwin.scm b/v7/src/edwin/modwin.scm
index 3750ffcee..998824075 100644
--- a/v7/src/edwin/modwin.scm
+++ b/v7/src/edwin/modwin.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modwin.scm,v 1.34 1990/10/05 13:32:48 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modwin.scm,v 1.35 1990/11/02 03:24:36 cph Rel $
 ;;;
 ;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -45,30 +45,32 @@
 ;;;; Modeline Window
 
 (declare (usual-integrations))
-
+
 (define-class modeline-window vanilla-window ())
 
 (define-method modeline-window (:initialize! window window*)
   (usual=> window :initialize! window*)
   (set! y-size 1))
 
-(define-method modeline-window (:update-display! window screen x-start y-start
-						 xl xu yl yu display-style)
+(define (modeline-window:update-display! window screen x-start y-start
+					 xl xu yl yu display-style)
   display-style				;ignore
   (if (< yl yu)
-      (let ((thunk
-	     (lambda ()
-	       (screen-write-substring!
-		screen x-start y-start
-		(string-pad-right (modeline-string superior) x-size #\-)
-		xl xu))))
-	(if (variable-local-value
-	     (window-buffer superior)
-	     (ref-variable-object mode-line-inverse-video))
-	    (with-screen-inverse-video! screen thunk)
-	    (thunk))))
+      (let ((superior (window-superior window)))
+	(screen-output-substring
+	 screen x-start y-start
+	 (string-pad-right (modeline-string superior)
+			   (window-x-size window)
+			   #\space)
+	 xl xu
+	 (variable-local-value
+	  (window-buffer superior)
+	  (ref-variable-object mode-line-inverse-video)))))
   true)
 
+(define-method modeline-window :update-display!
+  modeline-window:update-display!)
+
 (define-variable mode-line-inverse-video
   "*True means use inverse video, or other suitable display mode, for the mode line."
   true)
diff --git a/v7/src/edwin/rename.scm b/v7/src/edwin/rename.scm
index 2f241ba68..93f21506e 100644
--- a/v7/src/edwin/rename.scm
+++ b/v7/src/edwin/rename.scm
@@ -1,6 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	Copyright (c) 1989 Massachusetts Institute of Technology
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/rename.scm,v 1.4 1990/11/02 03:24:41 cph Rel $
+;;;
+;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -43,7 +45,7 @@
 ;;;; Edwin Interpackage Renames
 
 (declare (usual-integrations))
-
+
 (let ((global (->environment '()))
       (edwin (->environment '(edwin)))
       (window (->environment '(edwin window))))
@@ -57,4 +59,5 @@
     (e<-w 'window? 'buffer-frame?)
     (e<-w 'window-x-size 'buffer-frame-x-size)
     (e<-w 'window-y-size 'buffer-frame-y-size)
+    (e<-w 'window-needs-redisplay? 'buffer-frame-needs-redisplay?)
     (e<-w '%set-window-buffer! 'set-window-buffer!)))
\ No newline at end of file
diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index 0c1cb13e8..5e8db254a 100644
--- a/v7/src/edwin/screen.scm
+++ b/v7/src/edwin/screen.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.84 1990/10/09 16:24:41 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.85 1990/11/02 03:24:45 cph Rel $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -50,19 +50,18 @@
 		   (constructor make-screen
 				(state
 				 operation/beep
+				 operation/clear-line!
+				 operation/clear-rectangle!
+				 operation/clear-screen!
 				 operation/discard!
 				 operation/enter!
 				 operation/exit!
-				 operation/finish-update!
 				 operation/flush!
-				 operation/inverse-video!
 				 operation/modeline-event!
-				 operation/normal-video!
+				 operation/preempt-update?
 				 operation/scroll-lines-down!
 				 operation/scroll-lines-up!
-				 operation/start-update!
-				 operation/subscreen-clear!
-				 operation/wipe!
+				 operation/wrap-update!
 				 operation/write-char!
 				 operation/write-cursor!
 				 operation/write-substring!
@@ -70,29 +69,40 @@
 				 y-size)))
   (state false read-only true)
   (operation/beep false read-only true)
+  (operation/clear-line! false read-only true)
+  (operation/clear-rectangle! false read-only true)
+  (operation/clear-screen! false read-only true)
   (operation/discard! false read-only true)
   (operation/enter! false read-only true)
   (operation/exit! false read-only true)
-  (operation/finish-update! false read-only true)
   (operation/flush! false read-only true)
-  (operation/inverse-video! false read-only true)
   (operation/modeline-event! false read-only true)
-  (operation/normal-video! false read-only true)
+  (operation/preempt-update? false read-only true)
   (operation/scroll-lines-down! false read-only true)
   (operation/scroll-lines-up! false read-only true)
-  (operation/start-update! false read-only true)
-  (operation/subscreen-clear! false read-only true)
-  (operation/wipe! false read-only true)
+  (operation/wrap-update! false read-only true)
   (operation/write-char! false read-only true)
   (operation/write-cursor! false read-only true)
   (operation/write-substring! false read-only true)
   (operation/x-size false read-only true)
   (operation/y-size false read-only true)
   (root-window false)
+  (needs-update? false)
   (in-update? false)
   (x-size false)
   (y-size false)
-  (highlight? false))
+
+  ;; Description of actual screen contents.
+  current-matrix
+
+  ;; Description of desired screen contents.
+  new-matrix
+
+  ;; Set this variable in the debugger to force a display preemption.
+  (debug-preemption-y false)
+
+  ;; Set this variable in the debugger to trace interesting events.
+  (debug-trace false))
 
 (define (initialize-screen-root-window! screen bufferset buffer)
   (set-screen-root-window!
@@ -100,100 +110,13 @@
    (make-editor-frame
     screen
     buffer
-    (bufferset-find-or-create-buffer bufferset (make-typein-buffer-name -1)))))
-
-(define (with-screen-in-update! screen thunk)
-  (call-with-current-continuation
-   (lambda (continuation)
-     (let ((old-flag)
-	   (new-flag true)
-	   (transition
-	    (lambda (old new)
-	      (if old
-		  (if (not new)
-		      (begin
-			((screen-operation/finish-update! screen) screen)
-			(set-screen-in-update?! screen false)))
-		  (if new
-		      (begin
-			((screen-operation/start-update! screen) screen)
-			(set-screen-in-update?! screen continuation)))))))
-       (dynamic-wind (lambda ()
-		       (set! old-flag (screen-in-update? screen))
-		       (transition old-flag new-flag))
-		     thunk
-		     (lambda ()
-		       (set! new-flag (screen-in-update? screen))
-		       (transition new-flag old-flag)))))))
-
-(define (with-screen-inverse-video! screen thunk)
-  (let ((old-highlight?)
-	(new-highlight? true)
-	(transition
-	 (lambda (old new)
-	   (if old
-	       (if (not new)
-		   (begin
-		     ((screen-operation/normal-video! screen) screen)
-		     (set-screen-highlight?! screen false)))
-	       (if new
-		   (begin
-		     ((screen-operation/inverse-video! screen) screen)
-		     (set-screen-highlight?! screen true)))))))
-    (dynamic-wind (lambda ()
-		    (set! old-highlight? (screen-highlight? screen))
-		    (transition old-highlight? new-highlight?))
-		  thunk
-		  (lambda ()
-		    (set! new-highlight? (screen-highlight? screen))
-		    (transition new-highlight? old-highlight?)))))
+    (bufferset-find-or-create-buffer bufferset (make-typein-buffer-name -1))))
+  (set-screen-current-matrix! screen (make-matrix screen))
+  (set-screen-new-matrix! screen (make-matrix screen)))
 
 (define (screen-beep screen)
   ((screen-operation/beep screen) screen))
 
-(define (screen-flush! screen)
-  ((screen-operation/flush! screen) screen))
-
-(define (subscreen-clear! screen xl xu yl yu)
-  ((screen-operation/subscreen-clear! screen) screen xl xu yl yu))
-
-(define (screen-write-cursor! screen x y)
-  ((screen-operation/write-cursor! screen) screen x y))
-
-(define (screen-write-char! screen x y char)
-  ((screen-operation/write-char! screen) screen x y char))
-
-(define (screen-write-substring! screen x y string start end)
-  ((screen-operation/write-substring! screen) screen x y string start end))
-
-(define (screen-write-substrings! screen x y strings bil biu bjl bju)
-  (let ((write-substring! (screen-operation/write-substring! screen)))
-    (clip (screen-x-size screen) x bil biu
-      (lambda (bxl ail aiu)
-	(clip (screen-y-size screen) y bjl bju
-	  (lambda (byl ajl aju)
-	    (let loop ((y byl) (j ajl))
-	      (if (fix:< j aju)
-		  (begin
-		    (write-substring! screen bxl y
-				      (vector-ref strings j) ail aiu)
-		    (loop (fix:1+ y) (fix:1+ j)))))))))))
-
-(define (clip axu x bil biu receiver)
-  (let ((ail (fix:- bil x)))
-    (if (fix:< ail biu)
-	(let ((aiu (fix:+ ail axu)))
-	  (cond ((not (fix:positive? x))
-		 (receiver 0 ail (if (fix:< aiu biu) aiu biu)))
-		((fix:< x axu)
-		 (receiver x bil (if (fix:< aiu biu) aiu biu))))))))
-
-(define (screen-scroll-lines-down! screen xl xu yl yu amount)
-  ((screen-operation/scroll-lines-down! screen) screen xl xu yl yu amount))
-
-(define (screen-scroll-lines-up! screen xl xu yl yu amount)
-  ((screen-operation/scroll-lines-up! screen) screen xl xu yl yu amount))
-
 (define (screen-enter! screen)
   ((screen-operation/enter! screen) screen)
   (screen-modeline-event! screen
@@ -213,7 +136,7 @@
 
 (define (screen-modeline-event! screen window type)
   ((screen-operation/modeline-event! screen) screen window type))
-
+
 (define-integrable (screen-selected-window screen)
   (editor-frame-selected-window (screen-root-window screen)))
 
@@ -237,5 +160,556 @@
   (editor-frame-screen (window-root-window window)))
 
 (define (update-screen! screen display-style)
-  (if display-style ((screen-operation/wipe! screen) screen))
-  (editor-frame-update-display! (screen-root-window screen) display-style))
\ No newline at end of file
+  (if display-style (screen-force-update screen))
+  (with-screen-in-update screen display-style
+    (lambda ()
+      (editor-frame-update-display! (screen-root-window screen)
+				    display-style))))
+
+;;; Interface from update optimizer to terminal:
+
+(define-integrable (terminal-scroll-lines-down screen xl xu yl yu amount)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'terminal screen 'scroll-lines-down
+				   xl xu yl yu amount))
+  ((screen-operation/scroll-lines-down! screen) screen xl xu yl yu amount))
+
+(define-integrable (terminal-scroll-lines-up screen xl xu yl yu amount)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'terminal screen 'scroll-lines-up
+				   xl xu yl yu amount))
+  ((screen-operation/scroll-lines-up! screen) screen xl xu yl yu amount))
+
+(define-integrable (terminal-flush screen)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'terminal screen 'flush))
+  ((screen-operation/flush! screen) screen))
+
+(define-integrable (terminal-move-cursor screen x y)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'terminal screen 'move-cursor x y))
+  ((screen-operation/write-cursor! screen) screen x y))
+
+(define-integrable (terminal-preempt-update? screen y)
+  ((screen-operation/preempt-update? screen) screen y))
+
+(define-integrable (terminal-clear-screen screen)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'terminal screen 'clear-screen))
+  ((screen-operation/clear-screen! screen) screen))
+
+(define-integrable (terminal-clear-line screen x y first-unused-x)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'terminal screen 'clear-line
+				   x y first-unused-x))
+  ((screen-operation/clear-line! screen) screen x y first-unused-x))
+
+(define-integrable (terminal-output-char screen x y char highlight)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'terminal screen 'output-char
+				   x y char highlight))
+  ((screen-operation/write-char! screen) screen x y char highlight))
+
+(define-integrable (terminal-output-substring screen x y string start end
+					      highlight)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'terminal screen 'output-substring
+				   x y (string-copy string) start end
+				   highlight))
+  ((screen-operation/write-substring! screen) screen x y string start end
+					      highlight))
+
+;;;; Update Optimization
+
+(define-structure (matrix (constructor %make-matrix ()))
+  ;; Vector of line contents.
+  ;; (string-ref (vector-ref (matrix-contents m) y) x) is the
+  ;; character at position X, Y.
+  contents
+
+  ;; Vector of line highlights.
+  ;; (boolean-vector-ref (vector-ref (matrix-highlight m) y) x) is the
+  ;; highlight at position X, Y.
+  highlight
+
+  ;; Boolean-vector indicating, for each line, whether its contents
+  ;; mean anything.
+  enable
+
+  ;; Cursor position.
+  cursor-x
+  cursor-y)
+
+(define (make-matrix screen)
+  (let ((matrix (%make-matrix))
+	(x-size (screen-x-size screen))
+	(y-size (screen-y-size screen)))
+    (let ((contents (make-vector y-size))
+	  (highlight (make-vector y-size))
+	  (enable (make-boolean-vector y-size)))
+      (do ((i 0 (fix:1+ i)))
+	  ((fix:= i y-size))
+	(vector-set! contents i (make-string x-size))
+	(vector-set! highlight i (make-boolean-vector x-size)))
+      (boolean-vector-fill! enable false)
+      (set-matrix-contents! matrix contents)
+      (set-matrix-highlight! matrix highlight)
+      (set-matrix-enable! matrix enable))
+    (set-matrix-cursor-x! matrix false)
+    (set-matrix-cursor-y! matrix false)
+    matrix))
+
+(define (set-screen-size! screen x-size y-size)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'set-size! x-size y-size))
+  (without-interrupts
+   (lambda ()
+     (set-screen-x-size! screen x-size)
+     (set-screen-y-size! screen y-size)
+     (set-screen-current-matrix! screen (make-matrix screen))
+     (set-screen-new-matrix! screen (make-matrix screen))
+     (send (screen-root-window screen) ':set-size! x-size y-size))))
+
+(define (screen-move-cursor screen x y)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'move-cursor x y))
+  (let ((new-matrix (screen-new-matrix screen)))
+    (set-matrix-cursor-x! new-matrix x)
+    (set-matrix-cursor-y! new-matrix y)))
+
+(define (screen-direct-output-move-cursor screen x y)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'direct-output-move-cursor
+				   x y))
+  (terminal-move-cursor screen x y)
+  (terminal-flush screen)
+  (let ((current-matrix (screen-current-matrix screen))
+	(new-matrix (screen-new-matrix screen)))
+    (set-matrix-cursor-x! current-matrix x)
+    (set-matrix-cursor-y! current-matrix y)
+    (set-matrix-cursor-x! new-matrix x)
+    (set-matrix-cursor-y! new-matrix y)))
+
+(define (screen-output-char screen x y char highlight)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'output-char
+				   x y char highlight))
+  (let ((new-matrix (screen-new-matrix screen)))
+    (if (not (boolean-vector-ref (matrix-enable new-matrix) y))
+	(begin
+	  (boolean-vector-set! (matrix-enable new-matrix) y true)
+	  (set-screen-needs-update?! screen true)
+	  (guarantee-display-line screen y)))
+    (string-set! (vector-ref (matrix-contents new-matrix) y) x char)
+    (boolean-vector-set! (vector-ref (matrix-highlight new-matrix) y)
+			 x
+			 highlight)))
+
+(define (screen-direct-output-char screen x y char highlight)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'direct-output-char
+				   x y char highlight))
+  (let ((cursor-x (fix:1+ x))
+	(current-matrix (screen-current-matrix screen)))
+    (terminal-output-char screen x y char highlight)
+    (terminal-move-cursor screen cursor-x y)
+    (terminal-flush screen)
+    (string-set! (vector-ref (matrix-contents current-matrix) y) x char)
+    (boolean-vector-set! (vector-ref (matrix-highlight current-matrix) y)
+			 x
+			 highlight)
+    (set-matrix-cursor-x! current-matrix cursor-x)
+    (set-matrix-cursor-x! (screen-new-matrix screen) cursor-x)))
+
+(define (screen-output-substring screen x y string start end highlight)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'output-substring
+				   x y (string-copy string) start end
+				   highlight))
+  (let ((new-matrix (screen-new-matrix screen)))
+    (if (not (boolean-vector-ref (matrix-enable new-matrix) y))
+	(begin
+	  (boolean-vector-set! (matrix-enable new-matrix) y true)
+	  (set-screen-needs-update?! screen true)
+	  (guarantee-display-line screen y)))
+    (substring-move-left! string start end
+			  (vector-ref (matrix-contents new-matrix) y) x)
+    (boolean-subvector-fill! (vector-ref (matrix-highlight new-matrix) y)
+			     x (fix:+ x (fix:- end start)) highlight)))
+
+(define (screen-direct-output-substring screen x y string start end highlight)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'direct-output-substring
+				   x y (string-copy string) start end
+				   highlight))
+  (let ((cursor-x (fix:+ x (fix:- end start)))
+	(current-matrix (screen-current-matrix screen)))
+    (terminal-output-substring screen x y string start end highlight)
+    (terminal-move-cursor screen cursor-x y)
+    (terminal-flush screen)
+    (substring-move-left! string start end
+			  (vector-ref (matrix-contents current-matrix) y) x)
+    (boolean-subvector-fill! (vector-ref (matrix-highlight current-matrix) y)
+			     x cursor-x highlight)
+    (set-matrix-cursor-x! current-matrix cursor-x)
+    (set-matrix-cursor-x! (screen-new-matrix screen) cursor-x)))
+
+(define (guarantee-display-line screen y)
+  (let ((current-matrix (screen-current-matrix screen))
+	(new-matrix (screen-new-matrix screen)))
+    (if (boolean-vector-ref (matrix-enable current-matrix) y)
+	(begin
+	  (string-move! (vector-ref (matrix-contents current-matrix) y)
+			(vector-ref (matrix-contents new-matrix) y))
+	  (boolean-vector-move!
+	   (vector-ref (matrix-highlight current-matrix) y)
+	   (vector-ref (matrix-highlight new-matrix) y)))
+	(begin
+	  (string-fill! (vector-ref (matrix-contents new-matrix) y) #\space)
+	  (boolean-vector-fill! (vector-ref (matrix-highlight new-matrix) y)
+				false)))))
+
+(define (screen-clear-rectangle screen xl xu yl yu highlight)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'clear-rectangle
+				   xl xu yl yu highlight))
+  (let ((current-matrix (screen-current-matrix screen))
+	(new-matrix (screen-new-matrix screen)))
+    (let ((current-contents (matrix-contents current-matrix))
+	  (current-highlight (matrix-highlight current-matrix))
+	  (current-enable (matrix-enable current-matrix))
+	  (new-contents (matrix-contents new-matrix))
+	  (new-highlight (matrix-highlight new-matrix))
+	  (new-enable (matrix-enable new-matrix)))
+      (if (and (fix:= xl 0) (fix:= xu (screen-x-size screen)))
+	  (do ((y yl (fix:1+ y)))
+	      ((fix:= y yu))
+	    (string-fill! (vector-ref new-contents y) #\space)
+	    (boolean-vector-fill! (vector-ref new-highlight y) highlight)
+	    (boolean-vector-set! new-enable y true))
+	  (do ((y yl (fix:1+ y)))
+	      ((fix:= y yu))
+	    (let ((nl (vector-ref new-contents y))
+		  (nh (vector-ref new-highlight y)))
+	      (if (boolean-vector-ref new-enable y)
+		  (begin
+		    (substring-fill! nl xl xu #\space)
+		    (boolean-subvector-fill! nh xl xu highlight))
+		  (begin
+		    (boolean-vector-set! new-enable y true)
+		    (set-screen-needs-update?! screen true)
+		    (if (boolean-vector-ref current-enable y)
+			(begin
+			  (string-move! (vector-ref current-contents y) nl)
+			  (boolean-vector-move!
+			   (vector-ref current-highlight y)
+			   nh)
+			  (substring-fill! nl xl xu #\space)
+			  (boolean-subvector-fill! nh xl xu highlight))
+			(begin
+			  (string-fill! nl #\space)
+			  (boolean-vector-fill! nh false)
+			  (if highlight
+			      (boolean-subvector-fill! nh xl xu
+						       highlight))))))))))))
+
+(define (screen-force-update screen)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'force-update))
+  (let ((y-size (screen-y-size screen))
+	(current-matrix (screen-current-matrix screen))
+	(new-matrix (screen-new-matrix screen)))
+    (terminal-clear-screen screen)
+    (let ((current-contents (matrix-contents current-matrix))
+	  (current-highlight (matrix-highlight current-matrix))
+	  (current-enable (matrix-enable current-matrix))
+	  (new-contents (matrix-contents new-matrix))
+	  (new-highlight (matrix-highlight new-matrix))
+	  (new-enable (matrix-enable new-matrix)))
+      (do ((y 0 (fix:1+ y)))
+	  ((fix:= y y-size))
+	(if (boolean-vector-ref current-enable y)
+	    (begin
+	      (boolean-vector-set! current-enable y false)
+	      (if (not (boolean-vector-ref new-enable y))
+		  (begin
+		    (string-move! (vector-ref current-contents y)
+				  (vector-ref new-contents y))
+		    (boolean-vector-move! (vector-ref current-highlight y)
+					  (vector-ref new-highlight y))))))
+	(string-fill! (vector-ref current-contents y) #\space)
+	(boolean-vector-fill! (vector-ref current-highlight y) false))
+      (boolean-vector-fill! current-enable true)))
+  (set-screen-needs-update?! screen true))
+
+(define (screen-scroll-lines-down screen xl xu yl yu amount)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'scroll-lines-down
+				   xl xu yl yu amount))
+  (let ((current-matrix (screen-current-matrix screen)))
+    (and (boolean-subvector-all-elements? (matrix-enable current-matrix)
+					  yl yu true)
+	 (not (screen-needs-update? screen))
+	 (let ((scrolled?
+		(terminal-scroll-lines-down screen xl xu yl yu amount)))
+	   (and scrolled?
+		(begin
+		  (let ((contents (matrix-contents current-matrix))
+			(highlight (matrix-highlight current-matrix)))
+		    (do ((y (fix:-1+ (fix:- yu amount)) (fix:-1+ y))
+			 (y* (fix:-1+ yu) (fix:-1+ y*)))
+			((fix:< y yl))
+		      (substring-move-left! (vector-ref contents y) xl xu
+					    (vector-ref contents y*) xl)
+		      (boolean-subvector-move-left!
+		       (vector-ref highlight y) xl xu
+		       (vector-ref highlight y*) xl)))
+		  (if (eq? scrolled? 'CLEARED)
+		      (matrix-clear-rectangle current-matrix
+					      xl xu yl (fix:+ yl amount)
+					      false))
+		  scrolled?))))))
+
+(define (screen-scroll-lines-up screen xl xu yl yu amount)
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'scroll-lines-up
+				   xl xu yl yu amount))
+  (let ((current-matrix (screen-current-matrix screen)))
+    (and (boolean-subvector-all-elements? (matrix-enable current-matrix)
+					  yl yu true)
+	 (not (screen-needs-update? screen))
+	 (let ((scrolled?
+		(terminal-scroll-lines-up screen xl xu yl yu amount)))
+	   (and scrolled?
+		(begin
+		  (let ((contents (matrix-contents current-matrix))
+			(highlight (matrix-highlight current-matrix)))
+		    (do ((y yl (fix:1+ y))
+			 (y* (fix:+ yl amount) (fix:1+ y*)))
+			((fix:= y* yu))
+		      (substring-move-left! (vector-ref contents y*) xl xu
+					    (vector-ref contents y) xl)
+		      (boolean-subvector-move-left!
+		       (vector-ref highlight y*) xl xu
+		       (vector-ref highlight y) xl)))
+		  (if (eq? scrolled? 'CLEARED)
+		      (matrix-clear-rectangle current-matrix
+					      xl xu (fix:- yu amount) yu
+					      false))
+		  scrolled?))))))
+
+(define (matrix-clear-rectangle matrix xl xu yl yu hl)
+  (let ((contents (matrix-contents matrix))
+	(highlight (matrix-highlight matrix)))
+    (do ((y yl (fix:1+ y)))
+	((fix:= y yu))
+      (substring-fill! (vector-ref contents y) xl xu #\space)
+      (boolean-subvector-fill! (vector-ref highlight y) xl xu hl))))
+
+(define (with-screen-in-update screen display-style thunk)
+  (without-interrupts
+   (lambda ()
+     (call-with-current-continuation
+      (lambda (continuation)
+	(let ((old-flag))
+	  (dynamic-wind (lambda ()
+			  (set! old-flag (screen-in-update? screen))
+			  (set-screen-in-update?! screen
+						  (or old-flag continuation)))
+			(lambda ()
+			  ((screen-operation/wrap-update! screen)
+			   screen
+			   (lambda ()
+			     (and (thunk)
+				  (screen-update screen display-style)))))
+			(lambda ()
+			  (set-screen-in-update?! screen old-flag)
+			  (set! old-flag)
+			  unspecific))))))))
+
+(define (screen-update screen force?)
+  ;; Update the actual terminal screen based on the data in `new-matrix'.
+  ;; Value is #F if redisplay stopped due to pending input.
+  ;; FORCE? true means do not stop for pending input.
+  (if (screen-debug-trace screen)
+      ((screen-debug-trace screen) 'screen screen 'update force?))
+  (let ((current-matrix (screen-current-matrix screen))
+	(new-matrix (screen-new-matrix screen))
+	(y-size (screen-y-size screen)))
+    (let ((enable (matrix-enable new-matrix)))
+      (let loop ((y 0))
+	(cond ((fix:= y y-size)
+	       (let ((x (matrix-cursor-x new-matrix))
+		     (y (matrix-cursor-y new-matrix)))
+		 (terminal-move-cursor screen x y)
+		 (set-matrix-cursor-x! current-matrix x)
+		 (set-matrix-cursor-y! current-matrix y))
+	       (set-screen-needs-update?! screen false)
+	       true)
+	      ((and (terminal-preempt-update? screen y)
+		    ;; `terminal-preempt-update?' has side-effects,
+		    ;; and it must be run regardless of `force?'.
+		    (not force?)
+		    (or (keyboard-active? 0)
+			(eq? (screen-debug-preemption-y screen) y)))
+	       (terminal-move-cursor screen
+				     (matrix-cursor-x current-matrix)
+				     (matrix-cursor-y current-matrix))
+	       (if (screen-debug-trace screen)
+		   ((screen-debug-trace screen) 'screen screen
+						'update-preemption y))
+	       false)
+	      (else
+	       (if (boolean-vector-ref enable y)
+		   (update-line screen y))
+	       (loop (fix:1+ y))))))))
+
+(define (update-line screen y)
+  (let ((current-matrix (screen-current-matrix screen))
+	(new-matrix (screen-new-matrix screen))
+	(x-size (screen-x-size screen)))
+    (let ((current-contents (vector-ref (matrix-contents current-matrix) y))
+	  (current-highlight (vector-ref (matrix-highlight current-matrix) y))
+	  (new-contents (vector-ref (matrix-contents new-matrix) y))
+	  (new-highlight (vector-ref (matrix-highlight new-matrix) y)))
+      (cond ((not (and (boolean-vector-ref (matrix-enable current-matrix) y)
+		       (boolean-vector=? current-highlight new-highlight)))
+	     (update-line-ignore-current screen y
+					 new-contents new-highlight x-size))
+	    ((string=? current-contents new-contents)
+	     unspecific)
+	    ((boolean-vector-all-elements? new-highlight false)
+	     (update-line-no-highlight screen y current-contents new-contents))
+	    (else
+	     (update-line-ignore-current screen y
+					 new-contents new-highlight x-size)))
+      ;; Update current-matrix to contain the new line.
+      (vector-set! (matrix-contents current-matrix) y new-contents)
+      (vector-set! (matrix-highlight current-matrix) y new-highlight)
+      (boolean-vector-set! (matrix-enable current-matrix) y true)
+      ;; Move the old line to new-matrix so that it can be reused.
+      (vector-set! (matrix-contents new-matrix) y current-contents)
+      (vector-set! (matrix-highlight new-matrix) y current-highlight)
+      (boolean-vector-set! (matrix-enable new-matrix) y false))))
+
+(define (update-line-no-highlight screen y oline nline)
+  (let ((x-size (screen-x-size screen)))
+    (let ((olen (substring-non-space-end oline 0 x-size))
+	  (nlen (substring-non-space-end nline 0 x-size)))
+      (let ((len (fix:min olen nlen)))
+	(let loop ((x 0))
+	  (let ((x
+		 (fix:+ x (substring-match-forward oline x len nline x len))))
+	    (if (fix:= x len)
+		(if (fix:< x nlen)
+		    (terminal-output-substring screen x y
+					       nline x nlen false))
+		(let find-match ((x* (fix:1+ x)))
+		  (cond ((fix:= x* len)
+			 (if (fix:< x nlen)
+			     (terminal-output-substring screen x y
+							nline x nlen false)))
+			((fix:= (vector-8b-ref oline x*)
+				(vector-8b-ref nline x*))
+			 (let ((n
+				(substring-match-forward oline x* len
+							 nline x* len)))
+			   ;; Ignore matches of 4 characters or less.  The
+			   ;; overhead of moving the cursor and drawing
+			   ;; the characters is too much except for very
+			   ;; slow terminals.
+			   (if (fix:< n 5)
+			       (find-match (fix:+ x* n))
+			       (begin
+				 (terminal-output-substring screen x y
+							    nline x x* false)
+				 (loop (fix:+ x* n))))))
+			(else
+			 (find-match (fix:1+ x*)))))))))
+      (if (fix:< nlen olen)
+	  (terminal-clear-line screen nlen y olen)))))
+
+(define (update-line-ignore-current screen y nline highlight x-size)
+  (cond ((not (boolean-subvector-uniform? highlight 0 x-size))
+	 (let loop ((x 0))
+	   (let ((hl (boolean-vector-ref highlight x)))
+	     (let ((x*
+		    (boolean-subvector-find-next highlight (fix:1+ x) x-size
+						 (not hl))))
+	       (if x*
+		   (begin
+		     (terminal-output-substring screen x y nline x x* hl)
+		     (loop x*))
+		   (terminal-output-substring screen x y nline x x-size
+					      hl))))))
+	((boolean-vector-ref highlight 0)
+	 (terminal-output-substring screen 0 y nline 0 x-size true))
+	(else
+	 (let ((xe (substring-non-space-end nline 0 x-size)))
+	   (if (fix:< 0 xe)
+	       (terminal-output-substring screen 0 y nline 0 xe false))
+	   (if (fix:< xe x-size)
+	       (terminal-clear-line screen xe y x-size))))))
+
+(define-integrable (fix:min x y) (if (fix:< x y) x y))
+(define-integrable (fix:max x y) (if (fix:> x y) x y))
+
+(define (substring-non-space-end string start end)
+  (let ((index
+	 (substring-find-previous-char-in-set string start end
+					      char-set/not-space)))
+    (if index
+	(fix:1+ index)
+	start)))
+
+(define-integrable (substring-blank? string start end)
+  (not (substring-find-next-char-in-set string start end char-set/not-space)))
+
+(define char-set/not-space
+  (char-set-invert (char-set #\space)))
+
+(define (string-move! x y)
+  (substring-move-left! x 0 (string-length x) y 0))
+
+(define-integrable (boolean-vector-ref vector index)
+  (fix:= (char->integer #\t) (vector-8b-ref vector index)))
+
+(define-integrable (boolean-vector-set! vector index value)
+  (vector-8b-set! vector index (boolean->ascii value)))
+
+(define (boolean-vector-all-elements? vector value)
+  (boolean-subvector-all-elements? vector 0 (boolean-vector-length vector)
+				   value))
+
+(define (boolean-subvector-all-elements? vector start end value)
+  (if (vector-8b-find-next-char vector start end (boolean->ascii (not value)))
+      false
+      true))
+
+(define (boolean-subvector-uniform? vector start end)
+  (if (and (fix:< start end)
+	   (vector-8b-find-next-char
+	    vector start end
+	    (boolean->ascii (not (boolean-vector-ref vector start)))))
+      false
+      true))
+
+(define-integrable (boolean-subvector-find-next vector start end value)
+  (vector-8b-find-next-char vector start end (boolean->ascii value)))
+
+(define-integrable make-boolean-vector string-allocate)
+(define-integrable boolean-vector-length string-length)
+(define-integrable boolean-vector=? string=?)
+(define-integrable boolean-subvector-move-right! substring-move-right!)
+(define-integrable boolean-subvector-move-left! substring-move-left!)
+(define-integrable boolean-vector-move! string-move!)
+(define-integrable boolean-vector-copy string-copy)
+
+(define-integrable (boolean-subvector-fill! vector start end value)
+  (vector-8b-fill! vector start end (boolean->ascii value)))
+
+(define (boolean-vector-fill! vector value)
+  (boolean-subvector-fill! vector 0 (boolean-vector-length vector) value))
+
+(define-integrable (boolean->ascii boolean)
+  (if boolean (char->integer #\t) (char->integer #\f)))
\ No newline at end of file
diff --git a/v7/src/edwin/utlwin.scm b/v7/src/edwin/utlwin.scm
index eb09e4b46..9d6ffbcaf 100644
--- a/v7/src/edwin/utlwin.scm
+++ b/v7/src/edwin/utlwin.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utlwin.scm,v 1.54 1989/08/14 09:23:08 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/utlwin.scm,v 1.55 1990/11/02 03:24:51 cph Rel $
 ;;;
-;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -54,72 +54,48 @@
 (define-class string-base vanilla-window
   (image representation truncate-lines?))
 
-(define-method string-base (:update-display! window screen x-start y-start
-					     xl xu yl yu display-style)
-  window display-style			;ignore
-  (cond ((pair? representation)
-	 (cond ((not (cdr representation))
-		;; disable clipping.
-		(subscreen-clear! screen
-				  x-start (fix:+ x-start xu)
-				  y-start (fix:+ y-start yu))
-#|
-		(subscreen-clear! screen
-				  (fix:+ x-start xl) (fix:+ x-start xu)
-				  (fix:+ y-start yl) (fix:+ y-start yu))
-|#
-		)
-	       ((fix:< yl yu)
-		(let ((start (cdr representation))
-		      (end (string-length (car representation)))
-		      (ayu (fix:+ y-start yu)))
-		  ;; disable clipping.
-		  (if (not (fix:zero? start))
-		      (subscreen-clear! screen
-					x-start (fix:+ x-start start)
-					y-start ayu))
-		  (screen-write-substring! screen
-					   (fix:+ x-start start) y-start
-					   (car representation)
-					   start end)
-		  (if (fix:< end x-size)
-		      (subscreen-clear! screen
-					(fix:+ x-start end)
-					(fix:+ x-start x-size)
-					y-start
-					ayu))
-#|
-		  (if (not (fix:zero? start))
-		      (clip-window-region-1 xl xu start
-			(lambda (xl xu)
-			  (subscreen-clear! screen
-					    (fix:+ x-start xl)
-					    (fix:+ x-start xu)
-					    ayl
-					    ayu))))
-		  (clip-window-region-1 (fix:- xl start)
-					(fix:- xu start)
-					(fix:- end start)
-		    (lambda (xl xu)
-		      (let ((xl* (fix:+ xl start)))
-			(screen-write-substring! screen
-						 (fix:+ x-start xl*) ayl
-						 (car representation)
-						 xl* (fix:+ xu start)))))
-		  (clip-window-region-1 (fix:- xl end)
-					(fix:- xu end)
-					(fix:- x-size end)
-		    (lambda (xl xu)
-		      (let ((x-start (fix:+ x-start end)))
-			(subscreen-clear! screen
-					  (fix:+ x-start xl) (fix:+ x-start xu)
-					  ayl ayu))))
-|#
-		  ))))
-	(else
-	 (screen-write-substrings! screen (fix:+ x-start xl) (fix:+ y-start yl)
-				   representation xl xu yl yu)))
+(define-integrable (string-base:representation window)
+  (with-instance-variables string-base window () representation))
+
+(define (string-base:update-display! window screen x-start y-start
+				     xl xu yl yu display-style)
+  display-style				;ignore
+  (let ((representation (string-base:representation window)))
+    (cond ((false? representation)
+	   (screen-clear-rectangle screen
+				   x-start (fix:+ x-start xu)
+				   y-start (fix:+ y-start yu)
+				   false))
+	  ((string? representation)
+	   (screen-output-substring screen x-start y-start
+				    representation
+				    0 (string-length representation) false))
+	  (else
+	   (clip (screen-x-size screen) (fix:+ x-start xl) xl xu
+	     (lambda (x il iu)
+	       (clip (screen-y-size screen) (fix:+ y-start yl) yl yu
+		 (lambda (y jl ju)
+		   (let loop ((y y) (j jl))
+		     (if (fix:< j ju)
+			 (begin
+			   (screen-output-substring screen x y
+						    (vector-ref representation
+								j)
+						    il iu false)
+			   (loop (fix:1+ y) (fix:1+ j))))))))))))
   true)
+
+(define (clip axu x bil biu receiver)
+  (let ((ail (fix:- bil x)))
+    (if (fix:< ail biu)
+	(let ((aiu (fix:+ ail axu)))
+	  (cond ((fix:<= x 0)
+		 (receiver 0 ail (if (fix:< aiu biu) aiu biu)))
+		((fix:< x axu)
+		 (receiver x bil (if (fix:< aiu biu) aiu biu))))))))
+
+(define-method string-base :update-display!
+  string-base:update-display!)
 
 (define (string-base:set-size-given-x! window x *truncate-lines?)
   (with-instance-variables string-base window (x *truncate-lines?)
@@ -167,27 +143,27 @@
 (define (string-base:coordinates->index window x y)
   (with-instance-variables string-base window (x y)
     (image-column->index image
-			 (let ((column-size (image-column-size image)))
-			   (if (and truncate-lines? (fix:= x (fix:-1+ x-size)))
-			       column-size
-			       (min (coordinates->column x y x-size)
-				    column-size))))))
+			 (let ((column (coordinates->column x y x-size))
+			       (size (image-column-size image)))
+			   (if (fix:< column size)
+			       column
+			       size)))))
 
 (define (column->x-size column-size y-size truncate-lines?)
   ;; Assume Y-SIZE > 0.
   (if truncate-lines?
       column-size
       (let ((qr (integer-divide column-size y-size)))
-	(if (fix:zero? (integer-divide-remainder qr))
+	(if (fix:= (integer-divide-remainder qr) 0)
 	    (integer-divide-quotient qr)
 	    (fix:1+ (integer-divide-quotient qr))))))
 
 (define (column->y-size column-size x-size truncate-lines?)
   ;; Assume X-SIZE > 1.
-  (if (or truncate-lines? (fix:zero? column-size))
+  (if (or truncate-lines? (fix:< column-size x-size))
       1
       (let ((qr (integer-divide column-size (fix:-1+ x-size))))
-	(if (fix:zero? (integer-divide-remainder qr))
+	(if (fix:= (integer-divide-remainder qr) 0)
 	    (integer-divide-quotient qr)
 	    (fix:1+ (integer-divide-quotient qr))))))
 
@@ -199,7 +175,7 @@
 	   (cons -1+x-size 0))
 	  (else
 	   (let ((qr (integer-divide column -1+x-size)))
-	     (if (and (fix:zero? (integer-divide-remainder qr))
+	     (if (and (fix:= (integer-divide-remainder qr) 0)
 		      (fix:= column column-size))
 		 (cons -1+x-size
 		       (fix:-1+ (integer-divide-quotient qr)))
@@ -214,114 +190,114 @@
 	   -1+x-size)
 	  (else
 	   (let ((r (remainder column -1+x-size)))
-	     (if (and (fix:zero? r) (fix:= column column-size))
+	     (if (and (fix:= r 0) (fix:= column column-size))
 		 -1+x-size
 		 r))))))
 
 (define (column->y column-size x-size truncate-lines? column)
-  (if truncate-lines?
+  (if (or truncate-lines? (fix:< column (fix:-1+ x-size)))
       0
-      (let ((-1+x-size (fix:-1+ x-size)))
-	(if (fix:< column -1+x-size)
-	    0
-	    (let ((qr (integer-divide column -1+x-size)))
-	      (if (and (fix:zero? (integer-divide-remainder qr))
-		       (fix:= column column-size))
-		  (fix:-1+ (integer-divide-quotient qr))
-		  (integer-divide-quotient qr)))))))
+      (let ((qr (integer-divide column (fix:-1+ x-size))))
+	(if (and (fix:= (integer-divide-remainder qr) 0)
+		 (fix:= column column-size))
+	    (fix:-1+ (integer-divide-quotient qr))
+	    (integer-divide-quotient qr)))))
 
 (define-integrable (coordinates->column x y x-size)
   (fix:+ x (fix:* y (fix:-1+ x-size))))
 
 (define (string-base:direct-output-insert-char! window x char)
   (with-instance-variables string-base window (x char)
-    (if (pair? representation)
-	(begin
-	  (set-car! representation
-		    (string-append-char (car representation) char))
-	  (if (and (not (cdr representation))
-		   (not (char=? char #\Space)))
-	      (set-cdr! representation x)))
-	(string-set! (vector-ref representation (fix:-1+ y-size)) x char))))
+    (image-direct-output-insert-char! image char)
+    (cond ((false? representation)
+	   (let ((s (string-allocate x-size)))
+	     (string-fill! s #\space)
+	     (string-set! s x char)
+	     (set! representation s)))
+	  ((string? representation)
+	   (string-set! representation x char))
+	  (else
+	   (string-set! (vector-ref representation (fix:-1+ y-size))
+			x
+			char)))))
 
 (define (string-base:direct-output-insert-newline! window)
   (with-instance-variables string-base window ()
+    (set! image (make-null-image))
     (set! y-size 1)
-    (set! representation (cons "" false))))
+    (set! representation false)))
 
 (define (string-base:direct-output-insert-substring! window x string start end)
   (with-instance-variables string-base window (x string start end)
-    (if (pair? representation)
-	(begin
-	  (set-car! representation
-		    (string-append-substring (car representation)
-					     string start end))
-	  (if (not (cdr representation))
-	      (let ((index
-		     (substring-find-next-char-in-set string start end
-						      char-set:not-space)))
-		(if index
-		    (set-cdr! representation (fix:+ x index))))))
-	(substring-move-right! string start end
-			       (vector-ref representation (fix:-1+ y-size))
-			       x))))
+    (image-direct-output-insert-substring! image string start end)
+    (cond ((false? representation)
+	   (let ((s (string-allocate x-size)))
+	     (substring-fill! s 0 x #\space)
+	     (substring-move-left! string start end s x)
+	     (substring-fill! s (fix:+ x (fix:- end start)) x-size #\space)
+	     (set! representation s)))
+	  ((string? representation)
+	   (substring-move-left! string start end representation x))
+	  (else
+	   (substring-move-left! string start end
+				 (vector-ref representation (fix:-1+ y-size))
+				 x)))))
 
 (define (string-base:refresh! window)
   (with-instance-variables string-base window ()
-    (define (one-liner string)
-      (let ((start 
-	     (string-find-next-char-in-set string char-set:not-space)))
-	(if (not (and (pair? representation)
-		      (string=? (car representation) string)
-		      (eqv? (cdr representation) start)))
-	    (begin
-	      (set! representation (cons string start))
-	      (setup-redisplay-flags! redisplay-flags)))))
-    (let* ((string (image-representation image))
-	   (column-size (string-length string)))
-      (cond ((fix:< column-size x-size)
-	     (one-liner string))
-	    (truncate-lines?
-	     (one-liner
-	      (let ((s (string-allocate x-size))
-		    (x-max (fix:-1+ x-size)))
-		(substring-move-right! string 0 x-max s 0)
-		(string-set! s x-max #\$)
-		s)))
-	    (else
-	     (let ((rep (make-vector y-size '()))
-		   (x-max (fix:-1+ x-size)))
-	       (let loop ((start 0) (y 0))
-		 (let ((s (string-allocate x-size))
-		       (end (fix:+ start x-max)))
-		   (vector-set! rep y s)
-		   (if (fix:> column-size end)
-		       (begin
-			 (substring-move-right! string start end s 0)
-			 (string-set! s x-max #\\)
-			 (loop end (fix:1+ y)))
-		       (begin
-			 (substring-move-right! string start column-size s 0)
-			 (substring-fill! s
-					  (fix:- column-size start)
-					  x-size
-					  #\space)))))
-	       (set! representation rep)
-	       (setup-redisplay-flags! redisplay-flags)))))))
+    (let ((string (image-representation image)))
+      (let ((column-size (string-length string)))
+	(cond ((fix:= column-size 0)
+	       (set! representation false))
+	      ((fix:< column-size x-size)
+	       (let ((s (string-allocate x-size)))
+		 (substring-move-left! string 0 column-size s 0)
+		 (substring-fill! s column-size x-size #\space)
+		 (set! representation s)))
+	      (truncate-lines?
+	       (let ((s (string-allocate x-size))
+		     (x-max (fix:-1+ x-size)))
+		 (substring-move-left! string 0 x-max s 0)
+		 (string-set! s x-max #\$)
+		 (set! representation s)))
+	      (else
+	       (let ((rep (make-vector y-size '()))
+		     (x-max (fix:-1+ x-size)))
+		 (let loop ((start 0) (y 0))
+		   (let ((s (string-allocate x-size))
+			 (end (fix:+ start x-max)))
+		     (vector-set! rep y s)
+		     (if (fix:> column-size end)
+			 (begin
+			   (substring-move-left! string start end s 0)
+			   (string-set! s x-max #\\)
+			   (loop end (fix:1+ y)))
+			 (begin
+			   (substring-move-left! string start column-size s 0)
+			   (substring-fill! s
+					    (fix:- column-size start)
+					    x-size
+					    #\space)))))
+		 (set! representation rep))))))
+    (setup-redisplay-flags! redisplay-flags)))
 
 ;;;; Blank Window
 
 (define-class blank-window vanilla-window
   ())
 
-(define-method blank-window (:update-display! window screen x-start y-start
-					      xl xu yl yu display-style)
+(define (blank-window:update-display! window screen x-start y-start
+				      xl xu yl yu display-style)
   window display-style			;ignore
-  (subscreen-clear! screen
-		    (fix:+ x-start xl) (fix:+ x-start xu)
-		    (fix:+ y-start yl) (fix:+ y-start yu))
+  (screen-clear-rectangle screen
+			  (fix:+ x-start xl) (fix:+ x-start xu)
+			  (fix:+ y-start yl) (fix:+ y-start yu)
+			  false)
   true)
 
+(define-method blank-window :update-display!
+  blank-window:update-display!)
+
 ;;;; Vertical Border Window
 
 (define-class vertical-border-window vanilla-window
@@ -329,8 +305,7 @@
 
 (define-method vertical-border-window (:initialize! window window*)
   (usual=> window :initialize! window*)
-  (set! x-size 1)
-  unspecific)
+  (set! x-size 1))
 
 (define-method vertical-border-window (:set-x-size! window x)
   window				;ignore
@@ -338,26 +313,28 @@
 
 (define-method vertical-border-window (:set-size! window x y)
   (if (not (fix:= x 1))
-      (error "x-size of a vertical border window must be 1" x))
+      (error "Can't change the x-size of a vertical border window" x))
   (set! x-size x)
   (set! y-size y)
   (setup-redisplay-flags! redisplay-flags))
 
-(define-method vertical-border-window
-	       (:update-display! window screen x-start y-start
-				 xl xu yl yu display-style)
+(define (vertical-border-window:update-display! window screen x-start y-start
+						xl xu yl yu display-style)
   display-style				;ignore
   (if (fix:< xl xu)
-      (clip-window-region-1 yl yu y-size
+      (clip-window-region-1 yl yu (window-y-size window)
 	(lambda (yl yu)
 	  (let ((xl (fix:+ x-start xl))
 		(yu (fix:+ y-start yu)))
 	    (let loop ((y (fix:+ y-start yl)))
 	      (if (fix:< y yu)
 		  (begin
-		    (screen-write-char! screen xl y #\|)
-		    (loop (fix:1+ y)))))))))
+		    (screen-output-char screen xl y #\| false)
+		    (loop (fix:+ y 1)))))))))
   true)
+
+(define-method vertical-border-window :update-display!
+  vertical-border-window:update-display!)
 
 ;;;; Cursor Window
 
@@ -368,8 +345,7 @@
   (usual=> window :initialize! window*)
   (set! x-size 1)
   (set! y-size 1)
-  (set! enabled? false)
-  unspecific)
+  (set! enabled? false))
 
 (define-method cursor-window (:set-x-size! window x)
   window				;ignore
@@ -383,18 +359,22 @@
   window				;ignore
   (error "Can't change the size of a cursor window" x y))
 
-(define-method cursor-window (:update-display! window screen x-start y-start
-					       xl xu yl yu display-style)
+(define (cursor-window:update-display! window screen x-start y-start
+				       xl xu yl yu display-style)
   display-style				;ignore
-  (if (and enabled? (fix:< xl xu) (fix:< yl yu))
-      (screen-write-cursor! screen x-start y-start))
+  (if (and (with-instance-variables cursor-window window () enabled?)
+	   (fix:< xl xu)
+	   (fix:< yl yu))
+      (screen-move-cursor screen x-start y-start))
   true)
 
+(define-method cursor-window :update-display!
+  cursor-window:update-display!)
+
 (define-method cursor-window (:enable! window)
   (set! enabled? true)
   (setup-redisplay-flags! redisplay-flags))
 
 (define-method cursor-window (:disable! window)
   (set! enabled? false)
-  (set-car! redisplay-flags false)
-  unspecific)
\ No newline at end of file
+  (set-car! redisplay-flags false))
\ No newline at end of file
diff --git a/v7/src/edwin/wincom.scm b/v7/src/edwin/wincom.scm
index 27063cb83..256246c55 100644
--- a/v7/src/edwin/wincom.scm
+++ b/v7/src/edwin/wincom.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.98 1990/10/09 16:24:47 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/wincom.scm,v 1.99 1990/11/02 03:24:57 cph Rel $
 ;;;
 ;;;	Copyright (c) 1987, 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -96,7 +96,8 @@ negative args count from the bottom."
     (let ((window (current-window)))
       (if (not argument)
 	  (begin
-	    (window-redraw! window false)
+	    (window-scroll-y-absolute! window (window-y-center window))
+	    (window-redraw! window)
 	    (update-selected-screen! true))
 	  (window-scroll-y-absolute!
 	   window
@@ -184,11 +185,9 @@ means scroll one screenful down."
 		     (multi-scroll-window-argument window argument 1)))))
 
 (define (scroll-window window n #!optional limit)
-  (if (if (negative? n)
-	  (= (window-start-index window)
-	     (mark-index (buffer-start (window-buffer window))))
-	  (= (window-end-index window)
-	     (mark-index (buffer-end (window-buffer window)))))
+  (if (window-mark-visible?
+       window
+       ((if (negative? n) buffer-start buffer-end) (window-buffer window)))
       ((if (default-object? limit) editor-error limit))
       (window-scroll-y-relative! window n)))
 
diff --git a/v7/src/edwin/window.scm b/v7/src/edwin/window.scm
index 67ff4e43d..9bb48f471 100644
--- a/v7/src/edwin/window.scm
+++ b/v7/src/edwin/window.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/window.scm,v 1.151 1990/10/06 21:10:32 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/window.scm,v 1.152 1990/11/02 03:25:03 cph Rel $
 ;;;
-;;;	Copyright (c) 1986, 1989 Massachusetts Institute of Technology
+;;;	Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -45,7 +45,7 @@
 ;;;; Window System
 
 (declare (usual-integrations))
-
+
 ;;;  Based on WINDOW-WIN, designed by RMS.
 ;;;  See WINOPS.TXT for more information.
 
@@ -64,17 +64,19 @@
 ;;; method invocation.  However, these instance variables are always
 ;;; set by a method defined on the window itself.
 
+;;; It is assumed in several places that the methods to set a window's
+;;; size are called with interrupts disabled.
+
 ;;;; Vanilla Window
 
 (define-class vanilla-window ()
   (superior x-size y-size redisplay-flags inferiors))
 
 (define (window-initialize! window window*)
-  (with-instance-variables vanilla-window window (window*)
-    (set! superior window*)
-    (set! redisplay-flags (=> superior :inferior-redisplay-flags window))
-    (set! inferiors '())
-    unspecific))
+  (%set-window-superior! window window*)
+  (set-window-inferiors! window '())
+  (%set-window-redisplay-flags! window
+				(=> window* :inferior-redisplay-flags window)))
 
 (define (window-kill! window)
   (for-each-inferior-window window (lambda (window) (=> window :kill!))))
@@ -82,167 +84,176 @@
 (define-integrable (window-superior window)
   (with-instance-variables vanilla-window window () superior))
 
-(define (set-window-superior! window window*)
+(define-integrable (%set-window-superior! window window*)
   (with-instance-variables vanilla-window window (window*)
-    (set! superior window*)
-    (set! redisplay-flags (=> window* :inferior-redisplay-flags window))
-    (setup-redisplay-flags! redisplay-flags)
-    (for-each (lambda (inferior)
-		(set-inferior-redisplay-flags! inferior
-					       (cons false redisplay-flags))
-		(=> (inferior-window inferior) :set-superior! window))
-	      inferiors)))
-
-(define (window-root-window window)
-  (with-instance-variables vanilla-window window ()
-    (if superior (window-root-window superior) window)))
+    (set! superior window*)))
 
 (define-integrable (window-x-size window)
   (with-instance-variables vanilla-window window () x-size))
 
-(define (set-window-x-size! window x)
-  (with-instance-variables vanilla-window window (x)
-    (%set-window-x-size! window x)
-    (setup-redisplay-flags! redisplay-flags)))
-
 (define-integrable (%set-window-x-size! window x)
-  (with-instance-variables vanilla-window window (x)
-    (set! x-size x)
-    unspecific))
+  (with-instance-variables vanilla-window window (x) (set! x-size x)))
 
 (define-integrable (window-y-size window)
   (with-instance-variables vanilla-window window () y-size))
 
-(define (set-window-y-size! window y)
-  (with-instance-variables vanilla-window window (y)
-    (%set-window-y-size! window y)
-    (setup-redisplay-flags! redisplay-flags)))
-
 (define-integrable (%set-window-y-size! window y)
-  (with-instance-variables vanilla-window window (y)
-    (set! y-size y)
-    unspecific))
-
-(define (window-size window receiver)
-  (with-instance-variables vanilla-window window (receiver)
-    (receiver x-size y-size)))
-
-(define (set-window-size! window x y)
-  (with-instance-variables vanilla-window window (x y)
-    (set! x-size x)
-    (set! y-size y)
-    (setup-redisplay-flags! redisplay-flags)))
+  (with-instance-variables vanilla-window window (y) (set! y-size y)))
 
 (define-integrable (window-redisplay-flags window)
   (with-instance-variables vanilla-window window () redisplay-flags))
 
-(define-integrable (%window-needs-redisplay? window)
-  (with-instance-variables vanilla-window window () (car redisplay-flags)))
+(define-integrable (%set-window-redisplay-flags! window flags)
+  (with-instance-variables vanilla-window window (flags)
+    (set! redisplay-flags flags)))
 
 (define-integrable (window-inferiors window)
   (with-instance-variables vanilla-window window () inferiors))
 
+(define-integrable (set-window-inferiors! window inferiors*)
+  (with-instance-variables vanilla-window window (inferiors*)
+    (set! inferiors inferiors*)))
+
+(define (window-root-window window)
+  (if (window-superior window)
+      (window-root-window (window-superior window))
+      window))
+
+(define (set-window-superior! window window*)
+  (%set-window-superior! window window*)
+  (let ((flags (=> window* :inferior-redisplay-flags window)))
+    (%set-window-redisplay-flags! window flags)
+    (setup-redisplay-flags! flags)
+    (for-each-inferior window
+      (lambda (inferior)
+	(set-inferior-redisplay-flags! inferior (cons false flags))
+	(=> (inferior-window inferior) :set-superior! window)))))
+
+(define (window-size window receiver)
+  (receiver (window-x-size window) (window-y-size window)))
+
+(define (set-window-x-size! window x)
+  (%set-window-x-size! window x)
+  (window-needs-redisplay! window))
+
+(define (set-window-y-size! window y)
+  (%set-window-y-size! window y)
+  (window-needs-redisplay! window))
+
+(define (set-window-size! window x y)
+  (%set-window-x-size! window x)
+  (%set-window-y-size! window y)
+  (window-needs-redisplay! window))
+
+(define-integrable (window-needs-redisplay? window)
+  (car (window-redisplay-flags window)))
+
+(define-integrable (window-needs-redisplay! window)
+  (setup-redisplay-flags! (window-redisplay-flags window)))
+
 (define-integrable (window-inferior? window window*)
-  (with-instance-variables vanilla-window window (window*)
-    (find-inferior? inferiors window*)))
+  (find-inferior? (window-inferiors window) window*))
 
 (define-integrable (window-inferior window window*)
-  (with-instance-variables vanilla-window window (window*)
-    (find-inferior inferiors window*)))
+  (find-inferior (window-inferiors window) window*))
 
-(define (for-each-inferior window procedure)
-  (with-instance-variables vanilla-window window (procedure)
-    (let loop ((inferiors inferiors))
-      (if (not (null? inferiors))
-	  (begin
-	    (procedure (car inferiors))
-	    (loop (cdr inferiors)))))))
+(define-integrable (for-each-inferior window procedure)
+  (let loop ((inferiors (window-inferiors window)))
+    (if (not (null? inferiors))
+	(begin
+	  (procedure (car inferiors))
+	  (loop (cdr inferiors))))))
 
-(define (for-each-inferior-window window procedure)
+(define-integrable (for-each-inferior-window window procedure)
   (for-each-inferior window
-    (lambda (inferior) (procedure (inferior-window inferior)))))
+    (lambda (inferior)
+      (procedure (inferior-window inferior)))))
 
 (define (make-inferior window class)
-  (with-instance-variables vanilla-window window (class)
-    (let ((window* (make-object class)))
-      (let ((inferior
-	     (cons window*
-		   (vector false
+  (let ((window* (make-object class)))
+    (let ((inferior
+	   (%make-inferior window*
+			   false
 			   false
-			   (cons false redisplay-flags)))))
-	(set! inferiors (cons inferior inferiors))
-	(=> window* :initialize! window)
-	inferior))))
+			   (cons false (window-redisplay-flags window)))))
+      (set-window-inferiors! window (cons inferior (window-inferiors window)))
+      (=> window* :initialize! window)
+      inferior)))
 
 (define (add-inferior! window window*)
-  (with-instance-variables vanilla-window window (window*)
-    (set! inferiors
-	  (cons (cons window*
-		      (vector false
-			      false
-			      (cons false redisplay-flags)))
-		inferiors))
-    (=> window* :set-superior! window)))
+  (let ((inferior
+	 (%make-inferior window*
+			 false
+			 false
+			 (cons false (window-redisplay-flags window)))))
+    (set-window-inferiors! window (cons inferior (window-inferiors window)))
+    (=> window* :set-superior! window)
+    inferior))
 
 (define (delete-inferior! window window*)
-  (with-instance-variables vanilla-window window (window*)
-    (set! inferiors
-	  (delq! (find-inferior inferiors window*)
-		 inferiors))))
+  (set-window-inferiors! window
+			 (let ((inferiors (window-inferiors window)))
+			   (delq! (find-inferior inferiors window*)
+				  inferiors))))
 
 (define (replace-inferior! window old new)
-  (with-instance-variables vanilla-window window (old new)
-    (set-inferior-window! (find-inferior inferiors old) new)
-    (=> new :set-superior! window)))
+  (set-inferior-window! (find-inferior (window-inferiors window) old) new)
+  (=> new :set-superior! window))
 
 ;;; Returns #T if the redisplay finished, #F if aborted.
 ;;; Notice that the :UPDATE-DISPLAY! operation is assumed to return
 ;;; the same value.  This is used to control the setting of the
 ;;; redisplay flags.
 
-(define (update-inferiors! window screen x-start y-start xl xu yl yu
-			   display-style)
-  (with-instance-variables vanilla-window window
-			   (screen x-start y-start xl xu yl yu display-style)
-    (let loop ((inferiors inferiors))
-      (if (null? inferiors)
-	  true
-	  (let ((window (inferior-window (car inferiors)))
-		(xi (inferior-x-start (car inferiors)))
-		(yi (inferior-y-start (car inferiors)))
-		(flags (inferior-redisplay-flags (car inferiors))))
-	    (let ((continue
-		   (lambda ()
-		     (set-car! flags false)
-		     (loop (cdr inferiors)))))
-	      (if (and (or display-style (car flags))
-		       xi yi)
-		  (and (or display-style (not (keyboard-active? 0)))
-		       (clip-window-region xl xu yl yu
-					   xi (window-x-size window)
-					   yi (window-y-size window)
-			 (lambda (xl xu yl yu)
-			   (=> window :update-display!
-			       screen (fix:+ x-start xi) (fix:+ y-start yi)
-			       xl xu yl yu display-style)))
-		       (continue))
-		  (continue))))))))
-
-(define (clip-window-region xl xu yl yu xi xs yi ys receiver)
-  (clip-window-region-1 (fix:- xl xi) (fix:- xu xi) xs
-    (lambda (xl xu)
-      (clip-window-region-1 (fix:- yl yi) (fix:- yu yi) ys
-	(lambda (yl yu)
-	  (receiver xl xu yl yu))))))
+(define (window-update-display! window screen x-start y-start xl xu yl yu
+				display-style)
+  (update-inferiors! (window-inferiors window) screen x-start y-start
+		     xl xu yl yu display-style
+    (lambda (window screen x-start y-start xl xu yl yu display-style)
+      (and (or display-style (not (keyboard-active? 0)))
+	   (=> window :update-display! screen x-start y-start xl xu yl yu
+	       display-style)))))
+
+(define (update-inferiors! inferiors screen x-start y-start xl xu yl yu
+			   display-style updater)
+  (let loop ((inferiors inferiors))
+    (if (null? inferiors)
+	true
+	(and (update-inferior! (car inferiors) screen x-start y-start
+			       xl xu yl yu display-style updater)
+	     (loop (cdr inferiors))))))
+
+(define (update-inferior! inferior screen x-start y-start xl xu yl yu
+			  display-style updater)
+  (let ((window (inferior-window inferior))
+	(xi (inferior-x-start inferior))
+	(yi (inferior-y-start inferior))
+	(flags (inferior-redisplay-flags inferior)))
+    (and (or (not xi)
+	     (not (or display-style (car flags)))
+	     (clip-window-region-1 (fix:- xl xi)
+				   (fix:- xu xi)
+				   (window-x-size window)
+	       (lambda (xl xu)
+		 (clip-window-region-1 (fix:- yl yi)
+				       (fix:- yu yi)
+				       (window-y-size window)
+		   (lambda (yl yu)
+		     (updater window
+			      screen (fix:+ x-start xi) (fix:+ y-start yi)
+			      xl xu yl yu display-style))))))
+	 (begin
+	   (set-car! flags false)
+	   true))))
 
 (define (clip-window-region-1 al au bs receiver)
-  (if (fix:positive? al)
-      (if (fix:> al bs)
-	  true
-	  (receiver al (if (fix:< bs au) bs au)))
-      (if (fix:positive? au)
-	  (receiver 0 (if (fix:< bs au) bs au))
-	  true)))
+  (if (fix:< 0 al)
+      (if (fix:< au bs)
+	  (if (fix:< al au) (receiver al au) true)
+	  (if (fix:< al bs) (receiver al bs) true))
+      (if (fix:< au bs)
+	  (if (fix:< 0 au) (receiver 0 au) true)
+	  (if (fix:< 0 bs) (receiver 0 bs) true))))
 
 (define (salvage-inferiors! window)
   (for-each-inferior-window window (lambda (window) (=> window :salvage!))))
@@ -267,7 +278,7 @@
 (define-method vanilla-window :add-inferior! add-inferior!)
 (define-method vanilla-window :delete-inferior! delete-inferior!)
 (define-method vanilla-window :replace-inferior! replace-inferior!)
-(define-method vanilla-window :update-display! update-inferiors!)
+(define-method vanilla-window :update-display! window-update-display!)
 (define-method vanilla-window :salvage! salvage-inferiors!)
 
 ;;;; Operations on Inferiors
@@ -316,9 +327,96 @@
 
 ;;;; Inferiors
 
+(define %inferior-tag
+  "inferior")
+
+(define-integrable (%make-inferior window x-start y-start redisplay-flags)
+  (vector %inferior-tag window x-start y-start redisplay-flags))
+
+(define-integrable (inferior-window inferior)
+  (vector-ref inferior 1))
+
+(define-integrable (set-inferior-window! inferior window)
+  (vector-set! inferior 1 window))
+
+(define-integrable (inferior-x-start inferior)
+  (vector-ref inferior 2))
+
+(define-integrable (%set-inferior-x-start! inferior x-start)
+  (vector-set! inferior 2 x-start))
+
+(define-integrable (inferior-y-start inferior)
+  (vector-ref inferior 3))
+
+(define-integrable (%set-inferior-y-start! inferior y-start)
+  (vector-set! inferior 3 y-start))
+
+(define-integrable (inferior-redisplay-flags inferior)
+  (vector-ref inferior 4))
+
+(define-integrable (set-inferior-redisplay-flags! inferior redisplay-flags)
+  (vector-set! inferior 4 redisplay-flags))
+
+(unparser/set-tagged-vector-method! %inferior-tag
+  (unparser/standard-method 'INFERIOR
+    (lambda (state inferior)
+      (unparse-object state (inferior-window inferior))
+      (unparse-string state " x,y=(")
+      (unparse-object state (inferior-x-start inferior))
+      (unparse-string state ",")
+      (unparse-object state (inferior-y-start inferior))
+      (unparse-string state ")")
+      (if (inferior-needs-redisplay? inferior)
+	  (unparse-string state " needs-redisplay")))))
+
+(define (inferior-copy inferior)
+  (%make-inferior (inferior-window inferior)
+		  (inferior-x-start inferior)
+		  (inferior-y-start inferior)
+		  (inferior-redisplay-flags inferior)))
+
+(define (inferior-start inferior receiver)
+  (receiver (inferior-x-start inferior)
+	    (inferior-y-start inferior)))
+
+(define (%set-inferior-start! inferior x-start y-start)
+  (%set-inferior-x-start! inferior x-start)
+  (%set-inferior-y-start! inferior y-start))
+
+(define (set-inferior-x-start! inferior x-start)
+  (%set-inferior-x-start! inferior x-start)
+  (inferior-needs-redisplay! inferior))
+
+(define (set-inferior-y-start! inferior y-start)
+  (%set-inferior-y-start! inferior y-start)
+  (inferior-needs-redisplay! inferior))
+
+(define (set-inferior-start! inferior x-start y-start)
+  (%set-inferior-start! inferior x-start y-start)
+  (inferior-needs-redisplay! inferior))
+
+(define-integrable (%inferior-x-end inferior)
+  (fix:+ (inferior-x-start inferior) (inferior-x-size inferior)))
+
+(define-integrable (%inferior-y-end inferior)
+  (fix:+ (inferior-y-start inferior) (inferior-y-size inferior)))
+
+(define (inferior-x-end inferior)
+  (and (inferior-x-start inferior)
+       (%inferior-x-end inferior)))
+
+(define (inferior-y-end inferior)
+  (and (inferior-y-start inferior)
+       (%inferior-y-end inferior)))
+
+(define (set-inferior-x-end! inferior x-end)
+  (set-inferior-x-start! inferior (fix:- x-end (inferior-x-size inferior))))
+
+(define (set-inferior-y-end! inferior y-end)
+  (set-inferior-y-start! inferior (fix:- y-end (inferior-y-size inferior))))
+
 (define (inferior-position inferior)
   (and (inferior-x-start inferior)
-       (inferior-y-start inferior)
        (cons (inferior-x-start inferior)
 	     (inferior-y-start inferior))))
 
@@ -327,19 +425,21 @@
       (set-inferior-start! inferior false false)
       (set-inferior-start! inferior (car position) (cdr position))))
 
+(define-integrable (inferior-needs-redisplay? inferior)
+  (car (inferior-redisplay-flags inferior)))
+
 (define (inferior-needs-redisplay! inferior)
-  (if (and (inferior-x-start inferior)
-	   (inferior-y-start inferior))
+  (if (and (inferior-x-start inferior) (inferior-y-start inferior))
       (setup-redisplay-flags! (inferior-redisplay-flags inferior))
-      (set-car! (inferior-redisplay-flags inferior) false))
-  unspecific)
+      (set-car! (inferior-redisplay-flags inferior) false)))
 
 (define (setup-redisplay-flags! flags)
-  (if (not (or (null? flags) (car flags)))
-      (begin
-	(set-car! flags true)
-	(setup-redisplay-flags! (cdr flags)))))
-
+  (let loop ((flags flags))
+    (if (not (or (null? flags) (car flags)))
+	(begin
+	  (set-car! flags true)
+	  (loop (cdr flags))))))
+
 (define-integrable (inferior-x-size inferior)
   (window-x-size (inferior-window inferior)))
 
@@ -364,6 +464,19 @@
 (define-integrable (set-inferior-size! inferior x y)
   (=> (inferior-window inferior) :set-size! x y))
 
+(define (find-inferior? inferiors window)
+  (let loop ((inferiors inferiors))
+    (and (not (null? inferiors))
+	 (if (eq? window (inferior-window (car inferiors)))
+	     (car inferiors)
+	     (loop (cdr inferiors))))))
+
+(define (find-inferior inferiors window)
+  (let ((inferior (find-inferior? inferiors window)))
+    (if (not inferior)
+	(error "window not in inferiors" window))
+    inferior))
+
 (define (inferior-containing-coordinates window x y stop-search?)
   (let search ((window window) (x x) (y y))
     (if (stop-search? window)
@@ -377,74 +490,10 @@
 		  (if (and x-start y-start)
 		      (let ((x (fix:- x x-start))
 			    (y (fix:- y y-start)))
-			(if (and (not (fix:negative? x))
+			(if (and (fix:<= 0 x)
 				 (fix:< x (inferior-x-size inferior))
-				 (not (fix:negative? y))
+				 (fix:<= 0 y)
 				 (fix:< y (inferior-y-size inferior)))
 			    (search (inferior-window inferior) x y)
 			    (loop (cdr inferiors))))
-		      (loop (cdr inferiors))))))))))
-
-(define-integrable (find-inferior? inferiors window)
-  (assq window inferiors))
-
-(define-integrable (find-inferior inferiors window)
-  (or (find-inferior? inferiors window)
-      (error "Window is not an inferior" window)))
-
-(define-integrable inferior-window car)
-(define-integrable set-inferior-window! set-car!)
-
-(define-integrable (inferior-x-start inferior)
-  (vector-ref (cdr inferior) 0))
-
-(define-integrable (%set-inferior-x-start! inferior x-start)
-  (vector-set! (cdr inferior) 0 x-start))
-
-(define (set-inferior-x-start! inferior x-start)
-  (%set-inferior-x-start! inferior x-start)
-  (inferior-needs-redisplay! inferior))
-
-(define (inferior-x-end inferior)
-  (let ((x-start (inferior-x-start inferior)))
-    (and x-start
-	 (fix:+ x-start (inferior-x-size inferior)))))
-
-(define (set-inferior-x-end! inferior x-end)
-  (set-inferior-x-start! inferior (fix:- x-end (inferior-x-size inferior))))
-
-(define-integrable (inferior-y-start inferior)
-  (vector-ref (cdr inferior) 1))
-
-(define-integrable (%set-inferior-y-start! inferior y-start)
-  (vector-set! (cdr inferior) 1 y-start))
-
-(define (set-inferior-y-start! inferior y-start)
-  (%set-inferior-y-start! inferior y-start)
-  (inferior-needs-redisplay! inferior))
-
-(define (inferior-y-end inferior)
-  (let ((y-start (inferior-y-start inferior)))
-    (and y-start
-	 (fix:+ y-start (inferior-y-size inferior)))))
-
-(define (set-inferior-y-end! inferior y-end)
-  (set-inferior-y-start! inferior (fix:- y-end (inferior-y-size inferior))))
-
-(define (inferior-start inferior receiver)
-  (receiver (inferior-x-start inferior)
-	    (inferior-y-start inferior)))
-
-(define (%set-inferior-start! inferior x-start y-start)
-  (%set-inferior-x-start! inferior x-start)
-  (%set-inferior-y-start! inferior y-start))
-
-(define (set-inferior-start! inferior x-start y-start)
-  (%set-inferior-start! inferior x-start y-start)
-  (inferior-needs-redisplay! inferior))
-
-(define-integrable (inferior-redisplay-flags inferior)
-  (vector-ref (cdr inferior) 2))
-
-(define-integrable (set-inferior-redisplay-flags! inferior flags)
-  (vector-set! (cdr inferior) 2 flags))
\ No newline at end of file
+		      (loop (cdr inferiors))))))))))
\ No newline at end of file
diff --git a/v7/src/edwin/winren.scm b/v7/src/edwin/winren.scm
index 3040ebdea..e46443cc1 100644
--- a/v7/src/edwin/winren.scm
+++ b/v7/src/edwin/winren.scm
@@ -1,6 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	Copyright (c) 1989 Massachusetts Institute of Technology
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/winren.scm,v 1.3 1990/11/02 03:25:09 cph Rel $
+;;;
+;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
 ;;;	This material was developed by the Scheme project at the
 ;;;	Massachusetts Institute of Technology, Department of
@@ -43,9 +45,10 @@
 ;;;; Window System Rename Exports
 
 (declare (usual-integrations))
-
+
 ;; buffrm.scm
 (define window?)
 (define window-x-size)
 (define window-y-size)
+(define window-needs-redisplay?)
 (define %set-window-buffer!)
\ No newline at end of file
diff --git a/v7/src/edwin/xterm.scm b/v7/src/edwin/xterm.scm
index e31ee043d..fb5bec4cf 100644
--- a/v7/src/edwin/xterm.scm
+++ b/v7/src/edwin/xterm.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.12 1990/10/09 16:24:53 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/xterm.scm,v 1.13 1990/11/02 03:25:13 cph Rel $
 ;;;
 ;;;	Copyright (c) 1989, 1990 Massachusetts Institute of Technology
 ;;;
@@ -55,7 +55,6 @@
   (x-display-process-events 2)
   (x-display-sync 2)
   (x-window-beep 1)
-  (x-window-clear 1)
   (x-window-display 1)
   (x-window-set-event-mask 2)
   (x-window-set-icon-name 2)
@@ -67,8 +66,8 @@
   (xterm-open-window 3)
   (xterm-restore-contents 6)
   (xterm-save-contents 5)
-  (xterm-scroll-lines-down 7)
-  (xterm-scroll-lines-up 7)
+  (xterm-scroll-lines-down 6)
+  (xterm-scroll-lines-up 6)
   (xterm-set-size 3)
   (xterm-write-char! 5)
   (xterm-write-cursor! 3)
@@ -98,19 +97,18 @@
 	   (make-screen (make-xterm-screen-state xterm
 						 (x-window-display xterm))
 			xterm-screen/beep
+			xterm-screen/clear-line!
+			xterm-screen/clear-rectangle!
+			xterm-screen/clear-screen!
 			xterm-screen/discard!
 			xterm-screen/enter!
 			xterm-screen/exit!
-			xterm-screen/finish-update!
 			xterm-screen/flush!
-			xterm-screen/inverse-video!
 			xterm-screen/modeline-event!
-			xterm-screen/normal-video!
+			xterm-screen/preempt-update?
 			xterm-screen/scroll-lines-down!
 			xterm-screen/scroll-lines-up!
-			xterm-screen/start-update!
-			xterm-screen/subscreen-clear!
-			xterm-screen/wipe!
+			xterm-screen/wrap-update!
 			xterm-screen/write-char!
 			xterm-screen/write-cursor!
 			xterm-screen/write-substring!
@@ -125,9 +123,6 @@
 (define-integrable (screen-display screen)
   (xterm-screen-state/display (screen-state screen)))
 
-(define-integrable (screen-highlight screen)
-  (if (screen-highlight? screen) 1 0))
-
 (define-integrable (screen-redisplay-flag screen)
   (xterm-screen-state/redisplay-flag (screen-state screen)))
 
@@ -147,19 +142,21 @@
 	     (car screens)
 	     (loop (cdr screens))))))
 
-(define (xterm-screen/start-update! screen)
-  (xterm-enable-cursor (screen-xterm screen) false))
-
-(define (xterm-screen/finish-update! screen)
-  (if (screen-selected? screen)
-      (let ((xterm (screen-xterm screen)))
-	(xterm-enable-cursor xterm true)
-	(xterm-draw-cursor xterm)))
-  (if (screen-redisplay-flag screen)
-      (begin
-	(update-xterm-screen-names! screen)
-	(set-screen-redisplay-flag! screen false)))
-  (xterm-screen/flush! screen))
+(define (xterm-screen/wrap-update! screen thunk)
+  (dynamic-wind
+   (lambda ()
+     (xterm-enable-cursor (screen-xterm screen) false))
+   thunk
+   (lambda ()
+     (if (screen-selected? screen)
+	 (let ((xterm (screen-xterm screen)))
+	   (xterm-enable-cursor xterm true)
+	   (xterm-draw-cursor xterm)))
+     (if (screen-redisplay-flag screen)
+	 (begin
+	   (update-xterm-screen-names! screen)
+	   (set-screen-redisplay-flag! screen false)))
+     (xterm-screen/flush! screen))))
 
 (define (xterm-screen/discard! screen)
   (set! screen-list (delq! screen screen-list))
@@ -183,21 +180,18 @@
     (xterm-erase-cursor xterm))
   (xterm-screen/flush! screen))
 
-(define (xterm-screen/inverse-video! screen)
+(define (xterm-screen/preempt-update? screen y)
   screen				; ignored
-  unspecific)
-
-(define (xterm-screen/normal-video! screen)
-  screen				; ignored
-  unspecific)
+  (fix:= (fix:remainder y 8) 0))
+  
 
 (define (xterm-screen/scroll-lines-down! screen xl xu yl yu amount)
-  (xterm-scroll-lines-down (screen-xterm screen) xl xu yl yu amount 0)
-  true)
+  (xterm-scroll-lines-down (screen-xterm screen) xl xu yl yu amount)
+  'UNCHANGED)
 
 (define (xterm-screen/scroll-lines-up! screen xl xu yl yu amount)
-  (xterm-scroll-lines-up (screen-xterm screen) xl xu yl yu amount 0)
-  true)
+  (xterm-scroll-lines-up (screen-xterm screen) xl xu yl yu amount)
+  'UNCHANGED)
 
 (define (xterm-screen/beep screen)
   (x-window-beep (screen-xterm screen))
@@ -206,22 +200,27 @@
 (define-integrable (xterm-screen/flush! screen)
   (x-display-flush (screen-display screen)))
 
-(define (xterm-screen/write-char! screen x y char)
-  (xterm-write-char! (screen-xterm screen) x y char (screen-highlight screen)))
+(define (xterm-screen/write-char! screen x y char highlight)
+  (xterm-write-char! (screen-xterm screen) x y char (if highlight 1 0)))
 
 (define (xterm-screen/write-cursor! screen x y)
   (xterm-write-cursor! (screen-xterm screen) x y))
 
-(define (xterm-screen/write-substring! screen x y string start end)
+(define (xterm-screen/write-substring! screen x y string start end highlight)
   (xterm-write-substring! (screen-xterm screen) x y string start end
-			  (screen-highlight screen)))
+			  (if highlight 1 0)))
+
+(define (xterm-screen/clear-line! screen x y first-unused-x)
+  (xterm-clear-rectangle! (screen-xterm screen)
+			  x first-unused-x y (fix:1+ y) 0))
 
-(define (xterm-screen/subscreen-clear! screen xl xu yl yu)
-  (xterm-clear-rectangle! (screen-xterm screen) xl xu yl yu
-			  (screen-highlight screen)))
+(define (xterm-screen/clear-rectangle! screen xl xu yl yu highlight)
+  (xterm-clear-rectangle! (screen-xterm screen)
+			  xl xu yl yu (if highlight 1 0)))
 
-(define (xterm-screen/wipe! screen)
-  (x-window-clear (screen-xterm screen)))
+(define (xterm-screen/clear-screen! screen)
+  (xterm-clear-rectangle! (screen-xterm screen)
+			  0 (screen-x-size screen) 0 (screen-y-size screen) 0))
 
 ;;;; Input Port
 
@@ -344,10 +343,10 @@
   (set! pending-interrupt? false)
   (^G-signal))
 
-(define (with-editor-interrupts-from-x thunk)
+(define (with-editor-interrupts-from-x receiver)
   (fluid-let ((signal-interrupts? true)
 	      (pending-interrupt? false))
-    (thunk)))
+    (receiver (lambda (thunk) (thunk)))))
 
 (define (with-x-interrupts-enabled thunk)
   (bind-signal-interrupts? true thunk))
@@ -400,9 +399,7 @@
       (if (not (and (= x-size (screen-x-size screen))
 		    (= y-size (screen-y-size screen))))
 	  (begin
-	    (set-screen-x-size! screen x-size)
-	    (set-screen-y-size! screen y-size)
-	    (send (screen-root-window screen) ':set-size! x-size y-size)
+	    (set-screen-size! screen x-size y-size)
 	    (update-screen! screen true))))))
 
 (define-event-handler event-type:button-down
@@ -433,6 +430,8 @@
 (define x-display-data)
 
 (define (get-x-display)
+  ;; X-OPEN-DISPLAY hangs, uninterruptibly, when the X server is
+  ;; running the login loop of xdm.  Can this be fixed?
   (or x-display-data
       (let ((display (x-open-display false)))
 	(set! x-display-data display)