mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
Prefer safe alternatives to getWindowAttributes
Whenever possible, prefer the safe wrappers withWindowAttributes or safeGetWindowAttributes to getWindowAttributes. Places where these are not applicable are limited to layouts, where there is not good "default value" to give back in case these calls fail. In these cases, we let the exception handling of the layout mechanism handle it and fall back to the Full layout. Fixes: https://github.com/xmonad/xmonad-contrib/issues/146
This commit is contained in:
parent
528b9d9fde
commit
b6a8069e44
@ -44,8 +44,8 @@ import XMonad
|
|||||||
|
|
||||||
-- | Resize (floating) window with optional aspect ratio constraints.
|
-- | Resize (floating) window with optional aspect ratio constraints.
|
||||||
mouseResizeWindow :: Window -> Bool -> X ()
|
mouseResizeWindow :: Window -> Bool -> X ()
|
||||||
mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
|
mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
|
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
|
||||||
mouseDrag (\ex ey -> do
|
mouseDrag (\ex ey -> do
|
||||||
|
@ -1,4 +1,5 @@
|
|||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
{-# LANGUAGE MultiWayIf #-}
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
@ -263,7 +264,7 @@ handleSelectWindow c = do
|
|||||||
visibleWindows :: [Window]
|
visibleWindows :: [Window]
|
||||||
visibleWindows = toList mappedWins
|
visibleWindows = toList mappedWins
|
||||||
sortedOverlayWindows :: X [OverlayWindow]
|
sortedOverlayWindows :: X [OverlayWindow]
|
||||||
sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows dpy th visibleWindows
|
sortedOverlayWindows = sortOverlayWindows <$> buildOverlayWindows th visibleWindows
|
||||||
PerScreenKeys m ->
|
PerScreenKeys m ->
|
||||||
fmap concat
|
fmap concat
|
||||||
$ sequence
|
$ sequence
|
||||||
@ -275,7 +276,7 @@ handleSelectWindow c = do
|
|||||||
visibleWindowsOnScreen :: ScreenId -> [Window]
|
visibleWindowsOnScreen :: ScreenId -> [Window]
|
||||||
visibleWindowsOnScreen sid = filter (`elem` toList mappedWins) $ W.integrate' $ screenById sid >>= W.stack . W.workspace
|
visibleWindowsOnScreen sid = filter (`elem` toList mappedWins) $ W.integrate' $ screenById sid >>= W.stack . W.workspace
|
||||||
sortedOverlayWindows :: ScreenId -> X [OverlayWindow]
|
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
|
status <- io $ grabKeyboard dpy rw True grabModeAsync grabModeAsync currentTime
|
||||||
if status == grabSuccess
|
if status == grabSuccess
|
||||||
then do
|
then do
|
||||||
@ -298,8 +299,9 @@ handleSelectWindow c = do
|
|||||||
buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]
|
buildOverlays :: [KeySym] -> [OverlayWindow] -> [Overlay]
|
||||||
buildOverlays = appendChords (maxChordLen c)
|
buildOverlays = appendChords (maxChordLen c)
|
||||||
|
|
||||||
buildOverlayWindows :: Display -> Position -> [Window] -> X [OverlayWindow]
|
buildOverlayWindows :: Position -> [Window] -> X [OverlayWindow]
|
||||||
buildOverlayWindows dpy th ws = sequence $ buildOverlayWin dpy th <$> ws
|
buildOverlayWindows th = fmap (fromMaybe [] . sequenceA)
|
||||||
|
. traverse (buildOverlayWin th)
|
||||||
|
|
||||||
sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
|
sortOverlayWindows :: [OverlayWindow] -> [OverlayWindow]
|
||||||
sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs)
|
sortOverlayWindows = sortOn ((wa_x &&& wa_y) . attrs)
|
||||||
@ -307,12 +309,13 @@ handleSelectWindow c = do
|
|||||||
makeRect :: WindowAttributes -> Rectangle
|
makeRect :: WindowAttributes -> Rectangle
|
||||||
makeRect wa = Rectangle (fi (wa_x wa)) (fi (wa_y wa)) (fi (wa_width wa)) (fi (wa_height wa))
|
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 :: Position -> Window -> X (Maybe OverlayWindow)
|
||||||
buildOverlayWin dpy th w = do
|
buildOverlayWin th w = safeGetWindowAttributes w >>= \case
|
||||||
wAttrs <- io $ getWindowAttributes dpy w
|
Nothing -> pure Nothing
|
||||||
let r = overlayF c th $ makeRect wAttrs
|
Just wAttrs -> do
|
||||||
o <- createNewWindow r Nothing "" True
|
let r = overlayF c th $ makeRect wAttrs
|
||||||
return OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }
|
o <- createNewWindow r Nothing "" True
|
||||||
|
return . Just $ OverlayWindow { rect=r, overlay=o, win=w, attrs=wAttrs }
|
||||||
|
|
||||||
-- | Display an overlay with the provided formatting
|
-- | Display an overlay with the provided formatting
|
||||||
displayOverlay :: XMonadFont -> Overlay -> X ()
|
displayOverlay :: XMonadFont -> Overlay -> X ()
|
||||||
|
@ -24,9 +24,9 @@ module XMonad.Actions.FlexibleManipulate (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad
|
import XMonad
|
||||||
import XMonad.Prelude ((<&>))
|
import XMonad.Prelude ((<&>), fi)
|
||||||
import qualified Prelude as P
|
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
|
-- $usage
|
||||||
-- First, add this import to your @~\/.xmonad\/xmonad.hs@:
|
-- 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
|
-- | Given an interpolation function, implement an appropriate window
|
||||||
-- manipulation action.
|
-- manipulation action.
|
||||||
mouseWindow :: (Double -> Double) -> Window -> X ()
|
mouseWindow :: (Double -> Double) -> Window -> X ()
|
||||||
mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
|
mouseWindow f w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
[wpos, wsize] <- io $ getWindowAttributes d w <&> winAttrs
|
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
|
sh <- io $ getWMNormalHints d w
|
||||||
pointer <- io $ queryPointer d w <&> pointerPos
|
pointer <- io $ queryPointer d w <&> pointerPos
|
||||||
|
|
||||||
@ -104,18 +106,10 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
|
|||||||
|
|
||||||
where
|
where
|
||||||
pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
|
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
|
-- I'd rather I didn't have to do this, but I hate writing component 2d math
|
||||||
type Pnt = (Double, Double)
|
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 :: (a -> b) -> (a, a) -> (b, b)
|
||||||
mapP f (x, y) = (f x, f y)
|
mapP f (x, y) = (f x, f y)
|
||||||
zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)
|
zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)
|
||||||
|
@ -50,8 +50,8 @@ mouseResizeEdgeWindow
|
|||||||
:: Rational -- ^ The size of the area where only one edge is resized.
|
:: Rational -- ^ The size of the area where only one edge is resized.
|
||||||
-> Window -- ^ The window to resize.
|
-> Window -- ^ The window to resize.
|
||||||
-> X ()
|
-> X ()
|
||||||
mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
|
mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
(_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
|
(_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
|
||||||
let
|
let
|
||||||
|
@ -44,8 +44,8 @@ import XMonad.Prelude (fi)
|
|||||||
-- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the
|
-- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the
|
||||||
-- right and @dy@ pixels down.
|
-- right and @dy@ pixels down.
|
||||||
keysMoveWindow :: D -> Window -> X ()
|
keysMoveWindow :: D -> Window -> X ()
|
||||||
keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
|
keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
io $ moveWindow d w (fi (fi (wa_x wa) + dx))
|
io $ moveWindow d w (fi (fi (wa_x wa) + dx))
|
||||||
(fi (fi (wa_y wa) + dy))
|
(fi (fi (wa_y wa) + dy))
|
||||||
float w
|
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 (512,384) (1%2, 1%2) -- center the window on screen
|
||||||
-- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner
|
-- > keysMoveWindowTo (1024,0) (1, 0) -- put window in the top right corner
|
||||||
keysMoveWindowTo :: P -> G -> Window -> X ()
|
keysMoveWindowTo :: P -> G -> Window -> X ()
|
||||||
keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
|
keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
io $ moveWindow d w (x - round (gx * fi (wa_width wa)))
|
io $ moveWindow d w (x - round (gx * fi (wa_width wa)))
|
||||||
(y - round (gy * fi (wa_height wa)))
|
(y - round (gy * fi (wa_height wa)))
|
||||||
float w
|
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
|
ny = round $ fi y + gy * fi h - gy * fi nh
|
||||||
|
|
||||||
keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
|
keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
|
||||||
keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
|
keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
sh <- io $ getWMNormalHints d w
|
sh <- io $ getWMNormalHints d w
|
||||||
let wa_dim = (fi $ wa_width wa, fi $ wa_height wa)
|
let wa_dim = (fi $ wa_width wa, fi $ wa_height wa)
|
||||||
wa_pos = (fi $ wa_x wa, fi $ wa_y wa)
|
wa_pos = (fi $ wa_x wa, fi $ wa_y wa)
|
||||||
|
@ -92,8 +92,8 @@ snapMagicMouseResize
|
|||||||
-> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
|
-> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
|
||||||
-> Window -- ^ The window to move and resize.
|
-> Window -- ^ The window to move and resize.
|
||||||
-> X ()
|
-> X ()
|
||||||
snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
(_, _, _, px, py, _, _, _) <- io $ queryPointer d w
|
(_, _, _, px, py, _, _, _) <- io $ queryPointer d w
|
||||||
let x = (fromIntegral px - wx wa)/ww wa
|
let x = (fromIntegral px - wx wa)/ww wa
|
||||||
y = (fromIntegral py - wy wa)/wh 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.
|
-> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
|
||||||
-> Window -- ^ The window to move and resize.
|
-> Window -- ^ The window to move and resize.
|
||||||
-> X ()
|
-> X ()
|
||||||
snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
|
|
||||||
(xbegin,xend) <- handleAxis True d wa
|
(xbegin,xend) <- handleAxis True d wa
|
||||||
(ybegin,yend) <- handleAxis False 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.
|
-> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
|
||||||
-> Window -- ^ The window to move.
|
-> Window -- ^ The window to move.
|
||||||
-> X ()
|
-> X ()
|
||||||
snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
|
snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
|
|
||||||
nx <- handleAxis True d wa
|
nx <- handleAxis True d wa
|
||||||
ny <- handleAxis False d wa
|
ny <- handleAxis False d wa
|
||||||
|
|
||||||
@ -208,8 +206,8 @@ snapMove U = doSnapMove False True
|
|||||||
snapMove D = doSnapMove False False
|
snapMove D = doSnapMove False False
|
||||||
|
|
||||||
doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
|
doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
|
||||||
doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
|
doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
|
((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
|
||||||
|
|
||||||
let (mb,mf) = if rev then (bl,fl)
|
let (mb,mf) = if rev then (bl,fl)
|
||||||
@ -247,8 +245,8 @@ snapShrink
|
|||||||
snapShrink = snapResize False
|
snapShrink = snapResize False
|
||||||
|
|
||||||
snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
|
snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
|
||||||
snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
|
snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d ->
|
||||||
wa <- io $ getWindowAttributes d w
|
withWindowAttributes d w $ \wa -> do
|
||||||
mr <- case dir of
|
mr <- case dir of
|
||||||
L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
|
L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
|
||||||
return $ case (if grow then mg else ms) of
|
return $ case (if grow then mg else ms) of
|
||||||
|
@ -616,11 +616,8 @@ actOnScreens act wrap = withWindowSet $ \winset -> do
|
|||||||
|
|
||||||
-- | Determines whether a given window is mapped
|
-- | Determines whether a given window is mapped
|
||||||
isMapped :: Window -> X Bool
|
isMapped :: Window -> X Bool
|
||||||
isMapped win = withDisplay
|
isMapped = fmap (maybe False ((waIsUnmapped /=) . wa_map_state))
|
||||||
$ \dpy -> io
|
. safeGetWindowAttributes
|
||||||
$ (waIsUnmapped /=)
|
|
||||||
. wa_map_state
|
|
||||||
<$> getWindowAttributes dpy win
|
|
||||||
|
|
||||||
----------------------------------------------------------------------------------------------------
|
----------------------------------------------------------------------------------------------------
|
||||||
----------------------------------------------------------------------------------------------------
|
----------------------------------------------------------------------------------------------------
|
||||||
|
@ -27,8 +27,7 @@ import XMonad
|
|||||||
toggleBorder :: Window -> X ()
|
toggleBorder :: Window -> X ()
|
||||||
toggleBorder w = do
|
toggleBorder w = do
|
||||||
bw <- asks (borderWidth . config)
|
bw <- asks (borderWidth . config)
|
||||||
withDisplay $ \d -> io $ do
|
withDisplay $ \d -> withWindowAttributes d w $ \wa -> io $
|
||||||
cw <- wa_border_width <$> getWindowAttributes d w
|
if wa_border_width wa == 0
|
||||||
if cw == 0
|
|
||||||
then setWindowBorderWidth d w bw
|
then setWindowBorderWidth d w bw
|
||||||
else setWindowBorderWidth d w 0
|
else setWindowBorderWidth d w 0
|
||||||
|
@ -48,10 +48,11 @@ import XMonad.Layout.DraggingVisualizer
|
|||||||
-- | Create a mouse binding for this to be able to drag your windows around.
|
-- | Create a mouse binding for this to be able to drag your windows around.
|
||||||
-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
|
-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
|
||||||
dragWindow :: Window -> X ()
|
dragWindow :: Window -> X ()
|
||||||
dragWindow window = whenX (isClient window) $ do
|
dragWindow window = whenX (isClient window) $ withDisplay $ \dpy ->
|
||||||
|
withWindowAttributes dpy window $ \wa -> do
|
||||||
focus window
|
focus window
|
||||||
(offsetX, offsetY) <- getPointerOffset window
|
(offsetX, offsetY) <- getPointerOffset window
|
||||||
(winX, winY, winWidth, winHeight) <- getWindowPlacement window
|
let (winX, winY, winWidth, winHeight) = getWindowPlacement wa
|
||||||
|
|
||||||
mouseDrag
|
mouseDrag
|
||||||
(\posX posY ->
|
(\posX posY ->
|
||||||
@ -71,11 +72,8 @@ getPointerOffset win = do
|
|||||||
return (fi oX, fi oY)
|
return (fi oX, fi oY)
|
||||||
|
|
||||||
-- | return a tuple of windowX, windowY, windowWidth, windowHeight
|
-- | return a tuple of windowX, windowY, windowWidth, windowHeight
|
||||||
getWindowPlacement :: Window -> X (Int, Int, Int, Int)
|
getWindowPlacement :: WindowAttributes -> (Int, Int, Int, Int)
|
||||||
getWindowPlacement window = do
|
getWindowPlacement wa = (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)
|
||||||
wa <- withDisplay (\d -> io $ getWindowAttributes d window)
|
|
||||||
return (fi $ wa_x wa, fi $ wa_y wa, fi $ wa_width wa, fi $ wa_height wa)
|
|
||||||
|
|
||||||
|
|
||||||
performWindowSwitching :: Window -> X ()
|
performWindowSwitching :: Window -> X ()
|
||||||
performWindowSwitching win = do
|
performWindowSwitching win = do
|
||||||
|
@ -28,7 +28,6 @@ import XMonad
|
|||||||
import XMonad.Prelude
|
import XMonad.Prelude
|
||||||
import XMonad.StackSet (member, peek, screenDetail, current)
|
import XMonad.StackSet (member, peek, screenDetail, current)
|
||||||
|
|
||||||
import Control.Exception (SomeException, try)
|
|
||||||
import Control.Arrow ((&&&), (***))
|
import Control.Arrow ((&&&), (***))
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
@ -73,10 +72,9 @@ updatePointer refPos ratio = do
|
|||||||
let defaultRect = screenRect $ screenDetail $ current ws
|
let defaultRect = screenRect $ screenDetail $ current ws
|
||||||
rect <- case peek ws of
|
rect <- case peek ws of
|
||||||
Nothing -> return defaultRect
|
Nothing -> return defaultRect
|
||||||
Just w -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
|
Just w -> maybe defaultRect windowAttributesToRectangle
|
||||||
return $ case tryAttributes of
|
<$> safeGetWindowAttributes w
|
||||||
Left (_ :: SomeException) -> defaultRect
|
|
||||||
Right attributes -> windowAttributesToRectangle attributes
|
|
||||||
root <- asks theRoot
|
root <- asks theRoot
|
||||||
mouseIsMoving <- asks mouseFocused
|
mouseIsMoving <- asks mouseFocused
|
||||||
(_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root
|
(_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root
|
||||||
|
@ -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
|
-- | Warp the pointer to a given position relative to the currently
|
||||||
-- focused window. Top left = (0,0), bottom right = (1,1).
|
-- focused window. Top left = (0,0), bottom right = (1,1).
|
||||||
warpToWindow :: Rational -> Rational -> X ()
|
warpToWindow :: Rational -> Rational -> X ()
|
||||||
warpToWindow h v =
|
warpToWindow h v = withDisplay $ \d -> withFocused $ \w ->
|
||||||
withDisplay $ \d ->
|
withWindowAttributes d w $ \wa ->
|
||||||
withFocused $ \w -> do
|
warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
|
||||||
wa <- io $ getWindowAttributes d w
|
|
||||||
warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
|
|
||||||
|
|
||||||
-- | Warp the pointer to the given position (top left = (0,0), bottom
|
-- | Warp the pointer to the given position (top left = (0,0), bottom
|
||||||
-- right = (1,1)) on the given screen.
|
-- right = (1,1)) on the given screen.
|
||||||
|
@ -51,9 +51,9 @@ colorizer _ isFg = do
|
|||||||
else (nBC, fBC)
|
else (nBC, fBC)
|
||||||
|
|
||||||
windowMenu :: X ()
|
windowMenu :: X ()
|
||||||
windowMenu = withFocused $ \w -> do
|
windowMenu = withFocused $ \w -> withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
|
||||||
tags <- asks (workspaces . config)
|
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
|
Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset
|
||||||
let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
|
let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
|
||||||
originFractY = (fi y - fi sy + fi ht / 2) / fi sht
|
originFractY = (fi y - fi sy + fi ht / 2) / fi sht
|
||||||
@ -69,12 +69,10 @@ windowMenu = withFocused $ \w -> do
|
|||||||
| tag <- tags ]
|
| tag <- tags ]
|
||||||
runSelectedAction gsConfig actions
|
runSelectedAction gsConfig actions
|
||||||
|
|
||||||
getSize :: Window -> X Rectangle
|
getSize :: WindowAttributes -> Rectangle
|
||||||
getSize w = do
|
getSize wa =
|
||||||
d <- asks display
|
|
||||||
wa <- io $ getWindowAttributes d w
|
|
||||||
let x = fi $ wa_x wa
|
let x = fi $ wa_x wa
|
||||||
y = fi $ wa_y wa
|
y = fi $ wa_y wa
|
||||||
wh = fi $ wa_width wa
|
wh = fi $ wa_width wa
|
||||||
ht = fi $ wa_height wa
|
ht = fi $ wa_height wa
|
||||||
return (Rectangle x y wh ht)
|
in Rectangle x y wh ht
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
|
{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP, LambdaCase #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Hooks.ManageDocks
|
-- Module : XMonad.Hooks.ManageDocks
|
||||||
@ -42,10 +42,11 @@ import XMonad.Layout.LayoutModifier
|
|||||||
import XMonad.Util.Types
|
import XMonad.Util.Types
|
||||||
import XMonad.Util.WindowProperties (getProp32s)
|
import XMonad.Util.WindowProperties (getProp32s)
|
||||||
import qualified XMonad.Util.ExtensibleState as XS
|
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.Set as S
|
||||||
import qualified Data.Map as M
|
import qualified Data.Map as M
|
||||||
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
|
-- 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
|
-- | Goes through the list of windows and find the gap so that all
|
||||||
-- STRUT settings are satisfied.
|
-- STRUT settings are satisfied.
|
||||||
calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
|
calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
|
||||||
calcGap ss = withDisplay $ \dpy -> do
|
calcGap ss = do
|
||||||
rootw <- asks theRoot
|
rootw <- asks theRoot
|
||||||
struts <- filter careAbout . concat . M.elems <$> getStrutCache
|
struts <- filter careAbout . concat . M.elems <$> getStrutCache
|
||||||
|
|
||||||
-- we grab the window attributes of the root window rather than checking
|
-- If possible, we grab the window attributes of the root window rather
|
||||||
-- the width of the screen because xlib caches this info and it tends to
|
-- than checking the width of the screen because xlib caches this info
|
||||||
-- be incorrect after RAndR
|
-- and it tends to be incorrect after RAndR
|
||||||
wa <- io $ getWindowAttributes dpy rootw
|
screen <- safeGetWindowAttributes rootw >>= \case
|
||||||
let screen = r2c $ Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa) (fi $ wa_height wa)
|
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
|
return $ \r -> c2r $ foldr (reduce screen) (r2c r) struts
|
||||||
where careAbout (s,_,_,_) = s `S.member` ss
|
where careAbout (s,_,_,_) = s `S.member` ss
|
||||||
|
|
||||||
|
@ -68,10 +68,9 @@ positionStoreManageHook :: Maybe Theme -> ManageHook
|
|||||||
positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook
|
positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook
|
||||||
|
|
||||||
positionStoreInit :: Maybe Theme -> Window -> X ()
|
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
|
let decoH = maybe 0 decoHeight mDecoTheme -- take decoration into account, which - in its current
|
||||||
-- form - makes windows smaller to make room for it
|
-- form - makes windows smaller to make room for it
|
||||||
wa <- io $ getWindowAttributes d w
|
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
arbitraryOffsetX <- randomIntOffset
|
arbitraryOffsetX <- randomIntOffset
|
||||||
arbitraryOffsetY <- randomIntOffset
|
arbitraryOffsetY <- randomIntOffset
|
||||||
|
@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
----------------------------------------------------------------------------
|
----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Hooks.WorkspaceByPos
|
-- Module : XMonad.Hooks.WorkspaceByPos
|
||||||
@ -40,10 +41,10 @@ workspaceByPos :: ManageHook
|
|||||||
workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask
|
workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask
|
||||||
|
|
||||||
needsMoving :: Window -> X (Maybe WorkspaceId)
|
needsMoving :: Window -> X (Maybe WorkspaceId)
|
||||||
needsMoving w = withDisplay $ \d -> do
|
needsMoving w = safeGetWindowAttributes w >>= \case
|
||||||
-- only relocate windows with non-zero position
|
Nothing -> pure Nothing
|
||||||
wa <- io $ getWindowAttributes d w
|
Just wa -> fmap (either (const Nothing) Just) . runExceptT $ do
|
||||||
fmap (const Nothing `either` Just) . runExceptT $ do
|
-- only relocate windows with non-zero position
|
||||||
guard $ wa_x wa /= 0 || wa_y wa /= 0
|
guard $ wa_x wa /= 0 || wa_y wa /= 0
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
sc <- lift $ fromMaybe (W.current ws)
|
sc <- lift $ fromMaybe (W.current ws)
|
||||||
|
@ -23,17 +23,9 @@ module XMonad.Layout.FixedColumn (
|
|||||||
FixedColumn(..)
|
FixedColumn(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Graphics.X11.Xlib (Window, rect_width)
|
import XMonad
|
||||||
import Graphics.X11.Xlib.Extras ( getWMNormalHints
|
import XMonad.Prelude
|
||||||
, getWindowAttributes
|
import qualified XMonad.StackSet as W
|
||||||
, 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
|
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
-- 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
|
-- columns wide, using @inc@ as a resize increment for windows that
|
||||||
-- don't have one
|
-- don't have one
|
||||||
widthCols :: Int -> Int -> Window -> X Int
|
widthCols :: Int -> Int -> Window -> X Int
|
||||||
widthCols inc n w = withDisplay $ \d -> io $ do
|
widthCols inc n w = do
|
||||||
sh <- getWMNormalHints d w
|
d <- asks display
|
||||||
bw <- fromIntegral . wa_border_width <$> getWindowAttributes d w
|
bw <- asks $ fi . borderWidth . config
|
||||||
|
sh <- io $ getWMNormalHints d w
|
||||||
let widthHint f = f sh <&> fromIntegral . fst
|
let widthHint f = f sh <&> fromIntegral . fst
|
||||||
oneCol = fromMaybe inc $ widthHint sh_resize_inc
|
oneCol = fromMaybe inc $ widthHint sh_resize_inc
|
||||||
base = fromMaybe 0 $ widthHint sh_base_size
|
base = fromMaybe 0 $ widthHint sh_base_size
|
||||||
|
@ -1,6 +1,7 @@
|
|||||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE ParallelListComp, PatternGuards #-}
|
{-# LANGUAGE ParallelListComp, PatternGuards #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
{-# LANGUAGE LambdaCase #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Layout.LayoutHints
|
-- Module : XMonad.Layout.LayoutHints
|
||||||
@ -32,8 +33,8 @@ import XMonad(LayoutClass(runLayout), mkAdjust, Window,
|
|||||||
Dimension, Position, Rectangle(Rectangle), D,
|
Dimension, Position, Rectangle(Rectangle), D,
|
||||||
X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS,
|
X, refresh, Event(..), propertyNotify, wM_NORMAL_HINTS,
|
||||||
(<&&>), io, applySizeHints, whenX, isClient, withDisplay,
|
(<&&>), io, applySizeHints, whenX, isClient, withDisplay,
|
||||||
getWindowAttributes, getWMNormalHints, WindowAttributes(..))
|
getWMNormalHints, WindowAttributes(..))
|
||||||
import XMonad.Prelude (All (..), fromJust, join, maximumBy, on, sortBy)
|
import XMonad.Prelude
|
||||||
import qualified XMonad.StackSet as W
|
import qualified XMonad.StackSet as W
|
||||||
|
|
||||||
import XMonad.Layout.Decoration(isInStack)
|
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.
|
-- | True if the window's current size does not satisfy its size hints.
|
||||||
hintsMismatch :: Window -> X Bool
|
hintsMismatch :: Window -> X Bool
|
||||||
hintsMismatch w = withDisplay $ \d -> io $ do
|
hintsMismatch w = safeGetWindowAttributes w >>= \case
|
||||||
wa <- getWindowAttributes d w
|
Nothing -> pure False
|
||||||
sh <- getWMNormalHints d w
|
Just wa -> do
|
||||||
let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
|
sh <- withDisplay $ \d -> io (getWMNormalHints d w)
|
||||||
return $ dim /= applySizeHints 0 sh dim
|
let dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
|
||||||
|
return $ dim /= applySizeHints 0 sh dim
|
||||||
|
@ -62,8 +62,9 @@ import qualified XMonad.StackSet as W
|
|||||||
-- | Modify all screens.
|
-- | Modify all screens.
|
||||||
layoutScreens :: LayoutClass l Int => Int -> l Int -> X ()
|
layoutScreens :: LayoutClass l Int => Int -> l Int -> X ()
|
||||||
layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."
|
layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."
|
||||||
layoutScreens nscr l =
|
layoutScreens nscr l = asks theRoot >>= \w -> withDisplay $ \d ->
|
||||||
do rtrect <- asks theRoot >>= getWindowRectangle
|
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
|
(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 } ->
|
windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } ->
|
||||||
let x = W.workspace v
|
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
|
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 }
|
, W.hidden = ys }
|
||||||
|
|
||||||
getWindowRectangle :: Window -> X Rectangle
|
windowRectangle :: WindowAttributes -> Rectangle
|
||||||
getWindowRectangle w = withDisplay $ \d ->
|
windowRectangle a = Rectangle (fromIntegral $ wa_x a) (fromIntegral $ wa_y a)
|
||||||
do a <- io $ getWindowAttributes d w
|
(fromIntegral $ wa_width a) (fromIntegral $ wa_height a)
|
||||||
return $ 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)
|
newtype FixedLayout a = FixedLayout [Rectangle] deriving (Read,Show)
|
||||||
|
|
||||||
|
@ -23,7 +23,6 @@ import XMonad.Prelude
|
|||||||
|
|
||||||
import Codec.Binary.UTF8.String (decodeString)
|
import Codec.Binary.UTF8.String (decodeString)
|
||||||
import Control.Exception as E
|
import Control.Exception as E
|
||||||
import Foreign
|
|
||||||
import Foreign.C.String
|
import Foreign.C.String
|
||||||
import Numeric (showHex)
|
import Numeric (showHex)
|
||||||
import System.Exit
|
import System.Exit
|
||||||
@ -35,7 +34,7 @@ debugWindow :: Window -> X String
|
|||||||
debugWindow 0 = return "-no window-"
|
debugWindow 0 = return "-no window-"
|
||||||
debugWindow w = do
|
debugWindow w = do
|
||||||
let wx = pad 8 '0' $ showHex w ""
|
let wx = pad 8 '0' $ showHex w ""
|
||||||
w' <- withDisplay $ \d -> io (safeGetWindowAttributes d w)
|
w' <- safeGetWindowAttributes w
|
||||||
case w' of
|
case w' of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
return $ "(deleted window " ++ wx ++ ")"
|
return $ "(deleted window " ++ wx ++ ")"
|
||||||
|
Loading…
x
Reference in New Issue
Block a user