[gtk-cffi-cvs] CVS gtk-cffi/ext

[CVS User rklochkov]

Update of /project/gtk-cffi/cvsroot/gtk-cffi/ext
In directory tiger.common-lisp.net:/tmp/cvs-serv13474/ext

Modified Files:
	addons.lisp 
Log Message:
Refactored defslots/def*funs



--- /project/gtk-cffi/cvsroot/gtk-cffi/ext/addons.lisp	2011/12/31 17:20:56	1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/ext/addons.lisp	2012/01/21 18:35:00	1.2
@@ -1,21 +1,31 @@
-(in-package :gtk-cffi)
+(in-package :gtk-cffi-ext)
 
-(defmethod show ((seq sequence) &key &allow-other-keys)
+(defmethod show ((model-impl lisp-model-impl) &key (columns '("List"))
+                 &allow-other-keys)
   (show
    (gtk-model 
      'window
      ('scrolled-window
-      ('tree-view :model 
-                  (make-instance 
-                   'lisp-model
-                   :implementation 
-                   (make-instance 'lisp-model-array 
-                                  :array (map 'vector 
-                                              (compose #'list 
-                                                       #'princ-to-string) 
-                                              seq) 
-                                  :columns '(:string)))
-                  :columns '("Array"))))))
+      ('tree-view :model (make-instance 'lisp-model
+                                        :implementation model-impl)
+                  :columns columns)))))
+
+(defmethod show ((seq sequence) &key &allow-other-keys)
+  (show
+   (if (some #'consp seq)
+       (make-instance 'lisp-model-tree-array
+                      :tree (labels ((process (x)
+                                       (if (consp x)
+                                           (cons (list (car x)) 
+                                                 (mapcar #'process (cdr x)))
+                                           (list (list x)))))
+                              (mapcar #'process (coerce seq 'list)))
+                      :columns '(:string))
+       (make-instance 'lisp-model-array 
+                      :array (map 'vector 
+                                  (compose #'list #'princ-to-string)
+                                  seq)
+                      :columns '(:string)))))
 
 ;; (defun status-tree ()
 ;;   (let ((tree-model (make-instance 'tree-strore)))