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

avoid functions not available in Debian Stable

Browse Source
This commit is contained in:
Matthew Flatt 2010-08-12 19:12:47 -04:00 committed by Matthew Flatt
parent fddcdcf797
commit 6065f8cf12
4 changed files with 23 additions and 5 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)

6
collects/racket/draw/unsafe/cairo.rkt
View File

@ -195,7 +195,11 @@
#:wrap (allocator cairo_surface_destroy))
(define-cairo cairo_ps_surface_create (_fun _path _double* _double* -> _cairo_surface_t)
#:wrap (allocator cairo_surface_destroy))
(define-cairo cairo_ps_surface_set_eps (_fun _cairo_surface_t _bool -> _void))
(define-cairo cairo_ps_surface_set_eps (_fun _cairo_surface_t _bool -> _void)
#:fail (lambda ()
;; cairo_ps_surface_set_eps is in version 1.6 and later;
;; if it's not available, we just do without
(lambda (s b) (void))))
(define-cairo cairo_ps_surface_dsc_begin_setup (_fun _cairo_surface_t -> _void))
(define-cairo cairo_ps_surface_dsc_comment (_fun _cairo_surface_t _string -> _void))
(define-cairo cairo_image_surface_get_data (_fun (s : _cairo_surface_t)

9
collects/racket/draw/unsafe/pango.rkt
View File

@ -133,8 +133,14 @@
(define-pangocairo pango_cairo_font_map_new (_fun -> PangoFontMap)
#:wrap (allocator g_object_unref))
(define-pango pango_font_map_create_context (_fun PangoFontMap -> PangoContext)
(define-pango pango_context_new (_fun -> PangoContext)
#:wrap (allocator g_object_unref))
;; pango_font_map_create_context() is in 1.22 and later
(provide pango_font_map_create_context)
(define (pango_font_map_create_context fm)
(let ([c (pango_context_new)])
(pango_context_set_font_map c fm)
c))
(define-pangocairo pango_cairo_update_context (_fun _cairo_t PangoContext -> _void))
;; The convenince function pango_cairo_create_context() is in 1.22 and later
@ -180,6 +186,7 @@
(define-pango pango_layout_set_font_description (_fun PangoLayout PangoFontDescription -> _void)) ;; makes a copy
(define-pango pango_context_get_font_map (_fun PangoContext -> PangoFontMap)) ;; not an allocator
(define-pango pango_context_set_font_map (_fun PangoContext PangoFontMap -> _void))
(define-pango pango_font_family_get_name (_fun PangoFontFamily -> _string)) ;; not an allocator
(define-pango pango_font_family_is_monospace (_fun PangoFontFamily -> _bool))