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))