mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 11:30:22 -07:00
UpdatePointer bugfix.
This commit is contained in:
parent
061edbd954
commit
11e0d683af
@ -1,7 +1,7 @@
|
|||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonadContrib.UpdatePointer
|
-- Module : XMonadContrib.UpdatePointer
|
||||||
-- Copyright : (c) Robert Marlow <robreim@bobturf.org>
|
-- Copyright : (c) Robert Marlow <robreim@bobturf.org>, 2015 Evgeny Kurnevsky
|
||||||
-- License : BSD3-style (see LICENSE)
|
-- License : BSD3-style (see LICENSE)
|
||||||
--
|
--
|
||||||
-- Maintainer : Robert Marlow <robreim@bobturf.org>
|
-- Maintainer : Robert Marlow <robreim@bobturf.org>
|
||||||
@ -28,6 +28,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)
|
||||||
|
|
||||||
-- $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@:
|
||||||
@ -63,9 +64,15 @@ updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X ()
|
|||||||
updatePointer refPos ratio = do
|
updatePointer refPos ratio = do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
dpy <- asks display
|
dpy <- asks display
|
||||||
|
let defaultRect = screenRect $ screenDetail $ current ws
|
||||||
rect <- case peek ws of
|
rect <- case peek ws of
|
||||||
Nothing -> return $ (screenRect . screenDetail .current) ws
|
Nothing -> return defaultRect
|
||||||
Just w -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w)
|
Just w -> do -- We can't use just getWindowAttributes here bacause
|
||||||
|
-- the window might be closed.
|
||||||
|
maybeAttributes <- io $ getWindowAttributesMaybe dpy w
|
||||||
|
return $ case maybeAttributes of
|
||||||
|
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
|
||||||
@ -89,6 +96,13 @@ 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