1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
;;
;; Simple example, ported from the one in Gtk+2.0 tutorial.
;;
;; $Id: packbox.scm,v 1.2 2007/01/13 01:36:30 maruska Exp $
(use gtk)
;; Note: the delete_event handler is directly created in the main function
;; Make a new hbox filled with button-labels.
;; Note the use of internal function, compared to C version that
;; has to repeat same patterns.
(define (make-box homogeneous? spacing expand? fill? padding)
(let ((box (gtk-hbox-new homogeneous? spacing)))
(define (make-packed-button label)
(let ((button (gtk-button-new-with-label label)))
(gtk-box-pack-start box button expand? fill? padding)
(gtk-widget-show button)))
(make-packed-button "gtk_box_pack")
(make-packed-button "(box,")
(make-packed-button "button,")
(make-packed-button (if expand? "TRUE," "FALSE,"))
(make-packed-button (if fill? "TRUE," "FALSE,"))
(make-packed-button #`",|padding|);")
box))
(define (main args)
(gtk-init args)
(unless (= (length args) 2)
(error "usage: packbox num, where num is 1, 2, or 3."))
(let* ((which (string->number (cadr args)))
(window (gtk-window-new GTK_WINDOW_TOPLEVEL)))
(g-signal-connect window "delete_event"
(lambda (w e) (gtk-main-quit) #f))
(gtk-container-set-border-width window 10)
(let1 box1 (gtk-vbox-new #f 0)
(case which
((1)
(let ((make-packed-box
(lambda params
(let1 box2 (apply make-box params)
(gtk-box-pack-start box1 box2 #f #f 0)
(gtk-widget-show box2)))))
(let1 label (gtk-label-new "gtk-hbox-new (FALSE, 0);")
(gtk-misc-set-alignment label 0 0)
(gtk-box-pack-start box1 label #f #f 0)
(gtk-widget-show label)
(make-packed-box #f 0 #f #f 0)
(make-packed-box #f 0 #t #f 0)
(make-packed-box #f 0 #t #t 0)
(let1 separator (gtk-hseparator-new)
(gtk-box-pack-start box1 separator #f #t 5)
(gtk-widget-show separator))
(let1 label (gtk-label-new "gtk-hbox-new (TRUE, 0);")
(gtk-misc-set-alignment label 0 0)
(gtk-box-pack-start box1 label #f #f 0)
(gtk-widget-show label))
(make-packed-box #t 0 #t #f 0)
(make-packed-box #t 0 #t #t 0)
(let1 separator (gtk-hseparator-new)
(gtk-box-pack-start box1 separator #f #t 5)
(gtk-widget-show separator))
)))
((2)
(let ((make-packed-box
(lambda params
(let1 box2 (apply make-box params)
(gtk-box-pack-start box1 box2 #f #f 0)
(gtk-widget-show box2)))))
(let1 label (gtk-label-new "gtk-hbox-new (FALSE, 10);")
(gtk-misc-set-alignment label 0 0)
(gtk-box-pack-start box1 label #f #f 0)
(gtk-widget-show label)
(make-packed-box #f 10 #t #f 0)
(make-packed-box #f 10 #t #t 0)
(let1 separator (gtk-hseparator-new)
(gtk-box-pack-start box1 separator #f #t 5)
(gtk-widget-show separator))
(let1 label (gtk-label-new "gtk-hbox-new (FALSE, 0);")
(gtk-misc-set-alignment label 0 0)
(gtk-box-pack-start box1 label #f #f 0)
(gtk-widget-show label))
(make-packed-box #f 0 #t #f 10)
(make-packed-box #f 0 #t #t 10)
(let1 separator (gtk-hseparator-new)
(gtk-box-pack-start box1 separator #f #t 5)
(gtk-widget-show separator))
)))
((3)
(let ((box2 (make-box #f 0 #f #f 0)))
(let1 label (gtk-label-new "end")
(gtk-box-pack-end box2 label #f #f 0)
(gtk-widget-show label))
(gtk-box-pack-start box1 box2 #f #f 0)
(gtk-widget-show box2)
(let1 separator (gtk-hseparator-new)
(gtk-widget-set-size-request separator 400 5)
(gtk-box-pack-start box1 separator #f #t 5)
(gtk-widget-show separator))
))
)
(let ((quitbox (gtk-hbox-new #f 0))
(button (gtk-button-new-with-label "Quit")))
(g-signal-connect button "clicked" (lambda _ (gtk-main-quit)))
(gtk-box-pack-start quitbox button #t #f 0)
(gtk-box-pack-start box1 quitbox #f #f 0)
(gtk-container-add window box1)
(gtk-widget-show button)
(gtk-widget-show quitbox))
(gtk-widget-show box1))
(gtk-widget-show window))
(gtk-main)
0)
|
