diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # Changelog for gtk-sni-tray +## 0.1.11.0 + +- Restore `libdbusmenu` (`gi-dbusmenugtk3`) as the default menu backend. +- Add runtime-configurable menu backend selection: `LibDBusMenu` (default) or + `HaskellDBusMenu` via `trayMenuBackend` in `TrayParams` and `--menu-backend` + CLI flag. + ## 0.1.10.2 - Fix menu popups not appearing: restore `widgetShowAll` so menu items are diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -131,7 +131,6 @@ GtkLayerShell.setNamespace window (T.pack "gtk-sni-tray") GtkLayerShell.setLayer window GtkLayerShell.LayerTop - -- Default behavior if monitor info isn't available: behave like a full-width/height panel. GtkLayerShell.setMargin window GtkLayerShell.EdgeLeft xpadding GtkLayerShell.setMargin window GtkLayerShell.EdgeRight xpadding GtkLayerShell.setMargin window GtkLayerShell.EdgeTop ypadding @@ -468,6 +467,21 @@ <> value (5 % 7) ) +menuBackendP :: Parser MenuBackend +menuBackendP = + option (eitherReader parseMenuBackend) + ( long "menu-backend" + <> help "Menu backend: libdbusmenu (default) | haskell" + <> value LibDBusMenu + <> metavar "BACKEND" + ) + where + parseMenuBackend s = + case map toLower s of + "libdbusmenu" -> Right LibDBusMenu + "haskell" -> Right HaskellDBusMenu + _ -> Left "expected one of: libdbusmenu, haskell" + getColor :: String -> IO Gdk.RGBA getColor colorString = do rgba <- Gdk.newZeroRGBA @@ -490,9 +504,10 @@ -> Bool -> Rational -> Rational + -> MenuBackend -> IO () buildWindows pos align size padding monitors priority backendChoice maybeColorString expand - startWatcher noStrut barLength overlayScale = do + startWatcher noStrut barLength overlayScale menuBackend = do _ <- Gtk.init Nothing logger <- getLogger "StatusNotifier" saveGlobalLogger $ setLevel priority logger @@ -557,9 +572,9 @@ , trayLeftClickAction = Activate , trayMiddleClickAction = SecondaryActivate , trayRightClickAction = PopupMenu + , trayMenuBackend = menuBackend } window <- Gtk.windowNew Gtk.WindowTypeToplevel - -- Make it behave more like a panel/tray window in the fallback cases. Gtk.windowSetResizable window False Gtk.windowSetSkipTaskbarHint window True Gtk.windowSetSkipPagerHint window True @@ -591,7 +606,7 @@ parser = buildWindows <$> positionP <*> alignmentP <*> sizeP <*> paddingP <*> monitorNumberP <*> logP <*> backendChoiceP <*> colorP <*> expandP <*> startWatcherP <*> - noStrutP <*> barLengthP <*> overlayScaleP + noStrutP <*> barLengthP <*> overlayScaleP <*> menuBackendP versionOption :: Parser (a -> a) versionOption = infoOption diff --git a/gtk-sni-tray.cabal b/gtk-sni-tray.cabal --- a/gtk-sni-tray.cabal +++ b/gtk-sni-tray.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: gtk-sni-tray -version: 0.1.10.3 +version: 0.1.11.0 synopsis: A standalone StatusNotifierItem/AppIndicator tray description: Please see the README on Github at category: System @@ -49,6 +49,7 @@ , gi-cairo , gi-cairo-connector , gi-cairo-render + , gi-dbusmenugtk3 , gi-gdk3 , gi-gdkpixbuf >=2.0.16 , gi-glib diff --git a/src/StatusNotifier/DBusMenu.hs b/src/StatusNotifier/DBusMenu.hs --- a/src/StatusNotifier/DBusMenu.hs +++ b/src/StatusNotifier/DBusMenu.hs @@ -18,6 +18,8 @@ import System.Log.Logger (Priority(..), logM) import Text.Printf +import qualified StatusNotifier.DBus.Client.DBusMenu as DM + dbusMenuLogger :: Priority -> String -> IO () dbusMenuLogger = logM "StatusNotifier.DBusMenu" @@ -39,45 +41,47 @@ children <- traverse variantToLayout kids pure LayoutNode { lnId = i, lnProps = props, lnChildren = children } -callMenu - :: Client - -> BusName - -> ObjectPath - -> MemberName - -> [Variant] - -> IO [Variant] -callMenu client dest path member body = do - let call0 = - (methodCall path "com.canonical.dbusmenu" member) - { methodCallDestination = Just dest - , methodCallBody = body - } - reply <- call client call0 - case reply of - Left err -> fail $ "DBusMenu call failed: " <> show err - Right ret -> pure (methodReturnBody ret) +tupleToLayout :: LayoutTuple -> LayoutNode +tupleToLayout (i, props, kids) = + LayoutNode + { lnId = i + , lnProps = props + , lnChildren = [ n | v <- kids, Just n <- [variantToLayout v] ] + } +-- | Unwrap an Either MethodError, failing on Left. +unwrapCall :: String -> Either MethodError a -> IO a +unwrapCall label (Left err) = fail $ label <> " failed: " <> show err +unwrapCall _ (Right a) = pure a + aboutToShow :: Client -> BusName -> ObjectPath -> Int32 -> IO Bool -aboutToShow client dest path i = do - body <- callMenu client dest path "AboutToShow" [toVariant i] - case body of - (v : _) -> pure $ fromMaybe False (fromVariant v) - _ -> pure False +aboutToShow client dest path i = + either (const False) id <$> DM.aboutToShow client dest path i getLayout :: Client -> BusName -> ObjectPath -> Int32 -> Int32 -> [String] -> IO (Word32, LayoutNode) getLayout client dest path parentId depth propNames = do - body <- callMenu client dest path "GetLayout" - [ toVariant parentId - , toVariant depth - , toVariant propNames - ] - case body of - (revV : layoutV : _) -> do - rev <- maybe (fail "GetLayout: bad revision") pure (fromVariant revV) - node <- maybe (fail "GetLayout: bad layout") pure (variantToLayout layoutV) - pure (rev, node) - _ -> fail "GetLayout: unexpected reply body" + (rev, tup) <- unwrapCall "GetLayout" =<< + DM.getLayout client dest path parentId depth propNames + pure (rev, tupleToLayout tup) +sendClicked :: Client -> BusName -> ObjectPath -> Int32 -> Word32 -> IO () +sendClicked client dest path itemId ts = do + -- Use the TH-generated eventMethodCall for the method call structure, but + -- call it with callNoReply: the Event method has no output args, and many + -- services never send a reply, so using `call` (as DM.event does) would + -- block the GTK main thread until the dbus timeout (~25s). + let mc = DM.eventMethodCall + { methodCallDestination = Just dest + , methodCallPath = path + , methodCallBody = + [ toVariant itemId + , toVariant ("clicked" :: String) + , toVariant (toVariant (0 :: Int32)) + , toVariant ts + ] + } + callNoReply client mc + getPropS :: String -> LayoutNode -> Maybe String getPropS key LayoutNode { lnProps = props } = Map.lookup key props >>= fromVariant @@ -110,17 +114,6 @@ menuItemToggleState :: LayoutNode -> Maybe Int32 menuItemToggleState = getPropI32 "toggle-state" - -sendClicked :: Client -> BusName -> ObjectPath -> Int32 -> Word32 -> IO () -sendClicked client dest path itemId ts = do - -- "clicked" is the common event for activating menu items in the DBusMenu spec. - _ <- callMenu client dest path "Event" - [ toVariant itemId - , toVariant ("clicked" :: String) - , toVariant ("" :: String) -- v (data) - , toVariant ts - ] - pure () populateGtkMenu :: Client -> BusName -> ObjectPath -> Gtk.Menu -> LayoutNode -> IO () populateGtkMenu client dest path gtkMenu root = do diff --git a/src/StatusNotifier/Tray.hs b/src/StatusNotifier/Tray.hs --- a/src/StatusNotifier/Tray.hs +++ b/src/StatusNotifier/Tray.hs @@ -15,6 +15,7 @@ import qualified Data.ByteString as BS import Data.Coerce import Data.Foldable (traverse_) +import Data.GI.Base (unsafeCastTo) import qualified Data.GI.Base.ManagedPtr as ManagedPtr import Data.GI.Base.GError import Data.Int @@ -24,6 +25,7 @@ import Data.Ord import Data.Ratio import qualified Data.Text as T +import qualified GI.DbusmenuGtk3.Objects.Menu as DM import qualified GI.GLib as GLib import GI.GLib.Structs.Bytes import qualified GI.Gdk as Gdk @@ -201,6 +203,8 @@ data TrayClickAction = Activate | SecondaryActivate | PopupMenu +data MenuBackend = LibDBusMenu | HaskellDBusMenu deriving (Eq, Show) + data TrayParams = TrayParams { trayOrientation :: Gtk.Orientation , trayImageSize :: TrayImageSize @@ -210,6 +214,7 @@ , trayLeftClickAction :: TrayClickAction , trayMiddleClickAction :: TrayClickAction , trayRightClickAction :: TrayClickAction + , trayMenuBackend :: MenuBackend } defaultTrayParams :: TrayParams @@ -222,6 +227,7 @@ , trayLeftClickAction = Activate , trayMiddleClickAction = SecondaryActivate , trayRightClickAction = PopupMenu + , trayMenuBackend = LibDBusMenu } buildTray :: Host -> Client -> TrayParams -> IO Gtk.Box @@ -239,6 +245,7 @@ , trayLeftClickAction = leftClickAction , trayMiddleClickAction = middleClickAction , trayRightClickAction = rightClickAction + , trayMenuBackend = menuBackend } = do trayLogger INFO "Building tray" @@ -371,7 +378,10 @@ popupGtkMenu gtkMenu triggerEvent = do Gtk.menuAttachToWidget gtkMenu eventBox Nothing - _ <- Gtk.onWidgetHide gtkMenu (Gtk.widgetDestroy gtkMenu) + _ <- Gtk.onWidgetHide gtkMenu $ + void $ GLib.idleAdd GLib.PRIORITY_DEFAULT_IDLE $ do + Gtk.widgetDestroy gtkMenu + return False Gtk.widgetShowAll gtkMenu evPtr <- ManagedPtr.unsafeManagedPtrCastPtr triggerEvent :: IO (Ptr Gdk.Event) ManagedPtr.withTransient evPtr $ \ev -> @@ -403,7 +413,14 @@ menuPath' <- getInfoAttr menuPath Nothing serviceName traverse_ (\p -> catchAny - (DBusMenu.buildMenu client serviceName p >>= (`popupGtkMenu` event)) + (do gtkMenu <- case menuBackend of + LibDBusMenu -> do + let sn = T.pack (coerce serviceName :: String) + mp = T.pack (coerce p :: String) + DM.menuNew sn mp >>= unsafeCastTo Gtk.Menu + HaskellDBusMenu -> + DBusMenu.buildMenu client serviceName p + popupGtkMenu gtkMenu event) (logActionError "PopupMenu")) menuPath' return False @@ -415,8 +432,6 @@ ScrollDirectionLeft -> Just "horizontal" ScrollDirectionRight -> Just "horizontal" _ -> Nothing - -- deltaX/deltaY are provided only in case of smooth scrolling which - -- is enabled via additional flag, we don't to enable/handle it delta = case direction of ScrollDirectionUp -> -1 ScrollDirectionDown -> 1 @@ -469,12 +484,12 @@ _mainHeight <- getPixbufHeight pixbuf _mainWidth <- getPixbufWidth pixbuf pixbufComposite overlayPixbuf pixbuf - 0 0 -- Top left corner - actualOWidth actualOHeight -- Overlay size - 0 0 -- Offset - 1.0 1.0 -- Scale - InterpTypeBilinear -- InterpType - 255 -- Source image alpha + 0 0 + actualOWidth actualOHeight + 0 0 + 1.0 1.0 + InterpTypeBilinear + 255 return pixbuf getScaledPixBufFromInfo size info =