#:+g-priority-default-idle+
#:+g-priority-low+
#:g-idle-add-full
- #:g-idle-add)
+ #: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}."))
(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}
`(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
+ ((: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)))
+ (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