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

PR 9388

Browse Source 
svn: r9840

original commit: a2c4f5851b36f2e7bee1e9542c1b3ed2f4b72e4f
This commit is contained in:
Robby Findler 2008-05-14 23:25:19 +00:00
parent 99f969620f
commit 3f3ac48d60
4 changed files with 27 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/framework/private/color-prefs.ss
View File

@ -331,11 +331,11 @@
(new button% (new button%
[label (string-constant white-on-black-color-scheme)] [label (string-constant white-on-black-color-scheme)]
[parent hp] [parent hp]
[callback (λ (x y) (white-on-black))]) [callback (λ (x y) (preferences:set 'framework:white-on-black? #t))])
(new button% (new button%
[label (string-constant black-on-white-color-scheme)] [label (string-constant black-on-white-color-scheme)]
[parent hp] [parent hp]
[callback (λ (x y) (black-on-white))])))))) [callback (λ (x y) (preferences:set 'framework:white-on-black? #f))]))))))
(define (build-text-foreground-selection-panel parent pref-sym style-name example-text) (define (build-text-foreground-selection-panel parent pref-sym style-name example-text)
@ -488,12 +488,8 @@
"did not find color ~s in the-color-database" "did not find color ~s in the-color-database"
c))])) c))]))
(define (black-on-white) (define (black-on-white) (do-colorization cadr))
(preferences:set 'framework:white-on-black? #f) (define (white-on-black) (do-colorization caddr))
(do-colorization cadr))
(define (white-on-black)
(preferences:set 'framework:white-on-black? #t)
(do-colorization caddr))
(define (do-colorization sel) (define (do-colorization sel)
(for-each (λ (l) (for-each (λ (l)
(let* ([p (car l)] (let* ([p (car l)]

5
collects/framework/private/main.ss
View File

@ -51,6 +51,11 @@
(λ (x) (and (list? x) (andmap string? x)))) (λ (x) (and (list? x) (andmap string? x))))
(preferences:set-default 'framework:white-on-black? #f boolean?) (preferences:set-default 'framework:white-on-black? #f boolean?)
(preferences:add-callback 'framework:white-on-black?
(λ (p v)
(if v
(color-prefs:white-on-black)
(color-prefs:black-on-white))))
(preferences:set-default 'framework:case-sensitive-search? (preferences:set-default 'framework:case-sensitive-search?
#f #f

25
collects/framework/private/scheme.ss
View File

@ -252,16 +252,21 @@
(send text end-edit-sequence)))) (send text end-edit-sequence))))
;
;; ;
; ; ; ;
; ; ; ; ; ;;;;
;;; ;;; ; ;; ;;; ;;; ; ;;; ;;;;; ;;; ;;; ;;; ;;;;; ; ;; ;;;;
; ; ; ; ;; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;; ;;;;; ;;;; ;;; ;;; ;;; ;;;
;;; ; ; ; ;;;;; ; ; ; ;;;;; ; ;;;;; ; ; ; ;;;;;; ;;;;;; ;;;;;;;;; ;;;;; ;;;;;;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;;;;;; ;;;; ;;;; ;;;; ;;;; ;; ;;;; ;;
; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ; ;;;; ;;; ;;;; ;;;; ;;;; ;;;;;;; ;;;;
;;; ;;; ;;; ;;; ;;; ;; ; ;; ;;; ; ;;; ;;; ;; ;; ;;; ; ;;;;;;;; ;;;;; ;;;; ;;;; ;;;;; ;;;;
; ;;;;;; ;;;;; ;;;; ;;;; ;;;;;; ;;;;
; ;;;; ;;;; ;;;; ;;;; ;;;; ;;;;
;
;
;
(define color-prefs-table (define color-prefs-table

4
collects/framework/private/sig.ss
View File

@ -376,7 +376,9 @@
add-background-preferences-panel add-background-preferences-panel
marshall-style-delta marshall-style-delta
unmarshall-style-delta unmarshall-style-delta
set-default/color-scheme)) set-default/color-scheme
white-on-black
black-on-white))
(define-signature scheme-class^ (define-signature scheme-class^
(text<%> (text<%>