fix get-color-from-user on Mac OS X

Closes PR 15121

A better solution would be to implement the dialog, but given
how long it's been broken, maybe no one cares enough for that
to be worthwhile.
This commit is contained in:
Matthew Flatt 2015-10-02 15:56:42 -06:00
parent ac2d39e0e1
commit 5f63b8c95b
3 changed files with 13 additions and 9 deletions

View File

@ -305,13 +305,16 @@
[(eq? (wx:color-from-user-platform-mode) 'dialog) [(eq? (wx:color-from-user-platform-mode) 'dialog)
(wx:get-color-from-user message (and parent (mred->wx parent)) in-color)] (wx:get-color-from-user message (and parent (mred->wx parent)) in-color)]
[else [else
(define color (if (member 'alpha style) (define color (cond
in-color [in-color
(make-object wx:color% (if (member 'alpha style)
(send in-color red) in-color
(send in-color green) (make-object wx:color%
(send in-color blue) (send in-color red)
1.0))) (send in-color green)
(send in-color blue)
1.0))]
[else (make-object wx:color% 0 0 0)]))
(define ok? #f) (define ok? #f)
(define f (make-object dialog% "Choose Color" parent)) (define f (make-object dialog% "Choose Color" parent))
(define (done ok) (lambda (b e) (set! ok? ok) (send f show #f))) (define (done ok) (lambda (b e) (set! ok? ok) (send f show #f)))

View File

@ -16,8 +16,9 @@
(define-cocoa NSDeviceRGBColorSpace _id) (define-cocoa NSDeviceRGBColorSpace _id)
(define (get-color-from-user mode) (define (get-color-from-user message parent color)
(promote-to-gui!) (promote-to-gui!)
(define mode 'get)
(cond (cond
[(eq? mode 'show) [(eq? mode 'show)
(tellv (tell NSColorPanel sharedColorPanel) (tellv (tell NSColorPanel sharedColorPanel)

View File

@ -74,7 +74,7 @@
(define (find-graphical-system-path what) (define (find-graphical-system-path what)
#f) #f)
(define (color-from-user-platform-mode) "Show Picker") (define (color-from-user-platform-mode) #f) ; implementation in "colordialog.rkt" is incomplete
(define-unimplemented get-font-from-user) (define-unimplemented get-font-from-user)
(define (font-from-user-platform-mode) #f) (define (font-from-user-platform-mode) #f)