Patch for Hhp.hs in xmonad-utils

gistfile1.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Hhp
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD3
--
-- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
-- Stability   :  unstable
-- Portability :  unportable
--
--  Hides the pointer after some inactivity
--
-----------------------------------------------------------------------------

module Main where

import Prelude
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Bits
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import System.Exit

import Utils

main :: IO ()
main = do
  dpy <- openDisplay ""
  let dflt = defaultScreen dpy
  rootw  <- rootWindow dpy dflt
  waitForMotion dpy rootw

-- hides and grabs the pointer till the user moves it
hidePointer :: Display -> Window -> IO ()
hidePointer d w = do
  let em = buttonPressMask .|. pointerMotionMask
  cursor <- nullCursor d w
  ps <- grabPointer d w False em grabModeAsync
                    grabModeAsync w cursor currentTime
  when (ps /= grabSuccess) $ do
        waitASecond 1
        hidePointer d w
  allocaXEvent $ \e -> do
      maskEvent d em e
      ungrabPointer d currentTime
      waitForMotion d w

-- when the pointer is not moved a timer starts: after ten seconds, if
-- no motion interrupts the timer, the pointer is grabbed and made
-- invisible.
waitForMotion :: Display -> Window -> IO ()
waitForMotion d w = do
  mt <- myThreadId
  t <- forkIO (timer mt)
  mask $ \restore -> do --block deprecated in Control.Exception, replaced with mask (Seth A. Yoder, 5/29/2014)
    catch (restore $ stopAndWait t) (const $ hidePointer d w :: SomeException -> IO ())
        where
          -- interrupt the waiting for motion (and thus hide the pointer)
          timer t = do
            waitASecond 10
            throwTo t (ErrorCall "done")
          -- wait for the next motion, and restart the timer (?)
          stopAndWait t = do
              allocaXEvent $ maskEvent' d pointerMotionMask
              -- this seems to just suspend the timer...
              throwTo t (ExitSuccess)
              waitForMotion d w
          -- wait for a timer interrupt to hide the pointer