* (update-screen!): Clear the NEEDS-UPDATE? of the screen if the

  update finishes properly.

* (screen-force-update): Fix typo that caused the new and current
  matrix lines of highlighted text to become EQ?.

* (with-screen-in-update): Eliminate UNWIND-PROTECT since interrupts
  are locked while it executes and any errors in the redisplay
  indicate a serious problem that makes the UNWIND-PROTECT
  uninteresting.

* (with-screen-in-update): Avoid calling SCREEN-UPDATE if the screen's
  NEEDS-UPDATE? flag is not set.

* (with-screen-in-update, screen-update): Don't update the cursor
  position unless the screen update finishes and the cursor has moved.

* (screen-update): Avoid use of FIX:REMAINDER, which is not open-coded
  on the MIPS.

* (screen-update): Change meaning of PREEMPTION-MODULUS so that it
  counts the number of updated lines rather than the number of lines.
  This avoids unnecessary work when only a few lines need changing,
  such as when only the modeline or typein window is being updated.
  Because of this change, eliminate DEBUG-PREEMPTION-Y from the SCREEN
  structure since it is no longer easy to simulate preemption like
  this (and this debugging tool was never needed).

* (update-line-highlight): When comparing old and new lines, don't
  consider short matches since it is usually cheaper to ignore them.
  This has already been done for the no-highlight case and should have
  been done for this case at that time.

diff --git a/v7/src/edwin/screen.scm b/v7/src/edwin/screen.scm
index 3eeaa0a720c4063d802c5001c3cc9993dfd1ea5d..1cafa2b7f1536cc151d19eca285fa6270baaf0a0 100644 (file)
--- 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.96 1992/02/08 15:23:40 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/screen.scm,v 1.97 1992/03/13 10:47:39 cph Exp $
 ;;;
 ;;;    Copyright (c) 1989-92 Massachusetts Institute of Technology
 ;;;
@@ -99,9 +99,6 @@
   ;; 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))
 
@@ -170,16 +167,16 @@
   (eq? 'DELETED (screen-visibility screen)))
 
 (define (update-screen! screen display-style)
-  (if (screen-visible? screen)
-      (begin
-       (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))))
-      (begin
-       (set-screen-needs-update?! screen false)
-       true)))
+  (and (or (not (screen-visible? screen))
+          (begin
+            (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)))))
+       (begin
+        (set-screen-needs-update?! screen false)
+        true)))
 \f
 ;;; Interface from update optimizer to terminal:
 
@@ -520,7 +517,7 @@
              (boolean-vector-set! new-enable y true)
              (if (boolean-vector-ref current-hl-enable y)
                  (begin
-                   (let ((h (vector-ref current-hl y)))
+                   (let ((h (vector-ref new-hl y)))
                      (vector-set! new-hl y (vector-ref current-hl y))
                      (vector-set! current-hl y h))
                    (boolean-vector-set! new-hl-enable y true)))))
@@ -623,18 +620,30 @@
 (define (with-screen-in-update screen display-style thunk)
   (without-interrupts
    (lambda ()
-     (let ((old-flag))
-       (unwind-protect (lambda ()
-                        (set! old-flag (screen-in-update? screen))
-                        (set-screen-in-update?! screen true))
-                      (lambda ()
-                        ((screen-operation/wrap-update! screen)
-                         screen
-                         (lambda ()
-                           (and (thunk)
-                                (screen-update screen display-style)))))
-                      (lambda ()
-                        (set-screen-in-update?! screen old-flag)))))))
+     (let ((old-flag (screen-in-update? screen)))
+       (set-screen-in-update?! screen true)
+       (let ((finished?
+             ((screen-operation/wrap-update! screen)
+              screen
+              (lambda ()
+                (and (thunk)
+                     (or (not (screen-needs-update? screen))
+                         (screen-update screen display-style))
+                     (begin
+                       (screen-update-cursor screen)
+                       true))))))
+        (set-screen-in-update?! screen old-flag)
+        finished?)))))
+
+(define-integrable (screen-update-cursor screen)
+  (let ((x (matrix-cursor-x (screen-new-matrix screen)))
+       (y (matrix-cursor-y (screen-new-matrix screen))))
+    (if (not (and (fix:= x (matrix-cursor-x (screen-current-matrix screen)))
+                 (fix:= y (matrix-cursor-y (screen-current-matrix screen)))))
+       (begin
+         (terminal-move-cursor screen x y)
+         (set-matrix-cursor-x! (screen-current-matrix screen) x)
+         (set-matrix-cursor-y! (screen-current-matrix screen) y)))))
 
 (define (screen-update screen force?)
   ;; Update the actual terminal screen based on the data in `new-matrix'.
@@ -649,33 +658,24 @@
        (discretionary-flush (screen-operation/discretionary-flush screen))
        (halt-update? (editor-halt-update? current-editor)))
     (let ((enable (matrix-enable new-matrix)))
-      (let loop ((y 0))
+      (let loop ((y 0) (m 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 (fix:= 0 (fix:remainder y preemption-modulus))
-                   (begin
-                     (if discretionary-flush (discretionary-flush screen))
-                     true)
-                   (not force?)
-                   (or (halt-update?)
-                       (eq? (screen-debug-preemption-y screen) y)))
-              (terminal-move-cursor screen
-                                    (matrix-cursor-x current-matrix)
-                                    (matrix-cursor-y current-matrix))
+             ((not (boolean-vector-ref enable y))
+              (loop (fix:+ y 1) m))
+             ((not (fix:= 0 m))
+              (update-line screen y)
+              (loop (fix:+ y 1) (fix:- m 1)))
+             ((begin
+                (if discretionary-flush (discretionary-flush screen))
+                (and (not force?) (halt-update?)))
               (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))))))))
+              (update-line screen y)
+              (loop (fix:+ y 1) preemption-modulus)))))))
 \f
 (define (update-line screen y)
   (let ((current-matrix (screen-current-matrix screen))
@@ -815,17 +815,29 @@
              (let find-match ((x* (fix:+ x 1)))
                (cond ((fix:= x* x-size)
                       (terminal-output-substring screen x y nline x x* hl))
-                     ((or (not (eq? hl (boolean-vector-ref nhl x*)))
-                          (and (eq? hl (boolean-vector-ref ohl x*))
-                               (fix:= (vector-8b-ref oline x*)
-                                      (vector-8b-ref nline x*))))
-                      ;; Either found a match, or the highlight
-                      ;; changed.  In either case, output the current
-                      ;; segment and continue from the top.
+                     ((not (eq? hl (boolean-vector-ref nhl x*)))
                       (terminal-output-substring screen x y nline x x* hl)
                       (find-mismatch x*))
+                     ((not (and (eq? hl (boolean-vector-ref ohl x*))
+                                (fix:= (vector-8b-ref oline x*)
+                                       (vector-8b-ref nline x*))))
+                      (find-match (fix:+ x* 1)))
                      (else
-                      (find-match (fix:+ x* 1))))))))))
+                      (let find-end-match ((x** (fix:+ x* 1)))
+                        (cond ((fix:= x** x-size)
+                               (terminal-output-substring
+                                screen x y nline x x* hl))
+                              ((and (eq? hl (boolean-vector-ref ohl x**))
+                                    (fix:= (vector-8b-ref oline x**)
+                                           (vector-8b-ref nline x**)))
+                               (find-end-match (fix:+ x** 1)))
+                              ((fix:< (fix:- x** x*) 5)
+                               ;; Ignore matches of 4 chars or less.
+                               (find-match x**))
+                              (else
+                               (terminal-output-substring
+                                screen x y nline x x* hl)
+                               (find-mismatch x**))))))))))))
 \f
 (define-integrable (fix:min x y) (if (fix:< x y) x y))
 (define-integrable (fix:max x y) (if (fix:> x y) x y))