------------------------------------------------------------------------------
-- |
-- Module: Xmobar.X11.Events
-- Copyright: (c) 2018 Jose Antonio Ortega Ruiz
-- License: BSD3-style (see LICENSE)
--
-- Maintainer: jao@gnu.org
-- Stability: unstable
-- Portability: portable
-- Created: Sun Nov 25, 2018 23:24
--
--
-- Utilities or event handling
--
------------------------------------------------------------------------------


module Xmobar.X11.Events(nextEvent') where

import Control.Concurrent
import System.Posix.Types (Fd(..))

import Graphics.X11.Xlib (
  Display(..), XEventPtr, nextEvent, pending, connectionNumber)

-- | A version of nextEvent that does not block in foreign calls.
nextEvent' :: Display -> XEventPtr -> IO ()
nextEvent' :: Display -> XEventPtr -> IO ()
nextEvent' Display
d XEventPtr
p = do
    CInt
pend <- Display -> IO CInt
pending Display
d
    if CInt
pend CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0
        then Display -> XEventPtr -> IO ()
nextEvent Display
d XEventPtr
p
        else do
            Fd -> IO ()
threadWaitRead (CInt -> Fd
Fd CInt
fd)
            Display -> XEventPtr -> IO ()
nextEvent' Display
d XEventPtr
p
 where
    fd :: CInt
fd = Display -> CInt
connectionNumber Display
d