Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv10807/root/cells-gtk
Modified Files: widgets.lisp Log Message: Cleanup timeout-add for CFFI
--- /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp 2006/02/11 03:39:10 1.16 +++ /project/cells-gtk/cvsroot/root/cells-gtk/widgets.lisp 2006/02/16 18:18:56 1.17 @@ -233,15 +233,16 @@ (if r2 1 0)))
(defun timeout-add (milliseconds function) - (let ((id (gtk-global-callback-register + "Call FUNCTION repeatedly, waiting MILLISECONDS between calls. + Stops calling when function return false." + (let* ((id (gtk-global-callback-register (lambda () ;;(print :timeout-add-global) (let ((r (with-gdk-threads - (funcall function)))) + (funcall function)))) (trc nil "timeout func returning" r) r)))) - (c-id (fgn-alloc :int 1))) - (setf (cffi:mem-aref c-id :int 0) (coerce id 'integer)) + (c-id (cffi:foreign-alloc :int :initial-element id))) (trc nil "timeout-add > passing cb data, *data" c-id (cffi:mem-aref c-id :int 0)) (g-timeout-add milliseconds (cffi:get-callback 'timeout-handler-callback) c-id)))
@@ -344,7 +345,7 @@
(def-c-output icon ((self window)) (when new-value - (gtk-window-set-icon-from-file (id self) new-value c-null))) + (gtk-window-set-icon-from-file (id self) new-value +c-null+)))
(def-c-output decorated ((self window)) (gtk-window-set-decorated (id self) new-value))