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

added preference for the test coverage colors in the module language

Browse Source
This commit is contained in:
Robby Findler 2011-02-19 16:13:44 -06:00
parent c8acebce8b
commit 8ae72bc29c
3 changed files with 35 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
collects/drracket/private/debug.rkt
View File

@ -1042,12 +1042,8 @@ profile todo:
(super-new)))
(define test-covered-style-delta (make-object style-delta%))
(define test-not-covered-style-delta (make-object style-delta%))
;; test colors chosen to try to be color-blindness friendly
(send test-covered-style-delta set-delta-foreground "forest green")
(send test-not-covered-style-delta set-delta-foreground "maroon")
(define test-coverage-on-style-name "plt:module-language:test-coverage-on")
(define test-coverage-off-style-name "plt:module-language:test-coverage-off")
(define erase-test-coverage-style-delta (make-object style-delta% 'change-normal-color))
(send erase-test-coverage-style-delta set-transparent-text-backing-on #t)
@ -1181,8 +1177,14 @@ profile todo:
[span (srcloc-span srcloc)])
(send src change-style
(if on?
(or on-style test-covered-style-delta)
(or off-style test-not-covered-style-delta))
(or on-style
(send (editor:get-standard-style-list)
find-named-style
test-coverage-on-style-name))
(or off-style
(send (editor:get-standard-style-list)
find-named-style
test-coverage-off-style-name)))
(- pos 1)
(+ (- pos 1) span)
#f))))

2
collects/drracket/private/drsig.rkt
View File

@ -76,6 +76,8 @@
srcloc->edition/pair
test-coverage-on-style-name
test-coverage-off-style-name
;show-error-and-highlight
;print-bug-to-stderr

23
collects/drracket/private/main.rkt
View File

@ -637,6 +637,29 @@
(string-constant repl-out-color))))
(define test-coverage-on-style-pref (string->symbol drracket:debug:test-coverage-on-style-name))
(define test-coverage-off-style-pref (string->symbol drracket:debug:test-coverage-off-style-name))
(color-prefs:register-color-preference test-coverage-on-style-pref
drracket:debug:test-coverage-on-style-name
(send the-color-database find-color "forest green"))
(color-prefs:register-color-preference test-coverage-off-style-pref
drracket:debug:test-coverage-off-style-name
(send the-color-database find-color "maroon"))
(color-prefs:add-to-preferences-panel
"Module Language"
(λ (parent)
(color-prefs:build-color-selection-panel parent
test-coverage-on-style-pref
drracket:debug:test-coverage-on-style-name
(string-constant test-coverage-on))
(color-prefs:build-color-selection-panel parent
test-coverage-off-style-pref
drracket:debug:test-coverage-off-style-name
(string-constant test-coverage-off))))
(let* ([find-frame
(λ (item)
(let loop ([item item])