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)