commit ed46c25db536207e3280db4cd3d159d8ac8aef4a
parent f76c2a31468591aaae2f3b246f4fd57dc267988a
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 8 Jun 2010 14:11:44 -0600
macro-debugger: made properties display respect inverted-colors mode
original commit: b6b8e299572c53f2b75646755f46badf92a5ffd6
Diffstat:
3 files changed, 28 insertions(+), 18 deletions(-)
diff --git a/collects/macro-debugger/syntax-browser/display.rkt b/collects/macro-debugger/syntax-browser/display.rkt
@@ -9,6 +9,7 @@
(only-in mzlib/etc begin-with-definitions)
"pretty-printer.ss"
"interfaces.ss"
+ "prefs.ss"
"util.ss")
(provide print-syntax-to-editor
code-style)
@@ -281,7 +282,7 @@
;; translate-color : color-string -> color%
(define (translate-color color-string)
(let ([c (make-object color% color-string)])
- (if (preferences:get 'framework:white-on-black?)
+ (if (pref:invert-colors?)
(let-values ([(r* g* b*)
(lightness-invert (send c red) (send c green) (send c blue))])
#|
@@ -292,19 +293,6 @@
(make-object color% r* g* b*))
c)))
-#;
-(define (translate-color color)
- (let ([reversed-color
- (case (string->symbol (string-downcase color))
- [(white) "black"]
- [(black) "white"]
- [(yellow) "goldenrod"]
- [else (printf "unknown color ~s\n" color)
- color])])
- (if (preferences:get 'framework:white-on-black?)
- reversed-color
- color)))
-
;; lightness-invert : uint8 uint8 uint8 -> (values uint8 uint8 uint8)
(define (lightness-invert r g b)
(define (c x)
@@ -393,7 +381,7 @@
(let ([wob-version (highlight-style-delta wob-color em? #:translate-color? #f)]
[bow-version (highlight-style-delta bow-color em? #:translate-color? #f)])
(λ ()
- (if (preferences:get 'framework:white-on-black?)
+ (if (pref:invert-colors?)
wob-version
bow-version))))
diff --git a/collects/macro-debugger/syntax-browser/prefs.rkt b/collects/macro-debugger/syntax-browser/prefs.rkt
@@ -7,7 +7,9 @@
(provide prefs-base%
syntax-prefs-base%
syntax-prefs%
- syntax-prefs/readonly%)
+ syntax-prefs/readonly%
+
+ pref:invert-colors?)
(preferences:set-default 'SyntaxBrowser:Width 700 number?)
(preferences:set-default 'SyntaxBrowser:Height 600 number?)
@@ -19,6 +21,8 @@
(define pref:props-percentage (pref:get/set 'SyntaxBrowser:PropertiesPanelPercentage))
(define pref:props-shown? (pref:get/set 'SyntaxBrowser:PropertiesPanelShown))
+(define pref:invert-colors? (pref:get/set 'framework:white-on-black?))
+
(define prefs-base%
(class object%
;; suffix-option : SuffixOption
diff --git a/collects/macro-debugger/syntax-browser/properties.rkt b/collects/macro-debugger/syntax-browser/properties.rkt
@@ -1,6 +1,7 @@
#lang scheme/base
(require scheme/class
scheme/gui
+ framework
(rename-in unstable/class-iop
[send/i send:])
"interfaces.ss"
@@ -9,6 +10,23 @@
(provide properties-view%
properties-snip%)
+(define color-text-default-style-name
+ "macro-debugger/syntax-browser/properties color-text% basic")
+
+(define color-text%
+ (class (editor:standard-style-list-mixin text:basic%)
+ (inherit get-style-list)
+ (define/override (default-style-name)
+ color-text-default-style-name)
+ (super-new)
+ (let* ([sl (get-style-list)]
+ [standard
+ (send sl find-named-style (editor:get-default-color-style-name))]
+ [basic
+ (send sl find-or-create-style standard
+ (make-object style-delta% 'change-family 'default))])
+ (send sl new-named-style color-text-default-style-name basic))))
+
;; properties-view-base-mixin
(define properties-view-base-mixin
(mixin () ()
@@ -22,7 +40,7 @@
(define mode 'term)
;; text : text%
- (field (text (new text%)))
+ (field (text (new color-text%)))
(field (pdisplayer (new properties-displayer% (text text))))
(send: controller selection-manager<%> listen-selected-syntax
@@ -122,7 +140,7 @@
(callback
(lambda (tp e)
(set-mode (cdr (list-ref tab-choices (send tp get-selection))))))))
- (define ecanvas (new editor-canvas% (editor text) (parent tab-panel)))))
+ (define ecanvas (new canvas:color% (editor text) (parent tab-panel)))))
;; properties-displayer%
(define properties-displayer%
