fix for clozure: do not use (non-standard) make-instance method for STRUCTURE-CLASSes

[cl-gtk2.git] / glib / glib.lisp

diff --git a/glib/glib.lisp b/glib/glib.lisp
index 61f17a8..29cd6e4 100644 (file)
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -22,28 +22,44 @@
            #:+g-priority-high-idle+
            #:+g-priority-default-idle+
            #:+g-priority-low+
-           #:g-idle-add-full)
+           #:g-idle-add-full
+           #:g-idle-add)
   (:documentation
    "Cl-gtk2-glib is wrapper for @a[http://library.gnome.org/devel/glib/]{GLib}."))
 
 (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)
-  "@arg[body]{the code}
+(defmacro at-init ((&rest keys) &body body)
+  "
+@arg[keys]{list of expression}
+@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).
+
+At-init form may be called multiple times. The same code from should not be run multiple times at initialization time (in best case, this will only slow down initialization, in worst case, the code may crash). To ensure this, every @code{at-init} expression is added to hash-table with the @code{body} and @code{keys} as a composite key. This ensures that the same code is only executed once (once on the same set of parameters).
+
+Example:
+@begin{pre}
+\(defmethod initialize-instance :after ((class gobject-class) &key &allow-other-keys)
+  (register-object-type (gobject-class-g-type-name class) (class-name class))
+  (at-init (class) (initialize-gobject-class-g-type class)))
+@end{pre}
+
+In this example, for every @code{class}, @code{(initialize-gobject-class-g-type class)} will be called only once.
 "
-  `(progn (register-initializer (lambda () ,@body))
+  `(progn (register-initializer (list ,@keys ',body) (lambda () ,@body))
           ,@body))
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
@@ -383,7 +399,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)))