gtk-strut 0.1.4.0 → 0.1.4.1
raw patch · 5 files changed
+357/−297 lines, 5 filesdep ~data-defaultdep ~gi-gdk3dep ~gi-gtk3setup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: data-default, gi-gdk3, gi-gtk3, hslogger, text, transformers
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- Setup.hs +1/−0
- gtk-strut.cabal +12/−12
- src/Graphics/UI/EWMHStrut.hs +114/−104
- src/Graphics/UI/GIGtkStrut.hs +225/−181
ChangeLog.md view
@@ -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
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
gtk-strut.cabal view
@@ -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 <https://github.com/IvanMalison/gtk-strut#readme>+description: Please see the README on Github at <https://github.com/taffybar/gtk-strut#readme> 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
src/Graphics/UI/EWMHStrut.hs view
@@ -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
src/Graphics/UI/GIGtkStrut.hs view
@@ -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 ]