[cells-gtk-cvs] CVS root/cells-gtk

[pdenno]

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