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

shortcircuit some of the code involved in drawing the margin highlight

Browse Source 
for online expansion errors

This avoids drawing the margin highlight when it isn't inside the
region being repainted and it avoids even figuring anything out about it
when there is currently no error range

NOT for the release branch
This commit is contained in:
Robby Findler 2013-04-08 09:45:50 -05:00
parent 5735d37794
commit caec6d0711
1 changed files with 33 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
collects/drracket/private/module-language.rkt
View File

@ -1224,34 +1224,41 @@
(define/override (on-paint before? dc left top right bottom dx dy draw-caret) (define/override (on-paint before? dc left top right bottom dx dy draw-caret)
(super on-paint before? dc left top right bottom dx dy draw-caret) (super on-paint before? dc left top right bottom dx dy draw-caret)
(unless before? (unless (null? online-error-ranges)
(define saved-brush (send dc get-brush)) (unless before?
(define saved-pen (send dc get-pen))
(define smoothing (send dc get-smoothing))
(send dc set-smoothing 'smoothed)
(send dc set-brush "red" 'solid) (define path (new dc-path%))
(send dc set-pen (send the-pen-list find-or-create-pen "red" 1 'transparent)) (define found-something-to-draw? #f)
(send dc set-alpha
(if (preferences:get 'framework:white-on-black?)
.5
.25))
(define path (new dc-path%))
(for ([an-error-range (in-list online-error-ranges)]) (for ([an-error-range (in-list online-error-ranges)])
(define-values (x y w h) (get-box an-error-range)) (define-values (x y w h) (get-box an-error-range))
(when (rectangles-intersect? x y (+ x w) (+ y h)
left top right bottom)
(set! found-something-to-draw? #t)
(send path move-to (+ dx x) (+ dy y))
(send path line-to (+ dx x w) (+ dy y))
(send path line-to (+ dx x w) (+ dy y h))
(send path arc (+ dx x) (+ dy y) (* w 2/3) h (* pi 3/2) (* pi 1/2))
(send path close)))
(send path move-to (+ dx x) (+ dy y)) (when found-something-to-draw?
(send path line-to (+ dx x w) (+ dy y)) (define saved-brush (send dc get-brush))
(send path line-to (+ dx x w) (+ dy y h)) (define saved-pen (send dc get-pen))
(send path arc (+ dx x) (+ dy y) (* w 2/3) h (* pi 3/2) (* pi 1/2)) (define smoothing (send dc get-smoothing))
(send path close)) (send dc set-smoothing 'smoothed)
(send dc draw-path path) (send dc set-brush "red" 'solid)
(send dc set-alpha 1) (send dc set-pen "red" 1 'transparent)
(send dc set-brush saved-brush) (send dc set-alpha
(send dc set-pen saved-pen) (if (preferences:get 'framework:white-on-black?)
(send dc set-smoothing smoothing))) .5
.25))
(send dc draw-path path)
(send dc set-alpha 1)
(send dc set-brush saved-brush)
(send dc set-pen saved-pen)
(send dc set-smoothing smoothing)))))
(define/override (on-event evt) (define/override (on-event evt)
(define-values (mx my) (define-values (mx my)