Fix to avoid having to rely on internal _get_type functions

diff --git a/gdk/gdktypes.lisp b/gdk/gdktypes.lisp
index 6cfbc7f..1168b55 100644 (file)
--- a/gdk/gdktypes.lisp
+++ b/gdk/gdktypes.lisp
@@ -15,14 +15,14 @@
 ;; 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: gdktypes.lisp,v 1.16 2005-03-06 17:26:22 espen Exp $
+;; $Id: gdktypes.lisp,v 1.17 2005-03-11 10:56:56 espen Exp $
 
 (in-package "GDK")
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (init-types-in-library #.(concatenate 'string
                            (pkg-config:pkg-variable "gtk+-2.0" "libdir")
-                           "/libgdk-x11-2.0.so") :prefix ("gdk_" "_gdk_"))
+                           "/libgdk-x11-2.0.so") :prefix "gdk_")
   (init-types-in-library #.(concatenate 'string
                            (pkg-config:pkg-variable "gtk+-2.0" "libdir")
                            "/libgdk_pixbuf-2.0.so") :prefix "gdk_"))

diff --git a/glib/gboxed.lisp b/glib/gboxed.lisp
index 1bb152b..8e621aa 100644 (file)
--- 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.17 2005-03-06 17:26:23 espen Exp $
+;; $Id: gboxed.lisp,v 1.18 2005-03-11 10:56:58 espen Exp $
 
 (in-package "GLIB")
 
@@ -72,7 +72,7 @@
      ,(unless forward-p
        slots)
      (:metaclass boxed-class)
-     (:gtype ,(find-type-init-function type-number))))
+     (:gtype ,(register-type-as type-number))))
 
 (register-derivable-type 'boxed "GBoxed" 'expand-boxed-type)
 

diff --git a/glib/ginterface.lisp b/glib/ginterface.lisp
index b9a42b5..64cc0b6 100644 (file)
--- 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.9 2005-03-06 17:26:23 espen Exp $
+;; $Id: ginterface.lisp,v 1.10 2005-03-11 10:56:58 espen Exp $
 
 (in-package "GLIB")
 
@@ -56,10 +56,13 @@
 
 (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)))))
+  (let* ((class-name (or name (class-name class)))
+        (type-number
+         (or
+          (find-type-number class-name)
+          (register-type class-name 
+           (or (first gtype) (default-type-init-name class-name))))))
+    (type-default-interface-ref type-number))
   (call-next-method))
 
 
@@ -142,7 +145,7 @@
        ,(unless forward-p
          (slot-definitions class (query-object-interface-properties type) slots))
       (:metaclass ginterface-class)
-      (:gtype ,(find-type-init-function type)))))
+      (:gtype ,(register-type-as type)))))
 
 (defun ginterface-dependencies (type)
   (delete-duplicates 

diff --git a/glib/gobject.lisp b/glib/gobject.lisp
index 5b5bf4e..f354992 100644 (file)
--- a/glib/gobject.lisp
+++ b/glib/gobject.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: gobject.lisp,v 1.34 2005-03-06 17:26:23 espen Exp $
+;; $Id: gobject.lisp,v 1.35 2005-03-11 10:56:58 espen Exp $
 
 (in-package "GLIB")
 
@@ -332,7 +332,7 @@
       (nreverse properties))))
 
 (defun query-object-class-properties (type &optional inherited-p)
-  (let* ((type-number (find-type-number type))
+  (let* ((type-number (find-type-number type t))
         (class (type-class-ref type-number)))
     (unwind-protect
         (multiple-value-bind (array length)
@@ -364,8 +364,9 @@
       `(,slot-name
        :allocation :property :pname ,name
 
-       ,@(cond
-          ((find :unbound args) (list :unbound (getf args :unbound))))
+       ,@(when (find :unbound args) (list :unbound (getf args :unbound)))
+       ,@(when (find :getter args) (list :getter (getf args :getter)))
+       ,@(when (find :setter args) (list :setter (getf args :setter)))
        
        ;; accessors
        ,@(cond
@@ -427,10 +428,10 @@
        (class  (type-from-number type))
        (slots (getf options :slots)))    
     `(defclass ,class ,supers
-       ,(unless forward-p
-         (slot-definitions class (query-object-class-properties type) slots))
-      (:metaclass ,metaclass)
-      (:gtype ,(find-type-init-function type)))))
+        ,(unless forward-p
+           (slot-definitions class (query-object-class-properties type) slots))
+        (:metaclass ,metaclass)
+        (:gtype ,(register-type-as type)))))
 
 (defun gobject-dependencies (type)
   (delete-duplicates 

diff --git a/glib/gtype.lisp b/glib/gtype.lisp
index 33c8baf..766af01 100644 (file)
--- 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.27 2005-03-06 17:26:23 espen Exp $
+;; $Id: gtype.lisp,v 1.28 2005-03-11 10:56:58 espen Exp $
 
 (in-package "GLIB")
 
@@ -201,7 +201,7 @@
        (process-close process)))))
 
 
-(defmacro init-types-in-library (filename &key (prefix "") ignore)
+(defmacro init-types-in-library (filename &key prefix ignore)
   (let ((names (%find-types-in-library filename prefix ignore)))
     `(progn
        ,@(mapcar #'(lambda (name)
@@ -212,12 +212,16 @@
                 names))))
 
 (defun find-type-init-function (type-number)
-  (or
-   (loop
-    for type-init in *type-initializers*
-    when (= type-number (funcall type-init))
-    do (return type-init))
-   (error "Can't find init function for type number ~D" type-number)))
+  (loop
+   for type-init in *type-initializers*
+   when (= type-number (funcall type-init))
+   do (return type-init)))
+
+(defun register-type-as (type-number)
+  (or 
+   (find-type-init-function type-number)
+   (find-foreign-type-name type-number)
+   (error "Unknown type-number: ~A" type-number)))
 
 (defun default-type-init-name (type)
   (find-symbol (format nil "~A_~A_get_type" 
@@ -442,7 +446,7 @@
        (let ((name (find-foreign-type-name type-number)))
         (register-type
          (getf (type-options type-number) :type (default-type-name name))
-         (find-type-init-function type-number))))
+         (register-type-as type-number))))
 
      (let ((sorted-type-list (%sort-types-topologicaly type-list)))
        `(progn

diff --git a/gtk/gtkobject.lisp b/gtk/gtkobject.lisp
index d759227..6da0c48 100644 (file)
--- a/gtk/gtkobject.lisp
+++ b/gtk/gtkobject.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: gtkobject.lisp,v 1.24 2005-03-06 17:26:23 espen Exp $
+;; $Id: gtkobject.lisp,v 1.25 2005-03-11 10:58:41 espen Exp $
 
 
 (in-package "GTK")
@@ -36,7 +36,7 @@
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (init-types-in-library 
    #.(concatenate 'string (pkg-config:pkg-variable "gtk+-2.0" "libdir") 
-                         "/libgtk-x11-2.0.so"))
+                         "/libgtk-x11-2.0.so") :prefix "gtk_")
 
   (defclass %object (gobject)
     ()