Merge branch 'master' of git://github.com/dmitryvk/cl-gtk2

diff --git a/gdk/gdk.package.lisp b/gdk/gdk.package.lisp
index 3de1687..0e4f12b 100644 (file)
--- a/gdk/gdk.package.lisp
+++ b/gdk/gdk.package.lisp
@@ -8,16 +8,19 @@
 (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"))
+      ((:and :unix (:not :darwin)) (:or "libgdk-x11-2.0.so.0" "libgdk-x11-2.0.so"))
+      (:darwin (:or "libgdk-x11-2.0.0.dylib" "libgdk-x11-2.0.dylib"))
       (: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"))
+      ((:and :unix (:not :darwin)) (:or "libgdk_pixbuf-2.0.so.0" "libgdk_pixbuf-2.0.so"))
+      (:darwin (:or "libgdk_pixbuf-2.0.0.dylib" "libgdk_pixbuf-2.0.dylib"))
       (: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"))
+      ((:and :unix (:not :darwin)) (:or "libgtk-x11-2.0.so.0" "libgtk-x11-2.0.so"))
+      (:darwin (:or "libgtk-x11-2.0.0.dylib" "libgtk-x11-2.0.dylib"))
       (:windows (:or "libgtk-2.0-0.dll" "libgtk-win32-2.0-0.dll"))
       (t "libgtk-2.0")))
 

diff --git a/generating.lisp b/generating.lisp
index 885ef96..34dab49 100644 (file)
--- a/generating.lisp
+++ b/generating.lisp
@@ -210,15 +210,27 @@
        ("GtkFileChooser"
         (:cffi gtk::current-name gtk::file-chooser-current-name (:string :free-to-foreign t :encoding :utf-8)
          nil "gtk_file_chooser_set_current_name")
-        (:cffi gtk::filename gtk::file-chooser-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
+        (:cond :+win32
+         :cffi gtk::filename gtk::file-chooser-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
+         "gtk_file_chooser_get_filename_utf8" "gtk_file_chooser_set_filename_utf8")
+        (:cond :-win32
+         :cffi gtk::filename gtk::file-chooser-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
          "gtk_file_chooser_get_filename" "gtk_file_chooser_set_filename")
-        (:cffi gtk::current-folder gtk::file-chooser-current-folder (glib:g-string :free-from-foreign t :free-to-foreign t)
+        (:cond :+win32
+         :cffi gtk::current-folder gtk::file-chooser-current-folder (glib:g-string :free-from-foreign t :free-to-foreign t)
+         "gtk_file_chooser_get_current_folder_utf8" "gtk_file_chooser_set_current_folder_utf8")
+        (:cond :-win32
+         :cffi gtk::current-folder gtk::file-chooser-current-folder (glib:g-string :free-from-foreign t :free-to-foreign t)
          "gtk_file_chooser_get_current_folder" "gtk_file_chooser_set_current_folder")
         (:cffi gtk::uri gtk::file-chooser-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
          "gtk_file_chooser_get_uri" "gtk_file_chooser_set_uri")
         (:cffi gtk::current-folder-uri gtk::file-chooser-current-folder-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
          "gtk_file_chooser_get_current_folder_uri" "gtk_file_chooser_set_current_folder_uri")
-        (:cffi gtk::preview-filename gtk::file-chooser-preview-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
+        (:cond :+win32
+         :cffi gtk::preview-filename gtk::file-chooser-preview-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
+         "gtk_file_chooser_get_preview_filename_utf8" nil)
+        (:cond :-win32
+         :cffi gtk::preview-filename gtk::file-chooser-preview-filename (glib:g-string :free-from-foreign t :free-to-foreign t)
          "gtk_file_chooser_get_preview_filename" nil)
         (:cffi gtk::preview-uri gtk::file-chooser-preview-uri (glib:g-string :free-from-foreign t :free-to-foreign t)
          "gtk_file_chooser_get_preview_uri" nil))

diff --git a/glib/glib.lisp b/glib/glib.lisp
index cdd1d1a..bf6e9d6 100644 (file)
--- a/glib/glib.lisp
+++ b/glib/glib.lisp
@@ -101,12 +101,14 @@ In this example, for every @code{class}, @code{(initialize-gobject-class-g-type
 (at-init ()
   (eval-when (:compile-toplevel :load-toplevel :execute)
     (define-foreign-library glib
-      (:unix (:or "libglib-2.0.so.0" "libglib-2.0.so"))
+      ((: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
-      (:unix (:or "libgthread-2.0.so.0"  "libgthread-2.0.so"))
+      ((: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")))
 

diff --git a/glib/gobject.generating.lisp b/glib/gobject.generating.lisp
index 0560ddb..df57b56 100644 (file)
--- a/glib/gobject.generating.lisp
+++ b/glib/gobject.generating.lisp
@@ -240,6 +240,12 @@
           (write-char (char-downcase c) stream))
     (write-string "_get_type" stream)))
 
+(defclass print-readtime-condition ()
+  ((condition :initarg :condition)))
+
+(defmethod print-object ((o print-readtime-condition) stream)
+  (format stream "#~A" (slot-value o 'condition)))
+
 (defun get-g-class-definition (type &optional lisp-name-package)
   (when (and (stringp type) (null (ignore-errors (gtype type))))
     (let ((type-init-name (probable-type-init-name type)))
@@ -269,7 +275,11 @@
        (,@(mapcar (lambda (property)
                     (property->property-definition name property))
                   own-properties)
-          ,@(cdr (find g-name *additional-properties* :key 'car :test 'string=))))))
+          ,@(mapcan (lambda (property-definition)
+                      (if (eq :cond (car property-definition))
+                          (list (make-instance 'print-readtime-condition :condition (cadr property-definition)) (cddr property-definition))
+                          (list property-definition)))
+                    (cdr (find g-name *additional-properties* :key 'car :test 'string=)))))))
 
 (defun get-g-interface-definition (interface &optional lisp-name-package)
   (when (and (stringp interface) (null (ignore-errors (gtype interface))))
@@ -292,7 +302,11 @@
        ,@(append (mapcar (lambda (property)
                            (property->property-definition name property))
                          properties)
-                 (cdr (find g-name *additional-properties* :key 'car :test 'string=))))))
+                 (mapcan (lambda (property-definition)
+                           (if (eq :cond (car property-definition))
+                               (list (make-instance 'print-readtime-condition :condition (cadr property-definition)) (cddr property-definition))
+                               (list property-definition)))
+                         (cdr (find g-name *additional-properties* :key 'car :test 'string=)))))))
 
 (defun get-g-class-definitions-for-root-1 (type)
   (unless (member (gtype type) *generation-exclusions* :test 'g-type=)

diff --git a/glib/gobject.init.lisp b/glib/gobject.init.lisp
index 9c94cf9..aabf1f7 100644 (file)
--- a/glib/gobject.init.lisp
+++ b/glib/gobject.init.lisp
@@ -6,7 +6,8 @@
 (at-init ()
  (eval-when (:compile-toplevel :load-toplevel :execute)
    (cffi:define-foreign-library gobject
-     (:unix (:or "libgobject-2.0.so.0" "libgobject-2.0.so"))
+     ((:and :unix (:not :darwin)) (:or "libgobject-2.0.so.0" "libgobject-2.0.so"))
+     (:darwin (:or "libgobject-2.0.0.dylib" "libgobject-2.0.dylib"))
      (:windows "libgobject-2.0-0.dll")
      (t "libgobject-2.0")))
 

diff --git a/glib/gobject.object.high.lisp b/glib/gobject.object.high.lisp
index db156d1..f2b07b2 100644 (file)
--- a/glib/gobject.object.high.lisp
+++ b/glib/gobject.object.high.lisp
@@ -161,11 +161,11 @@
   (gethash name *registered-object-types*))
 (defun get-g-object-lisp-type (g-type)
   (setf g-type (gtype g-type))
-  (loop
-     while (not (null g-type))
-     for lisp-type = (gethash (gtype-name g-type) *registered-object-types*)
-     when lisp-type do (return lisp-type)
-     do (setf g-type (g-type-parent g-type))))
+  (iter (while (not (null g-type)))
+        (for lisp-type = (gethash (gtype-name g-type) *registered-object-types*))
+        (when lisp-type
+          (return lisp-type))
+        (setf g-type (g-type-parent g-type))))
 
 (defun make-g-object-from-pointer (pointer)
   (let* ((g-type (g-type-from-instance pointer))

diff --git a/gtk/cl-gtk2-gtk.asd b/gtk/cl-gtk2-gtk.asd
index 3d09695..1bccf83 100644 (file)
--- a/gtk/cl-gtk2-gtk.asd
+++ b/gtk/cl-gtk2-gtk.asd
@@ -60,6 +60,7 @@
                (:file "gtk.paned")
                (:file "gtk.child-properties")
                (:file "gtk.widget")
+               (:file "gtk.tree-view-dnd")
                (:file "gtk.builder")
                (:file "gtk.assistant")
                (:file "gtk.link-button")
@@ -81,6 +82,7 @@
                
                (:file "gtk.demo")
                (:file "gtk.timer")
+               (:file "gtk.finalize-classes")
                (:module "demo-files"
                         :pathname "demo/"
                         :components ((:plain-file "demo1" :type "ui")

diff --git a/gtk/gtk.finalize-classes.lisp b/gtk/gtk.finalize-classes.lisp
new file mode 100644 (file)
index 0000000..5080448
--- /dev/null
+++ b/gtk/gtk.finalize-classes.lisp
@@ -0,0 +1,12 @@
+(in-package :gtk)
+
+(defun finalize-subclasses (class)
+  ;(format t "Finalizing ~A~%" class)
+  (c2mop:ensure-finalized class)
+  (iter (for subclass in (c2mop:class-direct-subclasses class))
+        (finalize-subclasses subclass)))
+
+(defun finalize-gtk-classes ()
+  (finalize-subclasses (find-class 'gobject:g-object)))
+
+(finalize-gtk-classes)

diff --git a/gtk/gtk.generated-classes.lisp b/gtk/gtk.generated-classes.lisp
index fa8a81f..5c27690 100644 (file)
--- a/gtk/gtk.generated-classes.lisp
+++ b/gtk/gtk.generated-classes.lisp
@@ -1084,9 +1084,20 @@
   (:cffi current-name file-chooser-current-name
    (:string :free-to-foreign t :encoding :utf-8) nil
    "gtk_file_chooser_set_current_name")
+  #+win32
+  (:cffi filename file-chooser-filename
+   (g-string :free-from-foreign t :free-to-foreign t)
+   "gtk_file_chooser_get_filename_utf8" "gtk_file_chooser_set_filename_utf8")
+  #-win32
   (:cffi filename file-chooser-filename
    (g-string :free-from-foreign t :free-to-foreign t)
    "gtk_file_chooser_get_filename" "gtk_file_chooser_set_filename")
+  #+win32
+  (:cffi current-folder file-chooser-current-folder
+   (g-string :free-from-foreign t :free-to-foreign t)
+   "gtk_file_chooser_get_current_folder_utf8"
+   "gtk_file_chooser_set_current_folder_utf8")
+  #-win32
   (:cffi current-folder file-chooser-current-folder
    (g-string :free-from-foreign t :free-to-foreign t)
    "gtk_file_chooser_get_current_folder" "gtk_file_chooser_set_current_folder")
@@ -1097,6 +1108,11 @@
    (g-string :free-from-foreign t :free-to-foreign t)
    "gtk_file_chooser_get_current_folder_uri"
    "gtk_file_chooser_set_current_folder_uri")
+  #+win32
+  (:cffi preview-filename file-chooser-preview-filename
+   (g-string :free-from-foreign t :free-to-foreign t)
+   "gtk_file_chooser_get_preview_filename_utf8" nil)
+  #-win32
   (:cffi preview-filename file-chooser-preview-filename
    (g-string :free-from-foreign t :free-to-foreign t)
    "gtk_file_chooser_get_preview_filename" nil)

diff --git a/gtk/gtk.selectors.lisp b/gtk/gtk.selectors.lisp
index c09a509..f08c6de 100644 (file)
--- a/gtk/gtk.selectors.lisp
+++ b/gtk/gtk.selectors.lisp
@@ -43,13 +43,15 @@
 
 ; TODO: gtk_color_selection_set_change_palette_with_screen_hook
 
-(defcfun (file-chooser-select-filename "gtk_file_chooser_select_filename") :boolean
+(defcfun (file-chooser-select-filename #+win32 "gtk_file_chooser_select_filename_utf8"
+                                       #-win32 "gtk_file_chooser_select_filename") :boolean
   (file-chooser g-object)
   (filename :string))
 
 (export 'file-chooser-select-filename)
 
-(defcfun (file-chooser-unselect-filename "gtk_file_chooser_unselect_filename") :void
+(defcfun (file-chooser-unselect-filename #+win32 "gtk_file_chooser_unselect_filename_utf8"
+                                         #-win32 "gtk_file_chooser_unselect_filename") :void
   (file-chooser g-object)
   (filename :string))
 
@@ -65,7 +67,8 @@
 
 (export 'file-chooser-unselect-all)
 
-(defcfun (file-chooser-filenames "gtk_file_chooser_get_filenames") (gslist (g-string :free-from-foreign t))
+(defcfun (file-chooser-filenames #+win32 "gtk_file_chooser_get_filenames_utf8"
+                                 #-win32 "gtk_file_chooser_get_filenames") (gslist (g-string :free-from-foreign t))
   (file-chooser g-object))
 
 (export 'file-chooser-filenames)
@@ -104,7 +107,8 @@
 
 (export 'file-chooser-filters)
 
-(defcfun gtk-file-chooser-add-shortcut-folder :boolean
+(defcfun (gtk-file-chooser-add-shortcut-folder #+win32 "gtk_file_chooser_add_shortcut_folder_utf8"
+                                               #-win32 "gtk_file_chooser_add_shortcut_folder") :boolean
   (file-chooser g-object)
   (folder :string)
   (error :pointer))
@@ -114,7 +118,8 @@
 
 (export 'file-chooser-add-shortcut-folder)
 
-(defcfun gtk-file-chooser-remove-shortcut-folder :boolean
+(defcfun (gtk-file-chooser-remove-shortcut-folder #+win32 "gtk_file_chooser_remove_shortcut_folder_utf8"
+                                                  #-win32 "gtk_file_chooser_remove_shortcut_folder") :boolean
   (file-chooser g-object)
   (folder :string)
   (error :pointer))
@@ -124,7 +129,8 @@
 
 (export 'file-chooser-remove-shortcut-folder)
 
-(defcfun (file-chooser-shortcut-folders "gtk_file_chooser_list_shortcut_folders") (gslist (g-string :free-from-foreign t))
+(defcfun (file-chooser-shortcut-folders #+win32 "gtk_file_chooser_list_shortcut_folders_utf8"
+                                        #-win32 "gtk_file_chooser_list_shortcut_folders") (gslist (g-string :free-from-foreign t))
   (file-chooser g-object))
 
 (export 'file-chooser-shortcut-folders)

diff --git a/gtk/gtk.tree-view-dnd.lisp b/gtk/gtk.tree-view-dnd.lisp
new file mode 100644 (file)
index 0000000..224ace6
--- /dev/null
+++ b/gtk/gtk.tree-view-dnd.lisp
@@ -0,0 +1,28 @@
+(in-package :gtk)
+
+(define-vtable ("GtkTreeDragSource" tree-drag-source)
+  (:skip parent-instance g-type-interface)
+  ;;methods
+  (row-draggable (:boolean
+                 (tree-drag-source g-object)
+                 (path (g-boxed-foreign tree-path))))
+  (drag-data-get (:boolean
+                 (tree-drag-source g-object)
+                 (path (g-boxed-foreign tree-path))
+                 (selection-data (g-boxed-foreign selection-data))))
+  (drag-data-delete (:boolean
+                    (tree-drag-source g-object)
+                    (path (g-boxed-foreign tree-path)))))
+
+(define-vtable ("GtkTreeDragDest" tree-drag-dest)
+  (:skip parent-instance g-type-interface)
+  ;;methods
+  (drag-data-received (:boolean
+                      (tree-drag-dest g-object)
+                      (path (g-boxed-foreign tree-path))
+                      (selection-data (g-boxed-foreign selection-data))))
+  (row-drop-possible (:boolean
+                     (tree-drag-dest g-object)
+                     (path (g-boxed-foreign tree-path))
+                     (selection-data (g-boxed-foreign selection-data)))))
+

diff --git a/pango/pango.init.lisp b/pango/pango.init.lisp
index 760e3fe..a64c5ea 100644 (file)
--- a/pango/pango.init.lisp
+++ b/pango/pango.init.lisp
@@ -3,7 +3,8 @@
 (glib:at-init ()
   (eval-when (:compile-toplevel :load-toplevel :execute)
     (define-foreign-library pango
-      (:unix "libpango-1.0.so.0")
+      ((:and :unix (:not :darwin)) "libpango-1.0.so.0")
+      (:darwin (:or "libpango-1.0.0.dylib" "libpango-1.0.dylib"))
       (:windows "libpango-1.0-0.dll")
       (t (:default "libgpango-1.0"))))