[mcclim-cvs] CVS mcclim/Backends/gtkairo

dlichteblau dlichteblau at common-lisp.net
Sun Nov 12 11:26:13 UTC 2006


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

Modified Files:
	event.lisp gtk-ffi.lisp port.lisp 
Log Message:
Fix issue reported by C Y on cffi-devel, 2006-11-11:
Use the documented gdk_error_trap_push() instead of internal variables.

	* gtk-ffi.lisp (_gdk_error_warnings, _gdk_error_code): Removed.
	(gdk_error_trap_push, gdk_error_trap_pop): New declarations.
	
	* event.lisp (dribble-x-errors): Pop the previous error, push a
	new handler.

	* port.lisp (initialize-instance): Push a handler.

Misc:

	* port.lisp (*old-frontend-size-hack*): Removed.
	(mirror-drawable): Don't bind *o-f-s-h*.  (port-mirror-width,
	port-mirror-height): Don't obey *o-f-s-h*.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp	2006/11/05 18:43:19	1.10
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/event.lisp	2006/11/12 11:26:13	1.11
@@ -87,12 +87,13 @@
 
 (defun dribble-x-errors ()
   #-(or win32 windows mswindows)
-  (unless (zerop *-gdk-error-code*)
-    (warn "Ignoring X error ~D: ~A"
-	  *-gdk-error-code*
-	  (cffi:with-foreign-pointer-as-string (buf 64)
-	    (XGetErrorText *gdk-display* *-gdk-error-code* buf 63)))
-    (setf *-gdk-error-code* 0)))
+  (let ((code (gdk_error_trap_pop)))
+    (unless (zerop code)
+      (warn "Ignoring X error ~D: ~A"
+            code
+            (cffi:with-foreign-pointer-as-string (buf 64)
+              (XGetErrorText *gdk-display* code buf 63))))
+    (gdk_error_trap_push)))
 
 ;; thread-safe entry function
 (defun gtk-main-iteration (port &optional block)
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp	2006/11/05 21:23:11	1.11
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp	2006/11/12 11:26:13	1.12
@@ -133,8 +133,8 @@
 
 ;;; Error handling:
 
-(cffi:defcvar "_gdk_error_warnings" :int)
-(cffi:defcvar "_gdk_error_code" :int)
+(defcfun "gdk_error_trap_push" :void)
+(defcfun "gdk_error_trap_pop" :int)
 
 #-(or win32 mswindows windows)
 (cffi:defcfun "XGetErrorText"
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp	2006/11/05 21:23:12	1.7
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp	2006/11/12 11:26:13	1.8
@@ -76,7 +76,7 @@
     (g_thread_init (cffi:null-pointer))
     (gdk_threads_init)
     #-(or win32 windows mswindows)
-    (setf *-gdk-error-warnings* 0))
+    (gdk_error_trap_push))
   (with-gtk ()
     ;; FIXME: hier koennten wir mindestens ein anderes --display uebergeben
     ;; wenn wir wollten
@@ -135,14 +135,11 @@
 
 (defvar *double-buffering-p* t)
 
-(defparameter *old-frontend-size-hack* t)
-
 (defmethod mirror-drawable ((mirror widget-mirror))
   (if *double-buffering-p*
       (or (mirror-buffering-pixmap mirror)
 	  (setf (mirror-buffering-pixmap mirror)
-		(let* ((*old-frontend-size-hack* nil)
-		       (window (mirror-real-drawable mirror))
+		(let* ((window (mirror-real-drawable mirror))
 		       (region (climi::sheet-mirror-region
 				(climi::port-lookup-sheet
 				 (mirror-port mirror)
@@ -644,22 +641,18 @@
   (error "port-string-width called, what now?"))
 
 (defmethod port-mirror-width ((port gtkairo-port) sheet)
-  (if *old-frontend-size-hack*
-      #x10000
-      (cffi:with-foreign-object (r 'gtkrequisition)
-	(gtk_widget_size_request
-	 (mirror-widget (climi::port-lookup-mirror port sheet))
-	 r)
-	(cffi:foreign-slot-value r 'gtkrequisition 'width))))
+  (cffi:with-foreign-object (r 'gtkrequisition)
+    (gtk_widget_size_request
+     (mirror-widget (climi::port-lookup-mirror port sheet))
+     r)
+    (cffi:foreign-slot-value r 'gtkrequisition 'width)))
 
 (defmethod port-mirror-height ((port gtkairo-port) sheet)
-  (if *old-frontend-size-hack*
-      #x10000
-      (cffi:with-foreign-object (r 'gtkrequisition)
-	(gtk_widget_size_request
-	 (mirror-widget (climi::port-lookup-mirror port sheet))
-	 r)
-	(cffi:foreign-slot-value r 'gtkrequisition 'height))))
+  (cffi:with-foreign-object (r 'gtkrequisition)
+    (gtk_widget_size_request
+     (mirror-widget (climi::port-lookup-mirror port sheet))
+     r)
+    (cffi:foreign-slot-value r 'gtkrequisition 'height)))
 
 (defmethod port-mirror-width ((port gtkairo-port) (sheet gtkairo-graft))
   (graft-width sheet))




More information about the Mcclim-cvs mailing list