Merge pull request #647 from slotThe/safe-window-attrs

Prefer safe alternatives to getWindowAttributes

XMonad/Actions/ConstrainedResize.hs

@@ -44,8 +44,8 @@ import XMonad
 
 -- | Resize (floating) window with optional aspect ratio constraints.
 mouseResizeWindow :: Window -> Bool -> X ()
-mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
     io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
     mouseDrag (\ex ey -> do

XMonad/Actions/EasyMotion.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
@@ -263,7 +264,7 @@ handleSelectWindow c = do
       visibleWindows :: [Window]
       visibleWindows = toList mappedWins
       sortedOverlayWindows :: X [OverlayWindow]
-      sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows dpy th visibleWindows
+      sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows th visibleWindows
     PerScreenKeys m ->
       fmap concat
         $ sequence
@@ -275,7 +276,7 @@ handleSelectWindow c = do
       visibleWindowsOnScreen :: ScreenId -> [Window]
       visibleWindowsOnScreen sid = filter (`elem` toList mappedWins) $ W.integrate' $ screenById sid >>= W.stack . W.workspace
       sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
-      sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows dpy th (visibleWindowsOnScreen sid)
+      sortedOverlayWindows sid = sortOverlayWindows <$> buildOverlayWindows th (visibleWindowsOnScreen sid)
   status <- io $ grabKeyboard dpy rw True grabModeAsync grabModeAsync currentTime
   if status == grabSuccess
     then do
@@ -298,8 +299,9 @@ handleSelectWindow c = do
   buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]
   buildOverlays = appendChords (maxChordLen c)
 
-  buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow]
-  buildOverlayWindows dpy th ws = sequence $ buildOverlayWin dpy th <$> ws
+  buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow]
+  buildOverlayWindows th = fmap (fromMaybe [] . sequenceA)
+                         . traverse (buildOverlayWin th)
 
   sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
   sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs)
@@ -307,12 +309,13 @@ handleSelectWindow c = do
   makeRect :: WindowAttributes -> Rectangle
   makeRect wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa)) (fi (wa_height wa))
 
-  buildOverlayWin :: Display -> Position -> Window -> X OverlayWindow
-  buildOverlayWin dpy th w = do
-    wAttrs <- io $ getWindowAttributes dpy w
-    let r = overlayF c th $ makeRect wAttrs
-    o <- createNewWindow r Nothing "" True
-    return OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }
+  buildOverlayWin :: Position -> Window -> X (Maybe OverlayWindow)
+  buildOverlayWin th w = safeGetWindowAttributes w >>= \case
+    Nothing     -> pure Nothing
+    Just wAttrs -> do
+      let r = overlayF c th $ makeRect wAttrs
+      o <- createNewWindow r Nothing "" True
+      return . Just $ OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }
 
   -- | Display an overlay with the provided formatting
   displayOverlay :: XMonadFont -> Overlay -> X ()

XMonad/Actions/FlexibleManipulate.hs

@@ -24,9 +24,9 @@ module XMonad.Actions.FlexibleManipulate (
 ) where
 
 import XMonad
-import XMonad.Prelude ((<&>))
+import XMonad.Prelude ((<&>), fi)
 import qualified Prelude as P
-import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, map, otherwise, round, snd, uncurry, ($), (.))
+import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($))
 
 -- $usage
 -- First, add this import to your @~\/.xmonad\/xmonad.hs@:
@@ -80,8 +80,10 @@ position = const 0.5
 -- | Given an interpolation function, implement an appropriate window
 --   manipulation action.
 mouseWindow :: (Double -> Double) -> Window -> X ()
-mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
-    [wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs
+mouseWindow f w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
+    let wpos  = (fi (wa_x wa), fi (wa_y wa))
+        wsize = (fi (wa_width wa), fi (wa_height wa))
     sh <- io $ getWMNormalHints d w
     pointer <- io $ queryPointer d w <&> pointerPos
 
@@ -104,18 +106,10 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
 
   where
     pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
-    winAttrs :: WindowAttributes -> [Pnt]
-    winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
-
 
 -- I'd rather I didn't have to do this, but I hate writing component 2d math
 type Pnt = (Double, Double)
 
-pairUp :: [a] -> [(a,a)]
-pairUp [] = []
-pairUp [_] = []
-pairUp (x:y:xs) = (x, y) : pairUp xs
-
 mapP :: (a -> b) -> (a, a) -> (b, b)
 mapP f (x, y) = (f x, f y)
 zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)

XMonad/Actions/FlexibleResize.hs

@@ -50,8 +50,8 @@ mouseResizeEdgeWindow
   :: Rational -- ^ The size of the area where only one edge is resized.
   -> Window   -- ^ The window to resize.
   -> X ()
-mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
     (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
     let

XMonad/Actions/FloatKeys.hs

@@ -44,8 +44,8 @@ import XMonad.Prelude (fi)
 -- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the
 --   right and @dy@ pixels down.
 keysMoveWindow :: D -> Window -> X ()
-keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     io $ moveWindow d w (fi (fi (wa_x wa) + dx))
                         (fi (fi (wa_y wa) + dy))
     float w
@@ -61,8 +61,8 @@ keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
 -- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen
 -- > keysMoveWindowTo (1024,0) (1, 0)      -- put window in the top right corner
 keysMoveWindowTo :: P -> G -> Window -> X ()
-keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     io $ moveWindow d w (x - round (gx * fi (wa_width wa)))
                         (y - round (gy * fi (wa_height wa)))
     float w
@@ -113,8 +113,8 @@ keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
         ny = round $ fi y + gy * fi h - gy * fi nh
 
 keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
-keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     sh <- io $ getWMNormalHints d w
     let wa_dim = (fi $ wa_width wa, fi $ wa_height wa)
         wa_pos = (fi $ wa_x wa, fi $ wa_y wa)

XMonad/Actions/FloatSnap.hs

@@ -92,8 +92,8 @@ snapMagicMouseResize
     -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window    -- ^ The window to move and resize.
     -> X ()
-snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     (_, _, _, px, py, _, _, _) <- io $ queryPointer d w
     let x = (fromIntegral px - wx wa)/ww wa
         y = (fromIntegral py - wy wa)/wh wa
@@ -119,9 +119,8 @@ snapMagicResize
     -> Maybe Int   -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window      -- ^ The window to move and resize.
     -> X ()
-snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
-
+snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     (xbegin,xend) <- handleAxis True d wa
     (ybegin,yend) <- handleAxis False d wa
 
@@ -168,9 +167,8 @@ snapMagicMove
     -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
     -> Window    -- ^ The window to move.
     -> X ()
-snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
-
+snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     nx <- handleAxis True d wa
     ny <- handleAxis False d wa
 
@@ -208,8 +206,8 @@ snapMove U = doSnapMove False True
 snapMove D = doSnapMove False False
 
 doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
-doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
 
     let (mb,mf) = if rev then (bl,fl)
@@ -247,8 +245,8 @@ snapShrink
 snapShrink = snapResize False
 
 snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
-snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
-    wa <- io $ getWindowAttributes d w
+snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d ->
+  withWindowAttributes d w $ \wa -> do
     mr <- case dir of
               L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
                       return $ case (if grow then mg else ms) of

XMonad/Actions/Navigation2D.hs

@@ -616,11 +616,8 @@ actOnScreens act wrap = withWindowSet $ \winset -> do
 
 -- | Determines whether a given window is mapped
 isMapped :: Window -> X Bool
-isMapped win  =  withDisplay
-              $  \dpy -> io
-              $  (waIsUnmapped /=)
-              .  wa_map_state
-             <$> getWindowAttributes dpy win
+isMapped = fmap (maybe False ((waIsUnmapped /=) .  wa_map_state))
+         . safeGetWindowAttributes
 
 ----------------------------------------------------------------------------------------------------
 ----------------------------------------------------------------------------------------------------

XMonad/Actions/NoBorders.hs

@@ -27,8 +27,7 @@ import XMonad
 toggleBorder :: Window -> X ()
 toggleBorder w = do
     bw <- asks (borderWidth . config)
-    withDisplay $ \d -> io $ do
-        cw <- wa_border_width <$> getWindowAttributes d w
-        if cw == 0
+    withDisplay $ \d -> withWindowAttributes d w $ \wa -> io $
+        if wa_border_width wa == 0
             then setWindowBorderWidth d w bw
             else setWindowBorderWidth d w 0

XMonad/Actions/TiledWindowDragging.hs

@@ -48,10 +48,11 @@ import           XMonad.Layout.DraggingVisualizer
 -- | Create a mouse binding for this to be able to drag your windows around.
 -- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
 dragWindow :: Window -> X ()
-dragWindow window = whenX (isClient window) $ do
+dragWindow window = whenX (isClient window) $ withDisplay $ \dpy ->
+  withWindowAttributes dpy window $ \wa -> do
     focus window
-    (offsetX, offsetY)                <- getPointerOffset window
-    (winX, winY, winWidth, winHeight) <- getWindowPlacement window
+    (offsetX, offsetY)                    <- getPointerOffset window
+    let (winX, winY, winWidth, winHeight)  = getWindowPlacement wa
 
     mouseDrag
         (\posX posY ->
@@ -71,11 +72,8 @@ getPointerOffset win = do
     return (fi oX, fi oY)
 
 -- | return a tuple of windowX, windowY, windowWidth, windowHeight
-getWindowPlacement :: Window -> X (Int, Int, Int, Int)
-getWindowPlacement window = do
-    wa <- withDisplay (\d -> io $ getWindowAttributes d window)
-    return (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)
-
+getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)
+getWindowPlacement wa = (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)
 
 performWindowSwitching :: Window -> X ()
 performWindowSwitching win = do

XMonad/Actions/UpdatePointer.hs

@@ -28,7 +28,6 @@ import XMonad
 import XMonad.Prelude
 import XMonad.StackSet (member, peek, screenDetail, current)
 
-import Control.Exception (SomeException, try)
 import Control.Arrow ((&&&), (***))
 
 -- $usage
@@ -73,10 +72,9 @@ updatePointer refPos ratio = do
   let defaultRect = screenRect $ screenDetail $ current ws
   rect <- case peek ws of
         Nothing -> return defaultRect
-        Just w  -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
-                      return $ case tryAttributes of
-                        Left (_ :: SomeException) -> defaultRect
-                        Right attributes          -> windowAttributesToRectangle attributes
+        Just w  -> maybe defaultRect windowAttributesToRectangle
+               <$> safeGetWindowAttributes w
+
   root <- asks theRoot
   mouseIsMoving <- asks mouseFocused
   (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root

XMonad/Actions/Warp.hs

@@ -91,11 +91,9 @@ warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y
 -- | Warp the pointer to a given position relative to the currently
 --   focused window.  Top left = (0,0), bottom right = (1,1).
 warpToWindow :: Rational -> Rational -> X ()
-warpToWindow h v =
-    withDisplay $ \d ->
-        withFocused $ \w -> do
-            wa <- io $ getWindowAttributes d w
-            warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
+warpToWindow h v = withDisplay $ \d -> withFocused $ \w ->
+  withWindowAttributes d w $ \wa ->
+    warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
 
 -- | Warp the pointer to the given position (top left = (0,0), bottom
 --   right = (1,1)) on the given screen.

XMonad/Actions/WindowMenu.hs

@@ -51,9 +51,9 @@ colorizer _ isFg = do
                 else (nBC, fBC)
 
 windowMenu :: X ()
-windowMenu = withFocused $ \w -> do
+windowMenu = withFocused $ \w -> withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
     tags <- asks (workspaces . config)
-    Rectangle x y wh ht <- getSize w
+    let Rectangle x y wh ht = getSize wa
     Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset
     let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
         originFractY = (fi y - fi sy + fi ht / 2) / fi sht
@@ -69,12 +69,10 @@ windowMenu = withFocused $ \w -> do
                     | tag <- tags ]
     runSelectedAction gsConfig actions
 
-getSize :: Window -> X Rectangle
-getSize w = do
-  d  <- asks display
-  wa <- io $ getWindowAttributes d w
+getSize :: WindowAttributes -> Rectangle
+getSize wa =
   let x = fi $ wa_x wa
       y = fi $ wa_y wa
       wh = fi $ wa_width wa
       ht = fi $ wa_height wa
-  return (Rectangle x y wh ht)
+   in Rectangle x y wh ht

XMonad/Hooks/ManageDocks.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
+{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP, LambdaCase #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.ManageDocks
@@ -42,10 +42,11 @@ import XMonad.Layout.LayoutModifier
 import XMonad.Util.Types
 import XMonad.Util.WindowProperties (getProp32s)
 import qualified XMonad.Util.ExtensibleState as XS
-import XMonad.Prelude (All (..), fi, filterM, foldlM, void, when, (<=<))
+import XMonad.Prelude
 
-import qualified Data.Set as S
-import qualified Data.Map as M
+import qualified Data.Set        as S
+import qualified Data.Map        as M
+import qualified XMonad.StackSet as W
 
 -- $usage
 -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
@@ -200,15 +201,16 @@ getStrut w = do
 -- | Goes through the list of windows and find the gap so that all
 --   STRUT settings are satisfied.
 calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
-calcGap ss = withDisplay $ \dpy -> do
+calcGap ss = do
     rootw <- asks theRoot
     struts <- filter careAbout . concat . M.elems <$> getStrutCache
 
-    -- we grab the window attributes of the root window rather than checking
-    -- the width of the screen because xlib caches this info and it tends to
-    -- be incorrect after RAndR
-    wa <- io $ getWindowAttributes dpy rootw
-    let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
+    -- If possible, we grab the window attributes of the root window rather
+    -- than checking the width of the screen because xlib caches this info
+    -- and it tends to be incorrect after RAndR
+    screen <- safeGetWindowAttributes rootw >>= \case
+        Nothing -> gets $ r2c . screenRect . W.screenDetail . W.current . windowset
+        Just wa -> pure . r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
     return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts
   where careAbout (s,_,_,_) = s `S.member` ss
 

XMonad/Hooks/PositionStoreHooks.hs

@@ -68,10 +68,9 @@ positionStoreManageHook :: Maybe Theme -> ManageHook
 positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook
 
 positionStoreInit :: Maybe Theme -> Window -> X ()
-positionStoreInit mDecoTheme w  = withDisplay $ \d -> do
+positionStoreInit mDecoTheme w  = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
         let decoH = maybe 0 decoHeight mDecoTheme   -- take decoration into account, which - in its current
                                                     -- form - makes windows smaller to make room for it
-        wa <- io $ getWindowAttributes d w
         ws <- gets windowset
         arbitraryOffsetX <- randomIntOffset
         arbitraryOffsetY <- randomIntOffset

XMonad/Hooks/WorkspaceByPos.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE LambdaCase #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.WorkspaceByPos
@@ -40,10 +41,10 @@ workspaceByPos :: ManageHook
 workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask
 
 needsMoving :: Window -> X (Maybe WorkspaceId)
-needsMoving w = withDisplay $ \d -> do
-    -- only relocate windows with non-zero position
-    wa <- io $ getWindowAttributes d w
-    fmap (const Nothing `either` Just) . runExceptT $ do
+needsMoving w = safeGetWindowAttributes w >>= \case
+    Nothing -> pure Nothing
+    Just wa -> fmap (either (const Nothing) Just) . runExceptT $ do
+        -- only relocate windows with non-zero position
         guard $ wa_x wa /= 0 || wa_y wa /= 0
         ws <- gets windowset
         sc <- lift $ fromMaybe (W.current ws)

XMonad/Layout/FixedColumn.hs

@@ -23,17 +23,9 @@ module XMonad.Layout.FixedColumn (
         FixedColumn(..)
 ) where
 
-import Graphics.X11.Xlib (Window, rect_width)
-import Graphics.X11.Xlib.Extras ( getWMNormalHints
-                                , getWindowAttributes
-                                , sh_base_size
-                                , sh_resize_inc
-                                , wa_border_width)
-
-import XMonad.Prelude (fromMaybe, msum, (<&>))
-import XMonad.Core (X, LayoutClass(..), fromMessage, io, withDisplay)
-import XMonad.Layout (Resize(..), IncMasterN(..), tile)
-import XMonad.StackSet as W
+import XMonad
+import XMonad.Prelude
+import qualified XMonad.StackSet as W
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -82,9 +74,10 @@ instance LayoutClass FixedColumn Window where
 --   columns wide, using @inc@ as a resize increment for windows that
 --   don't have one
 widthCols :: Int -> Int -> Window -> X Int
-widthCols inc n w = withDisplay $ \d -> io $ do
-    sh <- getWMNormalHints d w
-    bw <- fromIntegral . wa_border_width <$> getWindowAttributes d w
+widthCols inc n w = do
+    d  <- asks display
+    bw <- asks $ fi . borderWidth . config
+    sh <- io $ getWMNormalHints d w
     let widthHint f = f sh <&> fromIntegral . fst
         oneCol      = fromMaybe inc $ widthHint sh_resize_inc
         base        = fromMaybe 0 $ widthHint sh_base_size

XMonad/Layout/LayoutHints.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
 {-# LANGUAGE ParallelListComp, PatternGuards #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Layout.LayoutHints
@@ -32,8 +33,8 @@ import XMonad(LayoutClass(runLayout), mkAdjust, Window,
               Dimension, Position, Rectangle(Rectangle), D,
               X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS,
               (<&&>), io, applySizeHints, whenX, isClient, withDisplay,
-              getWindowAttributes, getWMNormalHints, WindowAttributes(..))
-import XMonad.Prelude (All (..), fromJust, join, maximumBy, on, sortBy)
+              getWMNormalHints, WindowAttributes(..))
+import XMonad.Prelude
 import qualified XMonad.StackSet as W
 
 import XMonad.Layout.Decoration(isInStack)
@@ -264,8 +265,9 @@ hintsEventHook _ = return (All True)
 
 -- | True if the window's current size does not satisfy its size hints.
 hintsMismatch :: Window -> X Bool
-hintsMismatch w = withDisplay $ \d -> io $ do
-    wa <- getWindowAttributes d w
-    sh <- getWMNormalHints d w
-    let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
-    return $ dim /= applySizeHints 0 sh dim
+hintsMismatch w = safeGetWindowAttributes w >>= \case
+    Nothing -> pure False
+    Just wa -> do
+        sh <- withDisplay $ \d -> io (getWMNormalHints d w)
+        let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
+        return $ dim /= applySizeHints 0 sh dim

XMonad/Layout/LayoutScreens.hs

@@ -62,8 +62,9 @@ import qualified XMonad.StackSet as W
 -- | Modify all screens.
 layoutScreens :: LayoutClass l Int => Int -> l Int -> X ()
 layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."
-layoutScreens nscr l =
-    do rtrect <- asks theRoot >>= getWindowRectangle
+layoutScreens nscr l = asks theRoot >>= \w -> withDisplay $ \d ->
+  withWindowAttributes d w $ \attrs ->
+    do let rtrect = windowRectangle attrs
        (wss, _) <- runLayout (W.Workspace "" l (Just $ W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] })) rtrect
        windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } ->
            let x = W.workspace v
@@ -88,11 +89,9 @@ layoutSplitScreen nscr l =
                                 map (\v -> if W.screen v>W.screen c then v{W.screen = W.screen v + fromIntegral (nscr-1)} else v) vs
                   , W.hidden  = ys }
 
-getWindowRectangle :: Window -> X Rectangle
-getWindowRectangle w = withDisplay $ \d ->
-    do a <- io $ getWindowAttributes d w
-       return $ Rectangle (fromIntegral $ wa_x a)     (fromIntegral $ wa_y a)
-                          (fromIntegral $ wa_width a) (fromIntegral $ wa_height a)
+windowRectangle :: WindowAttributes -> Rectangle
+windowRectangle a = Rectangle (fromIntegral $ wa_x a)     (fromIntegral $ wa_y a)
+                              (fromIntegral $ wa_width a) (fromIntegral $ wa_height a)
 
 newtype FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show)
 

XMonad/Prelude.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE LambdaCase   #-}
 --------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Prelude
@@ -20,8 +21,12 @@ module XMonad.Prelude (
     (!?),
     NonEmpty((:|)),
     notEmpty,
+    safeGetWindowAttributes,
 ) where
 
+import Foreign (alloca, peek)
+import XMonad
+
 import Control.Applicative as Exports
 import Control.Monad       as Exports
 import Data.Bool           as Exports
@@ -68,3 +73,10 @@ chunksOf i xs = chunk : chunksOf i rest
 notEmpty :: HasCallStack => [a] -> NonEmpty a
 notEmpty [] = error "unexpected empty list"
 notEmpty (x:xs) = x :| xs
+
+-- | A safe version of 'Graphics.X11.Extras.getWindowAttributes'.
+safeGetWindowAttributes :: Window -> X (Maybe WindowAttributes)
+safeGetWindowAttributes w = withDisplay $ \dpy -> io . alloca $ \p ->
+  xGetWindowAttributes dpy w p >>= \case
+    0 -> pure Nothing
+    _ -> Just <$> peek p

XMonad/Util/DebugWindow.hs

@@ -23,7 +23,6 @@ import           XMonad.Prelude
 
 import           Codec.Binary.UTF8.String        (decodeString)
 import           Control.Exception                                     as E
-import           Foreign
 import           Foreign.C.String
 import           Numeric                         (showHex)
 import           System.Exit
@@ -35,7 +34,7 @@ debugWindow   :: Window -> X String
 debugWindow 0 =  return "-no window-"
 debugWindow w =  do
   let wx = pad 8 '0' $ showHex w ""
-  w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w)
+  w' <- safeGetWindowAttributes w
   case w' of
     Nothing                                   ->
       return $ "(deleted window " ++ wx ++ ")"
@@ -153,14 +152,6 @@ wrap s =  ' ' : '"' : wrap' s ++ "\""
                   | otherwise  =        s' : wrap' ss
     wrap' ""                   =             ""
 
--- Graphics.X11.Extras.getWindowAttributes is bugggggggy
-safeGetWindowAttributes     :: Display -> Window -> IO (Maybe WindowAttributes)
-safeGetWindowAttributes d w =  alloca $ \p -> do
-  s <- xGetWindowAttributes d w p
-  case s of
-    0 -> return Nothing
-    _ -> Just <$> peek p
-
 -- and so is getCommand
 safeGetCommand     :: Display -> Window -> X [String]
 safeGetCommand d w =  do