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

[Kenny Tilton]

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

Modified Files:
	cells-gtk.lisp tree-view.lisp widgets.lisp 
Log Message:
Both AllegroCL and Lispworks now run Cells-gtk on win32. Pretty much. All of Vasilis's examples work, with one known fault in Lispworks and bigger problems in AllegroCL in a couple of examples. This means a huge amount works, because vasilis did an extraordinary coverage of Gtk2 in his examples. I be moving on to see if I can score OS/X.
Date: Thu Dec 16 05:51:11 2004
Author: ktilton

Index: root/cells-gtk/cells-gtk.lisp
diff -u root/cells-gtk/cells-gtk.lisp:1.2 root/cells-gtk/cells-gtk.lisp:1.3
--- root/cells-gtk/cells-gtk.lisp:1.2	Sun Dec  5 07:33:22 2004
+++ root/cells-gtk/cells-gtk.lisp	Thu Dec 16 05:51:11 2004
@@ -25,11 +25,7 @@
 
 
 (defun gtk-tree-store-set-kids (model val-tree par-iter index column-types items-factory &optional path)
-  (with-foreign-object (iter 'gtk-tree-iter)
-    (setf (get-slot-value iter 'gtk-tree-iter 'stamp) 0)
-    (setf (get-slot-value iter 'gtk-tree-iter 'user-data) 0)
-    (setf (get-slot-value iter 'gtk-tree-iter 'user-data2) 0)
-    (setf (get-slot-value iter 'gtk-tree-iter 'user-data3) 0)
+  (with-tree-iter (iter)
     (gtk-ffi::gtk-tree-store-append model iter par-iter)
     (gtk-ffi::gtk-tree-store-set model iter
       column-types


Index: root/cells-gtk/tree-view.lisp
diff -u root/cells-gtk/tree-view.lisp:1.4 root/cells-gtk/tree-view.lisp:1.5
--- root/cells-gtk/tree-view.lisp:1.4	Tue Dec 14 05:01:51 2004
+++ root/cells-gtk/tree-view.lisp	Thu Dec 16 05:51:11 2004
@@ -102,24 +102,25 @@
 
 (ff-defun-callable :cdecl :int tree-view-select-handler
   ((column-widget (* :void)) (event (* :void)) (data (* :void)))
-  (let ((tree-view (gtk-object-find column-widget t)))
+  (bif (tree-view (gtk-object-find column-widget))
     (let ((cb (callback-recover tree-view :on-select)))
-      (funcall cb tree-view column-widget event data))))
+      (funcall cb tree-view column-widget event data))
+    (trc "dude, clean up old widgets after runs" column-widget)))
 
 (def-c-output on-select ((self tree-view))
   (when new-value    
     (trc "output on-select" self new-value)
     (let* ((selected-widget (gtk-tree-view-get-selection (id self)))
-           (selected-clos (gtk-object-find selected-widget nil)))
-      (unless selected-clos
-        (trc "whoa!!! no clos for selected" self selected-widget))
-      (when selected-clos
-        (assert (eql self selected-clos))
-        (gtk-object-store selected-widget self) ;; tie column widg to clos tree-view
-        (callback-register self :on-select new-value)
-        (let ((cb (ff-register-callable 'tree-view-select-handler)))
-          (trc "tree-view on-select pcb:" cb selected-widget "changed")
-          (gtk-signal-connect selected-widget "changed" cb)))))) 
+           (selected-clos (gtk-object-find selected-widget)))
+      (if (not selected-clos)
+        (trc "whoa!!! no clos for selected" self selected-widget)
+        (when selected-clos
+          (assert (eql self selected-clos))
+          (gtk-object-store selected-widget self) ;; tie column widg to clos tree-view
+          (callback-register self :on-select new-value)
+          (let ((cb (ff-register-callable 'tree-view-select-handler)))
+            (trc "tree-view on-select pcb:" cb selected-widget "changed")
+            (gtk-signal-connect selected-widget "changed" cb)))))))
 
 (defmodel listbox (tree-view)
   ()
@@ -171,13 +172,15 @@
 				  (append (column-types self) (list :string)) 
 				  (items-factory self)))))
 
-(ff-defun-callable :cdecl :int tree-view-render-call-callback
+(ff-defun-callable :cdecl :int tree-view-render-cell-callback
     ((tree-column (* :void)) (cell-renderer (* :void))
      (tree-model (* :void)) (iter (* :void)) (data (* :void)))
-  (let* ((self (gtk-object-find tree-column t))
-         (cb (callback-recover self :render-cell)))
-    (assert cb () "No :render-cell callback for ~a" self)
-    (funcall cb tree-column cell-renderer tree-model iter data)))
+  (bif (self (gtk-object-find tree-column))
+    (let ((cb (callback-recover self :render-cell)))
+      (assert cb () "No :render-cell callback for ~a" self)
+      (funcall cb tree-column cell-renderer tree-model iter data))
+    (trc "dude, clean up old widgets from prior runs" tree-column))
+  1)
 
 (def-c-output columns ((self tree-view))
   (when new-value
@@ -189,7 +192,7 @@
                          (t (gtk-cell-renderer-text-new))) do
           (gtk-tree-view-column-pack-start (id col) renderer t)
           (gtk-tree-view-column-set-cell-data-func (id col) renderer
-            (let ((cb (ff-register-callable 'tree-view-render-call-callback)))
+            (let ((cb (ff-register-callable 'tree-view-render-cell-callback)))
               (trc "tree-view columns pcb:" cb (id col) :render-cell)
               (callback-register col :render-cell
                 (gtk-tree-view-render-cell pos 


Index: root/cells-gtk/widgets.lisp
diff -u root/cells-gtk/widgets.lisp:1.4 root/cells-gtk/widgets.lisp:1.5
--- root/cells-gtk/widgets.lisp:1.4	Tue Dec 14 05:01:51 2004
+++ root/cells-gtk/widgets.lisp	Thu Dec 16 05:51:11 2004
@@ -80,11 +80,11 @@
   (when *gtk-objects*
     (let ((clos-widget (gethash hash-id *gtk-objects*)))
       (when (and must-find-p (not clos-widget))
-        (format t "~&gtk-object-find> ID ~a not found!!!!!!!" hash-id)
+        (format t "~&gtk.object.find> ID ~a not found!!!!!!!" hash-id)
         (maphash (lambda (key value)
                    (format t "~&  known: ~a | ~a" key value))
           *gtk-objects*)
-        (break "gtk-object-find ID not found ~a" hash-id))                  
+        (break "gtk.object.find ID not found ~a" hash-id))                  
       clos-widget)))
 
 ;; ----- fake callbackable closures ------------
@@ -120,9 +120,10 @@
   `(ff-defun-callable :cdecl :int ,(intern (string-upcase (format nil "~a-handler" event)))
      ((widget (* :void)) (event (* :void)) (data (* :void)))
      ;(print (list :entered-gtk-event-handler-cb ,(symbol-name event) widget))
-     (let ((self (gtk-object-find widget t)))
+     (bif (self (gtk-object-find widget))
        (let ((cb (callback-recover self ,(intern (symbol-name event) :keyword))))
-         (funcall cb self widget event data)))))
+         (funcall cb self widget event data))
+       (trc "unknown widget. from prior run. clean up on errors" widget))))
 
 (def-gtk-event-handler clicked)
 (def-gtk-event-handler changed)