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