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

avoid allocating a bunch of boxes (instead use ones already lying around)

Browse Source
This commit is contained in:
Robby Findler 2012-08-27 20:06:05 -05:00
parent 9fdb0ac507
commit 9934f202c9
1 changed files with 14 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/drracket/private/syncheck/gui.rkt
View File

@ -335,6 +335,7 @@ If the namespace does not, they are colored the unbound color.
find-position begin-edit-sequence end-edit-sequence find-position begin-edit-sequence end-edit-sequence
highlight-range unhighlight-range highlight-range unhighlight-range
paragraph-end-position first-line-currently-drawn-specially? paragraph-end-position first-line-currently-drawn-specially?
line-end-position position-line
syncheck:add-docs-range) syncheck:add-docs-range)
;; arrow-records : (U #f hash[text% => arrow-record]) ;; arrow-records : (U #f hash[text% => arrow-record])
@ -427,10 +428,8 @@ If the namespace does not, they are colored the unbound color.
;; find-dc-location : text number -> (values number number) ;; find-dc-location : text number -> (values number number)
(define (find-dc-location text pos) (define (find-dc-location text pos)
(let ([bx (box 0)] (send text position-location pos xlb xrb)
[by (box 0)]) (send text editor-location-to-dc-location (unbox xlb) (unbox xrb)))
(send text position-location pos bx by)
(send text editor-location-to-dc-location (unbox bx) (unbox by))))
(hash-for-each (hash-for-each
bindings-table bindings-table
@ -443,21 +442,17 @@ If the namespace does not, they are colored the unbound color.
;; returns the bounding box (left, top, right, bottom) for the text range. ;; returns the bounding box (left, top, right, bottom) for the text range.
;; only works right if the text is on a single line. ;; only works right if the text is on a single line.
(define/private (find-char-box text left-pos right-pos) (define/private (find-char-box text left-pos right-pos)
(let ([xlb (box 0)] (send text position-location left-pos xlb ylb #t)
[ylb (box 0)] (send text position-location right-pos xrb yrb #f)
[xrb (box 0)] (let*-values ([(xl-off yl-off) (send text editor-location-to-dc-location (unbox xlb) (unbox ylb))]
[yrb (box 0)]) [(xl yl) (dc-location-to-editor-location xl-off yl-off)]
(send text position-location left-pos xlb ylb #t) [(xr-off yr-off) (send text editor-location-to-dc-location (unbox xrb) (unbox yrb))]
(send text position-location right-pos xrb yrb #f) [(xr yr) (dc-location-to-editor-location xr-off yr-off)])
(let*-values ([(xl-off yl-off) (send text editor-location-to-dc-location (unbox xlb) (unbox ylb))] (values
[(xl yl) (dc-location-to-editor-location xl-off yl-off)] xl
[(xr-off yr-off) (send text editor-location-to-dc-location (unbox xrb) (unbox yrb))] yl
[(xr yr) (dc-location-to-editor-location xr-off yr-off)]) xr
(values yr)))
xl
yl
xr
yr))))
(define/private (get-arrow-poss arrow) (define/private (get-arrow-poss arrow)
(cond (cond
@ -1213,10 +1208,6 @@ If the namespace does not, they are colored the unbound color.
(send ed get-canvas))) (send ed get-canvas)))
(define/private (tooltip-info->ltrb tooltip) (define/private (tooltip-info->ltrb tooltip)
(define xlb (box 0))
(define ylb (box 0))
(define xrb (box 0))
(define yrb (box 0))
(define left-pos (tooltip-info-pos-left tooltip)) (define left-pos (tooltip-info-pos-left tooltip))
(define right-pos (tooltip-info-pos-right tooltip)) (define right-pos (tooltip-info-pos-right tooltip))
(define text (tooltip-info-text tooltip)) (define text (tooltip-info-text tooltip))