[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