[mcclim-cvs] CVS mcclim/Backends/gtkairo

[dlichteblau]

Update of /project/mcclim/cvsroot/mcclim/Backends/gtkairo
In directory clnet:/tmp/cvs-serv24530

Modified Files:
	event.lisp frame-manager.lisp gtk-ffi.lisp 
Log Message:

Fix CMUCL support.

	* event.lisp (get-next-event): Yield.
	
	* frame-manager.lisp ((defgeneric make-pane-2)): New.

	* gtk-ffi.lisp (invoke-with-gtk): Inhibit scheduling.

	* mcclim.asd: Don't (require :clx) when :gtkairo is set.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp	2006/12/10 16:34:32	1.16
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp	2006/12/10 19:33:05	1.17
@@ -115,6 +115,7 @@
     (t
       #+clim-gtkairo::do-not-block-in-ffi
       (sb-sys:wait-until-fd-usable (gdk-xlib-fd) :input 0.1)
+      #+cmu (mp:process-yield)
       (gtk-main-iteration port #-clim-gtkairo::do-not-block-in-ffi t)
       (dequeue port))))
 
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/frame-manager.lisp	2006/11/19 18:08:16	1.9
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/frame-manager.lisp	2006/12/10 19:33:05	1.10
@@ -44,6 +44,9 @@
 	 :port (port frame)
 	 initargs))
 
+;; make CMUCL happy
+(defgeneric make-pane-2 (type &rest args &key &allow-other-keys))
+
 (defmethod make-pane-2 (type &rest initargs)
   (apply #'make-instance type initargs))
 
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp	2006/12/10 16:34:32	1.18
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp	2006/12/10 19:33:05	1.19
@@ -131,17 +131,18 @@
 ;; functions to lock and unlock a recursive lock for that, which the
 ;; portability files currently don't provide.
 (defun invoke-with-gtk (fn)
-  (with-cairo-floats ()
-    (unless *have-lock*
-      (gdk_threads_enter))
-    (unwind-protect
-	(let ((*have-lock* t))
-	  (funcall fn))
+  (#-cmu progn #+cmu mp:without-scheduling
+    (with-cairo-floats ()
       (unless *have-lock*
-	;; fixme: gdk documentation recommends flushing before releasing
-	;; the lock.  But doing so makes everything s.l.o.w.
+	(gdk_threads_enter))
+      (unwind-protect
+	  (let ((*have-lock* t))
+	    (funcall fn))
+	(unless *have-lock*
+	  ;; fixme: gdk documentation recommends flushing before releasing
+	  ;; the lock.  But doing so makes everything s.l.o.w.
 ;;;	(gdk_flush)
-	(gdk_threads_leave)))))
+	  (gdk_threads_leave))))))
 
 
 ;;; GROVELME