X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/e9934f3905937272b78e9c26a84e791ac121139a..dcb31db65bd37358773232f94a915ee0caad97b9:/glib/ginterface.lisp diff --git a/glib/ginterface.lisp b/glib/ginterface.lisp index 4b65455..a48c552 100644 --- a/glib/ginterface.lisp +++ b/glib/ginterface.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: ginterface.lisp,v 1.6 2005/02/01 15:24:52 espen Exp $ +;; $Id: ginterface.lisp,v 1.9 2005/03/06 17:26:23 espen Exp $ (in-package "GLIB") @@ -54,19 +54,16 @@ (call-next-method))) -(defmethod shared-initialize ((class ginterface-class) names - &rest initargs &key name alien-name) - (declare (ignore initargs names)) - (let* ((class-name (or name (class-name class))) - (type-number - (find-type-number - (or (first alien-name) (default-alien-type-name class-name)) t))) - (register-type class-name type-number)) +(defmethod shared-initialize ((class ginterface-class) names &key name gtype) + (declare (ignore names)) + (let ((class-name (or name (class-name class)))) + (unless (find-type-number class-name) + (register-type class-name + (or (first gtype) (default-type-init-name class-name))))) (call-next-method)) -(defmethod validate-superclass - ((class ginterface-class) (super pcl::standard-class)) +(defmethod validate-superclass ((class ginterface-class) (super standard-class)) (subtypep (class-name super) 'ginterface)) @@ -129,9 +126,10 @@ (unwind-protect (multiple-value-bind (array length) (%object-interface-list-properties iface) - (unwind-protect - (%map-params array length type-number inherited-p) - (deallocate-memory array))) + (unless (null-pointer-p array) + (unwind-protect + (%map-params array length type-number inherited-p) + (deallocate-memory array)))) ; (type-default-interface-unref type-number) ))) @@ -144,9 +142,12 @@ ,(unless forward-p (slot-definitions class (query-object-interface-properties type) slots)) (:metaclass ginterface-class) - (:alien-name ,(find-type-name type))))) + (:gtype ,(find-type-init-function type))))) (defun ginterface-dependencies (type) - (delete-duplicates (mapcar #'param-value-type (query-object-interface-properties type)))) + (delete-duplicates + (cons + (supertype type) + (mapcar #'param-value-type (query-object-interface-properties type))))) (register-derivable-type 'ginterface "GInterface" 'expand-ginterface-type 'ginterface-dependencies)