{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
-- |
-- 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 Control.Concurrent
import Data.Unique
import XMonad
import XMonad.Prelude (listToMaybe)

-- $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 Int
startTimer Rational
s = IO Int -> X Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO Int -> X Int) -> IO Int -> X Int
forall a b. (a -> b) -> a -> b
$ do
  u   <- Unique -> Int
hashUnique (Unique -> Int) -> IO Unique -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
newUnique
  xfork $ do
    d   <- openDisplay ""
    rw  <- rootWindow d $ defaultScreen d
    threadDelay (fromEnum $ s * 1000000)
    a <- internAtom d "XMONAD_TIMER" False
    allocaXEvent $ \XEventPtr
e -> do
         XEventPtr -> ScreenNumber -> IO ()
setEventType XEventPtr
e ScreenNumber
clientMessage
         XEventPtr -> Atom -> Atom -> CInt -> Atom -> Atom -> IO ()
setClientMessageEvent XEventPtr
e Atom
rw Atom
a CInt
32 (Int -> Atom
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
u) Atom
0
         Display -> Atom -> Bool -> Atom -> XEventPtr -> IO ()
sendEvent Display
d Atom
rw Bool
False Atom
structureNotifyMask XEventPtr
e
    sync d False
  return 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 :: forall a. Int -> Event -> X (Maybe a) -> X (Maybe a)
handleTimer Int
ti ClientMessageEvent{ev_message_type :: Event -> Atom
ev_message_type = Atom
mt, ev_data :: Event -> [CInt]
ev_data = [CInt]
dt} X (Maybe a)
action = do
  d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  a <- io $ internAtom d "XMONAD_TIMER" False
  if | mt == a, Just dth <- listToMaybe dt, fromIntegral dth == ti -> action
     | otherwise -> return Nothing
handleTimer Int
_ Event
_ X (Maybe a)
_ = Maybe a -> X (Maybe a)
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing