From 9ca5565a9443f9bd9f464838b7828589fe47be7f Mon Sep 17 00:00:00 2001 From: espen Date: Fri, 19 Nov 2004 13:02:51 +0000 Subject: [PATCH] Added pseudo type COPY-OF --- glib/ffi.lisp | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++--- glib/gparam.lisp | 6 +++--- glib/gtype.lisp | 17 +++++++++++++-- glib/proxy.lisp | 33 ++++++++++++++++++++-------- 4 files changed, 105 insertions(+), 17 deletions(-) diff --git a/glib/ffi.lisp b/glib/ffi.lisp index 925eaf8..e7bbd95 100644 --- a/glib/ffi.lisp +++ b/glib/ffi.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: ffi.lisp,v 1.5 2004-11-12 11:34:14 espen Exp $ +;; $Id: ffi.lisp,v 1.6 2004-11-19 13:02:51 espen Exp $ (in-package "GLIB") @@ -234,6 +234,11 @@ (def-type-method from-alien-function ()) (def-type-method cleanup-function ()) +(def-type-method copy-to-alien-form (form)) +(def-type-method copy-to-alien-function ()) +(def-type-method copy-from-alien-form (form)) +(def-type-method copy-from-alien-function ()) + (def-type-method writer-function ()) (def-type-method reader-function ()) (def-type-method destroy-function ()) @@ -297,6 +302,18 @@ #'(lambda (location offset) (declare (ignore location offset)))) +(defmethod copy-to-alien-form (form (type t) &rest args) + (apply #'to-alien-form form type args)) + +(defmethod copy-to-alien-function ((type t) &rest args) + (apply #'to-alien-function type args)) + +(defmethod copy-from-alien-form (form (type t) &rest args) + (apply #'from-alien-form form type args)) + +(defmethod copy-from-alien-function ((type t) &rest args) + (apply #'from-alien-function type args)) + (defmethod alien-type ((type (eql 'signed-byte)) &rest args) (declare (ignore type)) @@ -494,13 +511,17 @@ (declare (ignore type args)) `(let ((string ,string)) (unless (null-pointer-p string) - (c-call::%naturalize-c-string string)))) + (prog1 + (c-call::%naturalize-c-string string) + (deallocate-memory string))))) (defmethod from-alien-function ((type (eql 'string)) &rest args) (declare (ignore type args)) #'(lambda (string) (unless (null-pointer-p string) - (c-call::%naturalize-c-string string)))) + (prog1 + (c-call::%naturalize-c-string string) + (deallocate-memory string))))) (defmethod cleanup-form (string (type (eql 'string)) &rest args) (declare (ignore type args)) @@ -514,6 +535,18 @@ (unless (null-pointer-p string) (deallocate-memory string)))) +(defmethod copy-from-alien-form (string (type (eql 'string)) &rest args) + (declare (ignore type args)) + `(let ((string ,string)) + (unless (null-pointer-p string) + (c-call::%naturalize-c-string string)))) + +(defmethod copy-from-alien-function ((type (eql 'string)) &rest args) + (declare (ignore type args)) + #'(lambda (string) + (unless (null-pointer-p string) + (c-call::%naturalize-c-string string)))) + (defmethod writer-function ((type (eql 'string)) &rest args) (declare (ignore type args)) #'(lambda (string location &optional (offset 0)) @@ -709,3 +742,30 @@ #'(lambda (value) (declare (ignore value)) (values))) + + +(defmethod alien-type ((type (eql 'copy-of)) &rest args) + (declare (ignore type)) + (alien-type (first args))) + +(defmethod size-of ((type (eql 'copy-of)) &rest args) + (declare (ignore type)) + (size-of (first args))) + +(defmethod to-alien-form (form (type (eql 'copy-of)) &rest args) + (declare (ignore type)) + (copy-to-alien-form form (first args))) + +(defmethod to-alien-function ((type (eql 'copy-of)) &rest args) + (declare (ignore type)) + (copy-to-alien-function (first args))) + +(defmethod from-alien-form (form (type (eql 'copy-of)) &rest args) + (declare (ignore type)) + (copy-from-alien-form form (first args))) + +(defmethod from-alien-function ((type (eql 'copy-of)) &rest args) + (declare (ignore type)) + (copy-from-alien-function (first args))) + +(export 'copy-of) diff --git a/glib/gparam.lisp b/glib/gparam.lisp index 4579a32..ec24b96 100644 --- a/glib/gparam.lisp +++ b/glib/gparam.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gparam.lisp,v 1.10 2004-11-12 15:01:42 espen Exp $ +;; $Id: gparam.lisp,v 1.11 2004-11-19 13:02:51 espen Exp $ (in-package "GLIB") @@ -134,12 +134,12 @@ :allocation :virtual :getter "g_param_spec_get_nick" :reader param-nickname - :type string) + :type (copy-of string)) (documentation :allocation :virtual :getter "g_param_spec_get_blurb" :reader param-documentation - :type string)) + :type (copy-of string))) (:metaclass param-spec-class)) diff --git a/glib/gtype.lisp b/glib/gtype.lisp index c674a21..414dc41 100644 --- a/glib/gtype.lisp +++ b/glib/gtype.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gtype.lisp,v 1.20 2004-11-13 16:37:09 espen Exp $ +;; $Id: gtype.lisp,v 1.21 2004-11-19 13:02:51 espen Exp $ (in-package "GLIB") @@ -147,7 +147,7 @@ (etypecase name (string (type-from-number (find-type-number name t))))) -(defbinding (find-type-name "g_type_name") (type) string +(defbinding (find-type-name "g_type_name") (type) (copy-of string) ((find-type-number type t) type-number)) (defun type-number-of (object) @@ -203,6 +203,19 @@ ;; TODO: (make-instance 'ginstance ...) location))) +(defmethod copy-from-alien-form (location (class ginstance-class) &rest args) + (declare (ignore location class args)) + (error "Doing copy-from-alien on a ref. counted class is most certainly an error, but if it really is what you want you should use REFERENCE-FOREIGN on the returned instance instead.")) + +(defmethod copy-from-alien-function ((class ginstance-class) &rest args) + (declare (ignore class args)) + (error "Doing copy-from-alien on a ref. counted class is most certainly an error, but if it really is what you want you should use REFERENCE-FOREIGN on the returned instance instead.")) + +(defmethod reader-function ((class ginstance-class) &rest args) + (declare (ignore args)) + #'(lambda (location &optional (offset 0)) + (ensure-proxy-instance class (sap-ref-sap location offset)))) + ;;;; Metaclass for subclasses of ginstance diff --git a/glib/proxy.lisp b/glib/proxy.lisp index 88971c1..f5c3f6e 100644 --- a/glib/proxy.lisp +++ b/glib/proxy.lisp @@ -15,7 +15,7 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: proxy.lisp,v 1.13 2004-11-15 19:20:55 espen Exp $ +;; $Id: proxy.lisp,v 1.14 2004-11-19 13:02:51 espen Exp $ (in-package "GLIB") @@ -365,6 +365,26 @@ (declare (ignore class args)) #'proxy-location) +(defmethod copy-from-alien-form (location (class proxy-class) &rest args) + (declare (ignore args)) + (let ((class-name (class-name class))) + `(ensure-proxy-instance ',class-name + (reference-foreign ',class-name ,location)))) + +(defmethod copy-from-alien-function ((class proxy-class) &rest args) + (declare (ignore args)) + #'(lambda (location) + (ensure-proxy-instance class (reference-foreign class location)))) + +(defmethod copy-to-alien-form (instance (class proxy-class) &rest args) + (declare (ignore args)) + `(reference-foreign ',(class-name class) (proxy-location ,instance))) + +(defmethod copy-to-alien-function ((class proxy-class) &rest args) + (declare (ignore class args)) + #'(lambda (instance) + (reference-foreign class (proxy-location instance)))) + (defmethod writer-function ((class proxy-class) &rest args) (declare (ignore args)) #'(lambda (instance location &optional (offset 0)) @@ -376,7 +396,9 @@ (defmethod reader-function ((class proxy-class) &rest args) (declare (ignore args)) #'(lambda (location &optional (offset 0)) - (ensure-proxy-instance class (sap-ref-sap location offset)))) + (let ((instance (sap-ref-sap location offset))) + (unless (null-pointer-p instance) + (ensure-proxy-instance class (reference-foreign class instance)))))) (defmethod destroy-function ((class proxy-class) &rest args) (declare (ignore args)) @@ -427,13 +449,6 @@ (defmethod unreference-foreign ((class struct-class) location) (deallocate-memory location)) -(defmethod reader-function ((class struct-class) &rest args) - (declare (ignore args)) - #'(lambda (location &optional (offset 0)) - (let ((instance (sap-ref-sap location offset))) - (unless (null-pointer-p instance) - (ensure-proxy-instance class (reference-foreign class instance)))))) - (defclass static-struct-class (struct-class) ()) -- 2.11.0