1;; Copyright (C) 2004 Patrick Bernaud 2;; GNU General Public License version 2 or later. No warrantee. 3 4(define-module (demos tree-store) 5 :use-module (oop goops) 6 :use-module (gnome gobject) 7 :use-module (gnome gtk)) 8 9 10(define january 11 '(("New Years Day" #t #t #t #t #f #t) 12 ("Presidential Inauguration" #f #t #f #t #f #f) 13 ("Martin Luther King Jr. day" #f #t #f #t #f #f))) 14 15(define february 16 '(("Presidents' Day" #f #t #f #t #f #f) 17 ("Groundhog Day" #f #f #f #f #f #f) 18 ("Valentine's Day" #f #f #f #f #t #t))) 19 20(define march 21 '(("National Tree Planting Day" #f #f #f #f #f #f) 22 ("St Patrick's Day" #f #f #f #f #f #t))) 23 24(define april 25 '(("April Fools' Day" #f #f #f #f #f #t) 26 ("Army Day" #f #f #f #f #f #f) 27 ("Earth Day" #f #f #f #f #f #t) 28 ("Administrative Professionals' Day" #f #f #f #f #f #f))) 29 30(define may 31 '(("Nurses' Day" #f #f #f #f #f #f) 32 ("National Day of Prayer" #f #f #f #f #f #f) 33 ("Mothers' Day" #f #f #f #f #f #t) 34 ("Armed Forces Day" #f #f #f #f #f #f) 35 ("Memorial Day" #t #t #t #t #f #t))) 36 37(define june 38 '(("June Fathers' Day" #f #f #f #f #f #t) 39 ("Juneteenth (Liberation of Slaves)" #f #f #f #f #f #f) 40 ("Flag Day" #f #t #f #t #f #f))) 41 42(define july 43 '(("Parents' Day" #f #f #f #f #f #t) 44 ("Independence Day" #f #t #f #t #f #f))) 45 46(define august 47 '(("Air Force Day" #f #f #f #f #f #f) 48 ("Coast Guard Day" #f #f #f #f #f #f) 49 ("Friendship Day" #f #f #f #f #f #f))) 50 51(define september 52 '(("Grandparents' Day" #f #f #f #f #f #t) 53 ("Citizenship Day or Constitution Day" #f #f #f #f #f #f) 54 ("Labor Day" #t #t #t #t #f #t))) 55 56(define october 57 '(("National Children's Day" #f #f #f #f #f #f) 58 ("Bosses' Day" #f #f #f #f #f #f) 59 ("Sweetest Day" #f #f #f #f #f #f) 60 ("Mother-in-Law's Day" #f #f #f #f #f #f) 61 ("Navy Day" #f #f #f #f #f #f) 62 ("Columbus Day" #f #t #f #t #f #f) 63 ("Halloween" #f #f #f #f #f #t))) 64 65(define november 66 '(("Marine Corps Day" #f #f #f #f #f #f) 67 ("Veterans' Day" #t #t #t #t #f #t) 68 ("Thanksgiving" #f #t #f #t #f #f))) 69 70(define december 71 '(("Pearl Harbor Remembrance Day" #f #f #f #f #f #f) 72 ("Christmas" #t #t #t #t #f #t) 73 ("Kwanzaa" #f #f #f #f #f #f))) 74 75(define toplevel 76 `(("January" ,january) 77 ("February" ,february) 78 ("March" ,march) 79 ("April" ,april) 80 ("May" ,may) 81 ("June" ,june) 82 ("July" ,july) 83 ("August" ,august) 84 ("September" ,september) 85 ("October" ,october) 86 ("November" ,november) 87 ("December" ,december))) 88 89 90(define holiday-name-column 0) 91(define alex-column 1) 92(define havoc-column 2) 93(define tim-column 3) 94(define owen-column 4) 95(define dave-column 5) 96(define visible-column 6) 97(define world-column 7) 98 99 100(define (create-model) 101 (let ( 102 ; create tree store 103 (model (gtk-tree-store-new (list <gchararray> 104 <gboolean> 105 <gboolean> 106 <gboolean> 107 <gboolean> 108 <gboolean> 109 <gboolean> 110 <gboolean>)))) 111 (for-each 112 (lambda (m) 113 (let ((iter (append model (make <gtk-tree-iter>)))) 114 (set-value model iter holiday-name-column (car m)) 115 (for-each (lambda (c) 116 (set-value model iter c #f)) 117 (list alex-column havoc-column tim-column owen-column 118 dave-column visible-column world-column)) 119 (for-each 120 (lambda (h) 121 (let ((iter (append model iter))) 122 (for-each 123 (lambda (c i) 124 (set-value model iter i c)) 125 h (list holiday-name-column alex-column havoc-column 126 tim-column owen-column dave-column world-column)) 127 (set-value model iter visible-column #t))) 128 (cadr m)))) 129 toplevel) 130 131 model)) 132 133(define (item-toggled treemodel pathstr column) 134 (let* ( 135 ;; get toggled iter 136 (iter (get-iter treemodel pathstr)) 137 ;; get current value and invert 138 (toggle (not (get-value treemodel iter column)))) 139 ;; set the new value 140 (set-value treemodel iter column toggle))) 141 142(define (add-columns treeview) 143 (let ((model (get-model treeview)) 144 ;; column for holiday names 145 (renderer1 (make <gtk-cell-renderer-text> 146 :xalign 0)) 147 (column1 (make <gtk-tree-view-column> 148 :title "Holliday" 149 ;; set this column to a fixed sizing (of 50 pixels) 150 :clickable #t)) 151 ;; alex column 152 (renderer2 (make <gtk-cell-renderer-toggle> 153 :xalign 0)) 154 (column2 (make <gtk-tree-view-column> 155 :title "Alex" 156 :sizing 'fixed 157 :fixed-width 50 158 :clickable #t)) 159 ;; havoc column 160 (renderer3 (make <gtk-cell-renderer-toggle> 161 :xalign 0)) 162 (column3 (make <gtk-tree-view-column> 163 :title "Havoc" 164 :sizing 'fixed 165 :fixed-width 50 166 :clickable #t)) 167 ;; tim column 168 (renderer4 (make <gtk-cell-renderer-toggle> 169 :xalign 0)) 170 (column4 (make <gtk-tree-view-column> 171 :title "Tim" 172 :sizing 'fixed 173 :fixed-width 50 174 :clickable #t)) 175 ;; owen column 176 (renderer5 (make <gtk-cell-renderer-toggle> 177 :xalign 0)) 178 (column5 (make <gtk-tree-view-column> 179 :title "Owen" 180 :sizing 'fixed 181 :fixed-width 50 182 :clickable #t)) 183 ;; dave column 184 (renderer6 (make <gtk-cell-renderer-toggle> 185 :xalign 0)) 186 (column6 (make <gtk-tree-view-column> 187 :title "Dave" 188 :sizing 'fixed 189 :fixed-width 50 190 :clickable #t))) 191 (pack-start column1 renderer1 #f) 192 (add-attribute column1 renderer1 "text" 0) 193 (append-column treeview column1) 194 195 (pack-start column2 renderer2 #f) 196 (connect renderer2 'toggled (lambda (w p) 197 (item-toggled model p alex-column))) 198 (add-attribute column2 renderer2 "active" alex-column) 199 (add-attribute column2 renderer2 "visible" visible-column) 200 (add-attribute column2 renderer2 "activatable" world-column) 201 (append-column treeview column2) 202 203 (connect renderer3 'toggled (lambda (w p) 204 (item-toggled model p havoc-column))) 205 (pack-start column3 renderer3 #f) 206 (add-attribute column3 renderer3 "active" havoc-column) 207 (add-attribute column3 renderer3 "visible" visible-column) 208 (append-column treeview column3) 209 210 (connect renderer4 'toggled (lambda (w p) 211 (item-toggled model p tim-column))) 212 (pack-start column4 renderer4 #f) 213 (add-attribute column4 renderer4 "active" tim-column) 214 (add-attribute column4 renderer4 "visible" visible-column) 215 (add-attribute column4 renderer4 "activatable" world-column) 216 (append-column treeview column4) 217 218 (connect renderer5 'toggled (lambda (w p) 219 (item-toggled model p owen-column))) 220 (pack-start column5 renderer5 #f) 221 (add-attribute column5 renderer5 "active" owen-column) 222 (add-attribute column5 renderer5 "visible" visible-column) 223 (append-column treeview column5) 224 225 (connect renderer6 'toggled (lambda (w p) 226 (item-toggled model p dave-column))) 227 (pack-start column6 renderer6 #f) 228 (add-attribute column6 renderer6 "active" dave-column) 229 (add-attribute column6 renderer6 "visible" visible-column) 230 (append-column treeview column6))) 231 232(define (main) 233 (let* ( 234 ;; create window, etc 235 (window (make <gtk-window> 236 :type 'toplevel :title "Card planning sheet" 237 :default-width 650 :default-height 400)) 238 (vbox (make <gtk-vbox> 239 :homogeneous #f :spacing 8 :border-width 8)) 240 (sw (make <gtk-scrolled-window> 241 :hscrollbar-policy 'automatic 242 :vscrollbar-policy 'automatic 243 :shadow-type 'etched-in)) 244 ;; create tree model 245 (model (create-model)) 246 ;; create tree view 247 (treeview (make <gtk-tree-view> 248 :model model :rules-hint #t)) 249 ;; some buttons 250 (hbox (make <gtk-hbox> :homogeneous #t :spacing 4)) 251 (button1 (make <gtk-button> :label "Add item")) 252 (button2 (make <gtk-button> :label "Remove item"))) 253 (add window vbox) 254 255 (pack-start vbox 256 (make <gtk-label> 257 :label "Jonathan's Holiday Card Planning Sheet") 258 #f #f 0) 259 260 (pack-start vbox sw #t #t 0) 261 262 (set-mode (get-selection treeview) 'multiple) 263 264 (add-columns treeview) 265 266 (add sw treeview) 267 268 ;; expand all rows after the treeview widget has been realized 269 (connect treeview 'realize (lambda (w) 270 (gtk-tree-view-expand-all treeview))) 271 272 (show-all window))) 273 274 275(define name "Tree View/Tree Store") 276(define description 277 (string-append 278 "The GtkTreeStore is used to store data in tree form, to be " 279 "used later on by a GtkTreeView to display it. This demo builds " 280 "a simple GtkTreeStore and displays it. If you're new to the " 281 "GtkTreeView widgets and associates, look into the GtkListStore " 282 "example first.")) 283 284