X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/028ac2764f3c4c4209e59ec71259d2c680c1caea..888d25fbde9bc2cd966efffc2d34cb8329aff573:/glib/gboxed.lisp diff --git a/glib/gboxed.lisp b/glib/gboxed.lisp index 664414a..2dc51a4 100644 --- a/glib/gboxed.lisp +++ b/glib/gboxed.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: gboxed.lisp,v 1.3 2001/05/11 16:04:33 espen Exp $ +;; $Id: gboxed.lisp,v 1.4 2001/05/29 15:46:17 espen Exp $ (in-package "GLIB") @@ -68,3 +68,34 @@ (defun expand-boxed-type (type-number &optional slots) (:alien-name ,(find-type-name type-number)))) (register-derivable-type 'boxed "GBoxed" :expand 'expand-boxed-type) + +;;;; Special boxed types + +(defclass gstring (boxed) + () + (:metaclass boxed-class) + (:alien-name "GString")) + +(deftype-method translate-from-alien + gstring (type-spec location &optional weak-ref) + `(let ((location ,location)) + (unless (null-pointer-p location) + (prog1 + (c-call::%naturalize-c-string location) + ,(unless weak-ref + (unreference-alien type-spec location)))))) + +(deftype-method translate-to-alien + gstring (type-spec string &optional weak-ref) + (declare (ignore type-spec weak-ref)) + `(let ((string ,string)) + ;; Always copy strings to prevent seg fault due to GC + (funcall + ',(proxy-class-copy (find-class type-spec)) + ',type-spec + (make-pointer (1+ (kernel:get-lisp-obj-address string)))))) + +(deftype-method cleanup-alien gstring (type-spec c-string &optional weak-ref) + (when weak-ref + (unreference-alien type-spec c-string))) +