From: Dmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Date: Wed, 8 Jul 2009 21:47:19 +0000 (+0400)
Subject: Add at-init calls to define-g-enum and define-g-flags; fix the at-init implementation... 
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=c770ca4a913da887d7e9cec76c4343cc1dc4a8aa;p=cl-gtk2.git

Add at-init calls to define-g-enum and define-g-flags; fix the at-init implementation to include "keys" that do not allow the same code to be added
to initialization twice
---

diff --git a/glib/glib.lisp b/glib/glib.lisp
index 61f17a8..874548d 100644
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -29,21 +29,23 @@
 (in-package :glib)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar *initializers-table* (make-hash-table :test 'equalp))
   (defvar *initializers* nil)
-  (defun register-initializer (fn)
-    (setf *initializers* (nconc *initializers* (list fn)))))
+  (defun register-initializer (key fn)
+    (unless (gethash key *initializers-table*)
+      (setf (gethash key *initializers-table*) t
+            *initializers* (nconc *initializers* (list fn))))))
 
 (defun run-initializers ()
   (iter (for fn in *initializers*)
         (funcall fn)))
 
-(defmacro at-init (&body body)
+(defmacro at-init ((&rest keys) &body body)
   "@arg[body]{the code}
 Runs the code normally but also schedules the code to be run at image load time.
-It is used to reinitialize the libraries when the dumped image is loaded.
-(Works only on SBCL for now)
+It is used to reinitialize the libraries when the dumped image is loaded. (Works only on SBCL for now)
 "
-  `(progn (register-initializer (lambda () ,@body))
+  `(progn (register-initializer (list ,@keys ',body) (lambda () ,@body))
           ,@body))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -383,7 +385,7 @@ Adds a function to be called whenever there are no higher priority events pendin
 
 (defvar *threads-initialized-p* nil)
 
-(at-init
+(at-init ()
   (unless *threads-initialized-p*
     (g-thread-init (null-pointer))
     (setf *threads-initialized-p* t)))
diff --git a/glib/gobject.foreign-gobject-subclassing.lisp b/glib/gobject.foreign-gobject-subclassing.lisp
index 0e921e8..0ee4e9b 100644
--- a/glib/gobject.foreign-gobject-subclassing.lisp
+++ b/glib/gobject.foreign-gobject-subclassing.lisp
@@ -198,7 +198,7 @@
     (setf parent (g-type-name (ensure-g-type parent))))
   `(progn
      (setf (gethash ,name *registered-types*) (make-object-type :name ,name :class ',class :parent ,parent :interfaces ',interfaces :properties ',properties))
-     (at-init
+     (at-init (',class)
        (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)
diff --git a/glib/gobject.generating.lisp b/glib/gobject.generating.lisp
index 0b7ebeb..7c3a807 100644
--- a/glib/gobject.generating.lisp
+++ b/glib/gobject.generating.lisp
@@ -349,7 +349,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
      ,@(when export
              (list `(export ',name (find-package ,(package-name (symbol-package name))))))
      ,@(when type-initializer
-             (list (type-initializer-call type-initializer)))))
+             (list `(at-init () ,(type-initializer-call type-initializer))))))
 
 (defun enum-value->definition (enum-value)
   (let ((value-name (intern (lispify-name (enum-item-nick enum-value))
@@ -393,7 +393,7 @@ If non-@code{NIL}, specifies the function that initializes the type: string spec
      ,@(when export
              (list `(export ',name (find-package ,(package-name (symbol-package name))))))
      ,@(when type-initializer
-             (list (type-initializer-call type-initializer)))))
+             (list `(at-init () ,(type-initializer-call type-initializer))))))
 
 (defun flags-value->definition (flags-value)
   (let ((value-name (intern (lispify-name (flags-item-nick flags-value))
diff --git a/glib/gobject.meta.lisp b/glib/gobject.meta.lisp
index b5d3f4c..83b0ef2 100644
--- a/glib/gobject.meta.lisp
+++ b/glib/gobject.meta.lisp
@@ -38,7 +38,7 @@
 
 (defmethod initialize-instance :after ((object gobject-class) &key &allow-other-keys)
   (register-object-type (gobject-class-g-type-name object) (class-name object))
-  (at-init (initialize-gobject-class-g-type object)))
+  (at-init (object) (initialize-gobject-class-g-type object)))
 
 (defclass gobject-direct-slot-definition (standard-direct-slot-definition)
   ((g-property-type :initform nil
diff --git a/glib/gobject.type.lisp b/glib/gobject.type.lisp
index 22eb2ec..f72b125 100644
--- a/glib/gobject.type.lisp
+++ b/glib/gobject.type.lisp
@@ -5,7 +5,7 @@
 
 (defcfun (%g-type-init "g_type_init") :void)
 
-(at-init (%g-type-init))
+(at-init () (%g-type-init))
 
 (defcfun (g-type-name "g_type_name") :string
   "Returns the GType name