suzanne.soy/gui
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Adjust text%s so they don't call on-reflow as often

Browse Source 
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 2012-11-23 19:50:27 -06:00
parent 33826c1585
commit f3b9e2ed13
2 changed files with 186 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
collects/mred/private/wxme/mline.rkt
View File

@ -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)))
(define val-changed?
(cond
[(= (val-sel mline) new-val) #f]
[else
(val-mut! mline new-val) (val-mut! mline new-val)
(let loop ([node mline]) #t]))
(or (let loop ([node mline])
(let ([parent (mline-parent node)]) (let ([parent (mline-parent node)])
(unless (eq? parent NIL) (cond
[(eq? parent NIL) #f]
[else
(if (eq? node (mline-left parent)) (if (eq? node (mline-left parent))
(begin (cond
[(= delta 0)
(loop parent)]
[else
(mut! parent (+ delta (sel parent))) (mut! parent (+ delta (sel parent)))
(loop parent)) (loop parent)
(loop parent))))))) #t])
(loop parent))])))
val-changed?))
(define (set-length mline len) (define (set-length mline len)
(adjust mline (adjust mline
@ -685,24 +697,25 @@
;; ------------------------------------------------------------ ;; ------------------------------------------------------------
(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)))
(set-mline-max-width! node (mline-max-width (mline-left node))) (values (mline-max-width (mline-left node)) MAX-W-LEFT)]
MAX-W-LEFT]
[else [else
(set-mline-max-width! node (mline-w node)) (values (mline-w node) MAX-W-HERE)]))
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) (unless (= old which)
(set-mline-flags! node (set-mline-flags! node
(bitwise-ior (bitwise-ior
@ -712,11 +725,13 @@
(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,17 +1083,19 @@ 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))]
[sizing-changed? #f])
(let loop ([asnip (mline-snip mline)] (let loop ([asnip (mline-snip mline)]
[maxbase 0.0] [maxbase 0.0]
[maxdescent 0.0] [maxdescent 0.0]
@ -1122,11 +1139,22 @@ Debugging tools:
w h))) w h)))
(let ([maxspace (max maxspace (- maxantidescent maxbase))] (let ([maxspace (max maxspace (- maxantidescent maxbase))]
[maxdescent (max maxdescent (- maxantispace maxbase))]) [maxdescent (max maxdescent (- maxantispace maxbase))])
(set-mline-scroll-snip! mline scroll-snip) (unless (eq? (mline-scroll-snip mline) scroll-snip)
(set-mline-last-h! mline last-h) (set! sizing-changed? #t)
(set-mline-last-w! mline last-w) (set-mline-scroll-snip! mline scroll-snip))
(set-mline-topbase! mline maxspace) (unless (= (mline-last-h mline) last-h)
(set-mline-bottombase! mline (+ maxspace maxbase)) (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 (let ([maxh (+ maxbase
maxdescent maxdescent
maxspace maxspace
@ -1141,9 +1169,11 @@ Debugging tools:
(if is-first? (if is-first?
(paragraph-left-margin-first para) (paragraph-left-margin-first para)
(paragraph-left-margin 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)) (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 (send-refresh-box w h)
(define x-delta (define x-delta
(case (if max-line-width (case (if max-line-width
@ -1159,23 +1189,29 @@ Debugging tools:
(if (= maxh (mline-h mline)) (if (= maxh (mline-h mline))
(send-refresh-box bigwidth maxh) (send-refresh-box bigwidth maxh)
(begin (begin
(set-height mline maxh) (when (set-height mline maxh)
(set! sizing-changed? #t))
(let ([bigwidth (max 1e5 ;; really want viewable width, but > ok (let ([bigwidth (max 1e5 ;; really want viewable width, but > ok
(send media get-s-total-width))] (send media get-s-total-width))]
[bigheight (+ maxh (send media get-s-total-height))]) [bigheight (+ maxh (send media get-s-total-height))])
(send-refresh-box bigwidth bigheight)))))))) (send-refresh-box bigwidth bigheight))))))))
#t))) (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)))
(values (or sizing-left? sizing-here? sizing-right?)
(or left? here? right?))) (or left? here? right?)))
;; ------------------------------------------------------------ ;; ------------------------------------------------------------

12
collects/mred/private/wxme/text.rkt
View File

@ -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))