Add support for file choosers

1 files changed, 86 insertions, 0 deletions

diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl
index 8704e35..787a2c9 100644
--- a/src/Gtk/Internal.icl
+++ b/src/Gtk/Internal.icl
@@ -2,11 +2,17 @@ implementation module Gtk.Internal
 
 import StdEnv
 import StdMaybe
+import StdDebug
 
 import System._Pointer
 
 import code from "clean_gtk_support."
 
+g_free :: !Pointer !.a -> .a
+g_free p env = code {
+	ccall g_free "p:V:A"
+}
+
 g_object_unref :: !Pointer !.a -> .a
 g_object_unref p env = code {
 	ccall g_object_unref "p:V:A"
@@ -70,6 +76,81 @@ where
 		ccall gtk_css_provider_load_from_path "psp:I:A"
 	}
 
+gtk_dialog_run :: !Pointer !.a -> (!Int, !.a)
+gtk_dialog_run dialog env = code {
+	ccall gtk_dialog_run "p:I:A"
+}
+
+gtk_dialog_set_default_response :: !Pointer !Int !.a -> .a
+gtk_dialog_set_default_response dialog response env = code {
+	ccall gtk_dialog_set_default_response "pI:V:A"
+}
+
+gtk_file_chooser_add_filter :: !Pointer !Pointer !.a -> .a
+gtk_file_chooser_add_filter chooser filter env = code {
+	ccall gtk_file_chooser_add_filter "pp:V:A"
+}
+
+gtk_file_chooser_dialog_new :: !(Maybe String) !Pointer !Int ![(String,Int)] !.a -> (!Pointer, !.a)
+gtk_file_chooser_dialog_new (Just title) parent action [(button,response)] env =
+	new (packString title) parent action (packString button) response 0 env
+where
+	new :: !String !Pointer !Int !String !Int !Pointer !.a -> (!Pointer, !.a)
+	new _ _ _ _ _ _ _ = code {
+		ccall gtk_file_chooser_dialog_new "spIsIp:p:A"
+	}
+gtk_file_chooser_dialog_new (Just title) parent action [(b1,r1),(b2,r2)] env =
+	new (packString title) parent action (packString b1) r1 (packString b2) r2 0 env
+where
+	new :: !String !Pointer !Int !String !Int !String !Int !Pointer !.a -> (!Pointer, !.a)
+	new _ _ _ _ _ _ _ _ _ = code {
+		ccall gtk_file_chooser_dialog_new "spIsIsIp:p:A"
+	}
+gtk_file_chooser_dialog_new Nothing parent action [(button,response)] env =
+	new 0 parent action (packString button) response 0 env
+where
+	new :: !Pointer !Pointer !Int !String !Int !Pointer !.a -> (!Pointer, !.a)
+	new _ _ _ _ _ _ _ = code {
+		ccall gtk_file_chooser_dialog_new "ppIsIp:p:A"
+	}
+gtk_file_chooser_dialog_new Nothing parent action [(b1,r1),(b2,r2)] env =
+	new 0 parent action (packString b1) r1 (packString b2) r2 0 env
+where
+	new :: !Pointer !Pointer !Int !String !Int !String !Int !Pointer !.a -> (!Pointer, !.a)
+	new _ _ _ _ _ _ _ _ _ = code {
+		ccall gtk_file_chooser_dialog_new "ppIsIsIp:p:A"
+	}
+gtk_file_chooser_dialog_new _ _ _ buttons env =
+	trace_n
+		("gtk_file_chooser_dialog_new: "+++toString (length buttons)+++" buttons not supported")
+		(0, env)
+
+gtk_file_chooser_get_filename :: !Pointer !.a -> (!Maybe String, !.a)
+gtk_file_chooser_get_filename chooser env
+	# (filename,env) = get chooser env
+	| filename == 0 = (Nothing, env)
+	# (filename_string,filename) = readP derefString filename
+	# env = g_free filename env
+	= (Just filename_string, env)
+where
+	get :: !Pointer !.a -> (!Pointer, !.a)
+	get _ _ = code {
+		ccall gtk_file_chooser_get_filename "p:p:A"
+	}
+
+gtk_file_filter_new :: !.a -> (!Pointer, !.a)
+gtk_file_filter_new env = code {
+	ccall gtk_file_filter_new ":p:A"
+}
+
+gtk_file_filter_add_pattern :: !Pointer !String !.a -> .a
+gtk_file_filter_add_pattern filter pattern env = add filter (packString pattern) env
+where
+	add :: !Pointer !String !.a -> .a
+	add _ _ _ = code {
+		ccall gtk_file_filter_add_pattern "ps:V:A"
+	}
+
 gtk_frame_new :: !(Maybe String) !.a -> (!Pointer, !.a)
 gtk_frame_new Nothing env = new 0 env
 where
@@ -216,6 +297,11 @@ gtk_text_view_set_editable text_view setting env = code {
 	ccall gtk_text_view_set_editable "pI:V:A"
 }
 
+gtk_widget_destroy :: !Pointer !.a -> .a
+gtk_widget_destroy widget env = code {
+	ccall gtk_widget_destroy "p:V:A"
+}
+
 gtk_widget_get_screen :: !Pointer !.a -> (!Pointer, !.a)
 gtk_widget_get_screen widget env = code {
 	ccall gtk_widget_get_screen "p:p:A"