From 15f8cceb901eccd5ce07bb120649ba7d46332134 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 13 Mar 1992 10:52:40 +0000 Subject: [PATCH] * 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. --- v7/src/edwin/buffrm.scm | 31 +++++++++++++++++-------------- v7/src/edwin/bufwin.scm | 21 +++++++++++++-------- v7/src/edwin/modwin.scm | 9 +++++---- v7/src/edwin/window.scm | 34 +++++++++++++++++++--------------- 4 files changed, 54 insertions(+), 41 deletions(-) diff --git a/v7/src/edwin/buffrm.scm b/v7/src/edwin/buffrm.scm index 681fbcb17..c3622b0eb 100644 --- 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)) (define-integrable (window-override-message window) diff --git a/v7/src/edwin/bufwin.scm b/v7/src/edwin/bufwin.scm index 64a7a3168..5685e1eb7 100644 --- 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 2bd0b26d3..8effa0f19 100644 --- 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 2df27ae54..8b200076a 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.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) -- 2.25.1