summaryrefslogtreecommitdiff
path: root/src/Gtk
diff options
context:
space:
mode:
Diffstat (limited to 'src/Gtk')
-rw-r--r--src/Gtk/Internal.dcl3
-rw-r--r--src/Gtk/Internal.icl16
-rw-r--r--src/Gtk/Signal.dcl6
-rw-r--r--src/Gtk/Signal.icl88
4 files changed, 79 insertions, 34 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 =
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-30 16:13:24 +0000