Remove dependency on supporting C code

5 files changed, 79 insertions, 88 deletions

diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl
index cff9cbf..5b4d55d 100644
--- a/src/Gtk/Internal.dcl
+++ b/src/Gtk/Internal.dcl
@@ -8,7 +8,8 @@ g_free :: !Pointer !.a -> .a
 
 g_object_unref :: !Pointer !.a -> .a
 
-g_signal_connect :: !Int !Pointer !String !Int !.a -> .a
+g_signal_connect :: !Pointer !String !Pointer !Int !.a -> .a
+g_signal_connect_data :: !Pointer !String !Pointer !Int !Pointer !Int !.a -> .a
 
 g_timeout_add :: !Int !Pointer !Int !.a -> .a
 g_timeout_add_seconds :: !Int !Pointer !Int !.a -> .a
diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl
index 8a32b2c..92a9009 100644
--- a/src/Gtk/Internal.icl
+++ b/src/Gtk/Internal.icl
@@ -6,7 +6,6 @@ import StdDebug
 
 import System._Pointer
 
-import code from "clean_gtk_support."
 import code from library "-lgtk-3"
 import code from library "-lgdk-3"
 import code from library "-lpangocairo-1.0"
@@ -29,12 +28,17 @@ g_object_unref p env = code {
 	ccall g_object_unref "p:V:A"
 }
 
-g_signal_connect :: !Int !Pointer !String !Int !.a -> .a
-g_signal_connect type widget signal id env = connect type widget (packString signal) id env
+g_signal_connect :: !Pointer !String !Pointer !Int !.a -> .a
+g_signal_connect widget signal callback data env =
+	g_signal_connect_data widget signal callback data 0 0 env
+
+g_signal_connect_data :: !Pointer !String !Pointer !Int !Pointer !Int !.a -> .a
+g_signal_connect_data widget signal callback data destroy_data flags env =
+	connect widget (packString signal) callback data destroy_data flags env
 where
-	connect :: !Int !Pointer !String !Int !.a -> .a
-	connect _ _ _ _ _ = code {
-		ccall clean_g_signal_connect "IpsI:V:A"
+	connect :: !Pointer !String !Pointer !Int !Pointer !Int !.a -> .a
+	connect _ _ _ _ _ _ _ = code {
+		ccall g_signal_connect_data "pspIpI:V:A"
 	}
 
 g_timeout_add :: !Int !Pointer !Int !.a -> .a
diff --git a/src/Gtk/Signal.dcl b/src/Gtk/Signal.dcl
index 7830886..fa9babf 100644
--- a/src/Gtk/Signal.dcl
+++ b/src/Gtk/Signal.dcl
@@ -46,7 +46,11 @@ retrieveState :: GtkM GtkState
 //* Wrap functionality in `saveState` and `retrieveState` if it can be re-entrant.
 withPossibleCallback :: !(GtkM a) -> GtkM a
 
-handleSignal :: !Int !{#Int} -> Int // only for foreign export
+// Only for foreign export:
+handleSignal_void :: !Pointer !Int -> Int
+handleSignal_pointer_bool :: !Pointer !Pointer !Int -> Int
+handleSignal_int_int_bool :: !Pointer !Int !Int !Int -> Int
+handleSignal_int_int_pointer_pointer_bool :: !Pointer !Int !Int !Pointer !Pointer !Int -> Int
 
 addTimeout :: !GtkTimeout !(GtkM Bool) -> GtkM ()
 handleTimeout :: !Int -> Int // only for foreign export
diff --git a/src/Gtk/Signal.icl b/src/Gtk/Signal.icl
index 3ed3bca..254523a 100644
--- a/src/Gtk/Signal.icl
+++ b/src/Gtk/Signal.icl
@@ -50,14 +50,31 @@ installSignalHandler handler widget =
 		, signal_counter  = st.signal_counter+1
 		}) >>= \{signal_counter=id} ->
 	let (GtkWidget w) = gtkWidget widget in
-	toState (g_signal_connect (type handler_internal) w (signalName handler) id) >>|
+	toState (g_signal_connect w (signalName handler) (callback handler_internal) id) >>|
 	pure widget
 where
-	type handler = case handler of
-		SHI_Void _                         -> 1
-		SHI_Int_Int_Bool _                 -> 2
-		SHI_Pointer_Bool _                 -> 3
-		SHI_Int_Int_Pointer_Pointer_Bool _ -> 4
+	callback handler = case handler of
+		SHI_Void _                         -> callback_void
+		SHI_Int_Int_Bool _                 -> callback_int_int_bool
+		SHI_Pointer_Bool _                 -> callback_pointer_bool
+		SHI_Int_Int_Pointer_Pointer_Bool _ -> callback_int_int_pointer_pointer_bool
+
+	callback_void :: Pointer
+	callback_void = code {
+		pushLc handleSignal_void
+	}
+	callback_int_int_bool :: Pointer
+	callback_int_int_bool = code {
+		pushLc handleSignal_int_int_bool
+	}
+	callback_pointer_bool :: Pointer
+	callback_pointer_bool = code {
+		pushLc handleSignal_pointer_bool
+	}
+	callback_int_int_pointer_pointer_bool :: Pointer
+	callback_int_int_pointer_pointer_bool = code {
+		pushLc handleSignal_int_int_pointer_pointer_bool
+	}
 
 instance tune w SignalHandler | gtkWidget w
 where
@@ -97,31 +114,50 @@ retrieveState = modState (const saved_state.[0])
 withPossibleCallback :: !(GtkM a) -> GtkM a
 withPossibleCallback m = saveState >>| m >>= \r -> retrieveState >>| pure r
 
-foreign export handleSignal
-handleSignal :: !Int !{#Int} -> Int
-handleSignal id args
-	# st = saved_state.[0]
-	= case 'Data.Map'.get id st.signal_handlers of
-		Nothing
-			-> trace_n ("handleSignal: missing signal handler #"+++toString id) 0
-		Just handler
-			# (GtkM f) = runSignalHandler handler args
-			# (i,st) = f st
-			-> save_state st i
-
-runSignalHandler :: !SignalHandlerInternal !{#Int} -> GtkM Int
-runSignalHandler handler args = case handler of
+foreign export handleSignal_void
+handleSignal_void :: !Pointer !Int -> Int
+handleSignal_void _ id = handleSignal id \h -> case h of
 	SHI_Void f
-		-> toInt <$> f
-	SHI_Int_Int_Bool f
-		-> toInt <$> f args.[0] args.[1]
+		-> Just (toInt <$> f)
+		-> Nothing
+
+foreign export handleSignal_pointer_bool
+handleSignal_pointer_bool :: !Pointer !Pointer !Int -> Int
+handleSignal_pointer_bool _ p id = handleSignal id \h -> case h of
 	SHI_Pointer_Bool f
-		-> toInt <$> f args.[0]
+		-> Just (toInt <$> f p)
+		-> Nothing
+
+foreign export handleSignal_int_int_bool
+handleSignal_int_int_bool :: !Pointer !Int !Int !Int -> Int
+handleSignal_int_int_bool _ i1 i2 id = handleSignal id \h -> case h of
+	SHI_Int_Int_Bool f
+		-> Just (toInt <$> f i1 i2)
+		-> Nothing
+
+foreign export handleSignal_int_int_pointer_pointer_bool
+handleSignal_int_int_pointer_pointer_bool :: !Pointer !Int !Int !Pointer !Pointer !Int -> Int
+handleSignal_int_int_pointer_pointer_bool _ i1 i2 p1 p2 id = handleSignal id \h -> case h of
 	SHI_Int_Int_Pointer_Pointer_Bool f
-		-> toInt <$> f args.[0] args.[1] args.[2] args.[3]
+		-> Just (toInt <$> f i1 i2 p1 p2)
+		-> Nothing
 
+instance toInt () where toInt () = 0
 instance toInt Bool where toInt b = if b 1 0
-instance toInt ()   where toInt _ = 0
+
+handleSignal :: !Int !(SignalHandlerInternal -> Maybe (GtkM Int)) -> Int
+handleSignal id handle
+	# st = saved_state.[0]
+	= case 'Data.Map'.get id st.signal_handlers of
+		Nothing
+			-> trace_n ("handleSignal: missing signal handler #"+++toString id) 0
+		Just handler
+			-> case handle handler of
+				Nothing
+					-> trace_n "handleSignal: signal handler does not match" 0
+				Just (GtkM f)
+					# (r,st) = f st
+					-> save_state st r
 
 addTimeout :: !GtkTimeout !(GtkM Bool) -> GtkM ()
 addTimeout interval callback =
diff --git a/src/clean_gtk_support.c b/src/clean_gtk_support.c
deleted file mode 100644
index 7106b57..0000000
--- a/src/clean_gtk_support.c
+++ /dev/null
@@ -1,54 +0,0 @@
-#include <gtk/gtk.h>
-
-typedef long CleanInt;
-
-extern CleanInt handleSignal (CleanInt,CleanInt*);
-
-static void clean_g_signal_handler_void (GtkWidget *target,gpointer data) {
-	CleanInt args[2];
-	args[0]=0;
-	handleSignal ((CleanInt)data,&args[2]);
-}
-
-static gboolean clean_g_signal_handler_int_int_bool
-		(GtkWidget *target,gint i1,gint i2,gpointer data) {
-	CleanInt args[4];
-	args[0]=4;
-	args[2]=i1;
-	args[3]=i2;
-	return (gboolean) handleSignal ((CleanInt)data,&args[2]);
-}
-
-static gboolean clean_g_signal_handler_pointer_bool (GtkWidget *target,gpointer p,gpointer data) {
-	CleanInt args[3];
-	args[0]=1;
-	args[2]=(CleanInt)p;
-	return (gboolean) handleSignal ((CleanInt)data,&args[2]);
-}
-
-static gboolean clean_g_signal_handler_int_int_pointer_pointer_bool
-		(GtkWidget *target,gint i1,gint i2,gpointer p1,gpointer p2,gpointer data) {
-	CleanInt args[6];
-	args[0]=4;
-	args[2]=i1;
-	args[3]=i2;
-	args[4]=(CleanInt)p1;
-	args[5]=(CleanInt)p2;
-	return (gboolean) handleSignal ((CleanInt)data,&args[2]);
-}
-
-void clean_g_signal_connect (int type,GtkWidget *widget,char *signal,CleanInt id) {
-	void *callback=NULL;
-
-	switch (type) {
-		case  1: callback=&clean_g_signal_handler_void; break;
-		case  2: callback=&clean_g_signal_handler_int_int_bool; break;
-		case  3: callback=&clean_g_signal_handler_pointer_bool; break;
-		case  4: callback=&clean_g_signal_handler_int_int_pointer_pointer_bool; break;
-		default:
-			fprintf (stderr,"clean_g_signal_connect: illegal type %d\n",type);
-			return;
-	}
-
-	g_signal_connect (widget,signal,G_CALLBACK (callback),(gpointer)id);
-}