-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Timer
-- Description :  A module for setting up timers.
-- Copyright   :  (c) Andrea Rossato and David Roundy 2007
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  andrea.rossato@unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A module for setting up timers
-----------------------------------------------------------------------------

module XMonad.Util.Timer
    ( -- * Usage
      -- $usage
      startTimer
    , handleTimer
    , TimerId
    ) where

import XMonad
import Control.Concurrent
import Data.Unique

-- $usage
-- This module can be used to setup a timer to handle deferred events.
-- See 'XMonad.Layout.ShowWName' for an usage example.

type TimerId = Int

-- | Start a timer, which will send a ClientMessageEvent after some
-- time (in seconds).
startTimer :: Rational -> X TimerId
startTimer :: Rational -> X TimerId
startTimer Rational
s = IO TimerId -> X TimerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO TimerId -> X TimerId) -> IO TimerId -> X TimerId
forall a b. (a -> b) -> a -> b
$ do
  TimerId
u   <- Unique -> TimerId
hashUnique (Unique -> TimerId) -> IO Unique -> IO TimerId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
newUnique
  IO () -> IO ProcessID
forall (m :: * -> *). MonadIO m => IO () -> m ProcessID
xfork (IO () -> IO ProcessID) -> IO () -> IO ProcessID
forall a b. (a -> b) -> a -> b
$ do
    Display
d   <- String -> IO Display
openDisplay String
""
    Window
rw  <- Display -> ScreenNumber -> IO Window
rootWindow Display
d (ScreenNumber -> IO Window) -> ScreenNumber -> IO Window
forall a b. (a -> b) -> a -> b
$ Display -> ScreenNumber
defaultScreen Display
d
    TimerId -> IO ()
threadDelay (Rational -> TimerId
forall a. Enum a => a -> TimerId
fromEnum (Rational -> TimerId) -> Rational -> TimerId
forall a b. (a -> b) -> a -> b
$ Rational
s Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000)
    Window
a <- Display -> String -> Bool -> IO Window
internAtom Display
d String
"XMONAD_TIMER" Bool
False
    (XEventPtr -> IO ()) -> IO ()
forall a. (XEventPtr -> IO a) -> IO a
allocaXEvent ((XEventPtr -> IO ()) -> IO ()) -> (XEventPtr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \XEventPtr
e -> do
         XEventPtr -> ScreenNumber -> IO ()
setEventType XEventPtr
e ScreenNumber
clientMessage
         XEventPtr -> Window -> Window -> CInt -> Window -> Window -> IO ()
setClientMessageEvent XEventPtr
e Window
rw Window
a CInt
32 (TimerId -> Window
forall a b. (Integral a, Num b) => a -> b
fromIntegral TimerId
u) Window
0
         Display -> Window -> Bool -> Window -> XEventPtr -> IO ()
sendEvent Display
d Window
rw Bool
False Window
structureNotifyMask XEventPtr
e
    Display -> Bool -> IO ()
sync Display
d Bool
False
  TimerId -> IO TimerId
forall (m :: * -> *) a. Monad m => a -> m a
return TimerId
u

-- | Given a 'TimerId' and an 'Event', run an action when the 'Event'
-- has been sent by the timer specified by the 'TimerId'
handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer :: TimerId -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer TimerId
ti ClientMessageEvent{ev_message_type :: Event -> Window
ev_message_type = Window
mt, ev_data :: Event -> [CInt]
ev_data = [CInt]
dt} X (Maybe a)
action = do
  Display
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  Window
a <- IO Window -> X Window
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Window -> X Window) -> IO Window -> X Window
forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Window
internAtom Display
d String
"XMONAD_TIMER" Bool
False
  if Window
mt Window -> Window -> Bool
forall a. Eq a => a -> a -> Bool
== Window
a Bool -> Bool -> Bool
&& [CInt]
dt [CInt] -> [CInt] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& CInt -> TimerId
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CInt] -> CInt
forall a. [a] -> a
head [CInt]
dt) TimerId -> TimerId -> Bool
forall a. Eq a => a -> a -> Bool
== TimerId
ti
     then X (Maybe a)
action
     else Maybe a -> X (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
handleTimer TimerId
_ Event
_ X (Maybe a)
_ = Maybe a -> X (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing