From c259d0839aa72beda91f7435eac5e500686b4237 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 18 Dec 2010 07:22:40 -0700 Subject: [PATCH] make editor caret adapt to background color --- collects/mred/private/wxme/text.rkt | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/collects/mred/private/wxme/text.rkt b/collects/mred/private/wxme/text.rkt index 03f02bb6db..a71ff6d908 100644 --- a/collects/mred/private/wxme/text.rkt +++ b/collects/mred/private/wxme/text.rkt @@ -5108,7 +5108,22 @@ (lambda () (call-on-paint #f) (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) @@ -5134,7 +5149,7 @@ hilite-on?) (let ([y ycounter] [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 set-pen save-pen))) (paint-done)] @@ -5314,7 +5329,7 @@ (when (eq? 'show-caret show-caret) (when (and (hsxs . <= . rightx) (hsxs . >= . leftx)) (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) (+ hsxs dx) (+ hsye (sub1 dy)))