Add GdkEvent and KeyPressHandler

10 files changed, 92 insertions, 12 deletions

diff --git a/src/Gdk/Events.dcl b/src/Gdk/Events.dcl
new file mode 100644
index 0000000..e3d5bd7
--- /dev/null
+++ b/src/Gdk/Events.dcl
@@ -0,0 +1,9 @@
+definition module Gdk.Events
+
+from StdMaybe import :: Maybe
+
+from System._Pointer import :: Pointer
+
+:: GdkEvent =: GdkEvent Pointer
+
+getKeyvalName :: !GdkEvent -> Maybe String
diff --git a/src/Gdk/Events.icl b/src/Gdk/Events.icl
new file mode 100644
index 0000000..58ca045
--- /dev/null
+++ b/src/Gdk/Events.icl
@@ -0,0 +1,13 @@
+implementation module Gdk.Events
+
+import StdEnv
+import StdMaybe
+
+import Data.Functor
+import Data.Maybe
+import System._Pointer
+
+import Gdk.Internal
+
+getKeyvalName :: !GdkEvent -> Maybe String
+getKeyvalName (GdkEvent ev) = gdk_keyval_name <$> gdk_event_get_keyval ev
diff --git a/src/Gdk/Internal.dcl b/src/Gdk/Internal.dcl
new file mode 100644
index 0000000..ccc157e
--- /dev/null
+++ b/src/Gdk/Internal.dcl
@@ -0,0 +1,10 @@
+definition module Gdk.Internal
+
+from StdMaybe import :: Maybe
+
+from System._Pointer import :: Pointer
+
+gdk_event_get_keyval :: !Pointer -> Maybe Int
+
+gdk_keyval_from_name :: !String -> Int
+gdk_keyval_name :: !Int -> String
diff --git a/src/Gdk/Internal.icl b/src/Gdk/Internal.icl
new file mode 100644
index 0000000..a922d84
--- /dev/null
+++ b/src/Gdk/Internal.icl
@@ -0,0 +1,44 @@
+implementation module Gdk.Internal
+
+import StdEnv
+import StdMaybe
+
+import System._Pointer
+
+gdk_event_get_keyval :: !Pointer -> Maybe Int
+gdk_event_get_keyval event
+	# arr = {#0}
+	# ok = get event (get_array_pointer arr)
+	| ok
+		= Just (arr.[0])
+		= Nothing
+where
+	get :: !Pointer !Pointer -> Bool
+	get _ _ = code {
+		ccall gdk_event_get_keyval "pp:I"
+	}
+
+gdk_keyval_from_name :: !String -> Int
+gdk_keyval_from_name name = get (packString name)
+where
+	get :: !String -> Int
+	get _ = code {
+		ccall gdk_keyval_from_name "s:I"
+	}
+
+gdk_keyval_name :: !Int -> String
+gdk_keyval_name keyval = derefString (get keyval)
+where
+	get :: !Pointer -> Pointer
+	get _ = code {
+		ccall gdk_keyval_name "p:p"
+	}
+
+get_array_pointer :: !{#Int} -> Pointer
+get_array_pointer arr = get arr + IF_INT_64_OR_32 24 12
+where
+	get :: !{#Int} -> Pointer
+	get _ = code {
+		push_a_b 0
+		pop_a 1
+	}
diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl
index 4d6920e..6d2e489 100644
--- a/src/Gtk/Internal.dcl
+++ b/src/Gtk/Internal.dcl
@@ -13,8 +13,6 @@ g_signal_connect :: !Int !Pointer !String !Int !.a -> .a
 g_timeout_add :: !Int !Int !.a -> .a
 g_timeout_add_seconds :: !Int !Int !.a -> .a
 
-gdk_keyval_from_name :: !String -> Int
-
 gtk_accel_group_new :: !.a -> (!Pointer, !.a)
 
 gtk_action_bar_new :: !.a -> (!Pointer, !.a)
diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl
index eeffe6b..e9b7a27 100644
--- a/src/Gtk/Internal.icl
+++ b/src/Gtk/Internal.icl
@@ -36,14 +36,6 @@ g_timeout_add_seconds interval id env = code {
 	ccall clean_g_timeout_add_seconds "II:V:A"
 }
 
-gdk_keyval_from_name :: !String -> Int
-gdk_keyval_from_name name = get (packString name)
-where
-	get :: !String -> Int
-	get _ = code {
-		ccall gdk_keyval_from_name "s:I"
-	}
-
 gtk_accel_group_new :: !.a -> (!Pointer, !.a)
 gtk_accel_group_new env = code {
 	ccall gtk_accel_group_new ":p:A"
diff --git a/src/Gtk/Signal.dcl b/src/Gtk/Signal.dcl
index 5ed6ac8..6bb60d8 100644
--- a/src/Gtk/Signal.dcl
+++ b/src/Gtk/Signal.dcl
@@ -2,9 +2,10 @@ definition module Gtk.Signal
 
 from System._Pointer import :: Pointer
 
+from Gdk.Events import :: GdkEvent
 from Gtk.State import :: GtkM, :: GtkState
 from Gtk.Tune import class tune
-from Gtk.Types import :: GtkTimeout
+from Gtk.Types import :: GtkPropagate, :: GtkTimeout
 from Gtk.Widgets import class gtkWidget
 
 class signalHandler h
@@ -19,6 +20,7 @@ where
 	| ChangedHandler       !(GtkM ())
 	| ClickedHandler       !(GtkM ())
 	| DestroyHandler       !(GtkM ())
+	| KeyPressHandler      !(GdkEvent -> GtkM GtkPropagate)
 	| NextMatchHandler     !(GtkM ())
 	| PreviousMatchHandler !(GtkM ())
 	| SearchChangedHandler !(GtkM ())
diff --git a/src/Gtk/Signal.icl b/src/Gtk/Signal.icl
index e97f2ab..cb13551 100644
--- a/src/Gtk/Signal.icl
+++ b/src/Gtk/Signal.icl
@@ -8,6 +8,8 @@ import Control.Monad
 import Data.Functor
 import qualified Data.Map
 
+import Gdk.Events
+
 import Gtk
 import Gtk.Internal
 
@@ -18,6 +20,7 @@ where
 		ChangedHandler _       -> "changed"
 		ClickedHandler _       -> "clicked"
 		DestroyHandler _       -> "destroy"
+		KeyPressHandler _      -> "key-press-event"
 		NextMatchHandler _     -> "next-match"
 		PreviousMatchHandler _ -> "previous-match"
 		SearchChangedHandler _ -> "search-changed"
@@ -27,10 +30,14 @@ where
 		ChangedHandler f       -> SHI_Void f
 		ClickedHandler f       -> SHI_Void f
 		DestroyHandler f       -> SHI_Void f
+		KeyPressHandler f      -> SHI_Pointer_Bool \ev -> toBool <$> f (GdkEvent ev)
 		NextMatchHandler f     -> SHI_Void f
 		PreviousMatchHandler f -> SHI_Void f
 		SearchChangedHandler f -> SHI_Void f
 		StopSearchHandler f    -> SHI_Void f
+	where
+		toBool :: !GtkPropagate -> Bool
+		toBool p = p=:StopPropagation
 
 installSignalHandler :: !h !w -> GtkM w | signalHandler h & gtkWidget w
 installSignalHandler handler widget =
diff --git a/src/Gtk/Types.dcl b/src/Gtk/Types.dcl
index 2c18c8f..cb264bb 100644
--- a/src/Gtk/Types.dcl
+++ b/src/Gtk/Types.dcl
@@ -127,6 +127,10 @@ instance toInt GtkMessageType
 	= WideHandle
 	| NarrowHandle
 
+:: GtkPropagate
+	= Propagate
+	| StopPropagation
+
 :: GtkResize
 	= Resize
 	| NoResize
diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl
index ff162cd..db69b81 100644
--- a/src/Gtk/Widgets.icl
+++ b/src/Gtk/Widgets.icl
@@ -12,6 +12,7 @@ from Text import class Text(split), instance Text String
 import qualified Text
 
 import Gtk
+import Gdk.Internal
 import Gtk.Internal
 
 newAccelGroup :: !w -> GtkM GtkAccelGroup | gtkWindow w
@@ -568,7 +569,7 @@ instance gtkWidget GtkWindow where gtkWidget (GtkWindow w) = GtkWidget w
 instance gtkContainer GtkWindow where gtkContainer (GtkWindow w) = GtkContainer w
 instance gtkWindow GtkWindow where gtkWindow w = w
 
-newPopup :: -> GtkM GtkWindow
+newPopup :: GtkM GtkWindow
 newPopup = new_window_or_popup True
 
 newWindow :: GtkM GtkWindow