From 7b91ee6247306f509bcc7838a195a47792e679bc Mon Sep 17 00:00:00 2001 From: Dmitry Kalyanov Date: Fri, 24 Jul 2009 01:57:21 +0400 Subject: [PATCH] gtk-demo: added demo-treeview-tree function --- gtk/gtk.demo.lisp | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 61 insertions(+), 1 deletion(-) diff --git a/gtk/gtk.demo.lisp b/gtk/gtk.demo.lisp index 5d142b9..435e97a 100644 --- a/gtk/gtk.demo.lisp +++ b/gtk/gtk.demo.lisp @@ -22,7 +22,8 @@ #:test-box-child-property #:test-builder #:demo-text-editor - #:demo-class-browser)) + #:demo-class-browser + #:demo-treeview-tree)) (in-package :gtk-demo) @@ -688,3 +689,62 @@ (display-class-slots class))))) (g-signal-connect search-button "clicked" #'on-search-clicked)) (widget-show window))))) + +(defun make-tree-from-sexp (l) + (setf l (if (listp l) l (list l))) + (let ((node (make-tree-node :item (make-tvi :title (format nil "~S" (first l)) + :value (format nil "~S" (class-of (first l))))))) + (iter (for child in (rest l)) + (tree-node-insert-at node (make-tree-from-sexp child) (length (tree-node-children node)))) + node)) + +(defun demo-treeview-tree () + (within-main-loop + (let* ((window (make-instance 'gtk-window :type :toplevel :title "Treeview (tree)")) + (model (make-instance 'tree-lisp-store)) + (scroll (make-instance 'scrolled-window :hscrollbar-policy :automatic :vscrollbar-policy :automatic)) + (tree-view (make-instance 'tree-view :headers-visible t :width-request 300 :height-request 400 :rules-hint t)) + (h-box (make-instance 'h-box)) + (v-box (make-instance 'v-box)) + (entry (make-instance 'entry)) + (button (make-instance 'button :label "Display"))) + (tree-lisp-store-add-column model "gchararray" #'tvi-title) + (tree-lisp-store-add-column model "gchararray" #'tvi-value) + (tree-node-insert-at (tree-lisp-store-root model) + (make-tree-from-sexp '(lambda (object &rest initargs &key &allow-other-keys) + (* 1 2) + (- 3 4))) + 0) + (setf (tree-view-model tree-view) model + (tree-view-tooltip-column tree-view) 0) + (connect-signal tree-view "row-activated" (lambda (tv path column) + (release* tv path column) + (format t "You clicked on row ~A~%" (tree-path-indices path)))) + (connect-signal button "clicked" (lambda (b) + (declare (ignore b)) + (let ((object (read-from-string (entry-text entry)))) + (tree-node-remove-at (tree-lisp-store-root model) 0) + (tree-node-insert-at (tree-lisp-store-root model) + (make-tree-from-sexp object) + 0)))) + (container-add window v-box) + (box-pack-start v-box h-box :expand nil) + (box-pack-start h-box entry) + (box-pack-start h-box button :expand nil) + (box-pack-start v-box scroll) + (container-add scroll tree-view) + (let ((column (make-instance 'tree-view-column :title "Value" :sort-column-id 0)) + (renderer (make-instance 'cell-renderer-text :text "A text"))) + (tree-view-column-pack-start column renderer) + (tree-view-column-add-attribute column renderer "text" 0) + (tree-view-append-column tree-view column) + (print (tree-view-column-tree-view column)) + (print (tree-view-column-cell-renderers column))) + (let ((column (make-instance 'tree-view-column :title "Type")) + (renderer (make-instance 'cell-renderer-text :text "A text"))) + (tree-view-column-pack-start column renderer) + (tree-view-column-add-attribute column renderer "text" 1) + (tree-view-append-column tree-view column) + (print (tree-view-column-tree-view column)) + (print (tree-view-column-cell-renderers column))) + (widget-show window)))) -- 1.7.10.4