/usr/share/doc/guile-gnome2-gtk/examples/guile-gtk-demo/demos/tree-model.scm is in guile-gnome2-gtk 2.16.2-1.1ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | ;; Copyright (C) 2003,2004 Free Software Foundation, Inc.
;; GNU General Public License version 2 or later. No warrantee.
(define-module (demos tree-model)
:use-module (oop goops)
:use-module (gnome gobject)
:use-module (gnome gtk))
(define-class <my-tree-model> (<guile-gtk-tree-model>)
depth
siblings)
(define-method (on-get-n-columns (obj <my-tree-model>))
1)
(define-method (on-get-column-type (obj <my-tree-model>) index)
<gchararray>)
(define-method (on-get-iter (obj <my-tree-model>) path)
path)
(define-method (on-get-path (obj <my-tree-model>) iter)
iter)
(define-method (on-get-value (obj <my-tree-model>) iter index)
(format #f "~A" iter))
(define-method (on-iter-next (obj <my-tree-model>) iter)
(let* ((reversed (reverse iter))
(next (1+ (car reversed))))
(if (eq? next (slot-ref obj 'siblings))
#f
(reverse (cons next (cdr reversed))))))
(define-method (on-iter-children (obj <my-tree-model>) parent)
(cond
((not parent)
(list 0))
((eq? (length parent) (slot-ref obj 'depth))
#f)
(else
(reverse (cons 0 (reverse parent))))))
(define-method (on-iter-has-child (obj <my-tree-model>) iter)
(not (eq? (length iter) (slot-ref obj 'depth))))
(define-method (on-iter-n-children (obj <my-tree-model>) iter)
(cond
((not iter)
(slot-ref obj 'siblings))
((on-iter-has-child obj iter)
(slot-ref obj 'siblings))
(else
0)))
(define-method (on-iter-nth-child (obj <my-tree-model>) parent n)
(let ((nchildren (on-iter-n-children obj parent)))
(if (< n nchildren)
(reverse (cons n (if parent (reverse parent) '())))
#f)))
(define-method (on-iter-parent (obj <my-tree-model>) iter)
(if (zero? (length iter))
#f
(reverse (cdr (reverse iter)))))
(define-method (initialize (obj <my-tree-model>) initargs)
(next-method)
(slot-set! obj 'depth 4)
(slot-set! obj 'siblings 5))
(define (main)
(let* ((w (make <gtk-window> :type 'toplevel :title "TreeModel Test"))
(scroll (make <gtk-scrolled-window>
:hscrollbar-policy 'automatic :vscrollbar-policy 'automatic))
(tmodel (make <my-tree-model>))
(tview (make <gtk-tree-view> :model tmodel))
(cell (make <gtk-cell-renderer-text>))
(column (make <gtk-tree-view-column> :title "Data")))
(pack-start column cell #t)
(add-attribute column cell "text" 0)
(append-column tview column)
(set-default-size w 250 250)
(add w scroll)
(add scroll tview)
(show-all w)
(connect w 'delete-event (lambda (w e) (gtk-widget-destroy w) #f))))
(define name "Tree Model")
(define description
(string-append
"This example shows how to implement a tree model in Scheme.\n"
"Tree paths are natively represented as lists of integers. In this simple "
"model, iters and values of the model are also the same as the paths. Note "
"that the data is not stored in the model, only the algorithm of how to "
"produce the data when it is requested. "))
|