Add GtkMenu* functionality and reorder combinator arguments to ease binding

4 files changed, 127 insertions, 9 deletions

diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl
index 1b24e94..31a50c9 100644
--- a/src/Gtk/Internal.dcl
+++ b/src/Gtk/Internal.dcl
@@ -30,6 +30,17 @@ gtk_init :: !.a -> .a
 gtk_main_iteration :: !.a -> (!Bool, !.a)
 gtk_main_quit :: !.a -> .a
 
+gtk_menu_bar_new :: !.a -> (!Pointer, !.a)
+
+gtk_menu_item_new :: !.a -> (!Pointer, !.a)
+gtk_menu_item_set_label :: !Pointer !String !.a -> .a
+gtk_menu_item_set_use_underline :: !Pointer !Bool !.a -> .a
+gtk_menu_item_set_submenu :: !Pointer !Pointer !.a -> .a
+
+gtk_menu_new :: !.a -> (!Pointer, !.a)
+
+gtk_menu_shell_append :: !Pointer !Pointer !.a -> .a
+
 gtk_paned_new :: !Bool !.a -> (!Pointer, !.a)
 gtk_paned_pack1 :: !Pointer !Pointer !Bool !Bool !.a -> .a
 gtk_paned_pack2 :: !Pointer !Pointer !Bool !Bool !.a -> .a
diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl
index 9bc0c7b..8f3a8ad 100644
--- a/src/Gtk/Internal.icl
+++ b/src/Gtk/Internal.icl
@@ -118,6 +118,44 @@ gtk_main_quit env = code {
 	ccall gtk_main_quit ":V:A"
 }
 
+gtk_menu_bar_new :: !.a -> (!Pointer, !.a)
+gtk_menu_bar_new env = code {
+	ccall gtk_menu_bar_new ":p:A"
+}
+
+gtk_menu_item_new :: !.a -> (!Pointer, !.a)
+gtk_menu_item_new env = code {
+	ccall gtk_menu_item_new ":p:A"
+}
+
+gtk_menu_item_set_label :: !Pointer !String !.a -> .a
+gtk_menu_item_set_label item label env = set item (packString label) env
+where
+	set :: !Pointer !String !.a -> .a
+	set _ _ _ = code {
+		ccall gtk_menu_item_set_label "ps:V:A"
+	}
+
+gtk_menu_item_set_use_underline :: !Pointer !Bool !.a -> .a
+gtk_menu_item_set_use_underline item setting env = code {
+	ccall gtk_menu_item_set_use_underline "pI:V:A"
+}
+
+gtk_menu_item_set_submenu :: !Pointer !Pointer !.a -> .a
+gtk_menu_item_set_submenu item menu env = code {
+	ccall gtk_menu_item_set_submenu "pp:V:A"
+}
+
+gtk_menu_new :: !.a -> (!Pointer, !.a)
+gtk_menu_new env = code {
+	ccall gtk_menu_new ":p:A"
+}
+
+gtk_menu_shell_append :: !Pointer !Pointer !.a -> .a
+gtk_menu_shell_append shell item env = code {
+	ccall gtk_menu_shell_append "pp:V:A"
+}
+
 gtk_paned_new :: !Bool !.a -> (!Pointer, !.a)
 gtk_paned_new vertical env = code {
 	ccall gtk_paned_new "I:p:A"
diff --git a/src/Gtk/Widgets.dcl b/src/Gtk/Widgets.dcl
index 42f65c1..ab5d5c8 100644
--- a/src/Gtk/Widgets.dcl
+++ b/src/Gtk/Widgets.dcl
@@ -35,14 +35,14 @@ instance gtkWidget GtkContainer
 instance gtkContainer GtkContainer
 instance ptr GtkContainer
 
-addToContainer :: !w !c -> GtkM () | gtkWidget w & gtkContainer c
+addToContainer :: !c !w -> GtkM w | gtkWidget w & gtkContainer c
 
 :: GtkBox
 instance gtkWidget GtkBox
 instance gtkContainer GtkBox
 
 newBox :: !GtkOrientation !Int -> GtkM GtkBox
-packBox :: !w !GtkBox !GtkDirection !GtkExpand -> GtkM () | gtkWidget w
+packBox :: !GtkBox !GtkDirection !GtkExpand !w -> GtkM w | gtkWidget w
 
 :: GtkFrame
 instance gtkWidget GtkFrame
@@ -51,6 +51,30 @@ instance gtkContainer GtkFrame
 newFrame :: !GtkLabel !w -> GtkM GtkFrame | gtkWidget w
 framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w
 
+:: GtkMenu
+instance gtkWidget GtkMenu
+
+newMenu :: GtkM GtkMenu
+
+:: GtkMenuBar
+instance gtkWidget GtkMenuBar
+
+newMenuBar :: GtkM GtkMenuBar
+
+:: GtkMenuItem
+instance gtkWidget GtkMenuItem
+
+newMenuItem :: !String -> GtkM GtkMenuItem
+setSubMenu :: !GtkMenuItem !GtkMenu -> GtkM GtkMenu
+
+:: GtkMenuShell
+instance gtkWidget GtkMenuShell
+
+class gtkMenuShell a :: !a -> GtkMenuShell
+instance gtkMenuShell GtkMenu, GtkMenuBar, GtkMenuShell
+
+appendToMenuShell :: !s !GtkMenuItem -> GtkM GtkMenuItem | gtkMenuShell s
+
 :: GtkPaned
 instance gtkWidget GtkPaned
 instance gtkContainer GtkPaned
diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl
index 0549c88..1ea63df 100644
--- a/src/Gtk/Widgets.icl
+++ b/src/Gtk/Widgets.icl
@@ -55,9 +55,10 @@ where
 	toPtr   c = c
 	fromPtr c = c
 
-addToContainer :: !w !c -> GtkM () | gtkWidget w & gtkContainer c
-addToContainer widget container =
-	toState ('I'.gtk_container_add (gtkContainer container) (gtkWidget widget))
+addToContainer :: !c !w -> GtkM w | gtkWidget w & gtkContainer c
+addToContainer container widget =
+	toState ('I'.gtk_container_add (gtkContainer container) (gtkWidget widget)) >>|
+	pure widget
 
 :: GtkBox :== Pointer
 
@@ -69,10 +70,11 @@ newBox orientation spacing =
 	toStateR ('I'.gtk_box_new orientation=:Vertical spacing) >>=
 	show
 
-packBox :: !w !GtkBox !GtkDirection !GtkExpand -> GtkM () | gtkWidget w
-packBox widget box direction expand =
+packBox :: !GtkBox !GtkDirection !GtkExpand !w -> GtkM w | gtkWidget w
+packBox box direction expand widget =
 	toState (if direction=:StartToEnd 'I'.gtk_box_pack_start 'I'.gtk_box_pack_end
-		box (gtkWidget widget) expand=:Expand True 0)
+		box (gtkWidget widget) expand=:Expand True 0) >>|
+	pure widget
 
 :: GtkFrame :== Pointer
 
@@ -85,7 +87,7 @@ newFrame label widget =
 	(case label of
 		Label _ -> toState ('I'.gtk_frame_set_label_align frame 0.02 0.5)
 		NoLabel -> pure ()) >>|
-	addToContainer widget frame >>|
+	addToContainer frame widget >>|
 	show frame
 
 framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w
@@ -93,6 +95,49 @@ framed label widgetf =
 	widgetf >>= \widget ->
 	tuple widget <$> newFrame label widget
 
+:: GtkMenu :== Pointer
+
+instance gtkWidget GtkMenu where gtkWidget m = m
+
+newMenu :: GtkM GtkMenu
+newMenu = toStateR 'I'.gtk_menu_new >>= show
+
+:: GtkMenuBar :== Pointer
+
+instance gtkWidget GtkMenuBar where gtkWidget mb = mb
+
+newMenuBar :: GtkM GtkMenuBar
+newMenuBar = toStateR 'I'.gtk_menu_bar_new >>= show
+
+:: GtkMenuItem :== Pointer
+
+instance gtkWidget GtkMenuItem where gtkWidget mi = mi
+
+newMenuItem :: !String -> GtkM GtkMenuItem
+newMenuItem label =
+	toStateR 'I'.gtk_menu_item_new >>= \item ->
+	toState ('I'.gtk_menu_item_set_label item label) >>|
+	toState ('I'.gtk_menu_item_set_use_underline item True) >>|
+	show item
+
+setSubMenu :: !GtkMenuItem !GtkMenu -> GtkM GtkMenu
+setSubMenu item menu =
+	toState ('I'.gtk_menu_item_set_submenu item menu) >>|
+	pure menu
+
+:: GtkMenuShell :== Pointer
+
+instance gtkWidget GtkMenuShell where gtkWidget ms = ms
+
+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 shell item =
+	toState ('I'.gtk_menu_shell_append (gtkMenuShell shell) item) >>|
+	pure item
+
 :: GtkPaned :== Pointer
 
 instance gtkWidget GtkPaned where gtkWidget p = p