racket/gui: fix auto-scrollbars for editor GUI
It's possible to go from a state where one scroll bar is needed (vertical or horizontal) to a state where each scrollbar is needed iff the other scrollbar is needed. In that case, the auto-scrollbar algorithm couldn't find either fixpoint and would loop forever.
This commit is contained in:
parent
87facb736f
commit
b041a151e6
|
@ -752,7 +752,7 @@
|
||||||
(begin
|
(begin
|
||||||
(set! given-h-scrolls-per-page -2)
|
(set! given-h-scrolls-per-page -2)
|
||||||
#f)
|
#f)
|
||||||
(let loop ([retval #f])
|
(let loop ([retval #f] [iters 0])
|
||||||
(let-boxes ([sx 0]
|
(let-boxes ([sx 0]
|
||||||
[sy 0])
|
[sy 0])
|
||||||
(get-scroll sx sy)
|
(get-scroll sx sy)
|
||||||
|
@ -806,7 +806,7 @@
|
||||||
|
|
||||||
(set! scroll-offset -scroll-offset)
|
(set! scroll-offset -scroll-offset)
|
||||||
|
|
||||||
(let-values ([(num-scrolls vspp)
|
(let-values ([(vnum-scrolls vspp)
|
||||||
(if (positive? vnum-scrolls)
|
(if (positive? vnum-scrolls)
|
||||||
(let ([num-lines (- (send med num-scroll-lines) 1)])
|
(let ([num-lines (- (send med num-scroll-lines) 1)])
|
||||||
(values vnum-scrolls
|
(values vnum-scrolls
|
||||||
|
@ -908,8 +908,24 @@
|
||||||
(set! scroll-width hnum-scrolls)
|
(set! scroll-width hnum-scrolls)
|
||||||
(set! scroll-height vnum-scrolls)
|
(set! scroll-height vnum-scrolls)
|
||||||
|
|
||||||
|
(when (and go-again? (iters . > . 2))
|
||||||
|
;; we're not reaching a fixpoint, so
|
||||||
|
;; it seems that a horizontal scroll
|
||||||
|
;; is needed iff there's a vertical
|
||||||
|
;; scrollbar; force a fixpoint
|
||||||
|
(cond
|
||||||
|
[(and auto-x? auto-y?)
|
||||||
|
(set! xscroll-on? #f)
|
||||||
|
(set! yscroll-on? #f)]
|
||||||
|
;; I don't think these cases are possible,
|
||||||
|
;; but in case I have it wrong, conservatively
|
||||||
|
;; force scrollbars on.
|
||||||
|
[auto-x? (set! xscroll-on? #t)]
|
||||||
|
[auto-y? (set! yscroll-on? #t)])
|
||||||
|
(show-scrollbars xscroll-on? yscroll-on?))
|
||||||
|
|
||||||
(if go-again?
|
(if go-again?
|
||||||
(loop #t)
|
(loop #t (add1 iters))
|
||||||
#t))))))
|
#t))))))
|
||||||
|
|
||||||
retval)))))))
|
retval)))))))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user