#:+g-priority-high-idle+
#:+g-priority-default-idle+
#:+g-priority-low+
- #:g-idle-add-full)
+ #:g-idle-add-full
+ #:g-idle-add
+ #:g-timeout-add-full
+ #:g-source-remove
+ #:at-finalize
+ #:with-g-error
+ #:with-catching-to-g-error
+ #:g-error-condition
+ #:g-error-condition-domain
+ #:g-error-condition-code
+ #:g-error-condition-message
+ #:g-spawn-flags
+ #:push-library-version-features
+ #:foreign-library-minimum-version-mismatch
+ #:require-library-version)
(: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)))))
+ (defvar *finalizers-table* (make-hash-table :test 'equalp))
+ (defvar *finalizers* nil)
+ (defun register-finalizer (key fn)
+ (unless (gethash key *finalizers-table*)
+ (setf (gethash key *finalizers-table*) t
+ *finalizers* (nconc *finalizers* (list fn))))))
(defun run-initializers ()
(iter (for fn in *initializers*)
(funcall fn)))
-(defmacro at-init (&body body)
- "@arg[body]{the code}
+(defun run-finalizers ()
+ (iter (for fn in *finalizers*)
+ (funcall fn)))
+
+#+sbcl
+(pushnew 'run-initializers sb-ext:*init-hooks*)
+#+openmcl
+(pushnew 'run-initializers ccl:*restore-lisp-functions*)
+
+#+sbcl
+(pushnew 'run-finalizers sb-ext:*save-hooks*)
+#+openmcl
+(pushnew 'run-finalizers ccl:*save-exit-functions*)
+
+(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)
-"
- `(progn (register-initializer (lambda () ,@body))
- ,@body))
+It is used to reinitialize the libraries when the dumped image is loaded. (Works only on SBCL for now).
-(eval-when (:compile-toplevel :load-toplevel :execute)
- (define-foreign-library glib
- (:unix (:or "libglib-2.0.so.0" "libglib-2.0.so"))
- (t "libglib-2.0")))
+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).
-(use-foreign-library glib)
+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}
-(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")))
+In this example, for every @code{class}, @code{(initialize-gobject-class-g-type class)} will be called only once.
+"
+ `(progn (register-initializer (list ,@keys ',body) (lambda () ,@body))
+ ,@body))
-(use-foreign-library gthread)
+(defmacro at-finalize ((&rest keys) &body body)
+ `(register-finalizer (list ,@keys ',body) (lambda () ,@body)))
+
+(at-init ()
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (define-foreign-library glib
+ ((:and :unix (:not :darwin)) (:or "libglib-2.0.so.0" "libglib-2.0.so"))
+ (:darwin (:or "libglib-2.0.0.dylib" "libglib-2.0.dylib"))
+ (:windows "libglib-2.0-0.dll")
+ (t (:default "libglib-2.0"))))
+ (eval-when (:compile-toplevel :load-toplevel :execute)
+ (define-foreign-library gthread
+ ((:and :unix (:not :darwin)) (:or "libgthread-2.0.so.0" "libgthread-2.0.so"))
+ (:darwin (:or "libgthread-2.0.0.dylib" "libgthread-2.0.dylib"))
+ (:windows "libgthread-2.0-0.dll")
+ (t "libgthread-2.0")))
+
+ (use-foreign-library glib)
+ (use-foreign-library gthread))
+
+(defmacro push-library-version-features (library-name major-version-var minor-version-var &body versions)
+ `(eval-when (:load-toplevel :execute)
+ ,@(iter (for (major minor) on versions by #'cddr)
+ (collect
+ `(when (or (and (= ,major-version-var ,major) (>= ,minor-version-var ,minor))
+ (> ,major-version-var ,major))
+ (pushnew ,(intern (format nil "~A-~A.~A" (string library-name) major minor) (find-package :keyword)) *features*))))))
+
+(define-condition foreign-library-minimum-version-mismatch (error)
+ ((library :initarg :library :reader .library)
+ (minimum-version :initarg :minimum-version :reader .minimum-version)
+ (actual-version :initarg :actual-version :reader .actual-version))
+ (:report (lambda (c s)
+ (format s "Library ~A has too old version: it is ~A but required to be at least ~A"
+ (.library c)
+ (.actual-version c)
+ (.minimum-version c)))))
+
+(defun require-library-version (library min-major-version min-minor-version major-version minor-version)
+ (unless (or (> major-version min-major-version)
+ (and (= major-version min-major-version)
+ (>= minor-version min-minor-version)))
+ (restart-case
+ (error 'foreign-library-minimum-version-mismatch
+ :library library
+ :minimum-version (format nil "~A.~A" min-major-version min-minor-version)
+ :actual-version (format nil "~A.~A" major-version minor-version))
+ (ignore () :report "Ignore version requirement" nil))))
;;
;; Glib Fundamentals
(cond
((cffi-features:cffi-feature-p :x86-64) (defctype gsize :uint64))
((cffi-features:cffi-feature-p :x86) (defctype gsize :ulong))
+ ((cffi-features:cffi-feature-p :ppc32) (defctype gsize :uint32))
+ ((cffi-features:cffi-feature-p :ppc64) (defctype gsize :uint64))
(t (error "Can not define 'gsize', unknown CPU architecture (known are x86 and x86-64)"))))
(defctype gssize :long)
(defcvar (*glib-binary-age* "glib_binary_age" :read-only t :library glib) :uint)
(defcvar (*glib-interface-age* "glib_interface_age" :read-only t :library glib) :uint)
+(push-library-version-features glib *glib-major-version* *glib-micro-version*
+ 2 2
+ 2 4
+ 2 6
+ 2 8
+ 2 10
+ 2 12
+ 2 14
+ 2 16
+ 2 18
+ 2 20
+ 2 22)
+
+(require-library-version "Glib" 2 20 *glib-major-version* *glib-minor-version*)
+
;;
;; Omitted:
;; Limits of Basic Types, Standard Macros, Type Conversion Macros, Byte Order Macros,
;; Core Application Support - The Main Event Loop
(defcstruct g-main-loop)
+(defctype g-main-loop (:struct g-main-loop))
(defcstruct g-main-context)
+(defctype g-main-context (:struct g-main-context))
(defcstruct g-source)
+(defctype g-source (:struct g-source))
(defcstruct g-source-funcs
(prepare :pointer)
(check :pointer)
(finalize :pointer)
(closure-callback :pointer)
(closure-marshal :pointer))
+(defctype g-source-funcs (:struct g-source-funcs))
(defcstruct g-source-callback-funcs
(ref :pointer)
(unref :pointer)
(get :pointer))
+(defctype g-source-callback-funcs (:struct g-source-callback-funcs))
(defcstruct g-cond)
+(defctype g-cond (:struct g-cond))
(defcstruct g-mutex)
+(defctype g-mutex (:struct g-mutex))
(defcstruct g-poll-fd
(fd :int) ;; TODO: #if defined (G_OS_WIN32) && GLIB_SIZEOF_VOID_P == 8
(events :ushort)
(revent :ushort))
+(defctype g-poll-fd (:struct g-poll-fd))
(defcstruct g-time-val
(seconds :long)
(microseconds :long))
+(defctype g-time-val (:struct g-time-val))
(defcstruct g-thread)
+(defctype g-thread (:struct g-thread))
(defcfun (g-main-loop-new "g_main_loop_new" :library glib) (:pointer g-main-loop)
(context (:pointer g-main-context))
(defcfun (g-thread-init "g_thread_init") :void
(vtable :pointer))
-(defvar *threads-initialized-p* nil)
+(defcfun g-thread-get-initialized :boolean)
-(at-init
- (unless *threads-initialized-p*
- (g-thread-init (null-pointer))
- (setf *threads-initialized-p* t)))
+(at-init ()
+ (unless (g-thread-get-initialized)
+ (g-thread-init (null-pointer))))
(defcenum g-thread-priority
:g-thread-priority-low
(str (:string :free-to-foreign t)))
;omitted all GLib Utilites
-;TODO: omitted Date and Time Functions
+(defbitfield g-spawn-flags
+ :leave-descriptors-open :do-not-reap-child :search-path :stdout-to-dev-null :stderr-to-dev-null
+ :child-inherits-stdin :file-and-argv-zero)
+
+;TODO: omitted Date and Time Functions
projects / cl-gtk2.git / blobdiff