{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Widget.Windows
-- Copyright   : (c) Ivan Malison
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : Ivan Malison <IvanMalison@gmail.com>
-- Stability   : unstable
-- Portability : unportable
--
-- Menu widget that shows the title of the currently focused window and that,
-- when clicked, displays a menu from which the user may select a window to
-- which to switch the focus.
-----------------------------------------------------------------------------

module System.Taffybar.Widget.Windows where

import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.Maybe
import           Data.Default (Default(..))
import           Data.Maybe
import qualified Data.Text as T
import           GI.GLib (markupEscapeText)
import qualified GI.Gtk as Gtk
import           System.Taffybar.Context
import           System.Taffybar.Information.EWMHDesktopInfo
import           System.Taffybar.Widget.Generic.AutoSizeImage
import           System.Taffybar.Widget.Generic.DynamicMenu
import           System.Taffybar.Widget.Util
import           System.Taffybar.Widget.Workspaces (WindowIconPixbufGetter, getWindowData, defaultGetWindowIconPixbuf)
import           System.Taffybar.Util

data WindowsConfig = WindowsConfig
  { WindowsConfig -> X11Window -> TaffyIO Text
getMenuLabel :: X11Window -> TaffyIO T.Text
  -- ^ A monadic function that will be used to make a label for the window in
  -- the window menu.
  , WindowsConfig -> TaffyIO Text
getActiveLabel :: TaffyIO T.Text
  -- ^ Action to build the label text for the active window.
  , WindowsConfig -> Maybe WindowIconPixbufGetter
getActiveWindowIconPixbuf :: Maybe WindowIconPixbufGetter
  -- ^ Optional function to retrieve a pixbuf to show next to the
  -- window label.
  }

defaultGetMenuLabel :: X11Window -> TaffyIO T.Text
defaultGetMenuLabel :: X11Window -> TaffyIO Text
defaultGetMenuLabel X11Window
window = do
  String
windowString <- String -> X11Property String -> TaffyIO String
forall a. a -> X11Property a -> TaffyIO a
runX11Def String
"(nameless window)" (X11Window -> X11Property String
getWindowTitle X11Window
window)
  Text -> TaffyIO Text
forall a. a -> ReaderT Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> TaffyIO Text) -> Text -> TaffyIO Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
windowString

defaultGetActiveLabel :: TaffyIO T.Text
defaultGetActiveLabel :: TaffyIO Text
defaultGetActiveLabel = do
  Text
label <- Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text)
-> ReaderT Context IO (Maybe Text) -> TaffyIO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe X11Window
-> X11Property (Maybe X11Window) -> TaffyIO (Maybe X11Window)
forall a. a -> X11Property a -> TaffyIO a
runX11Def Maybe X11Window
forall a. Maybe a
Nothing X11Property (Maybe X11Window)
getActiveWindow TaffyIO (Maybe X11Window)
-> (Maybe X11Window -> ReaderT Context IO (Maybe Text))
-> ReaderT Context IO (Maybe Text)
forall a b.
ReaderT Context IO a
-> (a -> ReaderT Context IO b) -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
                                       (X11Window -> TaffyIO Text)
-> Maybe X11Window -> ReaderT Context IO (Maybe Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse X11Window -> TaffyIO Text
defaultGetMenuLabel)
  Text -> Int64 -> TaffyIO Text
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Int64 -> m Text
markupEscapeText Text
label (-Int64
1)

truncatedGetActiveLabel :: Int -> TaffyIO T.Text
truncatedGetActiveLabel :: Int -> TaffyIO Text
truncatedGetActiveLabel Int
maxLength =
  Int -> Text -> Text
truncateText Int
maxLength (Text -> Text) -> TaffyIO Text -> TaffyIO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TaffyIO Text
defaultGetActiveLabel

truncatedGetMenuLabel :: Int -> X11Window -> TaffyIO T.Text
truncatedGetMenuLabel :: Int -> X11Window -> TaffyIO Text
truncatedGetMenuLabel Int
maxLength =
  (Text -> Text) -> TaffyIO Text -> TaffyIO Text
forall a b.
(a -> b) -> ReaderT Context IO a -> ReaderT Context IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
truncateText Int
maxLength) (TaffyIO Text -> TaffyIO Text)
-> (X11Window -> TaffyIO Text) -> X11Window -> TaffyIO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X11Window -> TaffyIO Text
defaultGetMenuLabel

defaultWindowsConfig :: WindowsConfig
defaultWindowsConfig :: WindowsConfig
defaultWindowsConfig =
  WindowsConfig
  { getMenuLabel :: X11Window -> TaffyIO Text
getMenuLabel = Int -> X11Window -> TaffyIO Text
truncatedGetMenuLabel Int
35
  , getActiveLabel :: TaffyIO Text
getActiveLabel = Int -> TaffyIO Text
truncatedGetActiveLabel Int
35
  , getActiveWindowIconPixbuf :: Maybe WindowIconPixbufGetter
getActiveWindowIconPixbuf = WindowIconPixbufGetter -> Maybe WindowIconPixbufGetter
forall a. a -> Maybe a
Just WindowIconPixbufGetter
defaultGetWindowIconPixbuf
  }

instance Default WindowsConfig where
  def :: WindowsConfig
def = WindowsConfig
defaultWindowsConfig

-- | Create a new Windows widget that will use the given Pager as
-- its source of events.
windowsNew :: WindowsConfig -> TaffyIO Gtk.Widget
windowsNew :: WindowsConfig -> TaffyIO Widget
windowsNew WindowsConfig
config = do
  Box
hbox <- IO Box -> ReaderT Context IO Box
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Box -> ReaderT Context IO Box)
-> IO Box -> ReaderT Context IO Box
forall a b. (a -> b) -> a -> b
$ Orientation -> Int32 -> IO Box
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Orientation -> Int32 -> m Box
Gtk.boxNew Orientation
Gtk.OrientationHorizontal Int32
0

  IO ()
refreshIcon <- case WindowsConfig -> Maybe WindowIconPixbufGetter
getActiveWindowIconPixbuf WindowsConfig
config of
    Just WindowIconPixbufGetter
getIcon -> do
      (IO ()
rf, Widget
icon) <- WindowIconPixbufGetter -> TaffyIO (IO (), Widget)
buildWindowsIcon WindowIconPixbufGetter
getIcon
      Box -> Widget -> Bool -> Bool -> Word32 -> ReaderT Context IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
a -> b -> Bool -> Bool -> Word32 -> m ()
Gtk.boxPackStart Box
hbox Widget
icon Bool
True Bool
True Word32
0
      IO () -> ReaderT Context IO (IO ())
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IO ()
rf
    Maybe WindowIconPixbufGetter
Nothing -> IO () -> ReaderT Context IO (IO ())
forall a. a -> ReaderT Context IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

  (Text -> IO ()
setLabelTitle, Widget
label) <- TaffyIO (Text -> IO (), Widget)
buildWindowsLabel
  Box -> Widget -> Bool -> Bool -> Word32 -> ReaderT Context IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsBox a, IsWidget b) =>
a -> b -> Bool -> Bool -> Word32 -> m ()
Gtk.boxPackStart Box
hbox Widget
label Bool
True Bool
True Word32
0
  let refreshLabel :: ReaderT Context IO ()
refreshLabel = WindowsConfig -> TaffyIO Text
getActiveLabel WindowsConfig
config TaffyIO Text
-> (Text -> ReaderT Context IO ()) -> ReaderT Context IO ()
forall a b.
ReaderT Context IO a
-> (a -> ReaderT Context IO b) -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> ReaderT Context IO ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> ReaderT Context IO ())
-> (Text -> IO ()) -> Text -> ReaderT Context IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
setLabelTitle

  Unique
subscription <- [String] -> Listener -> Taffy IO Unique
subscribeToPropertyEvents
    [String
ewmhActiveWindow, String
ewmhWMName, String
ewmhWMClass]
    (ReaderT Context IO () -> Listener
forall a b. a -> b -> a
const (ReaderT Context IO () -> Listener)
-> ReaderT Context IO () -> Listener
forall a b. (a -> b) -> a -> b
$ ReaderT Context IO ()
refreshLabel ReaderT Context IO ()
-> ReaderT Context IO () -> ReaderT Context IO ()
forall a b.
ReaderT Context IO a
-> ReaderT Context IO b -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO () -> ReaderT Context IO ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO ()
refreshIcon)

  ReaderT Context IO SignalHandlerId -> ReaderT Context IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT Context IO SignalHandlerId -> ReaderT Context IO ())
-> ReaderT Context IO SignalHandlerId -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$ (IO () -> IO SignalHandlerId)
-> ReaderT Context IO () -> ReaderT Context IO SignalHandlerId
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (Box -> ((?self::Box) => IO ()) -> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
Gtk.onWidgetUnrealize Box
hbox) (Unique -> ReaderT Context IO ()
unsubscribe Unique
subscription)

  Box -> ReaderT Context IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetShowAll Box
hbox
  Widget
boxWidget <- Box -> TaffyIO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget Box
hbox

  ReaderT Context IO () -> IO ()
runTaffy <- (Context -> ReaderT Context IO () -> IO ())
-> ReaderT Context IO (ReaderT Context IO () -> IO ())
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((ReaderT Context IO () -> Context -> IO ())
-> Context -> ReaderT Context IO () -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Context IO () -> Context -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT)
  Widget
menu <- DynamicMenuConfig -> TaffyIO Widget
forall (m :: * -> *). MonadIO m => DynamicMenuConfig -> m Widget
dynamicMenuNew
    DynamicMenuConfig { dmClickWidget :: Widget
dmClickWidget = Widget
boxWidget
                      , dmPopulateMenu :: Menu -> IO ()
dmPopulateMenu = ReaderT Context IO () -> IO ()
runTaffy (ReaderT Context IO () -> IO ())
-> (Menu -> ReaderT Context IO ()) -> Menu -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowsConfig -> Menu -> ReaderT Context IO ()
forall a.
IsMenuShell a =>
WindowsConfig -> a -> ReaderT Context IO ()
fillMenu WindowsConfig
config
                      }

  Widget -> Text -> TaffyIO Widget
forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
widgetSetClassGI Widget
menu Text
"windows"

buildWindowsLabel :: TaffyIO (T.Text -> IO (), Gtk.Widget)
buildWindowsLabel :: TaffyIO (Text -> IO (), Widget)
buildWindowsLabel = do
  Label
label <- IO Label -> ReaderT Context IO Label
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Label -> ReaderT Context IO Label)
-> IO Label -> ReaderT Context IO Label
forall a b. (a -> b) -> a -> b
$ Maybe Text -> IO Label
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Maybe Text -> m Label
Gtk.labelNew Maybe Text
forall a. Maybe a
Nothing
  let setLabelTitle :: Text -> IO ()
setLabelTitle Text
title = IO () -> IO ()
postGUIASync (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Label -> Text -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsLabel a) =>
a -> Text -> m ()
Gtk.labelSetMarkup Label
label Text
title
  (Text -> IO ()
setLabelTitle,) (Widget -> (Text -> IO (), Widget))
-> TaffyIO Widget -> TaffyIO (Text -> IO (), Widget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Label -> TaffyIO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget Label
label

buildWindowsIcon :: WindowIconPixbufGetter -> TaffyIO (IO (), Gtk.Widget)
buildWindowsIcon :: WindowIconPixbufGetter -> TaffyIO (IO (), Widget)
buildWindowsIcon WindowIconPixbufGetter
windowIconPixbufGetter = do
  Image
icon <- IO Image -> ReaderT Context IO Image
forall (m :: * -> *) a. Monad m => m a -> ReaderT Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IO Image
forall (m :: * -> *). (HasCallStack, MonadIO m) => m Image
Gtk.imageNew

  ReaderT Context IO (Maybe Pixbuf) -> IO (Maybe Pixbuf)
runTaffy <- (Context -> ReaderT Context IO (Maybe Pixbuf) -> IO (Maybe Pixbuf))
-> ReaderT
     Context IO (ReaderT Context IO (Maybe Pixbuf) -> IO (Maybe Pixbuf))
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks ((ReaderT Context IO (Maybe Pixbuf) -> Context -> IO (Maybe Pixbuf))
-> Context
-> ReaderT Context IO (Maybe Pixbuf)
-> IO (Maybe Pixbuf)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT Context IO (Maybe Pixbuf) -> Context -> IO (Maybe Pixbuf)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT)
  let getActiveWindowPixbuf :: Int32 -> IO (Maybe Pixbuf)
getActiveWindowPixbuf Int32
size = ReaderT Context IO (Maybe Pixbuf) -> IO (Maybe Pixbuf)
runTaffy (ReaderT Context IO (Maybe Pixbuf) -> IO (Maybe Pixbuf))
-> (MaybeT (ReaderT Context IO) Pixbuf
    -> ReaderT Context IO (Maybe Pixbuf))
-> MaybeT (ReaderT Context IO) Pixbuf
-> IO (Maybe Pixbuf)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT (ReaderT Context IO) Pixbuf
-> ReaderT Context IO (Maybe Pixbuf)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (ReaderT Context IO) Pixbuf -> IO (Maybe Pixbuf))
-> MaybeT (ReaderT Context IO) Pixbuf -> IO (Maybe Pixbuf)
forall a b. (a -> b) -> a -> b
$ do
        WindowData
wd <- ReaderT Context IO (Maybe WindowData)
-> MaybeT (ReaderT Context IO) WindowData
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT Context IO (Maybe WindowData)
 -> MaybeT (ReaderT Context IO) WindowData)
-> ReaderT Context IO (Maybe WindowData)
-> MaybeT (ReaderT Context IO) WindowData
forall a b. (a -> b) -> a -> b
$ Maybe WindowData
-> X11Property (Maybe WindowData)
-> ReaderT Context IO (Maybe WindowData)
forall a. a -> X11Property a -> TaffyIO a
runX11Def Maybe WindowData
forall a. Maybe a
Nothing (X11Property (Maybe WindowData)
 -> ReaderT Context IO (Maybe WindowData))
-> X11Property (Maybe WindowData)
-> ReaderT Context IO (Maybe WindowData)
forall a b. (a -> b) -> a -> b
$
          (X11Window -> ReaderT X11Context IO WindowData)
-> Maybe X11Window -> X11Property (Maybe WindowData)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Maybe X11Window
-> [X11Window] -> X11Window -> ReaderT X11Context IO WindowData
getWindowData Maybe X11Window
forall a. Maybe a
Nothing []) (Maybe X11Window -> X11Property (Maybe WindowData))
-> X11Property (Maybe X11Window) -> X11Property (Maybe WindowData)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< X11Property (Maybe X11Window)
getActiveWindow
        ReaderT Context IO (Maybe Pixbuf)
-> MaybeT (ReaderT Context IO) Pixbuf
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT Context IO (Maybe Pixbuf)
 -> MaybeT (ReaderT Context IO) Pixbuf)
-> ReaderT Context IO (Maybe Pixbuf)
-> MaybeT (ReaderT Context IO) Pixbuf
forall a b. (a -> b) -> a -> b
$ WindowIconPixbufGetter
windowIconPixbufGetter Int32
size WindowData
wd

  IO ()
updateImage <- Image
-> (Int32 -> IO (Maybe Pixbuf))
-> Orientation
-> ReaderT Context IO (IO ())
forall (m :: * -> *).
MonadIO m =>
Image -> (Int32 -> IO (Maybe Pixbuf)) -> Orientation -> m (IO ())
autoSizeImage Image
icon Int32 -> IO (Maybe Pixbuf)
getActiveWindowPixbuf Orientation
Gtk.OrientationHorizontal
  (IO () -> IO ()
postGUIASync IO ()
updateImage,) (Widget -> (IO (), Widget))
-> TaffyIO Widget -> TaffyIO (IO (), Widget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Image -> TaffyIO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget Image
icon

-- | Populate the given menu widget with the list of all currently open windows.
fillMenu :: Gtk.IsMenuShell a => WindowsConfig -> a -> ReaderT Context IO ()
fillMenu :: forall a.
IsMenuShell a =>
WindowsConfig -> a -> ReaderT Context IO ()
fillMenu WindowsConfig
config a
menu = ReaderT Context IO Context
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT Context IO Context
-> (Context -> ReaderT Context IO ()) -> ReaderT Context IO ()
forall a b.
ReaderT Context IO a
-> (a -> ReaderT Context IO b) -> ReaderT Context IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Context
context ->
  () -> X11Property () -> ReaderT Context IO ()
forall a. a -> X11Property a -> TaffyIO a
runX11Def () (X11Property () -> ReaderT Context IO ())
-> X11Property () -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$ do
    [X11Window]
windowIds <- X11Property [X11Window]
getWindows
    [X11Window] -> (X11Window -> X11Property ()) -> X11Property ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [X11Window]
windowIds ((X11Window -> X11Property ()) -> X11Property ())
-> (X11Window -> X11Property ()) -> X11Property ()
forall a b. (a -> b) -> a -> b
$ \X11Window
windowId ->
      IO () -> X11Property ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT X11Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO () -> X11Property ()) -> IO () -> X11Property ()
forall a b. (a -> b) -> a -> b
$ do
        Text
labelText <- TaffyIO Text -> Context -> IO Text
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WindowsConfig -> X11Window -> TaffyIO Text
getMenuLabel WindowsConfig
config X11Window
windowId) Context
context
        let focusCallback :: IO Bool
focusCallback = ReaderT Context IO () -> Context -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (X11Property () -> ReaderT Context IO ()
forall a. X11Property a -> TaffyIO a
runX11 (X11Property () -> ReaderT Context IO ())
-> X11Property () -> ReaderT Context IO ()
forall a b. (a -> b) -> a -> b
$ X11Window -> X11Property ()
focusWindow X11Window
windowId) Context
context IO () -> IO Bool -> IO Bool
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                            Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        MenuItem
item <- Text -> IO MenuItem
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m MenuItem
Gtk.menuItemNewWithLabel Text
labelText
        SignalHandlerId
_ <- MenuItem
-> ((?self::MenuItem) => WidgetButtonPressEventCallback)
-> IO SignalHandlerId
forall a (m :: * -> *).
(IsWidget a, MonadIO m) =>
a
-> ((?self::a) => WidgetButtonPressEventCallback)
-> m SignalHandlerId
Gtk.onWidgetButtonPressEvent MenuItem
item (((?self::MenuItem) => WidgetButtonPressEventCallback)
 -> IO SignalHandlerId)
-> ((?self::MenuItem) => WidgetButtonPressEventCallback)
-> IO SignalHandlerId
forall a b. (a -> b) -> a -> b
$ IO Bool -> WidgetButtonPressEventCallback
forall a b. a -> b -> a
const IO Bool
focusCallback
        a -> MenuItem -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsMenuShell a, IsMenuItem b) =>
a -> b -> m ()
Gtk.menuShellAppend a
menu MenuItem
item
        MenuItem -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetShow MenuItem
item