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

.

Browse Source 
original commit: e9884d5c69136d8a22adb5025f970281ac464472
This commit is contained in:
Matthew Flatt 1999-07-25 01:51:27 +00:00
parent f5f78950b7
commit 4ad8934b4d
1 changed files with 13 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
src/mred/wrap/mred.ss
View File

@ -4691,18 +4691,18 @@
((mk-file-selector 'put-file #t) message parent directory filename extension style)])) ((mk-file-selector 'put-file #t) message parent directory filename extension style)]))
(define get-color-from-user (define get-color-from-user
(if (not (eq? (system-type) 'unix)) (case-lambda
wx:get-color-from-user [() (get-color-from-user #f #f #f null)]
(case-lambda [(message) (get-color-from-user message #f #f null)]
[() (get-color-from-user #f #f #f null)] [(message parent) (get-color-from-user message parent #f null)]
[(message) (get-color-from-user message #f #f null)] [(message parent color) (get-color-from-user message parent color null)]
[(message parent) (get-color-from-user message parent #f null)] [(message parent color style)
[(message parent color) (get-color-from-user message parent color null)] (check-string/false 'get-color-from-user message)
[(message parent color style) (check-top-level-parent/false 'get-color-from-user parent)
(check-string/false 'get-color-from-user message) (check-instance 'get-color-from-user wx:color% 'color% #t color)
(check-top-level-parent/false 'get-color-from-user parent) (check-style 'get-color-from-user #f null style)
(check-instance 'get-color-from-user wx:color% 'color% #t color) (if (not (eq? (system-type) 'unix))
(check-style 'get-color-from-user #f null style) (wx:get-color-from-user message (and parent (mred->wx parent)) color)
(letrec ([ok? #f] (letrec ([ok? #f]
[f (make-object dialog% "Choose Color" parent)] [f (make-object dialog% "Choose Color" parent)]
[done (lambda (ok) (lambda (b e) (set! ok? ok) (send f show #f)))] [done (lambda (ok) (lambda (b e) (set! ok? ok) (send f show #f)))]
@ -4738,7 +4738,7 @@
(make-object wx:color% (make-object wx:color%
(send red get-value) (send red get-value)
(send green get-value) (send green get-value)
(send blue get-value))))]))) (send blue get-value)))))]))
(define get-font-from-user (define get-font-from-user
(if (eq? (system-type) 'windows) (if (eq? (system-type) 'windows)