Add basic functionality for accelerators (i.e. shortcuts)

1 files changed, 14 insertions, 0 deletions

diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl
index 5290d9f..9500b5f 100644
--- a/src/Gtk/Widgets.icl
+++ b/src/Gtk/Widgets.icl
@@ -14,6 +14,13 @@ import qualified Text
 import Gtk
 import Gtk.Internal
 
+newAccelGroup :: !w -> GtkM GtkAccelGroup | gtkWindow w
+newAccelGroup window =
+	let (GtkWindow w) = gtkWindow window in
+	toStateR gtk_accel_group_new >>= \ag ->
+	toState (gtk_window_add_accel_group w ag) >>|
+	pure (GtkAccelGroup ag)
+
 instance gtkWidget GtkActionBar where gtkWidget (GtkActionBar ab) = GtkWidget ab
 
 newActionBar :: GtkM GtkActionBar
@@ -520,6 +527,13 @@ where
 		toState (gtk_widget_set_vexpand w vexpand=:Expand) >>|
 		pure widget
 
+instance tune w GtkAccelerator | gtkWidget w
+where
+	tune (Accelerator (GtkAccelGroup ag) key mask) widget =
+		let (GtkWidget w) = gtkWidget widget in
+		toState (gtk_widget_add_accelerator w "activate" ag (gdk_keyval_from_name key) (toInt mask) 1) >>|
+		pure widget
+
 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