gtk-sni-tray 0.1.10.3 → 0.1.11.0

raw patch · 5 files changed

+90/−59 lines, 5 filesdep +gi-dbusmenugtk3PVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: gi-dbusmenugtk3

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• app/Main.hs +19/−4
• gtk-sni-tray.cabal +2/−1
• src/StatusNotifier/DBusMenu.hs +37/−44
• src/StatusNotifier/Tray.hs +25/−10

@@ -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

@@ -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

@@ -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 <https://github.com/IvanMalison/gtk-sni-tray#readme> 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

@@ -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

@@ -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 =