X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fgobject.foreign-gobject-subclassing.lisp;h=b197b5faa48e7c0c49bab0c2b591fae86af2555b;hb=fa09303681fef160cc4340fd5059321ff5d98776;hp=d41d5bb41891d3b7c0a434aa132bdb2f1299fdc9;hpb=ddaa0292b675c0336e20dfcca1ce3c7dcfc8ccee;p=cl-gtk2.git diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp index d41d5bb..b197b5f 100644 --- a/glib/gobject.foreign-gobject-subclassing.lisp +++ b/glib/gobject.foreign-gobject-subclassing.lisp @@ -72,7 +72,7 @@ (+g-type-string+ (g-param-spec-string property-name property-name property-name "" flags)) (+g-type-pointer+ (g-param-spec-pointer property-name property-name property-name flags)) (+g-type-boxed+ (g-param-spec-boxed property-name property-name property-name property-g-type flags)) - ;(+g-type-param+ (parse-gvalue-param gvalue)) + ;(+g-type-param+ (parse-g-value-param gvalue)) (+g-type-object+ (g-param-spec-object property-name property-name property-name property-g-type flags)) ;(+g-type-interface+ ) (t (error "Unknown type: ~A (~A)" property-g-type (g-type-name property-g-type))))))) @@ -117,7 +117,7 @@ (make-vtable-description :type-name ,type-name :cstruct-name ',cstruct-name :methods (list ,@(mapcar #'make-load-form (vtable-methods items))))) ,@(iter (for method in (vtable-methods items)) (collect `(defgeneric ,(vtable-method-info-name method) (,@(mapcar #'first (vtable-method-info-args method))))) - (collect `(defcallback ,(vtable-method-info-callback-name method) ,(vtable-method-info-return-type method) + (collect `(glib-defcallback ,(vtable-method-info-callback-name method) ,(vtable-method-info-return-type method) (,@(vtable-method-info-args method)) (restart-case (,(vtable-method-info-name method) ,@(mapcar #'first (vtable-method-info-args method))) @@ -125,6 +125,7 @@ (defun interface-init (iface data) (destructuring-bind (class-name interface-name) (prog1 (get-stable-pointer-value data) (free-stable-pointer data)) + (declare (ignorable class-name)) (let* ((vtable (gethash interface-name *vtables*)) (vtable-cstruct (vtable-description-cstruct-name vtable))) (debugf "interface-init for class ~A and interface ~A~%" class-name interface-name) @@ -184,7 +185,7 @@ (lisp-type-info (gethash type-name *registered-types*)) (property-info (find property-name (object-type-properties lisp-type-info) :test 'string= :key 'first)) (property-set-fn (fifth property-info)) - (new-value (parse-gvalue value))) + (new-value (parse-g-value value))) (debugf "set(~A,'~A',~A)~%" lisp-object property-name new-value) (restart-case (funcall property-set-fn new-value lisp-object) @@ -202,13 +203,12 @@ (debugf "Registering GObject type implementation ~A for type ~A~%" ',class ,name) (with-foreign-object (query 'g-type-query) (g-type-query (g-type-from-name ,parent) query) - (with-foreign-slots ((class-size instance-size) query g-type-query) - (g-type-register-static-simple (g-type-from-name ,parent) - ,name - (foreign-slot-value query 'g-type-query :class-size) - (callback c-class-init) - (foreign-slot-value query 'g-type-query :instance-size) - (callback c-instance-init) nil))) + (g-type-register-static-simple (g-type-from-name ,parent) + ,name + (foreign-slot-value query 'g-type-query :class-size) + (callback c-class-init) + (foreign-slot-value query 'g-type-query :instance-size) + (callback c-instance-init) nil)) (add-interfaces ,name)) (defmethod initialize-instance :before ((object ,class) &key pointer) (unless (or pointer (and (slot-boundp object 'gobject::pointer)