From d8ea48ab2bbc884b7f1cf8fd620420c8edfea6d9 Mon Sep 17 00:00:00 2001 From: Andrey Kutejko Date: Fri, 1 Apr 2011 05:58:22 +0300 Subject: [PATCH] fix file chooser functions on Win32 --- generating.lisp | 18 +++++++++++++++--- glib/gobject.generating.lisp | 18 ++++++++++++++++-- gtk/gtk.generated-classes.lisp | 16 ++++++++++++++++ gtk/gtk.selectors.lisp | 18 ++++++++++++------ 4 files changed, 59 insertions(+), 11 deletions(-) diff --git a/generating.lisp b/generating.lisp index 885ef96..34dab49 100644 --- 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/gobject.generating.lisp b/glib/gobject.generating.lisp index 0560ddb..df57b56 100644 --- 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/gtk/gtk.generated-classes.lisp b/gtk/gtk.generated-classes.lisp index fa8a81f..5c27690 100644 --- 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 --- 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) -- 1.7.10.4