Check the libraries' versions requirement and throw compile-time error; add libraries...
authorDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Sun, 24 Jan 2010 23:37:51 +0000 (02:37 +0300)
committerDmitry Kalyanov <Kalyanov.Dmitry@gmail.com>
Mon, 25 Jan 2010 01:04:51 +0000 (04:04 +0300)
gdk/gdk.package.lisp
glib/glib.lisp
gtk/gtk.package.lisp

index dd441c3..3de1687 100644 (file)
@@ -6,15 +6,40 @@
 (in-package :gdk)
 
 (glib:at-init ()
- (eval-when (:compile-toplevel :load-toplevel :execute)
-   (define-foreign-library gdk
-     (:unix (:or "libgdk-x11-2.0.so.0" "libgdk-x11-2.0.so"))
-     (:windows "libgdk-win32-2.0-0.dll")
-     (t "libgdk-2.0"))
-   (define-foreign-library gdk-pixbuf
-     (:unix (:or "libgdk_pixbuf-2.0.so.0" "libgdk_pixbuf-2.0.so"))
-     (:windows (:or "libgdk_pixbuf-win32-2.0-0" "libgdk_pixbuf-2.0-0.dll"))
-     (t "libgdk_pixbuf-2.0")))
+  (eval-when (:compile-toplevel :load-toplevel :execute)
+    (define-foreign-library gdk
+      (:unix (:or "libgdk-x11-2.0.so.0" "libgdk-x11-2.0.so"))
+      (:windows "libgdk-win32-2.0-0.dll")
+      (t "libgdk-2.0"))
+    (define-foreign-library gdk-pixbuf
+      (:unix (:or "libgdk_pixbuf-2.0.so.0" "libgdk_pixbuf-2.0.so"))
+      (:windows (:or "libgdk_pixbuf-win32-2.0-0" "libgdk_pixbuf-2.0-0.dll"))
+      (t "libgdk_pixbuf-2.0"))
+   
+    (define-foreign-library gtk
+      (:unix (:or "libgtk-x11-2.0.so.0" "libgtk-x11-2.0.so"))
+      (:windows (:or "libgtk-2.0-0.dll" "libgtk-win32-2.0-0.dll"))
+      (t "libgtk-2.0")))
 
- (use-foreign-library gdk)
- (use-foreign-library gdk-pixbuf))
\ No newline at end of file
+  (use-foreign-library gdk)
+  (use-foreign-library gdk-pixbuf)
+  (use-foreign-library gtk))
+
+(defcvar (*gtk-major-version* "gtk_major_version" :read-only t :library gtk) :uint)
+(defcvar (*gtk-minor-version* "gtk_minor_version" :read-only t :library gtk) :uint)
+(defcvar (*gtk-micro-version* "gtk_micro_version" :read-only t :library gtk) :uint)
+(defcvar (*gtk-binary-age* "gtk_binary_age" :read-only t :library gtk) :uint)
+(defcvar (*gtk-interface-age* "gtk_interface_age" :read-only t :library gtk) :uint)
+
+(glib:push-library-version-features gtk *gtk-major-version* *gtk-minor-version*
+  2 2
+  2 4
+  2 6
+  2 8
+  2 10
+  2 12
+  2 14
+  2 16
+  2 18)
+
+(glib:require-library-version "Gtk+" 2 16 *gtk-major-version* *gtk-minor-version*)
index 9507fef..8398148 100644 (file)
            #:g-error-condition-domain
            #:g-error-condition-code
            #:g-error-condition-message
-           #:g-spawn-flags)
+           #: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}."))
 
@@ -110,6 +113,35 @@ In this example, for every @code{class}, @code{(initialize-gobject-class-g-type
   (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
 ;;
@@ -141,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, 
index 287d4ee..88b0b2b 100644 (file)
 
 (in-package :gtk)
 
-(at-init ()
-  (eval-when (:compile-toplevel :load-toplevel :execute)
-    (define-foreign-library gtk
-      (:unix (:or "libgtk-x11-2.0.so.0" "libgtk-x11-2.0.so"))
-      (:windows (:or "libgtk-2.0-0.dll" "libgtk-win32-2.0-0.dll"))
-      (t "libgtk-2.0")))
-
-  (use-foreign-library gtk))
-
 #+sbcl (when (and (find-package "SB-EXT")
                   (find-symbol "SET-FLOATING-POINT-MODES" (find-package "SB-EXT")))
-         (funcall (find-symbol "SET-FLOATING-POINT-MODES" (find-package "SB-EXT")) :traps nil))
\ No newline at end of file
+         (funcall (find-symbol "SET-FLOATING-POINT-MODES" (find-package "SB-EXT")) :traps nil))