Fix to avoid having to rely on internal _get_type functions

diff --git a/gdk/gdktypes.lisp b/gdk/gdktypes.lisp
index fdda99d95570cbbaec54a037e90208fc8bc70ebd..dd56a05fc0f2b7a7530e895fbefb80e7b68db204 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 c5dd25379e217a50c18d6d6e0f4879f8868e3441..10646a2825f56dba3d88855703a301c2deb862e3 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 @@ (defun expand-boxed-type (type-number forward-p slots)
      ,(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 a48c552262a29f0f72179a0f576e439ca8b9117a..61e34f8588fd918e166b1ee002ee2c4ebdc7c8e5 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 compute-effective-slot-definition-initargs ((class ginterface-class)
 
 (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 @@ (defun expand-ginterface-type (type forward-p options &rest args)
        ,(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 deba03b46a2ceccfeb5ab9ff2f51c322ed6ab353..700d8850e218fd3469d883a3b5de8789c8f3678f 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 @@ (defun %map-params (params length type inherited-p)
       (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 @@ (defun slot-definition-from-property (class property &optional slot-name args)
       `(,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 @@ (defun expand-gobject-type (type forward-p options &optional (metaclass 'gobject
        (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 e05dfd0e2e6debdbc3dd2867ea595224863337ec..bd23dba0c52b066350c5fa04bb0770a357023fe5 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 @@   (defun %find-types-in-library (pathname prefixes ignore)
        (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 @@                   (defbinding (,(intern name) ,name) () type-number)
                 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 @@ (defun expand-type-definitions (prefix &optional args)
        (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 54e7640913c72e9ee03ef6ab2f276d0022c770c4..23a4a42e65e9120305beaa76716aae3cb5f2d14a 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 @@ (in-package "GTK")
 (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)
     ()