Rewrite XMonad.Actions.UpdatePointer bugfix with Control.Exception.try.

This commit is contained in:
Kurnevsky Evgeny 2015-12-30 12:07:33 +03:00
parent 11e0d683af
commit 86280c5063

View File

@ -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))