1;; Copyright (C) 2004 Patrick Bernaud
2;; GNU General Public License version 2 or later. No warrantee.
3
4(define-module (demos sizegroup)
5  :use-module (oop goops)
6  :use-module (gnome gobject)
7  :use-module (gnome gtk))
8
9
10(define color-options '("Red" "Green" "Blue"))
11
12(define dash-options  '("Solid" "Dashed" "Dotted"))
13
14(define end-options   '("Square" "Round" "Arrow"))
15
16
17(define (main)
18
19  ;; convenience function to create a combo box holding a number of strings
20  (define (create-combo-box strings)
21    (let ((combobox (gtk-combo-box-new-text)))
22      (for-each (lambda (str)
23		  (append-text combobox str)) strings)
24      (set-active combobox 0)
25      combobox))
26
27  (define (add-row table row sizegroup labeltext options)
28    (let* ((combobox (create-combo-box options))
29	   (label    (make <gtk-label>
30		       :label labeltext :use-underline #t
31		       :mnemonic-widget combobox :xalign 0 :yalign 1)))
32      (attach table label
33	      0 1 row (+ row 1)
34	      '(fill expand) #f
35	      0 0)
36      (add-widget sizegroup combobox)
37      (attach table combobox
38	      1 2 row (+ 1 row)
39	      #f #f
40	      0 0)))
41
42  (define (toggle-grouping checkbutton sizegroup)
43    (set sizegroup 'mode (if (get-active checkbutton)
44			     'horizontal
45			     'none)))
46
47  (let* ((w      (make <gtk-dialog> :title "GtkSizeGroup" :resizable #f))
48	 (vbox   (make <gtk-vbox>
49		   :homogeneous #f :spacing 5 :border-width 5))
50	 (sg     (make <gtk-size-group> :mode 'horizontal))
51	 (frame1 (make <gtk-frame> :label "Color options"))
52	 (table1 (make <gtk-table>
53		   :n-columns 2 :n-rows 2 :homogeneous #f
54		   :border-width 5 :row-spacing 5 :row-spacing 10))
55	 (frame2 (make <gtk-frame> :label "Line options"))
56	 (table2 (make <gtk-table>
57		   :n-columns 2 :n-rows 2 :homogeneous #f
58		   :border-width 5 :row-spacing 5 :row-spacing 10))
59	 (cb     (make <gtk-check-button>
60		   :label "_Enable grouping" :use-underline #t :active #t)))
61    (add-button w
62		(gtk-stock-id 'close)
63		(genum->value
64		 (make <gtk-response-type> :value 'none)))
65
66    (connect w 'response (lambda (w a) (gtk-widget-destroy w) #f))
67
68    (pack-start (get-vbox w) vbox #t #t 0)
69
70    ;; frame holding color options
71    (pack-start vbox frame1 #t #t 0)
72    (add frame1 table1)
73
74    (add-row table1 0 sg "_Foreground" color-options)
75    (add-row table1 1 sg "_Background" color-options)
76
77    ;; second frame holding line style options
78    (pack-start vbox frame2 #f #f 0)
79    (add frame2 table2)
80
81    (add-row table2 0 sg "_Dashing"   dash-options)
82    (add-row table2 1 sg "_Line ends" end-options)
83
84    ;; check button to turn grouping on and off
85    (pack-start vbox cb #f #f 0)
86
87    (connect cb 'toggled (lambda (b)
88			   (toggle-grouping b sg)))
89
90    (show-all w)))
91
92
93(define name "Size Groups")
94(define description
95  (string-append
96   "GtkSizeGroup provides a mechanism for grouping a number of "
97   "widgets together so they all request the same amount of space."
98   "This is typically useful when you want a column of widgets to "
99   "have the same size, but you can't use a GtkTable widget."
100   "\n"
101   "Note that size groups only affect the amount of space requested,"
102   "not the size that the widgets finally receive. If you want the"
103   "widgets in a GtkSizeGroup to actually be the same size, you need"
104   "to pack them in such a way that they get the size they request"
105   "and not more. For example, if you are packing your widgets"
106   "into a table, you would not include the GTK_FILL flag."))
107