X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=gboxed.test.lisp;h=e2e56e3d67579dc08bfcf0de28a5566d4e221542;hb=30479689751d0231111787728ac4cf4eab293e0e;hp=afd8dc4a674ed3ada605147cdd77e19f488af0e4;hpb=535f1c23d922cd039acafe083b6ea66ae9950051;p=cl-gtk2.git diff --git a/gboxed.test.lisp b/gboxed.test.lisp index afd8dc4..e2e56e3 100644 --- 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)