* Change all places that call UPDATE-INFERIOR! to test the redisplay

  flags before doing the call.  Change UPDATE-INFERIOR! to eliminate
  the test.  This change avoids a close-coded call with many arguments
  if it is unnecessary.

* Many of the low-level :UPDATE-DISPLAY! methods always return #T.
  Take advantage of this fact to eliminate unnecessary tests in the
  callers.

* WINDOW-MODELINE-EVENT! was informing the modeline window of the
  event by means of a message.  Change this to a procedure call.

* Change WINDOW-NEEDS-REDISPLAY! and INFERIOR-NEEDS-REDISPLAY! to
  avoid close-coded call to SETUP-REDISPLAY-FLAGS! when it is
  unnecessary.

* Add declarations to cause CLIP-WINDOW-REGION-1 to be open-coded.
  This eliminates two close-coded calls and generation of a closure
  over many variables.

diff --git a/v7/src/edwin/buffrm.scm b/v7/src/edwin/buffrm.scm
index 681fbcb172e04c1f8f160eedc7ae88bde37158ec..c3622b0eb0dc3e39f8cab892417715515391d22c 100644 (file)
--- a/v7/src/edwin/buffrm.scm
+++ b/v7/src/edwin/buffrm.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.40 1991/05/10 22:18:47 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/buffrm.scm,v 1.41 1992/03/13 10:52:38 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -88,17 +88,20 @@
 (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!)))
+  (if (or display-style (inferior-needs-redisplay? text-inferior))
+      (update-inferior! text-inferior screen x-start y-start
+                       xl xu yl yu display-style
+                       buffer-window:update-display!))
+  (if (and modeline-inferior
+          (or display-style (inferior-needs-redisplay? modeline-inferior)))
+      (update-inferior! modeline-inferior screen x-start y-start
+                       xl xu yl yu display-style
+                       modeline-window:update-display!))
+  (if (or display-style (inferior-needs-redisplay? border-inferior))
+      (update-inferior! border-inferior screen x-start y-start
+                       xl xu yl yu display-style
+                       vertical-border-window:update-display!))
+  true)
 
 (define (initial-modeline! frame modeline?)
   ;; **** Kludge: The text-inferior will generate modeline events, so
@@ -217,7 +220,7 @@
 (define (window-modeline-event! frame type)
   (with-instance-variables buffer-frame frame (type)
     (if modeline-inferior
-       (=> (inferior-window modeline-inferior) :event! type)))
+       (modeline-window:event! (inferior-window modeline-inferior) type)))
   (screen-modeline-event! (window-screen frame) frame type))
 \f
 (define-integrable (window-override-message window)

diff --git a/v7/src/edwin/bufwin.scm b/v7/src/edwin/bufwin.scm
index 64a7a3168b67c5b18923376df6ee7ec9800411a4..5685e1eb7f950b9ef8247c2d1ff51ed124dfd947 100644 (file)
--- a/v7/src/edwin/bufwin.scm
+++ b/v7/src/edwin/bufwin.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.295 1991/05/18 03:25:34 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.296 1992/03/13 10:52:39 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -724,12 +724,17 @@
   (if (%window-override-string window)
       (update-override-string! window screen x-start y-start xl xu yl yu)
       (update-outlines! window))
-  (and (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!)))
+  (let ((inferior (%window-blank-inferior window)))
+    (if (or display-style (inferior-needs-redisplay? inferior))
+       (update-inferior! inferior screen x-start y-start
+                         xl xu yl yu display-style
+                         blank-window:update-display!)))
+  (let ((inferior (%window-cursor-inferior window)))
+    (if (or display-style (inferior-needs-redisplay? inferior))
+       (update-inferior! inferior screen x-start y-start
+                         xl xu yl yu display-style
+                         cursor-window:update-display!)))
+  true)
 
 (define (buffer-window/redraw! window)
   (if (%window-debug-trace window)

diff --git a/v7/src/edwin/modwin.scm b/v7/src/edwin/modwin.scm
index 2bd0b26d37b3a798b01356e3002e1a8f1912f86e..8effa0f19264859dac52a49a592e37013f1d48e0 100644 (file)
--- a/v7/src/edwin/modwin.scm
+++ b/v7/src/edwin/modwin.scm
@@ -1,8 +1,8 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modwin.scm,v 1.38 1991/07/02 18:56:18 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/modwin.scm,v 1.39 1992/03/13 10:52:39 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -76,6 +76,7 @@
   true
   boolean?)
 
-(define-method modeline-window (:event! window type)
+(define (modeline-window:event! window type)
   type                                 ;ignored
-  (setup-redisplay-flags! redisplay-flags))
\ No newline at end of file
+  (with-instance-variables modeline-window window ()
+    (setup-redisplay-flags! redisplay-flags)))
\ No newline at end of file

diff --git a/v7/src/edwin/window.scm b/v7/src/edwin/window.scm
index 2df27ae5403c4171090894d66a17cfe0056f1634..8b200076a0ed1d9212aff69ac3606dda98f34ced 100644 (file)
--- 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.154 1991/03/16 00:03:11 cph Exp $
+;;;    $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/window.scm,v 1.155 1992/03/13 10:52:40 cph Exp $
 ;;;
-;;;    Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology
+;;;    Copyright (c) 1986, 1989-92 Massachusetts Institute of Technology
 ;;;
 ;;;    This material was developed by the Scheme project at the
 ;;;    Massachusetts Institute of Technology, Department of
@@ -149,7 +149,8 @@
   (car (window-redisplay-flags window)))
 
 (define-integrable (window-needs-redisplay! window)
-  (setup-redisplay-flags! (window-redisplay-flags window)))
+  (if (not (car (window-redisplay-flags window)))
+      (setup-redisplay-flags! (window-redisplay-flags window))))
 
 (define-integrable (window-inferior? window window*)
   (find-inferior? (window-inferiors window) window*))
@@ -209,29 +210,29 @@
                                display-style)
   (update-inferiors! (window-inferiors window) screen x-start y-start
                     xl xu yl yu display-style
-    (let ((halt-update? (editor-halt-update? current-editor)))
-      (lambda (window screen x-start y-start xl xu yl yu display-style)
-       (and (or display-style (not (halt-update?)))
-            (=> window :update-display! 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 ((editor-halt-update? current-editor))))
+          (=> 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)
+       (and (or (not (or display-style
+                         (inferior-needs-redisplay? (car inferiors))))
+                (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)
+  ;; Assumes (OR DISPLAY-STYLE (INFERIOR-NEEDS-REDISPLAY? INFERIOR))
   (let ((window (inferior-window inferior))
        (xi (inferior-x-start inferior))
-       (yi (inferior-y-start inferior))
-       (flags (inferior-redisplay-flags inferior)))
+       (yi (inferior-y-start 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)
@@ -244,10 +245,12 @@
                              screen (fix:+ x-start xi) (fix:+ y-start yi)
                              xl xu yl yu display-style))))))
         (begin
-          (set-car! flags false)
+          (set-car! (inferior-redisplay-flags inferior) false)
           true))))
 
+(declare (integrate-operator clip-window-region-1))
 (define (clip-window-region-1 al au bs receiver)
+  (declare (integrate al au bs))
   (if (fix:< 0 al)
       (if (fix:< au bs)
          (if (fix:< al au) (receiver al au) true)
@@ -431,7 +434,8 @@
 
 (define (inferior-needs-redisplay! inferior)
   (if (and (inferior-x-start inferior) (inferior-y-start inferior))
-      (setup-redisplay-flags! (inferior-redisplay-flags inferior))
+      (if (not (car (inferior-redisplay-flags inferior)))
+         (setup-redisplay-flags! (inferior-redisplay-flags inferior)))
       (set-car! (inferior-redisplay-flags inferior) false)))
 
 (define (setup-redisplay-flags! flags)