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

avoid functions not available in Debian Stable

Browse Source 
original commit: 6065f8cf125f2917f84651c819cf55b668f002da
This commit is contained in:
Matthew Flatt 2010-08-12 19:12:47 -04:00 committed by Matthew Flatt
parent 9806913cb2
commit 4109af7ecb
2 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/mred/private/wx/gtk/colordialog.rkt
View File

@ -7,14 +7,19 @@
"stddialog.rkt")
(provide
(protect-out get-color-from-user))
(protect-out get-color-from-user
color-dialog-works?))
(define-gtk gtk_color_selection_dialog_new (_fun _string -> _GtkWidget))
(define-gtk gtk_color_selection_dialog_get_color_selection (_fun _GtkWidget -> _GtkWidget))
(define-gtk gtk_color_selection_dialog_get_color_selection (_fun _GtkWidget -> _GtkWidget)
#:fail (lambda () #f))
(define-gtk gtk_color_selection_get_current_color (_fun _GtkWidget (c : (_ptr o _GdkColor)) -> _void -> c))
(define-gtk gtk_color_selection_set_current_color (_fun _GtkWidget _GdkColor-pointer -> _void))
(define (color-dialog-works?)
(and gtk_color_selection_dialog_get_color_selection #t))
(define (get-color-from-user message parent color)
(let ([d (as-gtk-window-allocation
(gtk_color_selection_dialog_new (or message "Choose Color")))]

4
collects/mred/private/wx/gtk/procs.rkt
View File

@ -64,7 +64,9 @@
(define-unimplemented play-sound)
(define (color-from-user-platform-mode) 'dialog)
(define (color-from-user-platform-mode)
(and (color-dialog-works?)
'dialog))
(define (font-from-user-platform-mode) #f)
(define-unimplemented get-font-from-user)