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

a few changes to the automaically changing language stuff, plus more white-on-black improvements

Browse Source 
svn: r5917

original commit: 031cd94b5c104c669844880388dc7c8bddf69724
This commit is contained in:
Robby Findler 2007-04-10 19:41:09 +00:00
parent f3284f1539
commit 61d5d4f244
1 changed files with 24 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
collects/framework/decorated-editor-snip.ss
View File

@ -5,7 +5,8 @@
decorated-editor-snip-mixin) decorated-editor-snip-mixin)
(require (lib "class.ss") (require (lib "class.ss")
(lib "mred.ss" "mred")) (lib "mred.ss" "mred")
"preferences.ss")
(define (decorated-editor-snip-mixin super%) (define (decorated-editor-snip-mixin super%)
(class super% (class super%
@ -15,7 +16,7 @@
(define/public (get-corner-bitmap) #f) (define/public (get-corner-bitmap) #f)
;; get-color : -> (union string (is-a?/c color%)) ;; get-color : -> (union string (is-a?/c color%))
(define/public (get-color) "black") (define/public (get-color) (if (preferences:get 'framework:white-on-black?) "white" "black"))
;; get-menu : -> (union #f (is-a?/c popup-menu%)) ;; get-menu : -> (union #f (is-a?/c popup-menu%))
;; returns the popup menu that should appear ;; returns the popup menu that should appear
@ -88,10 +89,16 @@
(get-margin bml bmt bmr bmb) (get-margin bml bmt bmr bmb)
(super draw dc x y left top right bottom dx dy draw-caret) (super draw dc x y left top right bottom dx dy draw-caret)
(let* ([old-pen (send dc get-pen)] (let* ([old-pen (send dc get-pen)]
[old-brush (send dc get-brush)]) [old-brush (send dc get-brush)]
[white-on-black? (preferences:get 'framework:white-on-black?)])
(send dc set-pen (send the-pen-list find-or-create-pen "white" 1 'transparent)) (send dc set-pen (send the-pen-list find-or-create-pen
(send dc set-brush (send the-brush-list find-or-create-brush "white" 'solid)) (if white-on-black? "black" "white")
1
'transparent))
(send dc set-brush (send the-brush-list find-or-create-brush
(if white-on-black? "black" "white")
'solid))
(case (get-position) (case (get-position)
[(top-right) [(top-right)
(send dc draw-rectangle (send dc draw-rectangle
@ -106,8 +113,13 @@
(- (unbox bml) (unbox bil)) (- (unbox bml) (unbox bil))
(max 0 (- (unbox bh) (unbox bmt) (unbox bmb))))]) (max 0 (- (unbox bh) (unbox bmt) (unbox bmb))))])
(send dc set-pen (send the-pen-list find-or-create-pen "black" 1 'solid)) (send dc set-pen (send the-pen-list find-or-create-pen
(send dc set-brush (send the-brush-list find-or-create-brush "black" 'solid)) (if white-on-black? "white" "black")
1
'solid))
(send dc set-brush (send the-brush-list find-or-create-brush
(if white-on-black? "white" "black")
'solid))
(when bm (when bm
(let ([bm-w (send bm get-width)] (let ([bm-w (send bm get-width)]
@ -173,6 +185,9 @@
(top-margin top-margin) (top-margin top-margin)
(left-margin left-margin))) (left-margin left-margin)))
(inherit use-style-background)
(use-style-background #t)
(reset-min-sizes))) (reset-min-sizes)))
(define decorated-editor-snip% (define decorated-editor-snip%
@ -211,4 +226,4 @@
(let ([snip (make-snip stream-in)]) (let ([snip (make-snip stream-in)])
(send (send snip get-editor) read-from-file stream-in #f) (send (send snip get-editor) read-from-file stream-in #f)
snip)) snip))
(super-instantiate ())))) (super-new))))