Fixed re-initialization of gtk libraries on loading of dumped image (for now only...

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

diff --git a/glib/glib.lisp b/glib/glib.lisp
index b7a132c..a262e07 100644 (file)
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -1,6 +1,7 @@
 (defpackage :glib
   (:use :cl :cffi :iter)
-  (:export #:gsize
+  (:export #:at-init
+           #:gsize
            #:gssize
            #:goffset
            #:*glib-major-version*
@@ -26,13 +27,31 @@
 (in-package :glib)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar *initializers* nil)
+  (defun register-initializer (fn)
+    (setf *initializers* (nconc *initializers* (list fn)))))
+
+(defun run-initializers ()
+  (iter (for fn in *initializers*)
+        (funcall fn)))
+
+(defmacro at-init (&body body)
+  `(progn (register-initializer (lambda () ,@body))
+          ,@body))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
   (define-foreign-library glib
-    (:unix "libglib-2.0.so")
-    (t "glib-2.0")))
+    (:unix (:or "libglib-2.0.so.0" "libglib-2.0.so"))
+    (t "libglib-2.0")))
 
 (use-foreign-library glib)
 
-(load-foreign-library "libgthread-2.0.so")
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (define-foreign-library gthread
+    (:unix (:or "libgthread-2.0.so.0"  "libgthread-2.0.so"))
+    (t "libgthread-2.0")))
+
+(use-foreign-library gthread)
 
 ;;
 ;; Glib Fundamentals
@@ -45,9 +64,10 @@
 
 ;; TODO: not sure about these: for amd64 they are ok
 (eval-when (:compile-toplevel :load-toplevel :execute)
-  (if (cffi-features:cffi-feature-p :x86-64)
-      (defctype gsize :uint64)
-      (error "Unknown type 'gsize'")))
+  (cond
+    ((cffi-features:cffi-feature-p :x86-64) (defctype gsize :uint64))
+    ((cffi-features:cffi-feature-p :x86) (defctype gsize :ulong))
+    (t (error "Can not define 'gsize', unknown CPU architecture (known are x86 and x86-64)"))))
 
 (defctype gssize :long)
 
@@ -350,9 +370,10 @@
 
 (defvar *threads-initialized-p* nil)
 
-(unless *threads-initialized-p*
-  (g-thread-init (null-pointer))
-  (setf *threads-initialized-p* t))
+(at-init
+  (unless *threads-initialized-p*
+    (g-thread-init (null-pointer))
+    (setf *threads-initialized-p* t)))
 
 (defcenum g-thread-priority
   :g-thread-priority-low
@@ -371,38 +392,40 @@
   (thread (:pointer g-thread))
   (priority g-thread-priority))
 
-(defcfun (g-mutex-new "g_mutex_new" :library glib) (:pointer g-mutex))
+;;;; TODO: Commented g_mutex_*, g_cond* because they are not functions, but called through dispatch table
 
-(defcfun (g-mutex-lock "g_mutex_lock" :library glib) :void
-  (mutex (:pointer g-mutex)))
+;; (defcfun (g-mutex-new "g_mutex_new" :library glib) (:pointer g-mutex))
 
-(defcfun (g-mutex-try-lock "g_mutex_trylock" :library glib) :boolean
-  (mutex (:pointer g-mutex)))
+;; (defcfun (g-mutex-lock "g_mutex_lock" :library glib) :void
+;;   (mutex (:pointer g-mutex)))
 
-(defcfun (g-mutex-free "g_mutex_free" :library glib) :void
-  (mutex (:pointer g-mutex)))
+;; (defcfun (g-mutex-try-lock "g_mutex_trylock" :library glib) :boolean
+;;   (mutex (:pointer g-mutex)))
+
+;; (defcfun (g-mutex-free "g_mutex_free" :library glib) :void
+;;   (mutex (:pointer g-mutex)))
 
 ;omitted: GStaticMutex, GStaticRWLock stuff
 
-(defcfun (g-cond-new "g_cond_new" :library glib) (:pointer g-cond))
+;; (defcfun (g-cond-new "g_cond_new" :library glib) (:pointer g-cond))
 
-(defcfun (g-cond-signal "g_cond_signal" :library glib) :void
-  (cond (:pointer g-cond)))
+;; (defcfun (g-cond-signal "g_cond_signal" :library glib) :void
+;;   (cond (:pointer g-cond)))
 
-(defcfun (g-cond-broadcast "g_cond_broadcast" :library glib) :void
-  (cond (:pointer g-cond)))
+;; (defcfun (g-cond-broadcast "g_cond_broadcast" :library glib) :void
+;;   (cond (:pointer g-cond)))
 
-(defcfun (g-cond-wait "g_cond_wait" :library glib) :void
-  (cond (:pointer g-cond))
-  (mutex (:pointer g-mutex)))
+;; (defcfun (g-cond-wait "g_cond_wait" :library glib) :void
+;;   (cond (:pointer g-cond))
+;;   (mutex (:pointer g-mutex)))
 
-(defcfun (g-cond-timed-wait "g_cond_timed_wait" :library glib) :boolean
-  (cond (:pointer g-cond))
-  (mutex (:pointer g-mutex))
-  (abs-time (:pointer g-time-val)))
+;; (defcfun (g-cond-timed-wait "g_cond_timed_wait" :library glib) :boolean
+;;   (cond (:pointer g-cond))
+;;   (mutex (:pointer g-mutex))
+;;   (abs-time (:pointer g-time-val)))
 
-(defcfun (g-cond-free "g_cond_free" :library glib) :void
-  (cond (:pointer g-cond)))
+;; (defcfun (g-cond-free "g_cond_free" :library glib) :void
+;;   (cond (:pointer g-cond)))
 
 ;omitted: GPrivate, GOnce stuff