Sophie

Sophie

distrib > Fedora > 15 > i386 > by-pkgid > 6c88046acf9c494c2022b09adb197f1d > files > 40

gauche-gtk-0.6-0.6.20120403gitf7d3f802f3750.fc15.i686.rpm

;;
;; Simple example, ported from the one in Gtk+2.0 tutorial.
;;
;; $Id: radiobuttons.scm,v 1.2 2007/01/13 01:36:30 maruska Exp $

(use gtk)

(define (main args)
  (gtk-init args)
  (let1 window (gtk-window-new GTK_WINDOW_TOPLEVEL)
    (g-signal-connect window "delete_event" (lambda _ (gtk-main-quit)))
    (gtk-window-set-title window "radio buttons")
    (gtk-container-set-border-width window 0)
    
    (let1 box1 (gtk-vbox-new #f 0)
      (gtk-container-add window box1)
      (gtk-widget-show box1)
      (let1 box2 (gtk-vbox-new #f 10)
        (gtk-container-set-border-width box2 10)
        (gtk-box-pack-start box1 box2 #t #t 0)
        (gtk-widget-show box2)
        (let1 button1 (gtk-radio-button-new-with-label #f "button1")
          (gtk-box-pack-start box2 button1 #t #t 0)
          (gtk-widget-show button1)
          (let* ((group (gtk-radio-button-get-group button1))
                 (button2 (gtk-radio-button-new-with-label group "button2")))
            (gtk-toggle-button-set-active button2 #t)
            (gtk-box-pack-start box2 button2 #t #t 0)
            (gtk-widget-show button2)
            (let1 button3 (gtk-radio-button-new-with-label-from-widget
                           button2 "button3")
              (gtk-box-pack-start box2 button3 #t #t 0)
              (gtk-widget-show button3))
            )
          )
        )
      (let1 separator (gtk-hseparator-new)
        (gtk-box-pack-start box1 separator #f #t 0)
        (gtk-widget-show separator))
      (let1 box2 (gtk-vbox-new #f 10)
        (gtk-container-set-border-width box2 10)
        (gtk-box-pack-start box1 box2 #f #t 0)
        (gtk-widget-show box2)
        (let1 button (gtk-button-new-with-label "close")
          (g-signal-connect button "clicked" (lambda _ (gtk-main-quit)))
          (gtk-box-pack-start box2 button #t #t 0)
          (gtk-widget-set-flags button GTK_CAN_DEFAULT)
          (gtk-widget-show button)))
      )
    (gtk-widget-show window))
  (gtk-main)
  0)