[cells-gtk-cvs] CVS update: root/cells-gtk/tree-view.lisp

[Peter Denno]

Update of /project/cells-gtk/cvsroot/root/cells-gtk
In directory common-lisp.net:/tmp/cvs-serv8145/cells-gtk

Modified Files:
	tree-view.lisp 
Log Message:
New ability: :expand-p allows tree to come up fully expanded. Moved code iter recording code from cells-gtk.lisp to here.
Date: Sun May 29 23:13:06 2005
Author: pdenno

Index: root/cells-gtk/tree-view.lisp
diff -u root/cells-gtk/tree-view.lisp:1.10 root/cells-gtk/tree-view.lisp:1.11
--- root/cells-gtk/tree-view.lisp:1.10	Sat Feb 26 23:30:39 2005
+++ root/cells-gtk/tree-view.lisp	Sun May 29 23:13:06 2005
@@ -16,6 +16,9 @@
  
 |#
 
+;;; Todo: separate tree-model/tree-store stuff into another file (used by combo box too).
+;;; BTW Tree-store implements the tree-model interface, among other things.
+
 (in-package :cgtk)
 
 (def-object list-store ()
@@ -56,6 +59,7 @@
    (children-fn :accessor children-fn :initarg :children-fn :initform #'(lambda (x) (declare (ignore x)) nil))
    (selected-items-cache :cell nil :accessor selected-items-cache :initform nil)
    (selection-mode :accessor selection-mode :initarg :selection-mode :initform :single)
+   (expand-all :accessor expand-all :initarg :expand-all :initform nil)
    (on-select :accessor on-select :initarg :on-select :initform nil)
    (tree-model :accessor tree-model :initarg :tree-model :initform nil))
   () ; gtk-slots
@@ -68,11 +72,16 @@
   (when new-value
     (gtk-tree-view-set-model (id self) (id (to-be new-value)))))
 
+(def-c-output expand-all ((self tree-view))
+  (when new-value
+    (gtk-tree-view-expand-all (id self))))
+
 (defun item-from-path (child-fn roots path)
   (loop for index in path
         for node = (nth index roots) then (nth index (funcall child-fn node))
         finally (return node)))
 
+;;; Used by combo-box also, when it is using a tree model. 
 (ff-defun-callable :cdecl :void tree-view-items-selector
   ((model :pointer-void) (path :pointer-void) (iter :pointer-void) (data :pointer-void))
   (declare (ignore path data))
@@ -161,8 +170,8 @@
 (defmodel treebox (tree-view)
   ()
   (:default-initargs 
-      :tree-model (c? (make-instance 'tree-store
-				:item-types (append (column-types self) (list :string))))))
+      :tree-model (c? (mk-tree-store
+		       :item-types (append (column-types self) (list :string))))))
 
 (defun mk-treebox (&rest inits)
   (let ((self (apply 'make-instance 'treebox inits)))
@@ -182,7 +191,24 @@
        for index from 0 do
 	 (gtk-tree-store-set-kids (id (tree-model self)) root c-null index
 				  (append (column-types self) (list :string)) 
-				  (print-fn self) (children-fn self)))))
+				  (print-fn self) (children-fn self)))
+    (when (expand-all self)
+      (gtk-tree-view-expand-all (id self)))))
+
+;;; These look like ("Trimmed Text" "(0 0 )") for example where menu structure is "Text --> Trimmed Text"
+;;; Column-types is a list of :string, :float etc. used to reference g-value-set-string etc.
+(defun gtk-tree-store-set-kids (model val-tree parent-iter index column-types print-fn children-fn &optional path)
+  (with-tree-iter (iter)
+    (gtk-tree-store-append model iter parent-iter) ; sets iter
+    (gtk-tree-store-set model iter ; Not a gtk function!
+      column-types
+      (append
+       (funcall print-fn val-tree)
+       (list (format nil "(~{~d ~})" (reverse (cons index path))))))
+    (loop for sub-tree in (funcall children-fn val-tree)
+          for pos from 0 do
+           (gtk-tree-store-set-kids model sub-tree iter
+            pos column-types print-fn children-fn (cons index path)))))
 
 (ff-defun-callable :cdecl :int tree-view-render-cell-callback
     ((tree-column :pointer-void) (cell-renderer :pointer-void)