From e620065031c106b4098aef3ae0ffb66bf20eb068 Mon Sep 17 00:00:00 2001 From: Camil Staps Date: Sun, 27 Oct 2019 22:45:37 +0100 Subject: Add many functions for action bars, buttons, list stores, tree views, and more --- src/Gtk/Internal.dcl | 20 +++++++++ src/Gtk/Internal.icl | 112 ++++++++++++++++++++++++++++++++++++++++++++++++--- src/Gtk/Shares.icl | 1 + src/Gtk/Signal.dcl | 6 ++- src/Gtk/Signal.icl | 8 +++- src/Gtk/Types.dcl | 16 ++++++++ src/Gtk/Types.icl | 10 +++++ src/Gtk/Widgets.dcl | 33 ++++++++++++++- src/Gtk/Widgets.icl | 94 ++++++++++++++++++++++++++++++++++++++++++ 9 files changed, 289 insertions(+), 11 deletions(-) (limited to 'src') diff --git a/src/Gtk/Internal.dcl b/src/Gtk/Internal.dcl index b606d1d..11c79e9 100644 --- a/src/Gtk/Internal.dcl +++ b/src/Gtk/Internal.dcl @@ -13,9 +13,16 @@ g_signal_connect :: !Int !Pointer !String !Int !.a -> .a g_timeout_add :: !Int !Int !.a -> .a g_timeout_add_seconds :: !Int !Int !.a -> .a +gtk_action_bar_new :: !.a -> (!Pointer, !.a) +gtk_action_bar_pack_start :: !Pointer !Pointer !.a -> .a +gtk_action_bar_pack_end :: !Pointer !Pointer !.a -> .a + 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_box_set_spacing :: !Pointer !Int !.a -> .a + +gtk_button_new_from_icon_name :: !String !Int !.a -> (!Pointer, !.a) gtk_cell_renderer_text_new :: !.a -> (!Pointer, !.a) @@ -49,12 +56,14 @@ gtk_frame_set_label_align :: !Pointer !Real !Real !.a -> .a gtk_init :: !.a -> .a gtk_list_store_append :: !Pointer -> .{#Int} +gtk_list_store_clear :: !Pointer !.a -> .a gtk_list_store_newv :: !{#Int} !.a -> (!Pointer, !.a) gtk_list_store_set_bool :: !Pointer !.{#Int} !Int !Bool !.a -> .a gtk_list_store_set_char :: !Pointer !.{#Int} !Int !Char !.a -> .a gtk_list_store_set_int :: !Pointer !.{#Int} !Int !Int !.a -> .a gtk_list_store_set_real :: !Pointer !.{#Int} !Int !Real !.a -> .a gtk_list_store_set_string :: !Pointer !.{#Int} !Int !String !.a -> .a +gtk_list_store_swap :: !Pointer !{#Int} !{#Int} !.a -> .a gtk_main_iteration :: !.a -> (!Bool, !.a) gtk_main_quit :: !.a -> .a @@ -72,6 +81,8 @@ gtk_menu_shell_append :: !Pointer !Pointer !.a -> .a gtk_message_dialog_new_with_markup :: !Pointer !Int !Int !Int !String !.a -> (!Pointer, !.a) +gtk_orientable_set_orientation :: !Pointer !Bool !.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 @@ -103,12 +114,20 @@ gtk_text_view_get_buffer :: !Pointer -> Pointer gtk_text_view_set_editable :: !Pointer !Bool !.a -> .a gtk_text_view_set_wrap_mode :: !Pointer !Int !.a -> .a +gtk_tree_model_get_iter_from_string :: !Pointer !String -> (!Bool, !{#Int}) +gtk_tree_model_get_string_from_iter :: !Pointer !{#Int} -> String + +gtk_tree_selection_get_selected :: !Pointer !.a -> (!(!Bool, !{#Int}), !.a) +gtk_tree_selection_select_iter :: !Pointer !{#Int} !.a -> .a + gtk_tree_view_column_add_attribute :: !Pointer !Pointer !String !Int !.a -> .a gtk_tree_view_column_new :: !.a -> (!Pointer, !.a) gtk_tree_view_column_pack_start :: !Pointer !Pointer !Bool !.a -> .a gtk_tree_view_column_set_title :: !Pointer !String !.a -> .a gtk_tree_view_append_column :: !Pointer !Pointer !.a -> .a +gtk_tree_view_get_model :: !Pointer -> Pointer +gtk_tree_view_get_selection :: !Pointer -> Pointer gtk_tree_view_new_with_model :: !Pointer !.a -> (!Pointer, !.a) gtk_widget_destroy :: !Pointer !.a -> .a @@ -119,6 +138,7 @@ gtk_widget_set_margin_bottom :: !Pointer !Int !.a -> .a gtk_widget_set_margin_left :: !Pointer !Int !.a -> .a gtk_widget_set_margin_right :: !Pointer !Int !.a -> .a gtk_widget_set_margin_top :: !Pointer !Int !.a -> .a +gtk_widget_set_sensitive :: !Pointer !Bool !.a -> .a gtk_widget_set_size_request :: !Pointer !Int !Int !.a -> .a gtk_widget_show :: !Pointer !.a -> .a diff --git a/src/Gtk/Internal.icl b/src/Gtk/Internal.icl index 36ef0c7..f77299e 100644 --- a/src/Gtk/Internal.icl +++ b/src/Gtk/Internal.icl @@ -36,6 +36,21 @@ g_timeout_add_seconds interval id env = code { ccall clean_g_timeout_add_seconds "II:V:A" } +gtk_action_bar_new :: !.a -> (!Pointer, !.a) +gtk_action_bar_new env = code { + ccall gtk_action_bar_new ":p:A" +} + +gtk_action_bar_pack_start :: !Pointer !Pointer !.a -> .a +gtk_action_bar_pack_start bar child env = code { + ccall gtk_action_bar_pack_start "pp:V:A" +} + +gtk_action_bar_pack_end :: !Pointer !Pointer !.a -> .a +gtk_action_bar_pack_end bar child env = code { + ccall gtk_action_bar_pack_end "pp:V:A" +} + gtk_box_new :: !Bool !Int !.a -> (!Pointer, !.a) gtk_box_new vertical spacing env = code { ccall gtk_box_new "II:p:A" @@ -51,6 +66,19 @@ gtk_box_pack_end box child expand fill spacing env = code { ccall gtk_box_pack_end "ppIII:V:A" } +gtk_box_set_spacing :: !Pointer !Int !.a -> .a +gtk_box_set_spacing box spacing env = code { + ccall gtk_box_set_spacing "pI:V:A" +} + +gtk_button_new_from_icon_name :: !String !Int !.a -> (!Pointer, !.a) +gtk_button_new_from_icon_name name size env = new (packString name) size env +where + new :: !String !Int !.a -> (!Pointer, !.a) + new _ _ _ = code { + ccall gtk_button_new_from_icon_name "sI:p:A" + } + gtk_cell_renderer_text_new :: !.a -> (!Pointer, !.a) gtk_cell_renderer_text_new env = code { ccall gtk_cell_renderer_text_new ":p:A" @@ -226,6 +254,11 @@ where ccall gtk_list_store_append "pp:V:A" } +gtk_list_store_clear :: !Pointer !.a -> .a +gtk_list_store_clear store env = code { + ccall gtk_list_store_clear "Gp:V:A" +} + gtk_list_store_newv :: !{#Int} !.a -> (!Pointer, !.a) gtk_list_store_newv types env = newv (size types) (get_array_pointer types) env where @@ -240,7 +273,7 @@ gtk_list_store_set_bool store iter col val env = where set :: !Pointer !Pointer !Int !Bool !Int !.a -> .a set _ _ _ _ _ _ = code { - ccall gtk_list_store_set "ppIII:V:A" + ccall gtk_list_store_set "GppIII:V:A" } gtk_list_store_set_char :: !Pointer !.{#Int} !Int !Char !.a -> .a @@ -249,7 +282,7 @@ gtk_list_store_set_char store iter col val env = where set :: !Pointer !Pointer !Int !Char !Int !.a -> .a set _ _ _ _ _ _ = code { - ccall gtk_list_store_set "ppIII:V:A" + ccall gtk_list_store_set "GppIII:V:A" } gtk_list_store_set_int :: !Pointer !.{#Int} !Int !Int !.a -> .a @@ -258,7 +291,7 @@ gtk_list_store_set_int store iter col val env = where set :: !Pointer !Pointer !Int !Int !Int !.a -> .a set _ _ _ _ _ _ = code { - ccall gtk_list_store_set "ppIII:V:A" + ccall gtk_list_store_set "GppIII:V:A" } gtk_list_store_set_real :: !Pointer !.{#Int} !Int !Real !.a -> .a @@ -267,7 +300,7 @@ gtk_list_store_set_real store iter col val env = where set :: !Pointer !Pointer !Int !Real !Int !.a -> .a set _ _ _ _ _ _ = code { - ccall gtk_list_store_set "ppIRI:V:A" + ccall gtk_list_store_set "GppIRI:V:A" } gtk_list_store_set_string :: !Pointer !.{#Int} !Int !String !.a -> .a @@ -276,7 +309,15 @@ gtk_list_store_set_string store iter col val env = where set :: !Pointer !Pointer !Int !String !Int !.a -> .a set _ _ _ _ _ _ = code { - ccall gtk_list_store_set "ppIsI:V:A" + ccall gtk_list_store_set "GppIsI:V:A" + } + +gtk_list_store_swap :: !Pointer !{#Int} !{#Int} !.a -> .a +gtk_list_store_swap store a b env = swap store (get_array_pointer a) (get_array_pointer b) env +where + swap :: !Pointer !Pointer !Pointer !.a -> .a + swap _ _ _ _ = code { + ccall gtk_list_store_swap "Gppp:V:A" } gtk_main_iteration :: !.a -> (!Bool, !.a) @@ -336,6 +377,11 @@ where ccall gtk_message_dialog_new "pIIIs:p:A" } +gtk_orientable_set_orientation :: !Pointer !Bool !.a -> .a +gtk_orientable_set_orientation orientable orientation env = code { + ccall gtk_orientable_set_orientation "pI:V:A" +} + gtk_paned_new :: !Bool !.a -> (!Pointer, !.a) gtk_paned_new vertical env = code { ccall gtk_paned_new "I:p:A" @@ -480,6 +526,47 @@ gtk_text_view_set_wrap_mode text_view mode env = code { ccall gtk_text_view_set_wrap_mode "pI:V:A" } +gtk_tree_model_get_iter_from_string :: !Pointer !String -> (!Bool, !{#Int}) +gtk_tree_model_get_iter_from_string model path + # iter = createArray 4 0 // size of GtkTreeIter + # ok = get model (get_array_pointer iter) (packString path) + = (ok, iter) +where + get :: !Pointer !Pointer !String -> Bool + get _ _ _ = code { + ccall gtk_tree_model_get_iter_from_string "pps:I" + } + +gtk_tree_model_get_string_from_iter :: !Pointer !{#Int} -> String +gtk_tree_model_get_string_from_iter model iter + # path = get model (get_array_pointer iter) + # (path_string,path) = readP derefString path + = g_free path path_string +where + get :: !Pointer !Pointer -> Pointer + get _ _ = code { + ccall gtk_tree_model_get_string_from_iter "pp:p" + } + +gtk_tree_selection_get_selected :: !Pointer !.a -> (!(!Bool, !{#Int}), !.a) +gtk_tree_selection_get_selected sel env + # iter = createArray 4 0 // size of GtkTreeIter + # (r,env) = get sel 0 (get_array_pointer iter) env + = ((r, iter), env) +where + get :: !Pointer !Pointer !Pointer !.a -> (!Bool, !.a) + get _ _ _ _ = code { + ccall gtk_tree_selection_get_selected "ppp:I:A" + } + +gtk_tree_selection_select_iter :: !Pointer !{#Int} !.a -> .a +gtk_tree_selection_select_iter sel iter env = select sel (get_array_pointer iter) env +where + select :: !Pointer !Pointer !.a -> .a + select _ _ _ = code { + ccall gtk_tree_selection_select_iter "Gpp:V:A" + } + gtk_tree_view_column_add_attribute :: !Pointer !Pointer !String !Int !.a -> .a gtk_tree_view_column_add_attribute tree_column renderer attr column env = add tree_column renderer (packString attr) column env @@ -512,6 +599,16 @@ gtk_tree_view_append_column tree column env = code { ccall gtk_tree_view_append_column "pp:V:A" } +gtk_tree_view_get_model :: !Pointer -> Pointer +gtk_tree_view_get_model tree = code { + ccall gtk_tree_view_get_model "p:p" +} + +gtk_tree_view_get_selection :: !Pointer -> Pointer +gtk_tree_view_get_selection tree = code { + ccall gtk_tree_view_get_selection "p:p" +} + gtk_tree_view_new_with_model :: !Pointer !.a -> (!Pointer, !.a) gtk_tree_view_new_with_model model env = code { ccall gtk_tree_view_new_with_model "p:p:A" @@ -557,6 +654,11 @@ gtk_widget_set_margin_top widget padding env = code { ccall gtk_widget_set_margin_top "pI:V:A" } +gtk_widget_set_sensitive :: !Pointer !Bool !.a -> .a +gtk_widget_set_sensitive widget setting env = code { + ccall gtk_widget_set_sensitive "pI:V:A" +} + gtk_widget_set_size_request :: !Pointer !Int !Int !.a -> .a gtk_widget_set_size_request widget hsize vsize env = code { ccall gtk_widget_set_size_request "pII:V:A" diff --git a/src/Gtk/Shares.icl b/src/Gtk/Shares.icl index d02b1b0..4dbfecc 100644 --- a/src/Gtk/Shares.icl +++ b/src/Gtk/Shares.icl @@ -51,5 +51,6 @@ withShared default f = updateShared inc temp_share_id >>= \id -> let shared_value = share ("withShared"+++toString id) default in f shared_value + // TODO: remove share from map where temp_share_id = share "withShared_temp_share_id" 0 diff --git a/src/Gtk/Signal.dcl b/src/Gtk/Signal.dcl index b082e02..0f90c1b 100644 --- a/src/Gtk/Signal.dcl +++ b/src/Gtk/Signal.dcl @@ -15,8 +15,10 @@ where :: SignalHandler = E.h: SignalHandler h & signalHandler h :: GSignalHandler - = DestroyHandler !(GtkM ()) - | ActivateHandler !(GtkM ()) + = ActivateHandler !(GtkM ()) + | ChangedHandler !(GtkM ()) + | ClickedHandler !(GtkM ()) + | DestroyHandler !(GtkM ()) instance signalHandler GSignalHandler diff --git a/src/Gtk/Signal.icl b/src/Gtk/Signal.icl index 56126f8..ca19afd 100644 --- a/src/Gtk/Signal.icl +++ b/src/Gtk/Signal.icl @@ -14,11 +14,15 @@ import Gtk.Internal instance signalHandler GSignalHandler where signalName h = case h of - DestroyHandler _ -> "destroy" ActivateHandler _ -> "activate" + ChangedHandler _ -> "changed" + ClickedHandler _ -> "clicked" + DestroyHandler _ -> "destroy" signalHandler h = case h of - DestroyHandler f -> SHI_Void f ActivateHandler f -> SHI_Void f + ChangedHandler f -> SHI_Void f + ClickedHandler f -> SHI_Void f + DestroyHandler f -> SHI_Void f installSignalHandler :: !h !w -> GtkM w | signalHandler h & gtkWidget w installSignalHandler handler widget = diff --git a/src/Gtk/Types.dcl b/src/Gtk/Types.dcl index d53fcb7..40bf899 100644 --- a/src/Gtk/Types.dcl +++ b/src/Gtk/Types.dcl @@ -49,6 +49,16 @@ instance toInt GtkButtonsType instance toInt GtkFileChooserAction +:: GtkIconSize + = MenuIconSize + | SmallToolbarIconSize + | LargeToolbarIconSize + | ButtonIconSize + | DragAndDropIconSize + | DialogIconSize + +instance toInt GtkIconSize + :: GtkJustification = JustifyLeft | JustifyRight @@ -119,10 +129,16 @@ instance toInt GtkResponse instance toInt GtkScrollbarPolicy +:: GtkSensitivity + = Sensitive + | Insensitive + :: GtkShrink = Shrink | NoShrink +:: GtkSpacing =: Spacing Int + :: GtkStylePriority = StylePriorityFallback | StylePriorityTheme diff --git a/src/Gtk/Types.icl b/src/Gtk/Types.icl index 8be86ff..7d6e6ac 100644 --- a/src/Gtk/Types.icl +++ b/src/Gtk/Types.icl @@ -32,6 +32,16 @@ where SelectFolderAction -> 2 CreateFolderAction -> 3 +instance toInt GtkIconSize +where + toInt size = case size of + MenuIconSize -> 1 + SmallToolbarIconSize -> 2 + LargeToolbarIconSize -> 3 + ButtonIconSize -> 4 + DragAndDropIconSize -> 5 + DialogIconSize -> 6 + instance toInt GtkJustification where toInt justification = case justification of diff --git a/src/Gtk/Widgets.dcl b/src/Gtk/Widgets.dcl index a80d9a6..b0a0448 100644 --- a/src/Gtk/Widgets.dcl +++ b/src/Gtk/Widgets.dcl @@ -12,21 +12,36 @@ from Gtk.Types import :: GtkButtonsType, :: GtkCSSClass, :: GtkDirection, :: GtkExpand, :: GtkFileChooserAction, :: GtkLabel, :: GtkMargins, :: GtkMessageType, :: GtkModal, :: GtkOrientation, :: GtkPanedHandleWidth, :: GtkResize, - :: GtkResponse, :: GtkScrollbarPolicy, :: GtkShrink, :: GtkStylePriority, - :: GtkTitle, :: GtkWrapMode + :: GtkResponse, :: GtkScrollbarPolicy, :: GtkSensitivity, :: GtkShrink, + :: GtkSpacing, :: GtkStylePriority, :: GtkTitle, :: GtkWrapMode class ptr a where toPtr :: !a -> Pointer fromPtr :: !Pointer -> a +:: GtkActionBar +instance gtkWidget GtkActionBar + +newActionBar :: GtkM GtkActionBar +packActionBar :: !GtkActionBar !GtkDirection !w -> GtkM w | gtkWidget w + :: GtkBox instance gtkWidget GtkBox instance gtkContainer GtkBox +instance gtkOrientable GtkBox newBox :: !GtkOrientation !Int -> GtkM GtkBox packBox :: !GtkBox !GtkDirection !GtkExpand !w -> GtkM w | gtkWidget w +instance tune GtkBox GtkSpacing + +:: GtkButton +instance gtkWidget GtkButton +instance ptr GtkButton + +newButtonFromIconName :: !String -> GtkM GtkButton + :: GtkContainer class gtkContainer a :: !a -> GtkContainer @@ -68,7 +83,9 @@ framed :: !GtkLabel !(GtkM w) -> GtkM (w, GtkFrame) | gtkWidget w :: GtkListStore newListStore :: ![GType] -> GtkM GtkListStore +clearListStore :: !GtkListStore -> GtkM GtkListStore appendToListStore :: ![GValue] !GtkListStore -> GtkM GtkListStore +swapItems :: !Int !Int !GtkListStore -> GtkM Bool :: GtkMenu instance gtkWidget GtkMenu @@ -107,6 +124,12 @@ instance gtkMenuShell GtkMenu, GtkMenuBar, GtkMenuShell appendToMenuShell :: !s !mi -> GtkM mi | gtkMenuShell s & gtkMenuItem mi +:: GtkOrientable + +class gtkOrientable a :: !a -> GtkOrientable + +instance tune o GtkOrientation | gtkOrientable o + :: GtkPaned instance gtkWidget GtkPaned instance gtkContainer GtkPaned @@ -160,6 +183,10 @@ instance gtkWidget GtkTreeView newTreeView :: !GtkListStore -> GtkM GtkTreeView appendColumnToTreeView :: !String !Int !GtkExpand !GtkTreeView -> GtkM GtkTreeView +addSelectionChangedHandler :: !(GtkM ()) !GtkTreeView -> GtkM GtkTreeView +getPathToSelection :: !GtkTreeView -> GtkM (Maybe [Int]) +selectPath :: ![Int] !GtkTreeView -> GtkM Bool + :: GtkWidget class gtkWidget a :: !a -> GtkWidget @@ -175,6 +202,8 @@ addCSSClass :: !GtkCSSClass !w -> GtkM w | gtkWidget w removeCSSClass :: !GtkCSSClass !w -> GtkM () | gtkWidget w setMargins :: !GtkMargins !w -> GtkM w | gtkWidget w +instance tune w GtkSensitivity | gtkWidget w + :: GtkWindow class gtkWindow a :: !a -> GtkWindow diff --git a/src/Gtk/Widgets.icl b/src/Gtk/Widgets.icl index 0848122..4bf537b 100644 --- a/src/Gtk/Widgets.icl +++ b/src/Gtk/Widgets.icl @@ -8,14 +8,32 @@ 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 Gtk.Internal +:: GtkActionBar :== Pointer + +instance gtkWidget GtkActionBar where gtkWidget ab = ab + +newActionBar :: GtkM GtkActionBar +newActionBar = toStateR gtk_action_bar_new >>= show + +packActionBar :: !GtkActionBar !GtkDirection !w -> GtkM w | gtkWidget w +packActionBar bar dir widget = + toState + (if dir=:StartToEnd gtk_action_bar_pack_start gtk_action_bar_pack_end + bar + (gtkWidget widget)) >>| + pure widget + :: GtkBox :== Pointer instance gtkWidget GtkBox where gtkWidget b = b instance gtkContainer GtkBox where gtkContainer b = b +instance gtkOrientable GtkBox where gtkOrientable b = b newBox :: !GtkOrientation !Int -> GtkM GtkBox newBox orientation spacing = @@ -28,6 +46,23 @@ packBox box direction expand widget = box (gtkWidget widget) expand=:Expand True 0) >>| pure widget +instance tune GtkBox GtkSpacing +where + tune (Spacing s) box = toState (gtk_box_set_spacing box s) >>| pure box + +:: GtkButton :== Pointer + +instance gtkWidget GtkButton where gtkWidget b = b +instance ptr GtkButton +where + toPtr b = b + fromPtr b = b + +newButtonFromIconName :: !String -> GtkM GtkButton +newButtonFromIconName icon = + toStateR (gtk_button_new_from_icon_name icon (toInt ButtonIconSize)) >>= + show + :: GtkContainer :== Pointer instance gtkWidget GtkContainer where gtkWidget c = c @@ -132,6 +167,11 @@ framed label widgetf = newListStore :: ![GType] -> GtkM GtkListStore newListStore types = toStateR (gtk_list_store_newv {toInt t \\ t <- types}) +clearListStore :: !GtkListStore -> GtkM GtkListStore +clearListStore store = + toState (gtk_list_store_clear store) >>| + pure store + appendToListStore :: ![GValue] !GtkListStore -> GtkM GtkListStore appendToListStore values store = set 0 values (gtk_list_store_append store) >>| @@ -148,6 +188,16 @@ where GValueString s -> toState (gtk_list_store_set_string store iter col s) set _ [] _ = pure () +swapItems :: !Int !Int !GtkListStore -> GtkM Bool +swapItems a b store = + let + (ok_a,iter_a) = gtk_tree_model_get_iter_from_string store (toString a) + (ok_b,iter_b) = gtk_tree_model_get_iter_from_string store (toString b) + in + if (ok_a && ok_b) + (toState (gtk_list_store_swap store iter_a iter_b) >>| pure True) + (pure False) + :: GtkMenu :== Pointer instance gtkWidget GtkMenu where gtkWidget m = m @@ -216,6 +266,14 @@ appendToMenuShell shell item = toState (gtk_menu_shell_append (gtkMenuShell shell) (gtkMenuItem item)) >>| pure item +:: GtkOrientable :== Pointer + +instance tune o GtkOrientation | gtkOrientable o +where + tune orientation orientable = + toState (gtk_orientable_set_orientation (gtkOrientable orientable) orientation=:Vertical) >>| + pure orientable + :: GtkPaned :== Pointer instance gtkWidget GtkPaned where gtkWidget p = p @@ -346,6 +404,36 @@ appendColumnToTreeView title col expand tree_view = toState (gtk_tree_view_append_column tree_view column) >>| pure tree_view +addSelectionChangedHandler :: !(GtkM ()) !GtkTreeView -> GtkM GtkTreeView +addSelectionChangedHandler handler tree = + let selection = gtk_tree_view_get_selection tree in + tune (ChangedHandler handler) selection >>| + pure tree + +getPathToSelection :: !GtkTreeView -> GtkM (Maybe [Int]) +getPathToSelection tree = + let selection = gtk_tree_view_get_selection tree in + toStateR (gtk_tree_selection_get_selected selection) >>= \(selected,iter) + | not selected -> + pure Nothing + | otherwise -> + let + model = gtk_tree_view_get_model tree + 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 tree = + let + store = gtk_tree_view_get_model tree + selection = gtk_tree_view_get_selection tree + (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) + :: GtkWidget :== Pointer instance gtkWidget GtkWidget where gtkWidget w = w @@ -384,6 +472,12 @@ setMargins {left,top,right,bottom} widget` = toState (gtk_widget_set_margin_bottom widget bottom) >>| pure widget` +instance tune w GtkSensitivity | gtkWidget w +where + tune sens widget = + toState (gtk_widget_set_sensitive (gtkWidget widget) sens=:Sensitive) >>| + pure widget + :: GtkWindow :== Pointer instance gtkWidget GtkWindow where gtkWidget w = w -- cgit v1.2.3