module System.Taffybar.Widget.Generic.DynamicMenu where
import Control.Monad.IO.Class
import qualified GI.Gtk as Gtk
data =
{ DynamicMenuConfig -> Widget
dmClickWidget :: Gtk.Widget
, :: Gtk.Menu -> IO ()
}
dynamicMenuNew :: MonadIO m => DynamicMenuConfig -> m Gtk.Widget
DynamicMenuConfig
{ dmClickWidget :: DynamicMenuConfig -> Widget
dmClickWidget = Widget
clickWidget
, dmPopulateMenu :: DynamicMenuConfig -> Menu -> IO ()
dmPopulateMenu = Menu -> IO ()
populateMenu
} = do
MenuButton
button <- m MenuButton
forall (m :: * -> *). (HasCallStack, MonadIO m) => m MenuButton
Gtk.menuButtonNew
Menu
menu <- m Menu
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Menu
Gtk.menuNew
MenuButton -> Widget -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
Gtk.containerAdd MenuButton
button Widget
clickWidget
MenuButton -> Maybe Menu -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuButton a, IsWidget b) =>
a -> Maybe b -> m ()
Gtk.menuButtonSetPopup MenuButton
button (Maybe Menu -> m ()) -> Maybe Menu -> m ()
forall a b. (a -> b) -> a -> b
$ Menu -> Maybe Menu
forall a. a -> Maybe a
Just Menu
menu
SignalHandlerId
_ <- MenuButton -> ((?self::MenuButton) => IO ()) -> m SignalHandlerId
forall a (m :: * -> *).
(IsButton a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
Gtk.onButtonPressed MenuButton
button (((?self::MenuButton) => IO ()) -> m SignalHandlerId)
-> ((?self::MenuButton) => IO ()) -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ Menu -> IO ()
forall a (m :: * -> *). (IsContainer a, MonadIO m) => a -> m ()
emptyMenu Menu
menu IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Menu -> IO ()
populateMenu Menu
menu
MenuButton -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetShowAll MenuButton
button
MenuButton -> m Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget MenuButton
button
emptyMenu :: (Gtk.IsContainer a, MonadIO m) => a -> m ()
a
menu =
a -> Callback -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsContainer a) =>
a -> Callback -> m ()
Gtk.containerForeach a
menu (Callback -> m ()) -> Callback -> m ()
forall a b. (a -> b) -> a -> b
$ \Widget
item ->
a -> Callback
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
Gtk.containerRemove a
menu Widget
item IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Callback
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetDestroy Widget
item