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!)
|
(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)))
|
||||||
(val-mut! mline new-val)
|
(define val-changed?
|
||||||
(let loop ([node mline])
|
(cond
|
||||||
(let ([parent (mline-parent node)])
|
[(= (val-sel mline) new-val) #f]
|
||||||
(unless (eq? parent NIL)
|
[else
|
||||||
(if (eq? node (mline-left parent))
|
(val-mut! mline new-val)
|
||||||
(begin
|
#t]))
|
||||||
(mut! parent (+ delta (sel parent)))
|
(or (let loop ([node mline])
|
||||||
(loop parent))
|
(let ([parent (mline-parent node)])
|
||||||
(loop parent)))))))
|
(cond
|
||||||
|
[(eq? parent NIL) #f]
|
||||||
|
[else
|
||||||
|
(if (eq? node (mline-left parent))
|
||||||
|
(cond
|
||||||
|
[(= delta 0)
|
||||||
|
(loop parent)]
|
||||||
|
[else
|
||||||
|
(mut! parent (+ delta (sel parent)))
|
||||||
|
(loop parent)
|
||||||
|
#t])
|
||||||
|
(loop parent))])))
|
||||||
|
val-changed?))
|
||||||
|
|
||||||
(define (set-length mline len)
|
(define (set-length mline len)
|
||||||
(adjust mline
|
(adjust mline
|
||||||
|
|
@ -685,38 +697,41 @@
|
||||||
;; ------------------------------------------------------------
|
;; ------------------------------------------------------------
|
||||||
|
|
||||||
(define (adjust-max-width mline [recur? #f])
|
(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 loop ([node mline])
|
||||||
(let ([old (bitwise-and (mline-flags node) MAX-W-MASK)])
|
(define old (bitwise-and (mline-flags node) MAX-W-MASK))
|
||||||
(let ([which
|
(define-values (new-max-width which)
|
||||||
(cond
|
(cond
|
||||||
[(and (not (eq? (mline-right node) NIL))
|
[(and (not (eq? (mline-right node) NIL))
|
||||||
((mline-max-width (mline-right node)) . > . (mline-w node))
|
((mline-max-width (mline-right node)) . > . (mline-w node))
|
||||||
(or (eq? (mline-left node) NIL)
|
(or (eq? (mline-left node) NIL)
|
||||||
((mline-max-width (mline-right node)) . > . (mline-max-width (mline-left node)))))
|
((mline-max-width (mline-right node)) . > . (mline-max-width (mline-left node)))))
|
||||||
(set-mline-max-width! node (mline-max-width (mline-right node)))
|
(values (mline-max-width (mline-right node)) MAX-W-RIGHT)]
|
||||||
MAX-W-RIGHT]
|
[(and (not (eq? (mline-left node) NIL))
|
||||||
[(and (not (eq? (mline-left node) NIL))
|
((mline-max-width (mline-left node)) . > . (mline-w node)))
|
||||||
((mline-max-width (mline-left node)) . > . (mline-w node)))
|
(values (mline-max-width (mline-left node)) MAX-W-LEFT)]
|
||||||
(set-mline-max-width! node (mline-max-width (mline-left node)))
|
[else
|
||||||
MAX-W-LEFT]
|
(values (mline-w node) MAX-W-HERE)]))
|
||||||
[else
|
(unless (= (mline-max-width node) new-max-width)
|
||||||
(set-mline-max-width! node (mline-w node))
|
(set! anything-changed? #t)
|
||||||
MAX-W-HERE])])
|
(set-mline-max-width! node new-max-width))
|
||||||
(unless (= old which)
|
(unless (= old which)
|
||||||
(set-mline-flags! node
|
(set-mline-flags! node
|
||||||
(bitwise-ior
|
(bitwise-ior
|
||||||
(bitwise-and (mline-flags node)
|
(bitwise-and (mline-flags node)
|
||||||
(bitwise-not MAX-W-MASK))
|
(bitwise-not MAX-W-MASK))
|
||||||
which)))
|
which)))
|
||||||
(when recur?
|
(when recur?
|
||||||
(let ([parent (mline-parent node)])
|
(let ([parent (mline-parent node)])
|
||||||
(unless (eq? parent NIL)
|
(unless (eq? parent NIL)
|
||||||
(loop parent)))))))))
|
(loop parent))))))
|
||||||
|
anything-changed?)
|
||||||
|
|
||||||
(define (set-width mline w)
|
(define (set-width mline w)
|
||||||
(set-mline-w! mline w)
|
(define w-same? (= (mline-w mline) w))
|
||||||
(adjust-max-width mline #t))
|
(unless w-same? (set-mline-w! mline w))
|
||||||
|
(or (adjust-max-width mline #t) (not w-same?)))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
|
|
@ -1068,115 +1083,136 @@ Debugging tools:
|
||||||
(flow-left))
|
(flow-left))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(define (update-graphics mline media dc padding-l padding-t max-line-width)
|
(define (update-graphics mline media dc padding-l padding-t max-line-width)
|
||||||
(define (update-left)
|
(define (update-left)
|
||||||
(and (bit-overlap? (mline-flags mline) CALC-LEFT)
|
(cond
|
||||||
(not (eq? (mline-left mline) NIL))
|
[(and (bit-overlap? (mline-flags mline) CALC-LEFT)
|
||||||
(update-graphics (mline-left mline) media dc padding-l padding-t max-line-width)))
|
(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)
|
(define (update-here)
|
||||||
(and
|
(cond
|
||||||
(bit-overlap? (mline-flags mline) CALC-HERE)
|
[(bit-overlap? (mline-flags mline) CALC-HERE)
|
||||||
(let ([y (+ (get-location mline) padding-t)]
|
(let ([y (+ (get-location mline) padding-t)]
|
||||||
[nextsnip (snip->next (mline-last-snip mline))])
|
[nextsnip (snip->next (mline-last-snip mline))]
|
||||||
(let loop ([asnip (mline-snip mline)]
|
[sizing-changed? #f])
|
||||||
[maxbase 0.0]
|
(let loop ([asnip (mline-snip mline)]
|
||||||
[maxdescent 0.0]
|
[maxbase 0.0]
|
||||||
[maxspace 0.0]
|
[maxdescent 0.0]
|
||||||
[maxantidescent 0.0]
|
[maxspace 0.0]
|
||||||
[maxantispace 0.0]
|
[maxantidescent 0.0]
|
||||||
[totalwidth padding-l]
|
[maxantispace 0.0]
|
||||||
[maxscroll 1]
|
[totalwidth padding-l]
|
||||||
[scroll-snip #f]
|
[maxscroll 1]
|
||||||
[last-w 0.0]
|
[scroll-snip #f]
|
||||||
[last-h 0.0])
|
[last-w 0.0]
|
||||||
(if (not (eq? asnip nextsnip))
|
[last-h 0.0])
|
||||||
(let-boxes ([w 0.0]
|
(if (not (eq? asnip nextsnip))
|
||||||
[h 0.0]
|
(let-boxes ([w 0.0]
|
||||||
[descent 0.0]
|
[h 0.0]
|
||||||
[space 0.0])
|
[descent 0.0]
|
||||||
(send asnip get-extent dc totalwidth y w h descent space #f #f)
|
[space 0.0])
|
||||||
(let* ([align (send (snip->style asnip) get-alignment)]
|
(send asnip get-extent dc totalwidth y w h descent space #f #f)
|
||||||
[scroll (send asnip get-num-scroll-steps)]
|
(let* ([align (send (snip->style asnip) get-alignment)]
|
||||||
[maxbase (max maxbase (- h descent space))]
|
[scroll (send asnip get-num-scroll-steps)]
|
||||||
[maxdescent (if (eq? align 'bottom)
|
[maxbase (max maxbase (- h descent space))]
|
||||||
(max maxdescent descent)
|
[maxdescent (if (eq? align 'bottom)
|
||||||
maxdescent)]
|
(max maxdescent descent)
|
||||||
[maxantispace (if (eq? align 'bottom)
|
maxdescent)]
|
||||||
maxantispace
|
[maxantispace (if (eq? align 'bottom)
|
||||||
(max maxantispace (- h space)))]
|
maxantispace
|
||||||
[maxspace (if (eq? align 'top)
|
(max maxantispace (- h space)))]
|
||||||
(max maxspace space)
|
[maxspace (if (eq? align 'top)
|
||||||
maxspace)]
|
(max maxspace space)
|
||||||
[maxantidescent (if (eq? align 'top)
|
maxspace)]
|
||||||
maxantidescent
|
[maxantidescent (if (eq? align 'top)
|
||||||
(max maxantidescent (- h descent)))]
|
maxantidescent
|
||||||
[scroll-snip (if (scroll . > . maxscroll)
|
(max maxantidescent (- h descent)))]
|
||||||
asnip
|
[scroll-snip (if (scroll . > . maxscroll)
|
||||||
scroll-snip)]
|
asnip
|
||||||
[maxscroll (max maxscroll scroll)]
|
scroll-snip)]
|
||||||
[totalwidth (+ w totalwidth)])
|
[maxscroll (max maxscroll scroll)]
|
||||||
(loop (snip->next asnip)
|
[totalwidth (+ w totalwidth)])
|
||||||
maxbase maxdescent maxspace maxantidescent maxantispace
|
(loop (snip->next asnip)
|
||||||
totalwidth maxscroll scroll-snip
|
maxbase maxdescent maxspace maxantidescent maxantispace
|
||||||
w h)))
|
totalwidth maxscroll scroll-snip
|
||||||
(let ([maxspace (max maxspace (- maxantidescent maxbase))]
|
w h)))
|
||||||
[maxdescent (max maxdescent (- maxantispace maxbase))])
|
(let ([maxspace (max maxspace (- maxantidescent maxbase))]
|
||||||
(set-mline-scroll-snip! mline scroll-snip)
|
[maxdescent (max maxdescent (- maxantispace maxbase))])
|
||||||
(set-mline-last-h! mline last-h)
|
(unless (eq? (mline-scroll-snip mline) scroll-snip)
|
||||||
(set-mline-last-w! mline last-w)
|
(set! sizing-changed? #t)
|
||||||
(set-mline-topbase! mline maxspace)
|
(set-mline-scroll-snip! mline scroll-snip))
|
||||||
(set-mline-bottombase! mline (+ maxspace maxbase))
|
(unless (= (mline-last-h mline) last-h)
|
||||||
(let ([maxh (+ maxbase
|
(set! sizing-changed? #t)
|
||||||
maxdescent
|
(set-mline-last-h! mline last-h))
|
||||||
maxspace
|
(unless (= (mline-last-w mline) last-w)
|
||||||
(send media get-s-line-spacing))]
|
(set! sizing-changed? #t)
|
||||||
[bigwidth (+ (if ((mline-w mline) . > . totalwidth)
|
(set-mline-last-w! mline last-w))
|
||||||
(mline-w mline)
|
(unless (= (mline-topbase mline) maxspace)
|
||||||
totalwidth)
|
(set! sizing-changed? #t)
|
||||||
CURSOR-WIDTH
|
(set-mline-topbase! mline maxspace))
|
||||||
(let-boxes ([is-first? #f]
|
(let ([bottombase (+ maxspace maxbase)])
|
||||||
[para #f])
|
(unless (= (mline-bottombase mline) bottombase)
|
||||||
(set-box! para (get-paragraph-style mline is-first?))
|
(set! sizing-changed? #t)
|
||||||
(if is-first?
|
(set-mline-bottombase! mline bottombase)))
|
||||||
(paragraph-left-margin-first para)
|
(let ([maxh (+ maxbase
|
||||||
(paragraph-left-margin para))))])
|
maxdescent
|
||||||
(set-width mline (- totalwidth padding-l))
|
maxspace
|
||||||
(unless (= maxscroll (mline-numscrolls mline))
|
(send media get-s-line-spacing))]
|
||||||
(set-scroll-length mline maxscroll))
|
[bigwidth (+ (if ((mline-w mline) . > . totalwidth)
|
||||||
(define (send-refresh-box w h)
|
(mline-w mline)
|
||||||
(define x-delta
|
totalwidth)
|
||||||
(case (if max-line-width
|
CURSOR-WIDTH
|
||||||
(let-boxes ([is-first? #f]
|
(let-boxes ([is-first? #f]
|
||||||
[para #f])
|
[para #f])
|
||||||
(set-box! para (get-paragraph-style mline is-first?))
|
(set-box! para (get-paragraph-style mline is-first?))
|
||||||
(paragraph-alignment para))
|
(if is-first?
|
||||||
'left)
|
(paragraph-left-margin-first para)
|
||||||
[(left) 0]
|
(paragraph-left-margin para))))])
|
||||||
[(right) (max 0 (- max-line-width w))]
|
(when (set-width mline (- totalwidth padding-l))
|
||||||
[else (max 0 (/ (- max-line-width w) 2))]))
|
(set! sizing-changed? #t))
|
||||||
(send media refresh-box (+ padding-l x-delta) y w h))
|
(unless (= maxscroll (mline-numscrolls mline))
|
||||||
(if (= maxh (mline-h mline))
|
(when (set-scroll-length mline maxscroll)
|
||||||
(send-refresh-box bigwidth maxh)
|
(set! sizing-changed? #t)))
|
||||||
(begin
|
(define (send-refresh-box w h)
|
||||||
(set-height mline maxh)
|
(define x-delta
|
||||||
(let ([bigwidth (max 1e5 ;; really want viewable width, but > ok
|
(case (if max-line-width
|
||||||
(send media get-s-total-width))]
|
(let-boxes ([is-first? #f]
|
||||||
[bigheight (+ maxh (send media get-s-total-height))])
|
[para #f])
|
||||||
(send-refresh-box bigwidth bigheight))))))))
|
(set-box! para (get-paragraph-style mline is-first?))
|
||||||
#t)))
|
(paragraph-alignment para))
|
||||||
|
'left)
|
||||||
|
[(left) 0]
|
||||||
|
[(right) (max 0 (- max-line-width w))]
|
||||||
|
[else (max 0 (/ (- max-line-width w) 2))]))
|
||||||
|
(send media refresh-box (+ padding-l x-delta) y w h))
|
||||||
|
(if (= maxh (mline-h mline))
|
||||||
|
(send-refresh-box bigwidth maxh)
|
||||||
|
(begin
|
||||||
|
(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))))))))
|
||||||
|
(values sizing-changed? #t))]
|
||||||
|
[else (values #f #f)]))
|
||||||
(define (update-right)
|
(define (update-right)
|
||||||
(and (bit-overlap? (mline-flags mline) CALC-RIGHT)
|
(cond
|
||||||
(not (eq? (mline-right mline) NIL))
|
[(and (bit-overlap? (mline-flags mline) CALC-RIGHT)
|
||||||
(update-graphics (mline-right mline) media dc padding-l padding-t max-line-width)))
|
(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)]
|
(define-values (sizing-left? left?) (update-left))
|
||||||
[here? (update-here)]
|
(define-values (sizing-here? here?) (update-here))
|
||||||
[right? (update-right)])
|
(define-values (sizing-right? right?) (update-right))
|
||||||
(set-mline-flags! mline (bitwise-and
|
(set-mline-flags! mline (bitwise-and
|
||||||
(mline-flags mline)
|
(mline-flags mline)
|
||||||
(bitwise-not CALC-MASK)))
|
(bitwise-not CALC-MASK)))
|
||||||
(or left? here? right?)))
|
(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! last-line (mline-last (unbox line-root-box)))
|
||||||
(set! num-valid-lines (mline-number (unbox line-root-box))))
|
(set! num-valid-lines (mline-number (unbox line-root-box))))
|
||||||
|
|
||||||
(let ([-changed?
|
(let*-values ([(snip-sizes-changed? this-changed?)
|
||||||
(or (mline-update-graphics (unbox line-root-box) this dc
|
(mline-update-graphics (unbox line-root-box) this dc
|
||||||
padding-l padding-t
|
padding-l padding-t
|
||||||
max-line-width)
|
max-line-width)]
|
||||||
-changed?)])
|
[(-changed?) (or this-changed? -changed?)])
|
||||||
|
|
||||||
(if (and (not -changed?)
|
(if (and (not -changed?)
|
||||||
(not graphic-maybe-invalid-force?))
|
(not graphic-maybe-invalid-force?))
|
||||||
|
|
@ -4868,8 +4868,8 @@
|
||||||
|
|
||||||
(when (and resized? s-admin)
|
(when (and resized? s-admin)
|
||||||
(send s-admin resized #f))
|
(send s-admin resized #f))
|
||||||
|
(when (or resized? snip-sizes-changed?)
|
||||||
(on-reflow)))))))))))
|
(on-reflow))))))))))))
|
||||||
|
|
||||||
(def/public (on-reflow) (void))
|
(def/public (on-reflow) (void))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue
Block a user