Added --disable-debugger to sbcl invokation for html colorization

[cl-gtk2.git] / gboxed.test.lisp

diff --git a/gboxed.test.lisp b/gboxed.test.lisp
index afd8dc4..e2e56e3 100644 (file)
--- a/gboxed.test.lisp
+++ b/gboxed.test.lisp
@@ -1,11 +1,5 @@
 (in-package :gobject)
 
-#+nil(define-g-boxed-class "GdkRectangle" rectangle ()
-  (x :int :initform 0)
-  (y :int :initform 0)
-  (width :int :initform 0)
-  (height :int :initform 0))
-
 (define-foreign-type g-boxed-foreign-type ()
   ((info :initarg :info
          :accessor g-boxed-foreign-info
@@ -148,24 +142,29 @@ This call is always paired by call to CREATE-REFERENCE-PROXY."))
                 (slot-value proxy slot)))))
 
 (defmethod translate-to-foreign (proxy (type g-boxed-foreign-type))
-  (let* ((info (g-boxed-foreign-info type)))
-    (values (create-temporary-native info proxy) proxy)))
+  (if proxy
+      (let* ((info (g-boxed-foreign-info type)))
+        (values (create-temporary-native info proxy) proxy))
+      (null-pointer)))
 
 (defmethod free-translated-object (native-structure (type g-boxed-foreign-type) proxy)
-  (free-temporary-native (g-boxed-foreign-info type) proxy native-structure))
+  (when proxy
+    (free-temporary-native (g-boxed-foreign-info type) proxy native-structure)))
 
 (defmethod translate-from-foreign (native-structure (type g-boxed-foreign-type))
-  (let* ((info (g-boxed-foreign-info type)))
-    (cond
-      ((g-boxed-foreign-for-callback type)
-       (create-reference-proxy info native-structure))
-      ((or (g-boxed-foreign-free-to-foreign type)
-           (g-boxed-foreign-free-from-foreign type))
-       (error "Feature not yet handled"))
-      (t (create-proxy-for-native info native-structure)))))
+  (unless (null-pointer-p native-structure)
+    (let* ((info (g-boxed-foreign-info type)))
+      (cond
+        ((g-boxed-foreign-for-callback type)
+         (create-reference-proxy info native-structure))
+        ((or (g-boxed-foreign-free-to-foreign type)
+             (g-boxed-foreign-free-from-foreign type))
+         (error "Feature not yet handled"))
+        (t (create-proxy-for-native info native-structure))))))
 
 (defmethod cleanup-translated-object-for-callback ((type g-boxed-foreign-type) proxy native-structure)
-  (free-reference-proxy (g-boxed-foreign-info type) proxy native-structure))
+  (unless (null-pointer-p native-structure)
+    (free-reference-proxy (g-boxed-foreign-info type) proxy native-structure)))
 
 (defmethod has-callback-cleanup ((type g-boxed-foreign-type))
   t)