gtk-sni-tray 0.1.11.0 → 0.1.11.1
raw patch · 5 files changed
+79/−24 lines, 5 files
Files
- ChangeLog.md +14/−0
- app/Main.hs +2/−2
- gtk-sni-tray.cabal +1/−1
- src/StatusNotifier/DBusMenu.hs +19/−7
- src/StatusNotifier/Tray.hs +43/−14
ChangeLog.md view
@@ -1,5 +1,19 @@ # Changelog for gtk-sni-tray +## 0.1.11.1++- Fix menu popups on Wayland/layer-shell: use `menuPopupAtWidget` instead of+ `menuPopupAtPointer` which fails with "no trigger event" when the GdkEvent's+ window is not a valid GDK surface.+- Fix menu item clicks: defer menu widget destruction via `idleAdd` with+ `PRIORITY_LOW` so GTK's `activate` signal fires before the widget is destroyed.+- Fix DBus Event variant wrapping: correctly double-wrap the data parameter+ to produce wire type `v` instead of `i`.+- Send Event DBus calls on a forked thread to avoid blocking the GTK main loop.+- Default menu backend to `HaskellDBusMenu` (pure Haskell implementation).+- Deferred popup for `LibDBusMenu` backend to avoid assertion failures from+ showing the menu before the C library finishes loading the layout.+ ## 0.1.11.0 - Restore `libdbusmenu` (`gi-dbusmenugtk3`) as the default menu backend.
app/Main.hs view
@@ -471,8 +471,8 @@ menuBackendP = option (eitherReader parseMenuBackend) ( long "menu-backend"- <> help "Menu backend: libdbusmenu (default) | haskell"- <> value LibDBusMenu+ <> help "Menu backend: haskell (default) | libdbusmenu"+ <> value HaskellDBusMenu <> metavar "BACKEND" ) where
gtk-sni-tray.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: gtk-sni-tray-version: 0.1.11.0+version: 0.1.11.1 synopsis: A standalone StatusNotifierItem/AppIndicator tray description: Please see the README on Github at <https://github.com/IvanMalison/gtk-sni-tray#readme> category: System
src/StatusNotifier/DBusMenu.hs view
@@ -3,8 +3,9 @@ ( buildMenu ) where +import Control.Concurrent (forkIO) import Control.Exception.Enclosed (catchAny)-import Control.Monad (forM_, when)+import Control.Monad (forM_, void, when) import Data.Int (Int32) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map@@ -66,10 +67,9 @@ 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).+ dbusMenuLogger DEBUG $+ printf "sendClicked: id=%d dest=%s path=%s ts=%d"+ itemId (show dest) (show path) ts let mc = DM.eventMethodCall { methodCallDestination = Just dest , methodCallPath = path@@ -80,7 +80,16 @@ , toVariant ts ] }- callNoReply client mc+ -- Send on a forked thread to avoid blocking GTK; use `call` instead of+ -- `callNoReply` so we can detect service errors.+ void $ forkIO $ catchAny+ (do result <- call client mc+ case result of+ Left err -> dbusMenuLogger WARNING $+ printf "sendClicked: Event error: %s" (show err)+ Right _ -> dbusMenuLogger DEBUG "sendClicked: Event succeeded")+ (\e -> dbusMenuLogger WARNING $+ printf "sendClicked: Event exception: %s" (show e)) getPropS :: String -> LayoutNode -> Maybe String getPropS key LayoutNode { lnProps = props } =@@ -200,9 +209,12 @@ buildMenu :: Client -> BusName -> ObjectPath -> IO Gtk.Menu buildMenu client dest path = do- dbusMenuLogger DEBUG "Building DBusMenu Gtk.Menu"+ dbusMenuLogger DEBUG $+ printf "buildMenu: dest=%s path=%s" (show dest) (show path) _ <- aboutToShow client dest path 0 (_, layout) <- getLayout client dest path 0 (-1) []+ dbusMenuLogger DEBUG $+ printf "buildMenu: root has %d children" (length (lnChildren layout)) menu <- Gtk.menuNew Gtk.widgetSetName menu "tray-menu-root" menuW <- Gtk.toWidget menu
src/StatusNotifier/Tray.hs view
@@ -4,6 +4,7 @@ module StatusNotifier.Tray where import Control.Concurrent.MVar as MV+import Data.IORef (newIORef, readIORef, writeIORef) import Control.Exception.Base import Control.Exception.Enclosed (catchAny) import Control.Monad@@ -227,7 +228,7 @@ , trayLeftClickAction = Activate , trayMiddleClickAction = SecondaryActivate , trayRightClickAction = PopupMenu- , trayMenuBackend = LibDBusMenu+ , trayMenuBackend = HaskellDBusMenu } buildTray :: Host -> Client -> TrayParams -> IO Gtk.Box@@ -376,16 +377,18 @@ , contextButton = eventBox } - popupGtkMenu gtkMenu triggerEvent = do+ popupGtkMenu gtkMenu _triggerEvent = do Gtk.menuAttachToWidget gtkMenu eventBox Nothing _ <- Gtk.onWidgetHide gtkMenu $- void $ GLib.idleAdd GLib.PRIORITY_DEFAULT_IDLE $ do+ void $ GLib.idleAdd GLib.PRIORITY_LOW $ do Gtk.widgetDestroy gtkMenu return False Gtk.widgetShowAll gtkMenu- evPtr <- ManagedPtr.unsafeManagedPtrCastPtr triggerEvent :: IO (Ptr Gdk.Event)- ManagedPtr.withTransient evPtr $ \ev ->- Gtk.menuPopupAtPointer gtkMenu (Just ev)+ -- Use menuPopupAtWidget: menuPopupAtPointer fails on+ -- Wayland/layer-shell with "no trigger event" because the+ -- GdkEvent's window is not a valid GDK surface.+ Gtk.menuPopupAtWidget gtkMenu eventBox+ Gdk.GravitySouth Gdk.GravityNorth Nothing _ <- Gtk.onWidgetButtonPressEvent eventBox $ \event -> do mouseButton <- Gdk.getEventButtonButton event@@ -413,14 +416,40 @@ menuPath' <- getInfoAttr menuPath Nothing serviceName traverse_ (\p -> catchAny- (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)+ (case menuBackend of+ LibDBusMenu -> do+ let sn = T.pack (coerce serviceName :: String)+ mp = T.pack (coerce p :: String)+ gtkMenu <- DM.menuNew sn mp >>= unsafeCastTo Gtk.Menu+ Gtk.menuAttachToWidget gtkMenu eventBox Nothing+ _ <- Gtk.onWidgetHide gtkMenu $+ void $ GLib.idleAdd GLib.PRIORITY_DEFAULT_IDLE $ do+ Gtk.widgetDestroy gtkMenu+ return False+ -- libdbusmenu-gtk fetches the menu layout+ -- asynchronously; showing before the root menuitem+ -- is available triggers assertion failures. Defer+ -- the popup until the menu is populated.+ attemptsRef <- newIORef (0 :: Int)+ _ <- GLib.timeoutAdd GLib.PRIORITY_DEFAULT 50 $ do+ n <- readIORef attemptsRef+ if n >= 100+ then do+ Gtk.widgetDestroy gtkMenu+ return False+ else do+ writeIORef attemptsRef (n + 1)+ children <- Gtk.containerGetChildren gtkMenu+ if null children+ then return True+ else do+ Gtk.widgetShowAll gtkMenu+ Gtk.menuPopupAtPointer gtkMenu Nothing+ return False+ return ()+ HaskellDBusMenu -> do+ gtkMenu <- DBusMenu.buildMenu client serviceName p+ popupGtkMenu gtkMenu event) (logActionError "PopupMenu")) menuPath' return False