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

[Kenny Tilton]

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

Modified Files:
	buttons.lisp gtk-app.lisp menus.lisp tree-view.lisp 
Log Message:
Fix for Lispworks for, inter alia, GDK-BUTTON-EVENT-HANDLER
Date: Wed Dec 22 17:23:50 2004
Author: ktilton

Index: root/cells-gtk/buttons.lisp
diff -u root/cells-gtk/buttons.lisp:1.4 root/cells-gtk/buttons.lisp:1.5
--- root/cells-gtk/buttons.lisp:1.4	Tue Dec 14 05:01:51 2004
+++ root/cells-gtk/buttons.lisp	Wed Dec 22 17:23:50 2004
@@ -43,7 +43,7 @@
 (def-c-output stock ((self button))
   (when new-value
     (setf (label self) (string-downcase (format nil "gtk-~a" new-value)))
-    (trc "stock" (label self)) (force-output)
+    (trc nil "c-outputting stock" (label self)) (force-output)
     (setf (use-stock self) t)))
 
 (def-widget toggle-button (button)
@@ -52,9 +52,9 @@
   (toggled)
   :active (c-in nil)
   :on-toggled (callback (widget event data)
-                (print (list :toggle-button :on-toggled-cb widget))
+                ;;(print (list :toggle-button :on-toggled-cb widget))
                 (let ((state (gtk-toggle-button-get-active widget)))
-                  (print (list :toggledstate state))
+                  ;;(print (list :toggledstate state))
                   (setf (md-value self) state))))
 
 #+test
@@ -88,7 +88,7 @@
 			  c-null
 			  (id (first (kids (fm-parent self))))))))
   :on-toggled  (callback (widget event data)
-                 (print (list :radio-button widget event data))
+                 ;;(print (list :radio-button widget event data))
                  (let ((state (gtk-toggle-button-get-active widget)))
                    (setf (md-value self) state))))
   


Index: root/cells-gtk/gtk-app.lisp
diff -u root/cells-gtk/gtk-app.lisp:1.4 root/cells-gtk/gtk-app.lisp:1.5
--- root/cells-gtk/gtk-app.lisp:1.4	Tue Dec 14 05:01:51 2004
+++ root/cells-gtk/gtk-app.lisp	Wed Dec 22 17:23:50 2004
@@ -84,7 +84,7 @@
           (gtk-main)))))
 
 (defvar *gtk-global-callbacks* nil)
-(defvar *gtk-loaded* nil)
+(defvar *gtk-loaded* #+clisp t #-clisp nil) ;; kt: looks like CLisp does this on its own
 
 (defun gtk-reset ()
   (cell-reset)
@@ -104,12 +104,20 @@
 
 (defun cells-gtk-init ()
   (gtk-reset)
+  #-cmu
   (unless *gtk-loaded*
     (loop for lib in '(:gthread :glib :gobject :gdk :gtk)
         do (assert (uffi:load-foreign-library (gtk-ffi::libname lib)
                      :force-load #+lispworks t #-lispworks nil
                      :module (string lib)))
         finally (setf *gtk-loaded* t))))
+
+#+cmu
+(loop for lib in '(:gthread :glib :gobject :gdk :gtk)
+        do (assert (uffi:load-foreign-library (gtk-ffi::libname lib)
+                     :force-load #+lispworks t #-lispworks nil
+                     :module (string lib)))
+        finally (setf *gtk-loaded* t))
 
 (eval-when (compile load eval)
   (export '(gtk-app gtk-reset cells-gtk-init title icon tooltips tooltips-enable tooltips-delay


Index: root/cells-gtk/menus.lisp
diff -u root/cells-gtk/menus.lisp:1.4 root/cells-gtk/menus.lisp:1.5
--- root/cells-gtk/menus.lisp:1.4	Tue Dec 14 05:01:51 2004
+++ root/cells-gtk/menus.lisp	Wed Dec 22 17:23:50 2004
@@ -196,16 +196,9 @@
   (toggled)
   :active (c-in nil)
   :on-toggled (callback (widget event data)
-                (trc "on-toggled" self widget event data)
+                (trc nil "on-toggled" self widget event data)
                 (let ((state (gtk-check-menu-item-get-active widget)))
                   (setf (md-value self) state))))
-
-#+not
-(DEF-GTK WIDGET CHECK-MENU-ITEM (MENU-ITEM) ((INIT :ACCESSOR INIT :INITARG :INIT :INITFORM NIL))
-         (ACTIVE) (TOGGLED) :ACTIVE (C-IN NIL) :ON-TOGGLED
-         (CALLBACK (WIDGET EVENT DATA) (TRC "on-toggled" SELF WIDGET EVENT DATA)
-                   (LET ((STATE (GTK-CHECK-MENU-ITEM-GET-ACTIVE WIDGET)))
-                     (SETF (MD-VALUE SELF) STATE))))
 
 (def-c-output init ((self check-menu-item))
   (setf (active self) new-value)


Index: root/cells-gtk/tree-view.lisp
diff -u root/cells-gtk/tree-view.lisp:1.5 root/cells-gtk/tree-view.lisp:1.6
--- root/cells-gtk/tree-view.lisp:1.5	Thu Dec 16 05:51:11 2004
+++ root/cells-gtk/tree-view.lisp	Wed Dec 22 17:23:50 2004
@@ -109,11 +109,11 @@
 
 (def-c-output on-select ((self tree-view))
   (when new-value    
-    (trc "output on-select" self new-value)
+    (trc nil "output on-select" self new-value)
     (let* ((selected-widget (gtk-tree-view-get-selection (id self)))
            (selected-clos (gtk-object-find selected-widget)))
       (if (not selected-clos)
-        (trc "whoa!!! no clos for selected" self selected-widget)
+        (trc nil "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
@@ -193,7 +193,7 @@
           (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-cell-callback)))
-              (trc "tree-view columns pcb:" cb (id col) :render-cell)
+              (trc nil "tree-view columns pcb:" cb (id col) :render-cell)
               (callback-register col :render-cell
                 (gtk-tree-view-render-cell pos 
                   (nth pos (column-types self))