path: root/src/Gtk/Widgets.icl

implementation module Gtk.Widgets

import StdEnv
import StdMaybe

import Control.Monad
import Data.Functor
import Data.Tuple
import System.FilePath
import System._Pointer
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
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
newActionBar =
	toStateR gtk_action_bar_new >>= \ab ->
	show (GtkActionBar ab)

packActionBar :: !GtkActionBar !GtkDirection !w -> GtkM w | gtkWidget w
packActionBar (GtkActionBar b) dir widget =
	let (GtkWidget w) = gtkWidget widget in
	toState
		(if dir=:StartToEnd gtk_action_bar_pack_start gtk_action_bar_pack_end
			b
			w) >>|
	pure widget

instance gtkWidget GtkBox where gtkWidget (GtkBox b) = GtkWidget b
instance gtkContainer GtkBox where gtkContainer (GtkBox b) = GtkContainer b
instance gtkOrientable GtkBox where gtkOrientable (GtkBox b) = GtkOrientable b

newBox :: !GtkOrientation !Int -> GtkM GtkBox
newBox orientation spacing =
	toStateR (gtk_box_new orientation=:Vertical spacing) >>= \b ->
	show (GtkBox b)

packBox :: !GtkBox !GtkDirection !GtkExpand !w -> GtkM w | gtkWidget w
packBox (GtkBox box) direction expand widget =
	let (GtkWidget widget_ptr) = gtkWidget widget in
	toState (if direction=:StartToEnd gtk_box_pack_start gtk_box_pack_end
		box widget_ptr expand=:Expand True 0) >>|
	pure widget

instance tune GtkBox GtkSpacing
where
	tune (Spacing s) box=:(GtkBox b) =
		toState (gtk_box_set_spacing b s) >>|
		pure box

instance gtkWidget GtkButton where gtkWidget (GtkButton b) = GtkWidget b

newButtonFromIconName :: !String -> GtkM GtkButton
newButtonFromIconName icon =
	toStateR (gtk_button_new_from_icon_name icon (toInt ButtonIconSize)) >>= \b ->
	show (GtkButton b)

instance gtkWidget GtkContainer where gtkWidget (GtkContainer c) = GtkWidget c
instance gtkContainer GtkContainer where gtkContainer c = c

addToContainer :: !c !w -> GtkM w | gtkWidget w & gtkContainer c
addToContainer container widget =
	let
		(GtkContainer c) = gtkContainer container
		(GtkWidget w) = gtkWidget widget
	in
	toState (gtk_container_add c w) >>|
	pure widget

instance gtkWidget GtkDialog where gtkWidget (GtkDialog d) = GtkWidget d
instance gtkContainer GtkDialog where gtkContainer (GtkDialog d) = GtkContainer d
instance gtkWindow GtkDialog where gtkWindow (GtkDialog d) = GtkWindow d
instance gtkDialog GtkDialog where gtkDialog d = d

instance tune d GtkModal | gtkDialog d
where
	tune setting dialog =
		let (GtkDialog d) = gtkDialog dialog in
		toState (gtk_dialog_set_modal d setting=:Modal) >>|
		pure dialog

newDialog :: !GtkWindow -> GtkM GtkDialog
newDialog (GtkWindow w) =
	toStateR gtk_dialog_new >>= \dialog ->
	toState (gtk_window_set_transient_for dialog w) >>|
	pure (GtkDialog dialog)

runDialog :: !d -> GtkM GtkResponse | gtkDialog d
runDialog dialog =
	let (GtkDialog d) = gtkDialog dialog in
	fromInt <$> toStateR (gtk_dialog_run d)

addButton :: !String !GtkResponse !d -> GtkM GtkButton | gtkDialog d
addButton text response dialog =
	let (GtkDialog d) = gtkDialog dialog in
	toStateR (gtk_dialog_add_button d text (toInt response)) >>= \b ->
	pure (GtkButton b)

getContentArea :: !d -> GtkBox | gtkDialog d
getContentArea dialog =
	let (GtkDialog d) = gtkDialog dialog in
	GtkBox (gtk_dialog_get_content_area d)

newMessageDialog :: !GtkWindow !GtkMessageType !GtkButtonsType !String -> GtkM GtkDialog
newMessageDialog (GtkWindow w) type buttons text =
	toStateR (gtk_message_dialog_new_with_markup
		w
		1 /* DESTROY_WITH_PARENT */
		(toInt type)
		(toInt buttons)
		text) >>= \d ->
	pure (GtkDialog d)

getFileWithDialog :: !GtkWindow !GtkFileChooserAction !(Maybe String) -> GtkM (Maybe FilePath)
getFileWithDialog (GtkWindow w) action title =
	toStateR (gtk_file_chooser_dialog_new title w (toInt action) buttons) >>= \dialog ->
	toState (gtk_dialog_set_default_response dialog (toInt ResponseAccept)) >>|
	run dialog
where
	buttons = map (\(s,r) -> (s,toInt r)) case action of
		OpenAction         -> [("Cancel", ResponseCancel), ("Open",   ResponseAccept)]
		SaveAction         -> [("Cancel", ResponseCancel), ("Save",   ResponseAccept)]
		SelectFolderAction -> [("Cancel", ResponseCancel), ("Select", ResponseAccept)]
		CreateFolderAction -> [("Cancel", ResponseCancel), ("Create", ResponseAccept)]

	run d =
		let dialog = GtkDialog d in
		runDialog dialog >>= \response -> case response of
			ResponseAccept ->
				toStateR (gtk_file_chooser_get_filename d) >>= \file_name -> case file_name of
					Just _  -> destroy dialog >>| pure file_name
					Nothing -> run d
			_ ->
				destroy dialog >>|
				pure Nothing

instance gtkWidget GtkEntry where gtkWidget (GtkEntry e) = GtkWidget e
instance gtkEntry GtkEntry where gtkEntry e = e

newEntry :: GtkM GtkEntry
newEntry =
	toStateR gtk_entry_new >>= \e ->
	show (GtkEntry e)

getText :: !e -> GtkM String | gtkEntry e
getText entry =
	let (GtkEntry e) = gtkEntry entry in
	toStateR (gtk_entry_get_text e)

instance tune GtkEntry GtkText
where
	tune (Text text) entry =
		let (GtkEntry e) = gtkEntry entry in
		toState (gtk_entry_set_text e text) >>|
		pure entry

instance tune GtkEntry GtkEntryCompletion
where
	tune (GtkEntryCompletion ec) entry=:(GtkEntry e) =
		toState (gtk_entry_set_completion e ec) >>|
		pure entry

newEntryCompletion :: GtkM GtkEntryCompletion
newEntryCompletion =
	toStateR gtk_entry_completion_new >>= \ec ->
	toState (gtk_entry_completion_set_inline_selection ec True) >>| // TODO
	pure (GtkEntryCompletion ec)

setTextColumn :: !Int !GtkEntryCompletion -> GtkM GtkEntryCompletion
setTextColumn col completion=:(GtkEntryCompletion ec) =
	toState (gtk_entry_completion_set_text_column ec col) >>|
	pure completion

instance tune GtkEntryCompletion GtkListStore
where
	tune (GtkListStore ls) completion=:(GtkEntryCompletion ec) =
		toState (gtk_entry_completion_set_model ec ls) >>|
		pure completion

instance tune GtkEntryCompletion GtkCompletionMode
where
	tune mode completion=:(GtkEntryCompletion ec) = set >>| pure completion
	where
		set = toState case mode of
			InlineCompletion   -> gtk_entry_completion_set_inline_completion ec True
			NoInlineCompletion -> gtk_entry_completion_set_inline_completion ec False
			InlineSelection    -> gtk_entry_completion_set_inline_selection ec True
			NoInlineSelection  -> gtk_entry_completion_set_inline_selection ec False

instance gtkWidget GtkFrame where gtkWidget (GtkFrame f) = GtkWidget f
instance gtkContainer GtkFrame where gtkContainer (GtkFrame f) = GtkContainer f

newFrame :: !GtkTitle !w -> GtkM GtkFrame | gtkWidget w
newFrame (Title title) widget =
	toStateR (gtk_frame_new (case title of "" -> Nothing; _ -> Just title)) >>= \f ->
	(case title of
		"" -> pure ()
		_  -> toState (gtk_frame_set_label_align f 0.02 0.5)) >>|
	let frame = GtkFrame f in
	addToContainer frame (gtkWidget widget) >>|
	show frame

framed :: !GtkTitle !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w
framed title widgetf =
	widgetf >>= \widget ->
	tuple widget <$> newFrame title widget

instance gtkWidget GtkGrid where gtkWidget (GtkGrid g) = GtkWidget g

newGrid :: GtkM GtkGrid
newGrid =
	toStateR gtk_grid_new >>= \g ->
	show (GtkGrid g)

attachGrid :: !GtkGrid !(!Int,!Int) !(!Int,!Int) !w -> GtkM w | gtkWidget w
attachGrid (GtkGrid g) (left,top) (width,height) widget =
	let (GtkWidget w) = gtkWidget widget in
	toState (gtk_grid_attach g w left top width height) >>|
	pure widget

instance gtkWidget GtkLabel where gtkWidget (GtkLabel l) = GtkWidget l

newLabel :: GtkM GtkLabel
newLabel =
	toStateR gtk_label_new >>= \l ->
	show (GtkLabel l)

instance tune GtkLabel GtkText
where
	tune (Text text) label=:(GtkLabel l) =
		toState (gtk_label_set_markup l text) >>|
		pure label

newListStore :: ![GType] -> GtkM GtkListStore
newListStore types =
	toStateR (gtk_list_store_newv {toInt t \\ t <- types}) >>= \s ->
	pure (GtkListStore s)

clearListStore :: !GtkListStore -> GtkM GtkListStore
clearListStore store=:(GtkListStore s) =
	toState (gtk_list_store_clear s) >>|
	pure store

appendToListStore :: ![GValue] !GtkListStore -> GtkM GtkListStore
appendToListStore values store=:(GtkListStore s) =
	set 0 values (gtk_list_store_append s) >>|
	pure store
where
	set :: !Int ![GValue] !.{#Int} -> GtkM ()
	set col [v:vs] iter = set` >>| set (col+1) vs iter
	where
		set` = case v of
			GValueBool b   -> toState (gtk_list_store_set_bool   s iter col b)
			GValueChar c   -> toState (gtk_list_store_set_char   s iter col c)
			GValueInt i    -> toState (gtk_list_store_set_int    s iter col i)
			GValueReal r   -> toState (gtk_list_store_set_real   s iter col r)
			GValueString a -> toState (gtk_list_store_set_string s iter col a)
	set _ [] _ = pure ()

swapItems :: !Int !Int !GtkListStore -> GtkM Bool
swapItems a b (GtkListStore s) =
	let
		(ok_a,iter_a) = gtk_tree_model_get_iter_from_string s (toString a)
		(ok_b,iter_b) = gtk_tree_model_get_iter_from_string s (toString b)
	in
	if (ok_a && ok_b)
		(toState (gtk_list_store_swap s iter_a iter_b) >>| pure True)
		(pure False)

instance gtkWidget GtkMenu where gtkWidget (GtkMenu m) = GtkWidget m

newMenu :: GtkM GtkMenu
newMenu =
	toStateR gtk_menu_new >>= \m ->
	show (GtkMenu m)

instance gtkWidget GtkMenuBar where gtkWidget (GtkMenuBar mb) = GtkWidget mb

newMenuBar :: GtkM GtkMenuBar
newMenuBar =
	toStateR gtk_menu_bar_new >>= \mb ->
	show (GtkMenuBar mb)

instance gtkWidget GtkMenuItem where gtkWidget (GtkMenuItem mi) = GtkWidget mi
instance gtkMenuItem GtkMenuItem where gtkMenuItem mi = mi

newMenuItem :: !String -> GtkM GtkMenuItem
newMenuItem label =
	toStateR gtk_menu_item_new >>= \item ->
	toState (gtk_menu_item_set_label item label) >>|
	toState (gtk_menu_item_set_use_underline item True) >>|
	show (GtkMenuItem item)

setSubMenu :: !mi !GtkMenu -> GtkM GtkMenu | gtkMenuItem mi
setSubMenu item menu=:(GtkMenu m) =
	let (GtkMenuItem mi) = gtkMenuItem item in
	toState (gtk_menu_item_set_submenu mi m) >>|
	pure menu

instance gtkWidget GtkCheckMenuItem where gtkWidget (GtkCheckMenuItem cmi) = GtkWidget cmi
instance gtkMenuItem GtkCheckMenuItem where gtkMenuItem (GtkCheckMenuItem cmi) = GtkMenuItem 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 (GtkCheckMenuItem item)

isActive :: !GtkCheckMenuItem -> GtkM Bool
isActive (GtkCheckMenuItem cmi) = toStateR (gtk_check_menu_item_get_active cmi)

setActive :: !Bool !GtkCheckMenuItem -> GtkM GtkCheckMenuItem
setActive active item=:(GtkCheckMenuItem cmi) =
	toState (gtk_check_menu_item_set_active cmi active) >>|
	pure item

instance gtkWidget GtkSeparatorMenuItem where gtkWidget (GtkSeparatorMenuItem smi) = GtkWidget smi
instance gtkMenuItem GtkSeparatorMenuItem where gtkMenuItem (GtkSeparatorMenuItem smi) = GtkMenuItem smi

newSeparatorMenuItem :: GtkM GtkSeparatorMenuItem
newSeparatorMenuItem =
	toStateR gtk_separator_menu_item_new >>= \smi ->
	show (GtkSeparatorMenuItem smi)

instance gtkWidget GtkMenuShell where gtkWidget (GtkMenuShell ms) = GtkWidget ms

instance gtkMenuShell GtkMenu where gtkMenuShell (GtkMenu m) = GtkMenuShell m
instance gtkMenuShell GtkMenuBar where gtkMenuShell (GtkMenuBar mb) = GtkMenuShell mb
instance gtkMenuShell GtkMenuShell where gtkMenuShell ms = ms

appendToMenuShell :: !s !mi -> GtkM mi | gtkMenuShell s & gtkMenuItem mi
appendToMenuShell shell item =
	let
		(GtkMenuShell ms) = gtkMenuShell shell
		(GtkMenuItem mi) = gtkMenuItem item
	in
	toState (gtk_menu_shell_append ms mi) >>|
	pure item

instance tune o GtkOrientation | gtkOrientable o
where
	tune orientation orientable =
		let (GtkOrientable o) = gtkOrientable orientable in
		toState (gtk_orientable_set_orientation o orientation=:Vertical) >>|
		pure orientable

instance gtkWidget GtkPaned where gtkWidget (GtkPaned p) = GtkWidget p
instance gtkContainer GtkPaned where gtkContainer (GtkPaned p) = GtkContainer p

newPaned :: !GtkOrientation !GtkPanedHandleWidth -> GtkM GtkPaned
newPaned orientation handle_width =
	toStateR (gtk_paned_new orientation=:Vertical) >>= \p ->
	toState (gtk_paned_set_wide_handle p handle_width=:WideHandle) >>|
	show (GtkPaned p)

packPane1 :: !GtkPaned !GtkResize !GtkShrink !w -> GtkM w | gtkWidget w
packPane1 (GtkPaned p) resize shrink widget =
	let (GtkWidget w) = gtkWidget widget in
	toState (gtk_paned_pack1 p w resize=:Resize shrink=:Shrink) >>|
	pure widget

packPane2 :: !GtkPaned !GtkResize !GtkShrink !w -> GtkM w | gtkWidget w
packPane2 (GtkPaned p) resize shrink widget =
	let (GtkWidget w) = gtkWidget widget in
	toState (gtk_paned_pack2 p w resize=:Resize shrink=:Shrink) >>|
	pure widget

instance gtkWidget GtkScrolledWindow where gtkWidget (GtkScrolledWindow sw) = GtkWidget sw
instance gtkContainer GtkScrolledWindow where gtkContainer (GtkScrolledWindow sw) = GtkContainer sw

newScrolledWindow :: GtkM GtkScrolledWindow
newScrolledWindow =
	toStateR (gtk_scrolled_window_new 0 0) >>= \sw ->
	show (GtkScrolledWindow sw)

instance tune GtkScrolledWindow (GtkScrollbarPolicy, GtkScrollbarPolicy)
where
	tune :: !(!GtkScrollbarPolicy, !GtkScrollbarPolicy) !GtkScrolledWindow -> GtkM GtkScrolledWindow
	tune (hp,vp) window=:(GtkScrolledWindow sw) =
		toState (gtk_scrolled_window_set_policy sw (toInt hp) (toInt vp)) >>|
		pure window

instance gtkWidget GtkSearchEntry where gtkWidget (GtkSearchEntry se) = GtkWidget se
instance gtkEntry GtkSearchEntry where gtkEntry (GtkSearchEntry se) = GtkEntry se

newSearchEntry :: GtkM GtkSearchEntry
newSearchEntry =
	toStateR gtk_search_entry_new >>= \se ->
	show (GtkSearchEntry se)

instance gtkWidget GtkSeparator where gtkWidget (GtkSeparator s) = GtkWidget s

newSeparator :: !GtkOrientation -> GtkM GtkSeparator
newSeparator orientation =
	toStateR (gtk_separator_new orientation=:Vertical) >>= \s ->
	show (GtkSeparator s)

instance gtkWidget GtkSpinner where gtkWidget (GtkSpinner s) = GtkWidget s

newSpinner :: GtkM GtkSpinner
newSpinner =
	toStateR gtk_spinner_new >>= \s ->
	show (GtkSpinner s)

startSpinner :: !GtkSpinner -> GtkM GtkSpinner
startSpinner spinner=:(GtkSpinner s) =
	toState (gtk_spinner_start s) >>|
	pure spinner

stopSpinner :: !GtkSpinner -> GtkM GtkSpinner
stopSpinner spinner=:(GtkSpinner s) =
	toState (gtk_spinner_stop s) >>|
	pure spinner

setText :: !String !GtkTextBuffer -> GtkM GtkTextBuffer
setText s buffer=:(GtkTextBuffer b) =
	toState (gtk_text_buffer_set_text b s (size s)) >>|
	pure buffer

setMarkup :: !String !GtkTextBuffer -> GtkM GtkTextBuffer
setMarkup s buffer=:(GtkTextBuffer b) =
	toStateR (gtk_text_buffer_get_start_iter b) >>= \start ->
	toStateR (gtk_text_buffer_get_end_iter b) >>= \end ->
	toState (gtk_text_buffer_delete b start end) >>|
	toStateR (gtk_text_buffer_get_start_iter b) >>= \start ->
	toState (gtk_text_buffer_insert_markup b start s) >>|
	pure buffer

insertAtCursor :: !String !GtkTextBuffer -> GtkM GtkTextBuffer
insertAtCursor s buffer=:(GtkTextBuffer b) =
	toState (gtk_text_buffer_insert_at_cursor b s (size s)) >>|
	pure buffer

instance gtkWidget GtkTextView where gtkWidget (GtkTextView tv) = GtkWidget tv
instance gtkContainer GtkTextView where gtkContainer (GtkTextView tv) = GtkContainer tv

newTextView :: GtkM GtkTextView
newTextView =
	toStateR gtk_text_view_new >>= \tv ->
	toState (gtk_text_view_set_editable tv False) >>|
	show (GtkTextView tv)

getTextBuffer :: !GtkTextView -> GtkTextBuffer
getTextBuffer (GtkTextView tv) = GtkTextBuffer (gtk_text_view_get_buffer tv)

instance tune GtkTextView GtkWrapMode
where
	tune mode view=:(GtkTextView tv) =
		toState (gtk_text_view_set_wrap_mode tv (toInt mode)) >>|
		pure view

instance gtkWidget GtkTreeView where gtkWidget (GtkTreeView tv) = GtkWidget tv

newTreeView :: !GtkListStore -> GtkM GtkTreeView
newTreeView (GtkListStore s) =
	toStateR (gtk_tree_view_new_with_model s) >>= \view ->
	toState (g_object_unref s) >>|
	show (GtkTreeView view)

appendColumnToTreeView :: !String !Int !GtkExpand !GtkTreeView -> GtkM GtkTreeView
appendColumnToTreeView title col expand tree=:(GtkTreeView tv) =
	toStateR gtk_cell_renderer_text_new >>= \renderer ->
	toStateR gtk_tree_view_column_new >>= \column ->
	toState (gtk_tree_view_column_set_title column title) >>|
	toState (gtk_tree_view_column_pack_start column renderer expand=:Expand) >>|
	toState (gtk_tree_view_column_add_attribute column renderer "text" col) >>|
	toState (gtk_tree_view_append_column tv column) >>|
	pure tree

addSelectionChangedHandler :: !(GtkM ()) !GtkTreeView -> GtkM GtkTreeView
addSelectionChangedHandler handler tree=:(GtkTreeView tv) =
	let selection = gtk_tree_view_get_selection tv in
	tune (ChangedHandler handler) (GtkWidget selection) >>|
	pure tree

getPathToSelection :: !GtkTreeView -> GtkM (Maybe [Int])
getPathToSelection (GtkTreeView tv) =
	let selection = gtk_tree_view_get_selection tv in
	toStateR (gtk_tree_selection_get_selected selection) >>= \(selected,iter)
		| not selected ->
			pure Nothing
		| otherwise ->
			let
				model = gtk_tree_view_get_model tv
				path = gtk_tree_model_get_string_from_iter model iter
			in
			pure (Just [toInt part \\ part <- split ":" path])

selectPath :: ![Int] !GtkTreeView -> GtkM Bool
selectPath path (GtkTreeView tv) =
	let
		store = gtk_tree_view_get_model tv
		selection = gtk_tree_view_get_selection tv
		(ok,iter) = gtk_tree_model_get_iter_from_string store ('Text'.join ":" [toString i \\ i <- path])
	in
	if ok
		(toState (gtk_tree_selection_select_iter selection iter) >>| pure True)
		(pure False)

instance gtkWidget GtkWidget where gtkWidget w = w

show :: !w -> GtkM w | gtkWidget w
show widget =
	let (GtkWidget w) = gtkWidget widget in
	toState (gtk_widget_show w) >>|
	pure widget

hide :: !w -> GtkM w | gtkWidget w
hide widget =
	let (GtkWidget w) = gtkWidget widget in
	toState (gtk_widget_hide w) >>|
	pure widget

isVisible :: !w -> GtkM Bool | gtkWidget w
isVisible widget =
	let (GtkWidget w) = gtkWidget widget in
	toStateR (gtk_widget_is_visible w)

destroy :: !w -> GtkM () | gtkWidget w
destroy widget =
	let (GtkWidget w) = gtkWidget widget in
	toState (gtk_widget_destroy w)

grabFocus :: !w -> GtkM w | gtkWidget w
grabFocus widget =
	let (GtkWidget w) = gtkWidget widget in
	toState (gtk_widget_grab_focus w) >>|
	pure widget

addCSSClass :: !GtkCSSClass !w -> GtkM w | gtkWidget w
addCSSClass (Class cls) widget =
	let (GtkWidget w) = gtkWidget widget in
	toStateR (gtk_widget_get_style_context w) >>= \context ->
	toState (gtk_style_context_add_class context cls) >>|
	pure widget

removeCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w
removeCSSClass (Class cls) widget =
	let (GtkWidget w) = gtkWidget widget in
	toStateR (gtk_widget_get_style_context w) >>= \context ->
	toState (gtk_style_context_remove_class context cls)

setMargins :: !GtkMargins !w -> GtkM w | gtkWidget w
setMargins {left,top,right,bottom} widget =
	let (GtkWidget w) = gtkWidget widget in
	toState (gtk_widget_set_margin_left   w left)   >>|
	toState (gtk_widget_set_margin_top    w top)    >>|
	toState (gtk_widget_set_margin_right  w right)  >>|
	toState (gtk_widget_set_margin_bottom w bottom) >>|
	pure widget

instance tune w GtkSensitivity | gtkWidget w
where
	tune sens widget =
		let (GtkWidget w) = gtkWidget widget in
		toState (gtk_widget_set_sensitive w sens=:Sensitive) >>|
		pure widget

instance tune w (GtkAlign,GtkAlign) | gtkWidget w
where
	tune :: !(!GtkAlign, !GtkAlign) !w -> GtkM w | gtkWidget w
	tune (halign,valign) widget =
		let (GtkWidget w) = gtkWidget widget in
		toState (gtk_widget_set_halign w (toInt halign)) >>|
		toState (gtk_widget_set_valign w (toInt valign)) >>|
		pure widget

instance tune w (GtkExpand,GtkExpand) | gtkWidget w
where
	tune :: !(!GtkExpand, !GtkExpand) !w -> GtkM w | gtkWidget w
	tune (hexpand,vexpand) widget =
		let (GtkWidget w) = gtkWidget widget in
		toState (gtk_widget_set_hexpand w hexpand=:Expand) >>|
		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 tune w GtkSizeRequest | gtkWidget w
where
	tune (GtkSizeRequest (width,height)) widget =
		let (GtkWidget w) = gtkWidget widget in
		toState (gtk_widget_set_size_request w width height) >>|
		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

newPopup :: GtkM GtkWindow
newPopup = new_window_or_popup True

newWindow :: GtkM GtkWindow
newWindow = new_window_or_popup False

new_window_or_popup :: !Bool -> GtkM GtkWindow
new_window_or_popup is_popup =
	toStateR (gtk_window_new is_popup) >>= \w ->
	show (GtkWindow w)

instance tune w GtkTitle | gtkWindow w
where
	tune (Title s) window =
		let (GtkWindow w) = gtkWindow window in
		toState (gtk_window_set_title w 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_
// add_provider_for_screen. This functionality has not been added to this
// library yet, but there is no reason to not provide it. To be clear that this
// style is global, we only allow it on GtkWindow, even though it would work on
// any GtkWidget.
addCSSFromFile :: !GtkStylePriority !FilePath !GtkWindow -> GtkM Bool
addCSSFromFile priority path (GtkWindow window) =
	toStateR gtk_css_provider_new >>= \provider ->
	toStateR (gtk_css_provider_load_from_path provider path 0) >>= \ok
		| not ok -> pure ok
		| otherwise ->
			toStateR (gtk_widget_get_screen window) >>= \screen ->
			toState (gtk_style_context_add_provider_for_screen screen provider (toInt priority)) >>|
			pure True