mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
Rewrite XMonad.Actions.UpdatePointer bugfix with Control.Exception.try.
This commit is contained in:
parent
11e0d683af
commit
86280c5063
@ -1,3 +1,4 @@
|
|||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonadContrib.UpdatePointer
|
-- Module : XMonadContrib.UpdatePointer
|
||||||
@ -28,7 +29,7 @@ import Control.Arrow
|
|||||||
import Control.Monad
|
import Control.Monad
|
||||||
import XMonad.StackSet (member, peek, screenDetail, current)
|
import XMonad.StackSet (member, peek, screenDetail, current)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import qualified Foreign as Foreign (peek, alloca)
|
import Control.Exception
|
||||||
|
|
||||||
-- $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@:
|
||||||
@ -67,12 +68,10 @@ 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 -- We can't use just getWindowAttributes here bacause
|
Just w -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
|
||||||
-- the window might be closed.
|
return $ case tryAttributes of
|
||||||
maybeAttributes <- io $ getWindowAttributesMaybe dpy w
|
Left (_ :: SomeException) -> defaultRect
|
||||||
return $ case maybeAttributes of
|
Right attributes -> windowAttributesToRectangle attributes
|
||||||
Nothing -> defaultRect
|
|
||||||
Just 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
|
||||||
@ -96,13 +95,6 @@ updatePointer refPos ratio = do
|
|||||||
(round . clip boundsX $ fi rootX)
|
(round . clip boundsX $ fi rootX)
|
||||||
(round . clip boundsY $ fi rootY)
|
(round . clip boundsY $ fi rootY)
|
||||||
|
|
||||||
getWindowAttributesMaybe :: Display -> Window -> IO (Maybe WindowAttributes)
|
|
||||||
getWindowAttributesMaybe d w = Foreign.alloca $ \p -> do
|
|
||||||
status <- xGetWindowAttributes d w p
|
|
||||||
if status /= 0
|
|
||||||
then fmap Just $ Foreign.peek p
|
|
||||||
else return Nothing
|
|
||||||
|
|
||||||
windowAttributesToRectangle :: WindowAttributes -> Rectangle
|
windowAttributesToRectangle :: WindowAttributes -> Rectangle
|
||||||
windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))
|
windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))
|
||||||
(fi (wa_y wa))
|
(fi (wa_y wa))
|
||||||
|
Loading…
x
Reference in New Issue
Block a user