Add newMessageDialog; add GtkTitle type and instance tune w GtkTitle | gtkWindow w

6 files changed, 90 insertions, 13 deletions

diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl
index 76eb13c..50fda0d 100644
--- a/src/Gtk/Internal.dcl
+++ b/src/Gtk/Internal.dcl
@@ -60,6 +60,8 @@ gtk_menu_new :: !.a -> (!Pointer, !.a)
 
 gtk_menu_shell_append :: !Pointer !Pointer !.a -> .a
 
+gtk_message_dialog_new_with_markup :: !Pointer !Int !Int !Int !String !.a -> (!Pointer, !.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 6f54acc..aed7b79 100644
--- a/src/Gtk/Internal.icl
+++ b/src/Gtk/Internal.icl
@@ -256,6 +256,15 @@ gtk_menu_shell_append shell item env = code {
 	ccall gtk_menu_shell_append "pp:V:A"
 }
 
+gtk_message_dialog_new_with_markup :: !Pointer !Int !Int !Int !String !.a -> (!Pointer, !.a)
+gtk_message_dialog_new_with_markup window flags type buttons text env =
+	new window flags type buttons (packString text) env
+where
+	new :: !Pointer !Int !Int !Int !String !.a -> (!Pointer, !.a)
+	new _ _ _ _ _ _ = code {
+		ccall gtk_message_dialog_new "pIIIs:p: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/Types.dcl b/src/Gtk/Types.dcl
index a3a722f..74b8c52 100644
--- a/src/Gtk/Types.dcl
+++ b/src/Gtk/Types.dcl
@@ -2,6 +2,16 @@ definition module Gtk.Types
 
 from StdOverloaded import class fromInt, class toInt
 
+:: GtkButtonsType
+	= NoButtons
+	| OkButton
+	| CloseButton
+	| CancelButton
+	| YesNoButtons
+	| OkCancelButtons
+
+instance toInt GtkButtonsType
+
 :: GtkCSSClass
 	= Class !String
 
@@ -42,6 +52,15 @@ instance toInt GtkJustification
 
 margin :: !Int -> GtkMargins
 
+:: GtkMessageType
+	= InfoMessage
+	| WarningMessage
+	| QuestionMessage
+	| ErrorMessage
+	| OtherMessage
+
+instance toInt GtkMessageType
+
 :: GtkModal
 	= Modal
 	| NotModal
@@ -92,6 +111,9 @@ instance toInt GtkStylePriority
 	= Milliseconds !Int
 	| Seconds !Int
 
+:: GtkTitle
+	= Title !String
+
 :: GtkWrapMode
 	= WrapNone
 	| WrapChar
diff --git a/src/Gtk/Types.icl b/src/Gtk/Types.icl
index 0c6aed8..e9f672c 100644
--- a/src/Gtk/Types.icl
+++ b/src/Gtk/Types.icl
@@ -3,6 +3,16 @@ implementation module Gtk.Types
 import StdEnv
 import StdDebug
 
+instance toInt GtkButtonsType
+where
+	toInt type = case type of
+		NoButtons       -> 0
+		OkButton        -> 1
+		CloseButton     -> 2
+		CancelButton    -> 3
+		YesNoButtons    -> 4
+		OkCancelButtons -> 5
+
 instance toInt GtkFileChooserAction
 where
 	toInt action = case action of
@@ -27,6 +37,15 @@ margin n =
 	, bottom = n
 	}
 
+instance toInt GtkMessageType
+where
+	toInt type = case type of
+		InfoMessage     -> 0
+		WarningMessage  -> 1
+		QuestionMessage -> 2
+		ErrorMessage    -> 3
+		OtherMessage    -> 4
+
 instance fromInt GtkResponse
 where
 	fromInt response = case response of
diff --git a/src/Gtk/Widgets.dcl b/src/Gtk/Widgets.dcl
index 7ff4616..405c4b5 100644
--- a/src/Gtk/Widgets.dcl
+++ b/src/Gtk/Widgets.dcl
@@ -7,10 +7,11 @@ from System._Pointer import :: Pointer
 
 from Gtk.State import :: GtkM
 from Gtk.Tune import class tune
-from Gtk.Types import :: GtkCSSClass, :: GtkDirection, :: GtkExpand,
-	:: GtkFileChooserAction, :: GtkLabel, :: GtkMargins, :: GtkModal,
-	:: GtkOrientation, :: GtkPanedHandleWidth, :: GtkResize, :: GtkResponse,
-	:: GtkShrink, :: GtkStylePriority, :: GtkWrapMode
+from Gtk.Types import :: GtkButtonsType, :: GtkCSSClass, :: GtkDirection,
+	:: GtkExpand, :: GtkFileChooserAction, :: GtkLabel, :: GtkMargins,
+	:: GtkMessageType, :: GtkModal, :: GtkOrientation, :: GtkPanedHandleWidth,
+	:: GtkResize, :: GtkResponse, :: GtkShrink, :: GtkStylePriority,
+	:: GtkTitle, :: GtkWrapMode
 
 class ptr a
 where
@@ -40,6 +41,7 @@ class gtkDialog a :: !a -> GtkDialog
 
 instance gtkWidget GtkDialog
 instance gtkContainer GtkDialog
+instance gtkWindow GtkDialog
 instance gtkDialog GtkDialog
 instance ptr GtkDialog
 
@@ -50,6 +52,7 @@ runDialog :: !d -> GtkM GtkResponse | gtkDialog d
 
 getContentArea :: !d -> GtkBox | gtkDialog d
 
+newMessageDialog :: !GtkWindow !GtkMessageType !GtkButtonsType !String -> GtkM GtkDialog
 getFileWithDialog :: !GtkWindow !GtkFileChooserAction !(Maybe String) -> GtkM (Maybe FilePath)
 
 :: GtkFrame
@@ -158,9 +161,15 @@ removeCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
 setMargins :: !GtkMargins !w -> GtkM w | gtkWidget w
 
 :: GtkWindow
+
+class gtkWindow a :: !a -> GtkWindow
+
 instance gtkWidget GtkWindow
 instance gtkContainer GtkWindow
+instance gtkWindow GtkWindow
 
-newPopup :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow
-newWindow :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow
+newPopup :: !(Maybe (Int,Int)) -> GtkM GtkWindow
+newWindow :: !(Maybe (Int,Int)) -> GtkM GtkWindow
 addCSSFromFile :: !GtkStylePriority !FilePath !GtkWindow -> GtkM Bool
+
+instance tune w GtkTitle | gtkWindow w
diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl
index ef1f0bc..ba0cb16 100644
--- a/src/Gtk/Widgets.icl
+++ b/src/Gtk/Widgets.icl
@@ -47,6 +47,7 @@ addToContainer container widget =
 
 instance gtkWidget GtkDialog where gtkWidget d = d
 instance gtkContainer GtkDialog where gtkContainer d = d
+instance gtkWindow GtkDialog where gtkWindow w = w
 instance gtkDialog GtkDialog where gtkDialog d = d
 
 instance ptr GtkDialog
@@ -72,6 +73,15 @@ runDialog dialog = fromInt <$> toStateR (gtk_dialog_run (gtkDialog dialog))
 getContentArea :: !d -> GtkBox | gtkDialog d
 getContentArea dialog = gtk_dialog_get_content_area (gtkDialog dialog)
 
+newMessageDialog :: !GtkWindow !GtkMessageType !GtkButtonsType !String -> GtkM GtkDialog
+newMessageDialog window type buttons text =
+	toStateR (gtk_message_dialog_new_with_markup
+		window
+		1 /* DESTROY_WITH_PARENT */
+		(toInt type)
+		(toInt buttons)
+		text)
+
 getFileWithDialog :: !GtkWindow !GtkFileChooserAction !(Maybe String) -> GtkM (Maybe FilePath)
 getFileWithDialog window action title =
 	toStateR (gtk_file_chooser_dialog_new title window (toInt action) buttons) >>= \dialog ->
@@ -334,22 +344,28 @@ setMargins {left,top,right,bottom} widget` =
 
 instance gtkWidget GtkWindow where gtkWidget w = w
 instance gtkContainer GtkWindow where gtkContainer w = w
+instance gtkWindow GtkWindow where gtkWindow w = w
 
-newPopup :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow
-newPopup title size = new_window_or_popup True title size
+newPopup :: !(Maybe (Int,Int)) -> GtkM GtkWindow
+newPopup size = new_window_or_popup True size
 
-newWindow :: !String !(Maybe (Int,Int)) -> GtkM GtkWindow
-newWindow title size = new_window_or_popup False title size
+newWindow :: !(Maybe (Int,Int)) -> GtkM GtkWindow
+newWindow size = new_window_or_popup False size
 
-new_window_or_popup :: !Bool !String !(Maybe (Int,Int)) -> GtkM GtkWindow
-new_window_or_popup is_popup title size =
+new_window_or_popup :: !Bool !(Maybe (Int,Int)) -> GtkM GtkWindow
+new_window_or_popup is_popup size =
 	toStateR (gtk_window_new is_popup) >>= \window ->
-	toState (gtk_window_set_title window title) >>|
 	(case size of
 		Nothing    -> pure ()
 		Just (h,v) -> toState (gtk_widget_set_size_request window h v)) >>|
 	show window
 
+instance tune w GtkTitle | gtkWindow w
+where
+	tune (Title s) window =
+		toState (gtk_window_set_title (gtkWindow window) s) >>|
+		pure window
+
 // NB: it is also possible to attach CSS to one widget in particular (excluding
 // children widgets). You then use gtk_widget_get_style_context and gtk_style_
 // context_add_provider instead of gtk_widget_get_screen and gtk_style_context_