From a8b3f20fa29d4272a7e2b98f3415e9ab163a42ac Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Sat, 16 Mar 1991 08:11:28 +0000 Subject: [PATCH] Implement `predict-y-limited' and use it in place of `predict-y' to guarantee that the bounds on predictions are related to the size of the window rather than the size of the buffer. --- v7/src/edwin/bufwin.scm | 76 +++++++++++++++++++++++++---------------- v7/src/edwin/bufwiu.scm | 72 +++++++++++++++++++++++++------------- v7/src/edwin/bufwmc.scm | 44 ++++++++++++++++++++++-- 3 files changed, 137 insertions(+), 55 deletions(-) diff --git a/v7/src/edwin/bufwin.scm b/v7/src/edwin/bufwin.scm index 95f8f99d9..9a382a6e2 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.288 1991/03/15 23:47:42 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwin.scm,v 1.289 1991/03/16 08:11:28 cph Exp $ ;;; ;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology ;;; @@ -818,34 +818,52 @@ (without-interrupts (lambda () (%guarantee-start-mark! window)))) (define (%guarantee-start-mark! window) - (let* ((index-at! - (lambda (index y) - (with-values (lambda () (predict-start-line window index y)) - (lambda (start y-start) - (set-start-mark! window start y-start))))) - (point-at! (lambda (y) (index-at! (%window-point-index window) y))) - (recenter! (lambda () (point-at! (buffer-window/y-center window))))) - (cond ((not (%window-start-line-mark window)) - (recenter!)) - ((not (%window-line-start-index? window - (%window-start-line-index window))) - (index-at! (%window-start-index window) 0)) - ((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)))))))))) + (let ((index-at! + (lambda (index y) + (with-values (lambda () (predict-start-line window index y)) + (lambda (start y-start) + (set-start-mark! window start y-start)))))) + (if (not (%window-start-line-mark window)) + (index-at! (%window-point-index window) + (buffer-window/y-center window)) + (let ((start-line (%window-start-line-index window))) + (cond ((not (%window-line-start-index? window start-line)) + (index-at! (%window-start-index window) 0)) + ((eq? (%window-point-moved? window) 'SINCE-START-SET) + (let ((point (%window-point-index window))) + (if (or (%window-start-clip-mark window) + (%window-start-changes-mark window) + (not (%window-current-start-mark window)) + (fix:< point (%window-current-start-index window)) + (fix:> point (%window-current-end-index window)) + (fix:< (inferior-y-start + (car (%window-line-inferiors window))) + 0)) + (let ((start-y (%window-start-line-y window)) + (y-size (window-y-size window)) + (scroll-step (ref-variable scroll-step))) + (if (fix:= 0 scroll-step) + (if (not (predict-y-limited window start-line + start-y point + 0 y-size)) + (index-at! point + (buffer-window/y-center window))) + (let ((y + (predict-y-limited window start-line + start-y point + (fix:- 0 scroll-step) + (fix:+ y-size + scroll-step)))) + (cond ((not y) + (index-at! + point + (buffer-window/y-center window))) + ((fix:< y 0) + (index-at! point (fix:+ y scroll-step))) + ((fix:>= y y-size) + (index-at! + point + (fix:- y scroll-step))))))))))))))) (define-variable scroll-step "*The number of lines to try scrolling a window by when point moves out. diff --git a/v7/src/edwin/bufwiu.scm b/v7/src/edwin/bufwiu.scm index 9fe916d59..0fa1bda70 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.14 1991/03/15 23:48:02 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwiu.scm,v 1.15 1991/03/16 08:11:11 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology +;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -171,10 +171,10 @@ (let ((start (%window-current-start-index window)) (end (%window-current-end-index window))) (cond ((and (%window-start-clip-mark window) - (or (not (and (fix:<= (%window-group-start-index window) start) - (fix:<= end (%window-group-end-index window)))) + (or (fix:< start (%window-group-start-index window)) (fix:< (%window-group-start-index window) (%window-start-clip-index window)) + (fix:< (%window-group-end-index window) end) (fix:< (%window-end-clip-index window) (%window-group-end-index window)))) (preserve-nothing! window)) @@ -218,18 +218,14 @@ (generate-line-inferiors window (%window-start-line-index window) (%window-start-line-y window)))) - + (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 () (maybe-scroll window inferiors start wlstart wlsy)) (lambda (inferiors start) (if (null? inferiors) (generate-line-inferiors window wlstart wlsy) @@ -237,12 +233,17 @@ (define-integrable (fill-edges! window inferiors start) (fill-top window (fill-bottom! window inferiors start) start)) - + (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 + (let ((regenerate + (lambda () + (set-line-inferiors! + window + (generate-line-inferiors window wlstart wlsy)))) + (scroll-down (lambda (y-start) (set-line-inferiors! window @@ -284,9 +285,24 @@ (else (scroll-down wlsy))))) ((fix:< wlstart start) - (scroll-down (predict-y window wlstart wlsy start))) + (let ((y + (predict-y-limited window wlstart wlsy start + (inferior-y-start (car inferiors)) + (window-y-size window)))) + (if (not y) + (regenerate) + (scroll-down y)))) (else - (scroll-up (predict-y window wlstart wlsy start))))))) + (let ((y + (predict-y-limited + window wlstart wlsy start + (fix:- 1 + (fix:- (inferior-y-end (car (last-pair inferiors))) + (inferior-y-start (car inferiors)))) + 1))) + (if (not y) + (regenerate) + (scroll-up y)))))))) (define (preserve-top-and-bottom! window start start-changes end-changes end) (let ((wlstart (%window-start-line-index window)) @@ -301,19 +317,12 @@ (set-cdr! middle-tail '()) (with-values (lambda () - (scroll-lines! window - top-inferiors - start - (predict-y window wlstart wlsy start))) + (maybe-scroll window top-inferiors start wlstart wlsy)) (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)))) + (maybe-scroll window bottom-inferiors (fix:+ end-changes 1) + wlstart wlsy)) (lambda (bottom-inferiors bottom-start) (set-line-inferiors! window @@ -333,6 +342,21 @@ bottom-start) top-start))))))))))) +(define (maybe-scroll window inferiors start wlstart wlsy) + (let ((y + (predict-y-limited + window + wlstart + wlsy + start + (fix:- 1 + (fix:- (inferior-y-end (car (last-pair inferiors))) + (inferior-y-start (car inferiors)))) + (window-y-size window)))) + (if (not y) + (values '() start) + (scroll-lines! window inferiors start y)))) + (define (changed-inferiors-tail inferiors end end-changes) (let find-end ((inferiors inferiors) diff --git a/v7/src/edwin/bufwmc.scm b/v7/src/edwin/bufwmc.scm index dcc3da2c6..6a9eed1e3 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.8 1990/11/02 03:23:08 cph Rel $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/bufwmc.scm,v 1.9 1991/03/16 08:10:55 cph Exp $ ;;; -;;; Copyright (c) 1986, 1989, 1990 Massachusetts Institute of Technology +;;; Copyright (c) 1986, 1989-91 Massachusetts Institute of Technology ;;; ;;; This material was developed by the Scheme project at the ;;; Massachusetts Institute of Technology, Department of @@ -228,6 +228,46 @@ (fix:+ y (%window-column->y-size window columns))) (fix:+ y (%window-line-y window columns start index)))))))) +(define (predict-y-limited window start y index yl yu) + ;; Like PREDICT-Y, except returns #F if the result is not in the + ;; range specified by YL and YU. Prevents long search to find INDEX + ;; when it is far away from the window. + (cond ((fix:= index start) + (and (fix:<= yl y) + (fix:< y yu) + y)) + ((fix:< index start) + (let loop ((start start) (y y)) + (and (fix:<= yl 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) + (let ((y + (fix:+ y + (%window-line-y window columns start + index)))) + (and (fix:<= yl y) + (fix:< y yu) + y))))))) + (else + (let loop ((start start) (y y)) + (and (fix:< y yu) + (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:<= yl y) + (fix:< y yu) + y))))))))) + (define (predict-index-visible? window start y index) (and (fix:>= index start) (let ((y-size (window-y-size window))) -- 2.25.1