1 files changed, 62 insertions, 26 deletions

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 =