gtk: configurable control font

collects/mred/private/wx/gtk/button.rkt

@@ -38,7 +38,7 @@
         [gtk_new_with_mnemonic gtk_button_new_with_mnemonic]
         [gtk_new gtk_button_new])
   (init-field [event-type 'button])
-  (inherit get-gtk set-auto-size is-window-enabled?
+  (inherit get-gtk get-client-gtk set-auto-size is-window-enabled?
            get-window-gtk)
 
   (super-new [parent parent]
@@ -58,6 +58,7 @@
                    [else
                     (as-gtk-allocation (gtk_new_with_mnemonic "<bad>"))])]
              [callback cb]
+             [font font]
              [no-show? (memq 'deleted style)])
   (define gtk (get-gtk))
   
@@ -81,6 +82,9 @@
     ;; Called from event-handling thread
     (queue-window-event this (lambda () (clicked))))
 
+  (define/override (get-label-gtk)
+    (gtk_bin_get_child (get-client-gtk)))
+
   (define/override (set-label s)
     (cond
      [(string? s)

collects/mred/private/wx/gtk/choice.rkt

@@ -21,6 +21,7 @@
 (define-gtk gtk_combo_box_remove_text (_fun _GtkWidget _int -> _void))
 (define-gtk gtk_combo_box_set_active (_fun _GtkWidget _int -> _void))
 (define-gtk gtk_combo_box_get_active (_fun _GtkWidget -> _int))
+(define-gtk gtk_bin_get_child (_fun _GtkWidget -> _GtkWidget))
 
 (define-signal-handler connect-changed "changed"
   (_fun _GtkWidget -> _void)
@@ -53,6 +54,8 @@
 
   (gtk_combo_box_set_active gtk 0)
 
+  (install-control-font (gtk_bin_get_child gtk) font)
+
   (set-auto-size)
 
   (connect-changed gtk)

collects/mred/private/wx/gtk/item.rkt

@@ -1,20 +1,36 @@
-#lang scheme/base
-(require scheme/class
+#lang racket/base
+(require ffi/unsafe
+         racket/class
+         racket/draw/local
           "../../syntax.rkt"
-         "window.rkt")
+         "window.rkt"
+         "utils.rkt"
+         "types.rkt")
 
-(provide item%)
+(provide item%
+         install-control-font)
+
+(define _PangoFontDescription _pointer)
+(define-gtk gtk_widget_modify_font (_fun _GtkWidget _PangoFontDescription -> _void))
+
+(define (install-control-font gtk font)
+  (when font
+    (gtk_widget_modify_font gtk (send font get-pango))))
 
 (defclass item% window%
   (inherit get-client-gtk)
 
   (init-field [callback void])
+  (init [font #f])
 
   (super-new)
 
   (let ([client-gtk (get-client-gtk)])
     (connect-focus client-gtk)
     (connect-key-and-mouse client-gtk))
+  (install-control-font (get-label-gtk) font)
+  
+  (define/public (get-label-gtk) (get-client-gtk))
 
   (def/public-unimplemented set-label)
   (def/public-unimplemented get-label)

collects/mred/private/wx/gtk/list-box.rkt

@@ -116,6 +116,7 @@
              [gtk gtk]
              [extra-gtks (list client-gtk selection)]
              [callback cb]
+             [font font]
              [no-show? (memq 'deleted style)])
 
   (set-auto-size)

collects/mred/private/wx/gtk/message.rkt

@@ -66,6 +66,7 @@
                                  (release-pixbuf pixbuf)))
                               (as-gtk-allocation
                                (gtk_label_new_with_mnemonic "<bad-image>")))))]
+             [font font]
              [no-show? (memq 'deleted style)])
 
   (when (string? label)

collects/mred/private/wx/gtk/radio-box.rkt

@@ -26,6 +26,7 @@
 (define-gtk gtk_toggle_button_set_active (_fun _GtkWidget _gboolean -> _void))
 (define-gtk gtk_toggle_button_get_active (_fun _GtkWidget -> _gboolean))
 (define-gtk gtk_widget_is_focus (_fun _GtkWidget -> _gboolean))
+(define-gtk gtk_bin_get_child (_fun _GtkWidget -> _GtkWidget))
 
 (define-signal-handler connect-clicked "clicked"
   (_fun _GtkWidget -> _void)
@@ -64,6 +65,7 @@
                                           [else
                                            (gtk_radio_button_new_with_mnemonic #f "<bad bitmap>")])])
                           (gtk_box_pack_start gtk radio-gtk #t #t 0)
+                          (install-control-font (gtk_bin_get_child radio-gtk) font)
                           (gtk_widget_show radio-gtk)
                           radio-gtk))))
   (for ([radio-gtk (in-list (cdr radio-gtks))])