From ecb68717b4fdc61090149bda2da126d4594ace85 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Fri, 25 Oct 2019 08:48:52 +0200
Subject: Add GtkCheckMenuItem

---
 src/Gtk/Internal.dcl |  4 ++++
 src/Gtk/Internal.icl | 15 +++++++++++++++
 src/Gtk/Widgets.dcl  | 17 +++++++++++++++--
 src/Gtk/Widgets.icl  | 33 +++++++++++++++++++++++++++++----
 4 files changed, 63 insertions(+), 6 deletions(-)

(limited to 'src')

diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl
index 8ffe98e..b73b843 100644
--- a/src/Gtk/Internal.dcl
+++ b/src/Gtk/Internal.dcl
@@ -14,6 +14,10 @@ gtk_box_new :: !Bool !Int !.a -> (!Pointer, !.a)
 gtk_box_pack_start :: !Pointer !Pointer !Bool !Bool !Int !.a -> .a
 gtk_box_pack_end :: !Pointer !Pointer !Bool !Bool !Int !.a -> .a
 
+gtk_check_menu_item_get_active :: !Pointer !.a -> (!Bool, !.a)
+gtk_check_menu_item_new :: !.a -> (!Pointer, !.a)
+gtk_check_menu_item_set_active :: !Pointer !Bool !.a -> .a
+
 gtk_container_add :: !Pointer !Pointer !.a -> .a
 
 gtk_css_provider_new :: !.a -> (!Pointer, !.a)
diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl
index dab7f62..d0993bf 100644
--- a/src/Gtk/Internal.icl
+++ b/src/Gtk/Internal.icl
@@ -41,6 +41,21 @@ gtk_box_pack_end box child expand fill spacing env = code {
 	ccall gtk_box_pack_end "ppIII:V:A"
 }
 
+gtk_check_menu_item_get_active :: !Pointer !.a -> (!Bool, !.a)
+gtk_check_menu_item_get_active item env = code {
+	ccall gtk_check_menu_item_get_active "p:I:A"
+}
+
+gtk_check_menu_item_new :: !.a -> (!Pointer, !.a)
+gtk_check_menu_item_new env = code {
+	ccall gtk_check_menu_item_new ":p:A"
+}
+
+gtk_check_menu_item_set_active :: !Pointer !Bool !.a -> .a
+gtk_check_menu_item_set_active item setting env = code {
+	ccall gtk_check_menu_item_set_active "pI:V:A"
+}
+
 gtk_container_add :: !Pointer !Pointer !.a -> .a
 gtk_container_add container widget env = code {
 	ccall gtk_container_add "pp:V:A"
diff --git a/src/Gtk/Widgets.dcl b/src/Gtk/Widgets.dcl
index 1140c75..a04929c 100644
--- a/src/Gtk/Widgets.dcl
+++ b/src/Gtk/Widgets.dcl
@@ -70,10 +70,23 @@ instance gtkWidget GtkMenuBar
 newMenuBar :: GtkM GtkMenuBar
 
 :: GtkMenuItem
+
+class gtkMenuItem a :: !a -> GtkMenuItem
+
 instance gtkWidget GtkMenuItem
+instance gtkMenuItem GtkMenuItem
 
 newMenuItem :: !String -> GtkM GtkMenuItem
-setSubMenu :: !GtkMenuItem !GtkMenu -> GtkM GtkMenu
+setSubMenu :: !mi !GtkMenu -> GtkM GtkMenu | gtkMenuItem mi
+
+:: GtkCheckMenuItem
+instance gtkWidget GtkCheckMenuItem
+instance gtkMenuItem GtkCheckMenuItem
+instance ptr GtkCheckMenuItem
+
+newCheckMenuItem :: !String -> GtkM GtkCheckMenuItem
+isActive :: !GtkCheckMenuItem -> GtkM Bool
+setActive :: !Bool !GtkCheckMenuItem -> GtkM GtkCheckMenuItem
 
 :: GtkMenuShell
 instance gtkWidget GtkMenuShell
@@ -81,7 +94,7 @@ instance gtkWidget GtkMenuShell
 class gtkMenuShell a :: !a -> GtkMenuShell
 instance gtkMenuShell GtkMenu, GtkMenuBar, GtkMenuShell
 
-appendToMenuShell :: !s !GtkMenuItem -> GtkM GtkMenuItem | gtkMenuShell s
+appendToMenuShell :: !s !mi -> GtkM mi | gtkMenuShell s & gtkMenuItem mi
 
 :: GtkPaned
 instance gtkWidget GtkPaned
diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl
index b7e4798..f9fb9a3 100644
--- a/src/Gtk/Widgets.icl
+++ b/src/Gtk/Widgets.icl
@@ -130,6 +130,7 @@ newMenuBar = toStateR gtk_menu_bar_new >>= show
 :: GtkMenuItem :== Pointer
 
 instance gtkWidget GtkMenuItem where gtkWidget mi = mi
+instance gtkMenuItem GtkMenuItem where gtkMenuItem mi = mi
 
 newMenuItem :: !String -> GtkM GtkMenuItem
 newMenuItem label =
@@ -138,11 +139,35 @@ newMenuItem label =
 	toState (gtk_menu_item_set_use_underline item True) >>|
 	show item
 
-setSubMenu :: !GtkMenuItem !GtkMenu -> GtkM GtkMenu
+setSubMenu :: !mi !GtkMenu -> GtkM GtkMenu | gtkMenuItem mi
 setSubMenu item menu =
-	toState (gtk_menu_item_set_submenu item menu) >>|
+	toState (gtk_menu_item_set_submenu (gtkMenuItem item) menu) >>|
 	pure menu
 
+:: GtkCheckMenuItem :== Pointer
+
+instance gtkWidget GtkCheckMenuItem where gtkWidget cmi = cmi
+instance gtkMenuItem GtkCheckMenuItem where gtkMenuItem cmi = cmi
+instance ptr GtkCheckMenuItem
+where
+	toPtr   cmi = cmi
+	fromPtr cmi = cmi
+
+newCheckMenuItem :: !String -> GtkM GtkCheckMenuItem
+newCheckMenuItem label =
+	toStateR gtk_check_menu_item_new >>= \item ->
+	toState (gtk_menu_item_set_label item label) >>|
+	toState (gtk_menu_item_set_use_underline item True) >>|
+	show item
+
+isActive :: !GtkCheckMenuItem -> GtkM Bool
+isActive item = toStateR (gtk_check_menu_item_get_active item)
+
+setActive :: !Bool !GtkCheckMenuItem -> GtkM GtkCheckMenuItem
+setActive active item =
+	toState (gtk_check_menu_item_set_active item active) >>|
+	pure item
+
 :: GtkMenuShell :== Pointer
 
 instance gtkWidget GtkMenuShell where gtkWidget ms = ms
@@ -151,9 +176,9 @@ instance gtkMenuShell GtkMenu where gtkMenuShell m = m
 instance gtkMenuShell GtkMenuBar where gtkMenuShell mb = mb
 instance gtkMenuShell GtkMenuShell where gtkMenuShell ms = ms
 
-appendToMenuShell :: !s !GtkMenuItem -> GtkM GtkMenuItem | gtkMenuShell s
+appendToMenuShell :: !s !mi -> GtkM mi | gtkMenuShell s & gtkMenuItem mi
 appendToMenuShell shell item =
-	toState (gtk_menu_shell_append (gtkMenuShell shell) item) >>|
+	toState (gtk_menu_shell_append (gtkMenuShell shell) (gtkMenuItem item)) >>|
 	pure item
 
 :: GtkPaned :== Pointer
-- 
cgit v1.2.3