X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=glib%2Fglib.lisp;h=8398148cb5043b374158eaabdd1031d4e771a9ab;hb=47427d9e824cf990bf88b4db8fdb205565062cd2;hp=df8af72d0c1da46a923cd10ea141ddaff0d43bec;hpb=8db173e3df82074b8ca96d00304c4e63b499f598;p=cl-gtk2.git diff --git a/glib/glib.lisp b/glib/glib.lisp index df8af72..8398148 100644 --- a/glib/glib.lisp +++ b/glib/glib.lisp @@ -25,7 +25,18 @@ #:g-idle-add-full #:g-idle-add #:g-timeout-add-full - #:g-source-remove) + #: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}.")) @@ -37,12 +48,32 @@ (defun register-initializer (key fn) (unless (gethash key *initializers-table*) (setf (gethash key *initializers-table*) t - *initializers* (nconc *initializers* (list fn)))))) + *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))) +(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} @@ -64,19 +95,52 @@ In this example, for every @code{class}, @code{(initialize-gobject-class-g-type `(progn (register-initializer (list ,@keys ',body) (lambda () ,@body)) ,@body)) -(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"))) - -(use-foreign-library glib) +(defmacro at-finalize ((&rest keys) &body body) + `(register-finalizer (list ,@keys ',body) (lambda () ,@body))) -(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) +(at-init () + (eval-when (:compile-toplevel :load-toplevel :execute) + (define-foreign-library glib + (:unix (:or "libglib-2.0.so.0" "libglib-2.0.so")) + (:windows "libglib-2.0-0.dll") + (t (:default "libglib-2.0")))) + (eval-when (:compile-toplevel :load-toplevel :execute) + (define-foreign-library gthread + (:unix (:or "libgthread-2.0.so.0" "libgthread-2.0.so")) + (: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 @@ -109,6 +173,21 @@ In this example, for every @code{class}, @code{(initialize-gobject-class-g-type (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, @@ -399,12 +478,11 @@ Adds a function to be called whenever there are no higher priority events pendin (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))) + (unless (g-thread-get-initialized) + (g-thread-init (null-pointer)))) (defcenum g-thread-priority :g-thread-priority-low @@ -482,5 +560,9 @@ Allocates a new string that is equal to @code{str}. Use @fun{g-free} to free it. (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