X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/fb7dd5b982f27bfb45c3f96e97fba11ccc7d8105..4769576f381e72d2bc169a23e33b1c897f59e6e7:/glib/gtype.lisp

diff --git a/glib/gtype.lisp b/glib/gtype.lisp
index 17e9da7..add9c8e 100644
--- a/glib/gtype.lisp
+++ b/glib/gtype.lisp
@@ -20,7 +20,7 @@
 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 
-;; $Id: gtype.lisp,v 1.67 2008-12-10 02:54:17 espen Exp $
+;; $Id: gtype.lisp,v 1.69 2009-02-10 15:16:34 espen Exp $
 
 (in-package "GLIB")
 
@@ -131,7 +131,7 @@
 (defun type-registered-p (type)
   (nth-value 1 (gethash type *lisp-type-to-type-number*)))
 
-(defun register-type (type id)
+(defun register-type (type id &optional (error-p t))
   (cond
    ((type-registered-p type) (find-type-number type))
    ((not id) (warn "Can't register type with no foreign id: ~A" type))
@@ -139,7 +139,7 @@
     (pushnew (cons type id) *registered-types* :key #'car)
     (let ((type-number 
 	   (typecase id
-	     (string (type-number-from-glib-name id))
+	     (string (type-number-from-glib-name id error-p))
 	     (symbol (funcall id)))))
       (setf (gethash type *lisp-type-to-type-number*) type-number)
       (setf (gethash type-number *type-number-to-lisp-type*) type)
@@ -156,7 +156,7 @@
   (clrhash *type-number-to-lisp-type*)
   (type-init) ; initialize the glib type system
   (mapc #'(lambda (type) 
-	    (register-type (car type) (cdr type)))
+	    (register-type (car type) (cdr type) nil))
 	*registered-types*)
   (mapc #'(lambda (type) 
 	    (apply #'register-new-type type))
@@ -165,14 +165,11 @@
 	    (register-type-alias (car type) (cdr type)))
 	*registered-type-aliases*))
 
-(pushnew 'reinitialize-all-types 
-  #+cmu *after-save-initializations*
-  #+sbcl *init-hooks*
-  #+clisp custom:*init-hooks*)
-
 #+cmu
-(pushnew 'system::reinitialize-global-table ; we shouldn't have to do this?
- *after-save-initializations*)
+(asdf:install-init-hook 'system::reinitialize-global-table 
+ *after-save-initializations*) ; we shouldn't need to do this?
+(asdf:install-init-hook 'reinitialize-all-types)
+
 
 
 (defun find-type-number (type &optional error-p)
@@ -351,6 +348,8 @@
 
 ;;;; Metaclass for subclasses of ginstance
 
+(defvar *referenced-ginstance-classes* ())
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defclass ginstance-class (proxy-class)
     ((gtype :initarg :gtype :initform nil :reader ginstance-class-gtype))))
@@ -379,7 +378,8 @@
 	(type-class-ref
 	 (if (or (symbolp gtype) (type-number-from-glib-name gtype nil))
 	     (register-type class-name gtype)
-	   (register-new-type class-name (class-name super) gtype))))
+	   (register-new-type class-name (class-name super) gtype)))
+	(push class-name *referenced-ginstance-classes*))
       #+nil
       (when (and
 	     (supertype (find-type-number class))
@@ -389,6 +389,12 @@
     (update-size class))
   #-clisp(call-next-method))
 
+(defun reinitialize-ginstance-classes ()
+  (mapc #'type-class-ref *referenced-ginstance-classes*))
+
+(asdf:install-init-hook 'reinitialize-ginstance-classes)
+
+
 
 (defmethod shared-initialize ((class ginstance-class) names &rest initargs)
   (declare (ignore names initargs))