module System.Taffybar.Widgets.Util where
import Control.Monad
import Control.Monad.IO.Class
import Data.Tuple.Sequence
import Graphics.UI.Gtk
import Prelude
onClick :: [Click]
-> IO a
-> EventM EButton Bool
onClick triggers action = tryEvent $ do
click <- eventClick
when (click `elem` triggers) $ liftIO action >> return ()
attachPopup :: (WidgetClass w, WindowClass wnd) =>
w
-> String
-> wnd
-> IO ()
attachPopup widget title window = do
set window [ windowTitle := title
, windowTypeHint := WindowTypeHintTooltip
, windowSkipTaskbarHint := True
, windowSkipPagerHint := True
, windowTransientFor :=> getWindow
]
windowSetKeepAbove window True
windowStick window
where getWindow = do
Just topLevelWindow <- (fmap castToWindow) <$> widgetGetAncestor widget gTypeWindow
return topLevelWindow
displayPopup :: (WidgetClass w, WindowClass wnd) =>
w
-> wnd
-> IO ()
displayPopup widget window = do
windowSetPosition window WinPosMouse
(x, y ) <- windowGetPosition window
(_, y') <- widgetGetSizeRequest widget
widgetShowAll window
if y > y'
then windowMove window x (y - y')
else windowMove window x y'
widgetGetAllocatedSize
:: (WidgetClass self, MonadIO m)
=> self -> m (Int, Int)
widgetGetAllocatedSize widget =
liftIO $
sequenceT (widgetGetAllocatedWidth widget, widgetGetAllocatedHeight widget)