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

make editor caret adapt to background color

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-18 07:22:40 -07:00
parent 70955d5540
commit c259d0839a
1 changed files with 18 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -5108,7 +5108,22 @@
(lambda () (lambda ()
(call-on-paint #f) (call-on-paint #f)
(set! write-locked? wl?) (set! write-locked? wl?)
(set! flow-locked? #f))]) (set! flow-locked? #f))]
[local-caret-pen
(if bg-color
(let ([r (send bg-color red)]
[g (send bg-color green)]
[b (send bg-color blue)])
(if (and (= r 255) (= g 255) (= b 255))
caret-pen
(make-object pen% (make-object color%
(- 255 r)
(- 255 g)
(- 255 b))
(send caret-pen get-width)
'solid)))
caret-pen)])
(call-on-paint #t) (call-on-paint #t)
@ -5134,7 +5149,7 @@
hilite-on?) hilite-on?)
(let ([y ycounter] (let ([y ycounter]
[save-pen (send dc get-pen)]) [save-pen (send dc get-pen)])
(send dc set-pen caret-pen) (send dc set-pen local-caret-pen)
(send dc draw-line dx (+ y dy) dx (sub1 (+ y extra-line-h dy))) (send dc draw-line dx (+ y dy) dx (sub1 (+ y extra-line-h dy)))
(send dc set-pen save-pen))) (send dc set-pen save-pen)))
(paint-done)] (paint-done)]
@ -5314,7 +5329,7 @@
(when (eq? 'show-caret show-caret) (when (eq? 'show-caret show-caret)
(when (and (hsxs . <= . rightx) (hsxs . >= . leftx)) (when (and (hsxs . <= . rightx) (hsxs . >= . leftx))
(let ([save-pen (send dc get-pen)]) (let ([save-pen (send dc get-pen)])
(send dc set-pen caret-pen) (send dc set-pen local-caret-pen)
(send dc draw-line (+ hsxs dx) (+ hsys dy) (send dc draw-line (+ hsxs dx) (+ hsys dy)
(+ hsxs dx) (+ hsxs dx)
(+ hsye (sub1 dy))) (+ hsye (sub1 dy)))