module System.Taffybar.Widget.XDGMenu.MenuWidget
(
menuWidgetNew
)
where
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Text as T
import GI.GdkPixbuf
import GI.Gtk hiding (Menu)
import System.Directory
import System.FilePath.Posix
import System.Log.Logger
import System.Process
import System.Taffybar.Widget.XDGMenu.Menu
addItem :: (IsMenuShell msc) =>
msc
-> MenuEntry
-> IO ()
addItem ms de = do
item <- imageMenuItemNewWithLabel (feName de)
setWidgetTooltipText item (feComment de)
setIcon item (T.unpack <$> feIcon de)
menuShellAppend ms item
_ <- onMenuItemActivate item $ do
let cmd = feCommand de
logM "System.Taffybar.Widget.XDGMenu.MenuWidget" DEBUG $ "Launching '" ++ cmd ++ "'"
_ <- spawnCommand cmd
return ()
return ()
addMenu :: (IsMenuShell msc) =>
msc
-> Menu
-> IO ()
addMenu ms fm = do
let subMenus = fmSubmenus fm
items = fmEntries fm
when (not (null items) || not (null subMenus)) $ do
item <- imageMenuItemNewWithLabel (T.pack $ fmName fm)
setIcon item (fmIcon fm)
menuShellAppend ms item
subMenu <- menuNew
menuItemSetSubmenu item (Just subMenu)
mapM_ (addMenu subMenu) subMenus
mapM_ (addItem subMenu) items
setIcon :: ImageMenuItem -> Maybe String -> IO ()
setIcon _ Nothing = return ()
setIcon item (Just iconName) = do
iconTheme <- iconThemeGetDefault
hasIcon <- iconThemeHasIcon iconTheme (T.pack iconName)
mImg <- if hasIcon
then Just <$> imageNewFromIconName (Just $ T.pack iconName) (fromIntegral $ fromEnum IconSizeMenu)
else if isAbsolute iconName
then
do
ex <- doesFileExist iconName
if ex
then do let defaultSize = 24
pb <- pixbufNewFromFileAtScale iconName
defaultSize defaultSize True
Just <$> imageNewFromPixbuf (Just pb)
else return Nothing
else return Nothing
case mImg of
Just img -> imageMenuItemSetImage item (Just img)
Nothing -> logM "System.Taffybar.Widget.XDGMenu.MenuWidget" WARNING $ "Icon not found: " ++ iconName
menuWidgetNew :: MonadIO m => Maybe String
-> m GI.Gtk.Widget
menuWidgetNew mMenuPrefix = liftIO $ do
mb <- menuBarNew
m <- buildMenu mMenuPrefix
addMenu mb m
widgetShowAll mb
toWidget mb