Adjust text%s so they don't call on-reflow as often
Specifically, when a style change happens that ends up not changing the size of anything, then track that lack of size change enough to be able to avoid calling on-reflow. This is important for the interaction between the colorer and the search bubbles in DrRacket. That is, when you make an edit that causes the colorer to have lots of work, then each chunk of work it does before yielding control to the event loop would also trigger a call to on-reflow, which would cause the search bubbles to recompute their sizes. Overall, the main bad thing this does is cause lots of allocation and aside from that it doesn't hurt interactivity. Still, there is a lot of useless work here, and those extra GCs can be pretty substantial when you're doing something crazy like searching for " " in a big file.... (there are 95k spaces in unit.rkt, in case you were curious) original commit: 0264d3d5adca4a85f1fad65a89165184f5286459
This commit is contained in:
Robby Findler
parent
33826c1585
commit
f3b9e2ed13
|
|
@ -601,16 +601,28 @@
|
|||
;; ----------------------------------------
|
||||
|
||||
(define (adjust mline new-val val-sel val-mut! sel mut!)
|
||||
(let ([delta (- new-val (val-sel mline))])
|
||||
(define delta (- new-val (val-sel mline)))
|
||||
(define val-changed?
|
||||
(cond
|
||||
[(= (val-sel mline) new-val) #f]
|
||||
[else
|
||||
(val-mut! mline new-val)
|
||||
(let loop ([node mline])
|
||||
#t]))
|
||||
(or (let loop ([node mline])
|
||||
(let ([parent (mline-parent node)])
|
||||
(unless (eq? parent NIL)
|
||||
(cond
|
||||
[(eq? parent NIL) #f]
|
||||
[else
|
||||
(if (eq? node (mline-left parent))
|
||||
(begin
|
||||
(cond
|
||||
[(= delta 0)
|
||||
(loop parent)]
|
||||
[else
|
||||
(mut! parent (+ delta (sel parent)))
|
||||
(loop parent))
|
||||
(loop parent)))))))
|
||||
(loop parent)
|
||||
#t])
|
||||
(loop parent))])))
|
||||
val-changed?))
|
||||
|
||||
(define (set-length mline len)
|
||||
(adjust mline
|
||||
|
|
@ -685,24 +697,25 @@
|
|||
;; ------------------------------------------------------------
|
||||
|
||||
(define (adjust-max-width mline [recur? #f])
|
||||
(when (not (eq? mline NIL))
|
||||
(define anything-changed? #f)
|
||||
(unless (eq? mline NIL)
|
||||
(let loop ([node mline])
|
||||
(let ([old (bitwise-and (mline-flags node) MAX-W-MASK)])
|
||||
(let ([which
|
||||
(define old (bitwise-and (mline-flags node) MAX-W-MASK))
|
||||
(define-values (new-max-width which)
|
||||
(cond
|
||||
[(and (not (eq? (mline-right node) NIL))
|
||||
((mline-max-width (mline-right node)) . > . (mline-w node))
|
||||
(or (eq? (mline-left node) NIL)
|
||||
((mline-max-width (mline-right node)) . > . (mline-max-width (mline-left node)))))
|
||||
(set-mline-max-width! node (mline-max-width (mline-right node)))
|
||||
MAX-W-RIGHT]
|
||||
(values (mline-max-width (mline-right node)) MAX-W-RIGHT)]
|
||||
[(and (not (eq? (mline-left node) NIL))
|
||||
((mline-max-width (mline-left node)) . > . (mline-w node)))
|
||||
(set-mline-max-width! node (mline-max-width (mline-left node)))
|
||||
MAX-W-LEFT]
|
||||
(values (mline-max-width (mline-left node)) MAX-W-LEFT)]
|
||||
[else
|
||||
(set-mline-max-width! node (mline-w node))
|
||||
MAX-W-HERE])])
|
||||
(values (mline-w node) MAX-W-HERE)]))
|
||||
(unless (= (mline-max-width node) new-max-width)
|
||||
(set! anything-changed? #t)
|
||||
(set-mline-max-width! node new-max-width))
|
||||
(unless (= old which)
|
||||
(set-mline-flags! node
|
||||
(bitwise-ior
|
||||
|
|
@ -712,11 +725,13 @@
|
|||
(when recur?
|
||||
(let ([parent (mline-parent node)])
|
||||
(unless (eq? parent NIL)
|
||||
(loop parent)))))))))
|
||||
(loop parent))))))
|
||||
anything-changed?)
|
||||
|
||||
(define (set-width mline w)
|
||||
(set-mline-w! mline w)
|
||||
(adjust-max-width mline #t))
|
||||
(define w-same? (= (mline-w mline) w))
|
||||
(unless w-same? (set-mline-w! mline w))
|
||||
(or (adjust-max-width mline #t) (not w-same?)))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
|
|
@ -1068,17 +1083,19 @@ Debugging tools:
|
|||
(flow-left))
|
||||
|
||||
;; ----------------------------------------
|
||||
|
||||
(define (update-graphics mline media dc padding-l padding-t max-line-width)
|
||||
(define (update-left)
|
||||
(and (bit-overlap? (mline-flags mline) CALC-LEFT)
|
||||
(not (eq? (mline-left mline) NIL))
|
||||
(update-graphics (mline-left mline) media dc padding-l padding-t max-line-width)))
|
||||
(cond
|
||||
[(and (bit-overlap? (mline-flags mline) CALC-LEFT)
|
||||
(not (eq? (mline-left mline) NIL)))
|
||||
(update-graphics (mline-left mline) media dc padding-l padding-t max-line-width)]
|
||||
[else (values #f #f)]))
|
||||
(define (update-here)
|
||||
(and
|
||||
(bit-overlap? (mline-flags mline) CALC-HERE)
|
||||
(cond
|
||||
[(bit-overlap? (mline-flags mline) CALC-HERE)
|
||||
(let ([y (+ (get-location mline) padding-t)]
|
||||
[nextsnip (snip->next (mline-last-snip mline))])
|
||||
[nextsnip (snip->next (mline-last-snip mline))]
|
||||
[sizing-changed? #f])
|
||||
(let loop ([asnip (mline-snip mline)]
|
||||
[maxbase 0.0]
|
||||
[maxdescent 0.0]
|
||||
|
|
@ -1122,11 +1139,22 @@ Debugging tools:
|
|||
w h)))
|
||||
(let ([maxspace (max maxspace (- maxantidescent maxbase))]
|
||||
[maxdescent (max maxdescent (- maxantispace maxbase))])
|
||||
(set-mline-scroll-snip! mline scroll-snip)
|
||||
(set-mline-last-h! mline last-h)
|
||||
(set-mline-last-w! mline last-w)
|
||||
(set-mline-topbase! mline maxspace)
|
||||
(set-mline-bottombase! mline (+ maxspace maxbase))
|
||||
(unless (eq? (mline-scroll-snip mline) scroll-snip)
|
||||
(set! sizing-changed? #t)
|
||||
(set-mline-scroll-snip! mline scroll-snip))
|
||||
(unless (= (mline-last-h mline) last-h)
|
||||
(set! sizing-changed? #t)
|
||||
(set-mline-last-h! mline last-h))
|
||||
(unless (= (mline-last-w mline) last-w)
|
||||
(set! sizing-changed? #t)
|
||||
(set-mline-last-w! mline last-w))
|
||||
(unless (= (mline-topbase mline) maxspace)
|
||||
(set! sizing-changed? #t)
|
||||
(set-mline-topbase! mline maxspace))
|
||||
(let ([bottombase (+ maxspace maxbase)])
|
||||
(unless (= (mline-bottombase mline) bottombase)
|
||||
(set! sizing-changed? #t)
|
||||
(set-mline-bottombase! mline bottombase)))
|
||||
(let ([maxh (+ maxbase
|
||||
maxdescent
|
||||
maxspace
|
||||
|
|
@ -1141,9 +1169,11 @@ Debugging tools:
|
|||
(if is-first?
|
||||
(paragraph-left-margin-first para)
|
||||
(paragraph-left-margin para))))])
|
||||
(set-width mline (- totalwidth padding-l))
|
||||
(when (set-width mline (- totalwidth padding-l))
|
||||
(set! sizing-changed? #t))
|
||||
(unless (= maxscroll (mline-numscrolls mline))
|
||||
(set-scroll-length mline maxscroll))
|
||||
(when (set-scroll-length mline maxscroll)
|
||||
(set! sizing-changed? #t)))
|
||||
(define (send-refresh-box w h)
|
||||
(define x-delta
|
||||
(case (if max-line-width
|
||||
|
|
@ -1159,23 +1189,29 @@ Debugging tools:
|
|||
(if (= maxh (mline-h mline))
|
||||
(send-refresh-box bigwidth maxh)
|
||||
(begin
|
||||
(set-height mline maxh)
|
||||
(when (set-height mline maxh)
|
||||
(set! sizing-changed? #t))
|
||||
(let ([bigwidth (max 1e5 ;; really want viewable width, but > ok
|
||||
(send media get-s-total-width))]
|
||||
[bigheight (+ maxh (send media get-s-total-height))])
|
||||
(send-refresh-box bigwidth bigheight))))))))
|
||||
#t)))
|
||||
(values sizing-changed? #t))]
|
||||
[else (values #f #f)]))
|
||||
(define (update-right)
|
||||
(and (bit-overlap? (mline-flags mline) CALC-RIGHT)
|
||||
(not (eq? (mline-right mline) NIL))
|
||||
(update-graphics (mline-right mline) media dc padding-l padding-t max-line-width)))
|
||||
(cond
|
||||
[(and (bit-overlap? (mline-flags mline) CALC-RIGHT)
|
||||
(not (eq? (mline-right mline) NIL)))
|
||||
(update-graphics (mline-right mline) media dc padding-l padding-t max-line-width)]
|
||||
[else
|
||||
(values #f #f)]))
|
||||
|
||||
(let ([left? (update-left)]
|
||||
[here? (update-here)]
|
||||
[right? (update-right)])
|
||||
(define-values (sizing-left? left?) (update-left))
|
||||
(define-values (sizing-here? here?) (update-here))
|
||||
(define-values (sizing-right? right?) (update-right))
|
||||
(set-mline-flags! mline (bitwise-and
|
||||
(mline-flags mline)
|
||||
(bitwise-not CALC-MASK)))
|
||||
(values (or sizing-left? sizing-here? sizing-right?)
|
||||
(or left? here? right?)))
|
||||
|
||||
;; ------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -4803,11 +4803,11 @@
|
|||
(set! last-line (mline-last (unbox line-root-box)))
|
||||
(set! num-valid-lines (mline-number (unbox line-root-box))))
|
||||
|
||||
(let ([-changed?
|
||||
(or (mline-update-graphics (unbox line-root-box) this dc
|
||||
(let*-values ([(snip-sizes-changed? this-changed?)
|
||||
(mline-update-graphics (unbox line-root-box) this dc
|
||||
padding-l padding-t
|
||||
max-line-width)
|
||||
-changed?)])
|
||||
max-line-width)]
|
||||
[(-changed?) (or this-changed? -changed?)])
|
||||
|
||||
(if (and (not -changed?)
|
||||
(not graphic-maybe-invalid-force?))
|
||||
|
|
@ -4868,8 +4868,8 @@
|
|||
|
||||
(when (and resized? s-admin)
|
||||
(send s-admin resized #f))
|
||||
|
||||
(on-reflow)))))))))))
|
||||
(when (or resized? snip-sizes-changed?)
|
||||
(on-reflow))))))))))))
|
||||
|
||||
(def/public (on-reflow) (void))
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user