diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,10 @@ # Changelog for gtk-strut +## 0.1.4.1 - 2026-05-13 + +- Fix X11 strut sizing and safely handle non-X11 GTK windows. +- Clean up compiler warnings. + ## 0.1.4.0 - Use the `gi-gtk3` and `gi-gdk3` build dependencies, which have been diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/gtk-strut.cabal b/gtk-strut.cabal --- a/gtk-strut.cabal +++ b/gtk-strut.cabal @@ -1,16 +1,16 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.38.2. +-- This file has been generated from package.yaml by hpack version 0.38.3. -- -- see: https://github.com/sol/hpack name: gtk-strut -version: 0.1.4.0 +version: 0.1.4.1 synopsis: Library for creating strut windows with gi-gtk -description: Please see the README on Github at +description: Please see the README on Github at category: System -homepage: https://github.com/IvanMalison/gtk-strut#readme -bug-reports: https://github.com/IvanMalison/gtk-strut/issues +homepage: https://github.com/taffybar/gtk-strut#readme +bug-reports: https://github.com/taffybar/gtk-strut/issues author: Ivan Malison maintainer: IvanMalison@gmail.com copyright: Ivan Malison @@ -23,7 +23,7 @@ source-repository head type: git - location: https://github.com/IvanMalison/gtk-strut + location: https://github.com/taffybar/gtk-strut library exposed-modules: @@ -34,10 +34,10 @@ src build-depends: base >=4.7 && <5 - , data-default - , gi-gdk3 - , gi-gtk3 - , hslogger - , text - , transformers + , data-default >=0.7 && <0.9 + , gi-gdk3 ==3.0.* + , gi-gtk3 ==3.0.* + , hslogger >=1.2 && <1.4 + , text >=1.2 && <2.2 + , transformers >=0.4 && <0.7 default-language: Haskell2010 diff --git a/src/Graphics/UI/EWMHStrut.hs b/src/Graphics/UI/EWMHStrut.hs --- a/src/Graphics/UI/EWMHStrut.hs +++ b/src/Graphics/UI/EWMHStrut.hs @@ -1,121 +1,131 @@ -{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE MonoLocalBinds #-} -module Graphics.UI.EWMHStrut where +{-# LANGUAGE OverloadedStrings #-} -import Control.Monad.IO.Class -import Data.Int -import Data.Text -import Data.Word -import Foreign.C.Types -import Foreign.Marshal.Array -import Foreign.Ptr -import Foreign.Storable +module Graphics.UI.EWMHStrut where +import Control.Monad.IO.Class +import Data.Int +import Foreign.C.Types +import Foreign.Marshal.Array +import Foreign.Ptr +import Foreign.Storable import qualified GI.Gdk as Gdk data EWMHStrutSettings = EWMHStrutSettings - { _left :: Int32 - , _right :: Int32 - , _top :: Int32 - , _bottom :: Int32 - , _left_start_y :: Int32 - , _left_end_y :: Int32 - , _right_start_y :: Int32 - , _right_end_y :: Int32 - , _top_start_x :: Int32 - , _top_end_x :: Int32 - , _bottom_start_x :: Int32 - , _bottom_end_x :: Int32 - } deriving (Show, Eq) - -zeroStrutSettings = EWMHStrutSettings - { _left = 0 - , _right = 0 - , _top = 0 - , _bottom = 0 - , _left_start_y = 0 - , _left_end_y = 0 - , _right_start_y = 0 - , _right_end_y = 0 - , _top_start_x = 0 - , _top_end_x = 0 - , _bottom_start_x = 0 - , _bottom_end_x = 0 + { _left :: Int32, + _right :: Int32, + _top :: Int32, + _bottom :: Int32, + _left_start_y :: Int32, + _left_end_y :: Int32, + _right_start_y :: Int32, + _right_end_y :: Int32, + _top_start_x :: Int32, + _top_end_x :: Int32, + _bottom_start_x :: Int32, + _bottom_end_x :: Int32 } + deriving (Show, Eq) +zeroStrutSettings :: EWMHStrutSettings +zeroStrutSettings = + EWMHStrutSettings + { _left = 0, + _right = 0, + _top = 0, + _bottom = 0, + _left_start_y = 0, + _left_end_y = 0, + _right_start_y = 0, + _right_end_y = 0, + _top_start_x = 0, + _top_end_x = 0, + _bottom_start_x = 0, + _bottom_end_x = 0 + } + scaleStrutSettings :: Int32 -> EWMHStrutSettings -> EWMHStrutSettings -scaleStrutSettings scaleFactor st = st - { _left = _left st * scaleFactor - , _right = _right st * scaleFactor - , _top = _top st * scaleFactor - , _bottom = _bottom st * scaleFactor - , _left_start_y = _left_start_y st * scaleFactor - , _left_end_y = _left_end_y st * scaleFactor - , _right_start_y = _right_start_y st * scaleFactor - , _right_end_y = _right_end_y st * scaleFactor - , _top_start_x = _top_start_x st * scaleFactor - , _top_end_x = _top_end_x st * scaleFactor - , _bottom_start_x = _bottom_start_x st * scaleFactor - , _bottom_end_x = _bottom_end_x st * scaleFactor - } +scaleStrutSettings scaleFactor st = + st + { _left = _left st * scaleFactor, + _right = _right st * scaleFactor, + _top = _top st * scaleFactor, + _bottom = _bottom st * scaleFactor, + _left_start_y = _left_start_y st * scaleFactor, + _left_end_y = _left_end_y st * scaleFactor, + _right_start_y = _right_start_y st * scaleFactor, + _right_end_y = _right_end_y st * scaleFactor, + _top_start_x = _top_start_x st * scaleFactor, + _top_end_x = _top_end_x st * scaleFactor, + _bottom_start_x = _bottom_start_x st * scaleFactor, + _bottom_end_x = _bottom_end_x st * scaleFactor + } -strutSettingsToPtr :: MonadIO m => EWMHStrutSettings -> m (Ptr CULong) -strutSettingsToPtr EWMHStrutSettings - { _left = left - , _right = right - , _top = top - , _bottom = bottom - , _left_start_y = left_start_y - , _left_end_y = left_end_y - , _right_start_y = right_start_y - , _right_end_y = right_end_y - , _top_start_x = top_start_x - , _top_end_x = top_end_x - , _bottom_start_x = bottom_start_x - , _bottom_end_x = bottom_end_x - } = liftIO $ do - arr <- mallocArray 12 - let doPoke off v = pokeElemOff arr off $ fromIntegral v - doPoke 0 left - doPoke 1 right - doPoke 2 top - doPoke 3 bottom - doPoke 4 left_start_y - doPoke 5 left_end_y - doPoke 6 right_start_y - doPoke 7 right_end_y - doPoke 8 top_start_x - doPoke 9 top_end_x - doPoke 10 bottom_start_x - doPoke 11 bottom_end_x - return arr +strutSettingsToPtr :: (MonadIO m) => EWMHStrutSettings -> m (Ptr CULong) +strutSettingsToPtr + EWMHStrutSettings + { _left = left, + _right = right, + _top = top, + _bottom = bottom, + _left_start_y = left_start_y, + _left_end_y = left_end_y, + _right_start_y = right_start_y, + _right_end_y = right_end_y, + _top_start_x = top_start_x, + _top_end_x = top_end_x, + _bottom_start_x = bottom_start_x, + _bottom_end_x = bottom_end_x + } = liftIO $ do + arr <- mallocArray 12 + let doPoke off v = pokeElemOff arr off $ fromIntegral v + doPoke 0 left + doPoke 1 right + doPoke 2 top + doPoke 3 bottom + doPoke 4 left_start_y + doPoke 5 left_end_y + doPoke 6 right_start_y + doPoke 7 right_end_y + doPoke 8 top_start_x + doPoke 9 top_end_x + doPoke 10 bottom_start_x + doPoke 11 bottom_end_x + return arr -foreign import ccall "gdk_property_change" gdk_property_change :: - Ptr Gdk.Window -> - Ptr Gdk.Atom -> Ptr Gdk.Atom -> Int32 -> CUInt -> Ptr CUChar -> Int32 -> IO () +foreign import ccall "gdk_property_change" + gdk_property_change :: + Ptr Gdk.Window -> + Ptr Gdk.Atom -> + Ptr Gdk.Atom -> + Int32 -> + CUInt -> + Ptr CUChar -> + Int32 -> + IO () -propertyChange - :: (Gdk.IsWindow a, MonadIO m) - => a - -> Gdk.Atom - -> Gdk.Atom - -> Int32 - -> Gdk.PropMode - -> Ptr CUChar - -> Int32 - -> m () +propertyChange :: + (Gdk.IsWindow a, MonadIO m) => + a -> + Gdk.Atom -> + Gdk.Atom -> + Int32 -> + Gdk.PropMode -> + Ptr CUChar -> + Int32 -> + m () propertyChange window property type_ format mode data_ nelements = liftIO $ do - window' <- Gdk.unsafeManagedPtrCastPtr window - property' <- Gdk.unsafeManagedPtrGetPtr property - type_' <- Gdk.unsafeManagedPtrGetPtr type_ - let mode' = (fromIntegral . fromEnum) mode - gdk_property_change window' property' type_' format mode' data_ nelements - Gdk.touchManagedPtr window - Gdk.touchManagedPtr property - Gdk.touchManagedPtr type_ - return () + window' <- Gdk.unsafeManagedPtrCastPtr window + property' <- Gdk.unsafeManagedPtrGetPtr property + type_' <- Gdk.unsafeManagedPtrGetPtr type_ + let mode' = (fromIntegral . fromEnum) mode + gdk_property_change window' property' type_' format mode' data_ nelements + Gdk.touchManagedPtr window + Gdk.touchManagedPtr property + Gdk.touchManagedPtr type_ + return () -setStrut :: MonadIO m => Gdk.IsWindow w => w -> EWMHStrutSettings -> m () +setStrut :: (MonadIO m) => (Gdk.IsWindow w) => w -> EWMHStrutSettings -> m () setStrut w settings = do strutAtom <- Gdk.atomIntern "_NET_WM_STRUT_PARTIAL" False cardinalAtom <- Gdk.atomIntern "CARDINAL" False diff --git a/src/Graphics/UI/GIGtkStrut.hs b/src/Graphics/UI/GIGtkStrut.hs --- a/src/Graphics/UI/GIGtkStrut.hs +++ b/src/Graphics/UI/GIGtkStrut.hs @@ -1,78 +1,85 @@ module Graphics.UI.GIGtkStrut - ( defaultStrutConfig - , StrutPosition(..) - , StrutSize(..) - , StrutAlignment(..) - , StrutConfig(..) - , buildStrutWindow - , setupStrutWindow - ) where + ( defaultStrutConfig, + StrutPosition (..), + StrutSize (..), + StrutAlignment (..), + StrutConfig (..), + buildStrutWindow, + setupStrutWindow, + ) +where -import Control.Monad -import Control.Monad.Fail (MonadFail) -import Control.Monad.IO.Class -import Control.Monad.Trans.Class -import Control.Monad.Trans.Maybe -import Data.Default -import Data.Int -import Data.Maybe +import Control.Monad +import Control.Monad.IO.Class +import Data.Default +import Data.IORef +import Data.Int +import Data.Maybe import qualified Data.Text as T import qualified GI.Gdk as Gdk import qualified GI.Gtk as Gtk -import Graphics.UI.EWMHStrut -import System.Log.Logger -import Text.Printf +import Graphics.UI.EWMHStrut +import System.Log.Logger +import Text.Printf -strutLog :: MonadIO m => Priority -> String -> m () +strutLog :: (MonadIO m) => Priority -> String -> m () strutLog p s = liftIO $ logM "Graphics.UI.GIGtkStrut" p s data StrutPosition - = TopPos | BottomPos | LeftPos | RightPos - deriving (Show, Read, Eq) + = TopPos + | BottomPos + | LeftPos + | RightPos + deriving (Show, Read, Eq) data StrutAlignment - = Beginning | Center | End - deriving (Show, Read, Eq) + = Beginning + | Center + | End + deriving (Show, Read, Eq) data StrutSize - = ExactSize Int32 | ScreenRatio Rational - deriving (Show, Read, Eq) + = ExactSize Int32 + | ScreenRatio Rational + deriving (Show, Read, Eq) data StrutConfig = StrutConfig - { strutWidth :: StrutSize - , strutHeight :: StrutSize - , strutXPadding :: Int32 - , strutYPadding :: Int32 - , strutMonitor :: Maybe Int32 - , strutPosition :: StrutPosition - , strutAlignment :: StrutAlignment - , strutDisplayName :: Maybe T.Text - } deriving (Show, Eq) - -defaultStrutConfig = StrutConfig - { strutWidth = ScreenRatio 1 - , strutHeight = ScreenRatio 1 - , strutXPadding = 0 - , strutYPadding = 0 - , strutMonitor = Nothing - , strutPosition = TopPos - , strutAlignment = Beginning - , strutDisplayName = Nothing + { strutWidth :: StrutSize, + strutHeight :: StrutSize, + strutXPadding :: Int32, + strutYPadding :: Int32, + strutMonitor :: Maybe Int32, + strutPosition :: StrutPosition, + strutAlignment :: StrutAlignment, + strutDisplayName :: Maybe T.Text } + deriving (Show, Eq) +defaultStrutConfig :: StrutConfig +defaultStrutConfig = + StrutConfig + { strutWidth = ScreenRatio 1, + strutHeight = ScreenRatio 1, + strutXPadding = 0, + strutYPadding = 0, + strutMonitor = Nothing, + strutPosition = TopPos, + strutAlignment = Beginning, + strutDisplayName = Nothing + } + instance Default StrutConfig where def = StrutConfig - { strutWidth = ScreenRatio 1 - , strutHeight = ScreenRatio 1 - , strutXPadding = 0 - , strutYPadding = 0 - , strutMonitor = Nothing - , strutPosition = TopPos - , strutAlignment = Beginning - , strutDisplayName = Nothing - } - + { strutWidth = ScreenRatio 1, + strutHeight = ScreenRatio 1, + strutXPadding = 0, + strutYPadding = 0, + strutMonitor = Nothing, + strutPosition = TopPos, + strutAlignment = Beginning, + strutDisplayName = Nothing + } -- | Build a strut window to the specifications provided by the 'StrutConfig' -- argument. @@ -85,146 +92,183 @@ -- | Configure the provided 'Gtk.Window' so that it has the properties specified -- by the 'StrutConfig' argument. setupStrutWindow :: (MonadFail m, MonadIO m) => StrutConfig -> Gtk.Window -> m () -setupStrutWindow StrutConfig - { strutWidth = widthSize - , strutHeight = heightSize - , strutXPadding = xpadding - , strutYPadding = ypadding - , strutMonitor = monitorNumber - , strutPosition = position - , strutAlignment = alignment - , strutDisplayName = displayName - } window = do - strutLog DEBUG "Starting strut window setup" - Just display <- maybe Gdk.displayGetDefault Gdk.displayOpen displayName - Just monitor <- maybe (Gdk.displayGetPrimaryMonitor display) - (Gdk.displayGetMonitor display) monitorNumber +setupStrutWindow + StrutConfig + { strutWidth = widthSize, + strutHeight = heightSize, + strutXPadding = xpadding, + strutYPadding = ypadding, + strutMonitor = monitorNumber, + strutPosition = position, + strutAlignment = alignment, + strutDisplayName = displayName + } + window = do + strutLog DEBUG "Starting strut window setup" + Just display <- maybe Gdk.displayGetDefault Gdk.displayOpen displayName + Just monitor <- + maybe + (Gdk.displayGetPrimaryMonitor display) + (Gdk.displayGetMonitor display) + monitorNumber - screen <- Gdk.displayGetDefaultScreen display + screen <- Gdk.displayGetDefaultScreen display - monitorCount <- Gdk.displayGetNMonitors display - allMonitors <- catMaybes <$> mapM (Gdk.displayGetMonitor display) - [0..(monitorCount-1)] - allGeometries <- mapM Gdk.monitorGetGeometry allMonitors + monitorCount <- Gdk.displayGetNMonitors display + allMonitors <- + catMaybes + <$> mapM + (Gdk.displayGetMonitor display) + [0 .. (monitorCount - 1)] + allGeometries <- mapM Gdk.monitorGetGeometry allMonitors - let getFullY geometry = (+) <$> Gdk.getRectangleY geometry - <*> Gdk.getRectangleHeight geometry - getFullX geometry = (+) <$> Gdk.getRectangleX geometry - <*> Gdk.getRectangleWidth geometry + let getFullY geometry = + (+) + <$> Gdk.getRectangleY geometry + <*> Gdk.getRectangleHeight geometry + getFullX geometry = + (+) + <$> Gdk.getRectangleX geometry + <*> Gdk.getRectangleWidth geometry - -- The screen concept actually encapsulates things displayed across multiple - -- monitors, which is why we take the maximum here -- what we really want to - -- know is what is the farthest we can go in each direction on any monitor. - screenWidth <- maximum <$> mapM getFullX allGeometries - screenHeight <- maximum <$> mapM getFullY allGeometries + -- The screen concept actually encapsulates things displayed across multiple + -- monitors, which is why we take the maximum here -- what we really want to + -- know is what is the farthest we can go in each direction on any monitor. + screenWidth <- maximum <$> mapM getFullX allGeometries + screenHeight <- maximum <$> mapM getFullY allGeometries - geometry <- Gdk.newZeroGeometry + geometry <- Gdk.newZeroGeometry - monitorGeometry <- Gdk.monitorGetGeometry monitor - monitorScaleFactor <- Gdk.monitorGetScaleFactor monitor - monitorWidth <- Gdk.getRectangleWidth monitorGeometry - monitorHeight <- Gdk.getRectangleHeight monitorGeometry - monitorX <- Gdk.getRectangleX monitorGeometry - monitorY <- Gdk.getRectangleY monitorGeometry + monitorGeometry <- Gdk.monitorGetGeometry monitor + monitorScaleFactor <- Gdk.monitorGetScaleFactor monitor + monitorWidth <- Gdk.getRectangleWidth monitorGeometry + monitorHeight <- Gdk.getRectangleHeight monitorGeometry + monitorX <- Gdk.getRectangleX monitorGeometry + monitorY <- Gdk.getRectangleY monitorGeometry - let width = - case widthSize of - ExactSize w -> w - ScreenRatio p -> - floor $ p * fromIntegral (monitorWidth - (2 * xpadding)) - height = - case heightSize of - ExactSize h -> h - ScreenRatio p -> - floor $ p * fromIntegral (monitorHeight - (2 * ypadding)) + let width = + case widthSize of + ExactSize w -> w + ScreenRatio p -> + floor $ p * fromIntegral (monitorWidth - (2 * xpadding)) + height = + case heightSize of + ExactSize h -> h + ScreenRatio p -> + floor $ p * fromIntegral (monitorHeight - (2 * ypadding)) - Gdk.setGeometryBaseWidth geometry width - Gdk.setGeometryBaseHeight geometry height - Gdk.setGeometryMinWidth geometry width - Gdk.setGeometryMinHeight geometry height - Gdk.setGeometryMaxWidth geometry width - Gdk.setGeometryMaxHeight geometry height - Gtk.windowSetGeometryHints window (Nothing :: Maybe Gtk.Window) - (Just geometry) allHints + Gdk.setGeometryBaseWidth geometry width + Gdk.setGeometryBaseHeight geometry height + Gdk.setGeometryMinWidth geometry width + Gdk.setGeometryMinHeight geometry height + Gdk.setGeometryMaxWidth geometry width + Gdk.setGeometryMaxHeight geometry height + Gtk.windowSetGeometryHints + window + (Nothing :: Maybe Gtk.Window) + (Just geometry) + allHints - let paddedHeight = height + 2 * ypadding - paddedWidth = width + 2 * xpadding - getAlignedPos dimensionPos dpadding monitorSize barSize = - dimensionPos + - case alignment of - Beginning -> dpadding - Center -> (monitorSize - barSize) `div` 2 - End -> monitorSize - barSize - dpadding - xAligned = getAlignedPos monitorX xpadding monitorWidth width - yAligned = getAlignedPos monitorY ypadding monitorHeight height - (xPos, yPos) = - case position of - TopPos -> (xAligned, monitorY + ypadding) - BottomPos -> (xAligned, monitorY + monitorHeight - height - ypadding) - LeftPos -> (monitorX + xpadding, yAligned) - RightPos -> (monitorX + monitorWidth - width - xpadding, yAligned) + let paddedHeight = height + 2 * ypadding + paddedWidth = width + 2 * xpadding + getAlignedPos dimensionPos dpadding monitorSize barSize = + dimensionPos + + case alignment of + Beginning -> dpadding + Center -> (monitorSize - barSize) `div` 2 + End -> monitorSize - barSize - dpadding + xAligned = getAlignedPos monitorX xpadding monitorWidth width + yAligned = getAlignedPos monitorY ypadding monitorHeight height + (xPos, yPos) = + case position of + TopPos -> (xAligned, monitorY + ypadding) + BottomPos -> (xAligned, monitorY + monitorHeight - height - ypadding) + LeftPos -> (monitorX + xpadding, yAligned) + RightPos -> (monitorX + monitorWidth - width - xpadding, yAligned) - Gtk.windowSetTypeHint window Gdk.WindowTypeHintDock - Gtk.windowSetScreen window screen - Gtk.windowMove window xPos yPos - Gtk.windowSetKeepBelow window True + Gtk.windowSetTypeHint window Gdk.WindowTypeHintDock + Gtk.windowSetScreen window screen + Gtk.windowMove window xPos yPos + Gtk.windowSetKeepBelow window True - let ewmhSettings = - case position of - TopPos -> - zeroStrutSettings - { _top = monitorY + paddedHeight - , _top_start_x = xPos - xpadding - , _top_end_x = xPos + width + xpadding - 1 - } - BottomPos -> - zeroStrutSettings - { _bottom = screenHeight - monitorY - monitorHeight + paddedHeight - , _bottom_start_x = xPos - xpadding - , _bottom_end_x = xPos + width + xpadding - 1 - } - LeftPos -> - zeroStrutSettings - { _left = monitorX + paddedWidth - , _left_start_y = yPos - ypadding - , _left_end_y = yPos + height + ypadding - 1 - } - RightPos -> - zeroStrutSettings - { _right = screenWidth - monitorX - monitorWidth + paddedWidth - , _right_start_y = yPos - ypadding - , _right_end_y = yPos + height + ypadding - 1 - } - scaledStrutSettings = scaleStrutSettings monitorScaleFactor ewmhSettings - setStrutProperties = - void $ runMaybeT $ do - gdkWindow <- MaybeT $ Gtk.widgetGetWindow window - lift $ setStrut gdkWindow scaledStrutSettings - logPairs = - [ ("width", show width) - , ("height", show height) - , ("xPos", show xPos) - , ("yPos", show yPos) - , ("paddedWidth", show paddedWidth) - , ("paddedHeight", show paddedHeight) - , ("monitorWidth", show monitorWidth) - , ("monitorHeight", show monitorHeight) - , ("monitorX", show monitorX) - , ("monitorY", show monitorY) - , ("strutSettings", show ewmhSettings) - , ("scaledStrutSettings", show scaledStrutSettings) - ] + let makeEWMHSettings actualWidth actualHeight = + case position of + TopPos -> + zeroStrutSettings + { _top = monitorY + actualHeight + 2 * ypadding, + _top_start_x = xPos - xpadding, + _top_end_x = xPos + actualWidth + xpadding - 1 + } + BottomPos -> + zeroStrutSettings + { _bottom = screenHeight - monitorY - monitorHeight + actualHeight + 2 * ypadding, + _bottom_start_x = xPos - xpadding, + _bottom_end_x = xPos + actualWidth + xpadding - 1 + } + LeftPos -> + zeroStrutSettings + { _left = monitorX + actualWidth + 2 * xpadding, + _left_start_y = yPos - ypadding, + _left_end_y = yPos + actualHeight + ypadding - 1 + } + RightPos -> + zeroStrutSettings + { _right = screenWidth - monitorX - monitorWidth + actualWidth + 2 * xpadding, + _right_start_y = yPos - ypadding, + _right_end_y = yPos + actualHeight + ypadding - 1 + } + ewmhSettings = makeEWMHSettings width height + scaledStrutSettings = scaleStrutSettings monitorScaleFactor ewmhSettings + setStrutProperties settings = do + mGdkWindow <- Gtk.widgetGetWindow window + case mGdkWindow of + Nothing -> pure False + Just gdkWindow -> do + setStrut gdkWindow settings + pure True + logPairs = + [ ("width", show width), + ("height", show height), + ("xPos", show xPos), + ("yPos", show yPos), + ("paddedWidth", show paddedWidth), + ("paddedHeight", show paddedHeight), + ("monitorWidth", show monitorWidth), + ("monitorHeight", show monitorHeight), + ("monitorX", show monitorX), + ("monitorY", show monitorY), + ("strutSettings", show ewmhSettings), + ("scaledStrutSettings", show scaledStrutSettings) + ] - strutLog DEBUG "Properties:" - mapM_ (\(name, value) -> strutLog WARNING $ printf "%s: %s" name value) logPairs + strutLog DEBUG "Properties:" + mapM_ (\(name, value) -> strutLog WARNING $ printf "%s: %s" name value) logPairs - void $ Gtk.onWidgetRealize window setStrutProperties + lastStrutRef <- liftIO $ newIORef Nothing + let updateStrutProperties settings = liftIO $ do + let scaledSettings = scaleStrutSettings monitorScaleFactor settings + lastSettings <- readIORef lastStrutRef + when (lastSettings /= Just scaledSettings) $ do + strutLog DEBUG $ "Setting strut properties: " ++ show scaledSettings + didSet <- setStrutProperties scaledSettings + when didSet $ + writeIORef lastStrutRef $ + Just scaledSettings + void $ Gtk.onWidgetRealize window $ updateStrutProperties ewmhSettings + void $ Gtk.onWidgetSizeAllocate window $ \allocation -> do + actualWidth <- Gdk.getRectangleWidth allocation + actualHeight <- Gdk.getRectangleHeight allocation + updateStrutProperties $ + makeEWMHSettings + actualWidth + actualHeight + allHints :: [Gdk.WindowHints] allHints = - [ Gdk.WindowHintsMinSize - , Gdk.WindowHintsMaxSize - , Gdk.WindowHintsBaseSize - , Gdk.WindowHintsUserPos - , Gdk.WindowHintsUserSize + [ Gdk.WindowHintsMinSize, + Gdk.WindowHintsMaxSize, + Gdk.WindowHintsBaseSize, + Gdk.WindowHintsUserPos, + Gdk.WindowHintsUserSize ]