1;; Copyright (C) 2004 Patrick Bernaud 2;; GNU General Public License version 2 or later. No warrantee. 3 4(define-module (demos editable-cells) 5 :use-module (oop goops) 6 :use-module (gnome gobject) 7 :use-module (gnome gtk)) 8 9(define (populate-model model) 10 (for-each 11 (lambda (x) 12 (add-item model x)) 13 '((3 "bottles of coke" #t) 14 (5 "package of noodles" #t) 15 (2 "packages of chocolate chip cookies" #t) 16 (1 "can vanilla ice cream" #t) 17 (6 "eggs" #t)))) 18 19(define (add-item model item) 20 (let ((iter (append model))) 21 (for-each 22 (lambda (i x) (set-value model iter i x)) 23 '(0 1 2) 24 item))) 25 26(define (add-new-item model) 27 (add-item model '(0 "Description here" #t))) 28 29(define (remove-selected-item treeview) 30 (call-with-values (lambda () (get-selected (get-selection treeview))) 31 (lambda (model iter) 32 (if iter (remove model iter))))) 33 34(define (cell-edited model column path newtext) 35 (let ((iter (get-iter model path))) 36 (cond (;; number column 37 (eqv? column 0) 38 (set-value model iter 0 (string->number newtext))) 39 (;; product column 40 (eq? column 1) 41 (set-value model iter 1 newtext))))) 42 43(define (add-columns treeview) 44 (let ((model (get-model treeview)) 45 ;; number column 46 (renderer1 (make <gtk-cell-renderer-text>)) 47 (column1 (make <gtk-tree-view-column> 48 :title "Number")) 49 ;; product column 50 (renderer2 (make <gtk-cell-renderer-text>)) 51 (column2 (make <gtk-tree-view-column> 52 :title "Product"))) 53 54 (connect renderer1 'edited (lambda (w p d) 55 (cell-edited model 0 p d))) 56 (pack-start column1 renderer1 #f) 57 (add-attribute column1 renderer1 "text" 0) 58 (add-attribute column1 renderer1 "editable" 2) 59 (append-column treeview column1) 60 61 (connect renderer2 'edited (lambda (w p d) 62 (cell-edited model 1 p d))) 63 (pack-start column2 renderer2 #f) 64 (add-attribute column2 renderer2 "text" 1) 65 (add-attribute column2 renderer2 "editable" 2) 66 (append-column treeview column2))) 67 68(define (main) 69 (let* (;; create window, etc 70 (window (make <gtk-window> 71 :type 'toplevel :title "Shopping list")) 72 (vbox (make <gtk-vbox> :homogeneous #f :spacing 5)) 73 (sw (make <gtk-scrolled-window> 74 :hscrollbar-policy 'automatic 75 :vscrollbar-policy 'automatic 76 :shadow-type 'etched-in)) 77 ;; create tree model 78 (model (gtk-list-store-new (list <gint> <gchararray> <gboolean>))) 79 ;; create tree view 80 (treeview (make <gtk-tree-view> 81 :model model :rules-hint #t)) 82 ;; some buttons 83 (hbox (make <gtk-hbox> :homogeneous #t :spacing 4)) 84 (button1 (make <gtk-button> :label "Add item")) 85 (button2 (make <gtk-button> :label "Remove item"))) 86 87 (set-border-width window 5) 88 89 (add window vbox) 90 (pack-start vbox 91 (make <gtk-label> 92 :label "Shopping list (you can edit the cells!)") 93 #f #f 0) 94 95 (pack-start vbox sw #t #t 0) 96 97 (populate-model model) 98 (set-mode (get-selection treeview) 'single) 99 (add-columns treeview) 100 (add sw treeview) 101 102 (pack-start vbox hbox #f #f 0) 103 104 (connect button1 'clicked (lambda (w) 105 (add-new-item model))) 106 (pack-start hbox button1 #t #t 0) 107 108 (connect button2 'clicked (lambda (w) 109 (remove-selected-item treeview))) 110 (pack-start hbox button2 #t #t 0) 111 112 (set-default-size window 320 200) 113 114 (show-all window))) 115 116(define name "Tree View/Editable Cells") 117(define description 118 (string-append 119 "This demo demonstrates the use of editable cells in a GtkTreeView. If " 120 "you're new to the GtkTreeView widgets and associates, look into " 121 "the GtkListStore example first.")) 122