-- |
-- Module: WildBind.X11.Internal.FrontEnd
-- Description: WildBind FrontEnd implementation for X11
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- __This is an internal module. Package users should not rely on this.__
module WildBind.X11.Internal.FrontEnd
       ( -- * X11Front
         X11Front(..),
         withFrontEnd,
         withX11Front,
         makeFrontEnd,
         defaultRootWindow
       ) where


import Control.Applicative ((<$>), empty)
import Control.Concurrent (rtsSupportsBoundThreads)
import Control.Concurrent.STM (atomically, TChan, newTChanIO, tryReadTChan, writeTChan)
import Control.Exception (bracket, throwIO)
import Control.Monad (when, filterM, mapM_)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Cont (ContT(ContT), runContT)
import Control.Monad.Trans.Maybe (MaybeT, runMaybeT)
import Control.Monad.Trans.Writer (WriterT, execWriterT, tell)
import Data.Bits ((.|.))
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import qualified Graphics.X11.Xlib as Xlib

import WildBind
  ( FrontEnd(FrontEnd, frontDefaultDescription, frontSetGrab, frontUnsetGrab, frontNextEvent),
    FrontEvent(FEInput,FEChange)
  )
import qualified WildBind.Description as WBD

import WildBind.X11.Internal.Key
  ( xKeyEventToXKeyInput,
    xGrabKey, xUngrabKey,
    XKeyInput(..), KeyMaskMap, getKeyMaskMap,
    KeyEventType(..)
  )
import WildBind.X11.Internal.Window
  ( ActiveWindow,getActiveWindow, Window,
    winInstance, winClass, winName, emptyWindow,
    defaultRootWindowForDisplay
  )
import qualified WildBind.X11.Internal.NotificationDebouncer as Ndeb
import qualified WildBind.X11.Internal.GrabMan as GM

-- | The X11 front-end. @k@ is the input key type.
--
-- This is the implementation of the 'FrontEnd' given by
-- 'withFrontEnd' function. With this object, you can do more advanced
-- actions. See "WildBind.X11.Emulate".
--
-- 'X11Front' is relatively low-level interface, so it's more likely
-- for this API to change in the future than 'FrontEnd'.
--
-- @since 0.2.0.0
data X11Front k =
  X11Front { forall k. X11Front k -> Display
x11Display :: Xlib.Display,
             forall k. X11Front k -> Debouncer
x11Debouncer :: Ndeb.Debouncer,
             forall k. X11Front k -> IORef (Maybe ActiveWindow)
x11PrevActiveWindow :: IORef (Maybe ActiveWindow),
             forall k. X11Front k -> TChan (FrontEvent ActiveWindow k)
x11PendingEvents :: TChan (FrontEvent ActiveWindow k),
             forall k. X11Front k -> KeyMaskMap
x11KeyMaskMap :: KeyMaskMap,
             forall k. X11Front k -> IORef (GrabMan k)
x11GrabMan :: IORef (GM.GrabMan k)
           }

x11PopPendingEvent :: X11Front k -> IO (Maybe (FrontEvent ActiveWindow k))
x11PopPendingEvent :: forall k. X11Front k -> IO (Maybe (FrontEvent ActiveWindow k))
x11PopPendingEvent X11Front k
f = STM (Maybe (FrontEvent ActiveWindow k))
-> IO (Maybe (FrontEvent ActiveWindow k))
forall a. STM a -> IO a
atomically (STM (Maybe (FrontEvent ActiveWindow k))
 -> IO (Maybe (FrontEvent ActiveWindow k)))
-> STM (Maybe (FrontEvent ActiveWindow k))
-> IO (Maybe (FrontEvent ActiveWindow k))
forall a b. (a -> b) -> a -> b
$ TChan (FrontEvent ActiveWindow k)
-> STM (Maybe (FrontEvent ActiveWindow k))
forall a. TChan a -> STM (Maybe a)
tryReadTChan (TChan (FrontEvent ActiveWindow k)
 -> STM (Maybe (FrontEvent ActiveWindow k)))
-> TChan (FrontEvent ActiveWindow k)
-> STM (Maybe (FrontEvent ActiveWindow k))
forall a b. (a -> b) -> a -> b
$ X11Front k -> TChan (FrontEvent ActiveWindow k)
forall k. X11Front k -> TChan (FrontEvent ActiveWindow k)
x11PendingEvents X11Front k
f

x11UnshiftPendingEvents :: X11Front k -> [FrontEvent ActiveWindow k] -> IO ()
x11UnshiftPendingEvents :: forall k. X11Front k -> [FrontEvent ActiveWindow k] -> IO ()
x11UnshiftPendingEvents X11Front k
f = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ())
-> ([FrontEvent ActiveWindow k] -> STM ())
-> [FrontEvent ActiveWindow k]
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FrontEvent ActiveWindow k -> STM ())
-> [FrontEvent ActiveWindow k] -> STM ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (TChan (FrontEvent ActiveWindow k)
-> FrontEvent ActiveWindow k -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan (TChan (FrontEvent ActiveWindow k)
 -> FrontEvent ActiveWindow k -> STM ())
-> TChan (FrontEvent ActiveWindow k)
-> FrontEvent ActiveWindow k
-> STM ()
forall a b. (a -> b) -> a -> b
$ X11Front k -> TChan (FrontEvent ActiveWindow k)
forall k. X11Front k -> TChan (FrontEvent ActiveWindow k)
x11PendingEvents X11Front k
f)

openMyDisplay :: IO Xlib.Display
openMyDisplay :: IO Display
openMyDisplay = String -> IO Display
Xlib.openDisplay String
""

-- | Initialize and obtain 'FrontEnd' for X11, and run the given
-- action.
--
-- The X11 'FrontEnd' watches and provides 'ActiveWindow' as the
-- front-end state. 'ActiveWindow' keeps information about the window
-- currently active. As for the input type @i@, this 'FrontEnd' gets
-- keyboard events from the X server.
-- 
-- CAVEATS
--
-- Code using this function must be compiled
-- __with @-threaded@ option enabled__ in @ghc@. Otherwise, it aborts.
--
-- Basically you should call this function directly under @main@. This
-- is because this function calls some low-level X11 functions to
-- initialize the X11 client, which should be done first.
--
-- Because this 'FrontEnd' currently uses @XGrabKey(3)@ to get the
-- input, it may cause some weird behavior such as:
--
-- - Every input event makes the active window lose focus
--   temporarily. This may result in flickering cursor, for example. See
--   also: https://stackoverflow.com/questions/15270420/
--
-- - Key input is captured only while the first grabbed key is
--   pressed. For example, if @(release xK_a)@ and @(release xK_b)@
--   are bound, and you input @(press xK_a)@, @(press xK_b)@, @(release xK_a)@,
--   @(release xK_b)@, the last @(release xK_b)@ is NOT captured
--   because key grab ends with @(release xK_a)@.
withFrontEnd :: (XKeyInput i, WBD.Describable i, Ord i) => (FrontEnd ActiveWindow i -> IO a) -> IO a
withFrontEnd :: forall i a.
(XKeyInput i, Describable i, Ord i) =>
(FrontEnd ActiveWindow i -> IO a) -> IO a
withFrontEnd FrontEnd ActiveWindow i -> IO a
action = String -> (X11Front i -> IO a) -> IO a
forall k a. String -> (X11Front k -> IO a) -> IO a
withX11Front' String
"WildBind.X11.withFrontEnd" ((X11Front i -> IO a) -> IO a) -> (X11Front i -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \X11Front i
x11front -> FrontEnd ActiveWindow i -> IO a
action (X11Front i -> FrontEnd ActiveWindow i
forall k.
(XKeyInput k, Describable k, Ord k) =>
X11Front k -> FrontEnd ActiveWindow k
makeFrontEnd X11Front i
x11front)

-- | Same as 'withFrontEnd', but it creates 'X11Front'. To create
-- 'FrontEnd', use 'makeFrontEnd'.
--
-- @since 0.2.0.0
withX11Front :: (X11Front k -> IO a) -> IO a
withX11Front :: forall k a. (X11Front k -> IO a) -> IO a
withX11Front = String -> (X11Front k -> IO a) -> IO a
forall k a. String -> (X11Front k -> IO a) -> IO a
withX11Front' String
"WildBind.X11.withX11Front"

withX11Front' :: String -- ^ function name used in the error message.
              -> (X11Front k -> IO a)
              -> IO a
withX11Front' :: forall k a. String -> (X11Front k -> IO a) -> IO a
withX11Front' String
func_name = if Bool
rtsSupportsBoundThreads then (X11Front k -> IO a) -> IO a
forall k a. (X11Front k -> IO a) -> IO a
impl else (X11Front k -> IO a) -> IO a
forall {p} {a}. p -> IO a
error_impl where
  impl :: (X11Front k -> IO r) -> IO r
impl = ContT r IO (X11Front k) -> (X11Front k -> IO r) -> IO r
forall {k} (r :: k) (m :: k -> *) a.
ContT r m a -> (a -> m r) -> m r
runContT (ContT r IO (X11Front k) -> (X11Front k -> IO r) -> IO r)
-> ContT r IO (X11Front k) -> (X11Front k -> IO r) -> IO r
forall a b. (a -> b) -> a -> b
$ do
    IO () -> ContT r IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ()) -> IO () -> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
doInitThreads
    Display
disp <- ((Display -> IO r) -> IO r) -> ContT r IO Display
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Display -> IO r) -> IO r) -> ContT r IO Display)
-> ((Display -> IO r) -> IO r) -> ContT r IO Display
forall a b. (a -> b) -> a -> b
$ IO Display -> (Display -> IO ()) -> (Display -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Display
openMyDisplay Display -> IO ()
Xlib.closeDisplay
    KeyMaskMap
keymask_map <- IO KeyMaskMap -> ContT r IO KeyMaskMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO KeyMaskMap -> ContT r IO KeyMaskMap)
-> IO KeyMaskMap -> ContT r IO KeyMaskMap
forall a b. (a -> b) -> a -> b
$ Display -> IO KeyMaskMap
getKeyMaskMap Display
disp
    Display
notif_disp <- ((Display -> IO r) -> IO r) -> ContT r IO Display
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Display -> IO r) -> IO r) -> ContT r IO Display)
-> ((Display -> IO r) -> IO r) -> ContT r IO Display
forall a b. (a -> b) -> a -> b
$ IO Display -> (Display -> IO ()) -> (Display -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Display
openMyDisplay Display -> IO ()
Xlib.closeDisplay
    Debouncer
debouncer <- ((Debouncer -> IO r) -> IO r) -> ContT r IO Debouncer
forall {k} (r :: k) (m :: k -> *) a.
((a -> m r) -> m r) -> ContT r m a
ContT (((Debouncer -> IO r) -> IO r) -> ContT r IO Debouncer)
-> ((Debouncer -> IO r) -> IO r) -> ContT r IO Debouncer
forall a b. (a -> b) -> a -> b
$ Display -> (Debouncer -> IO r) -> IO r
forall a. Display -> (Debouncer -> IO a) -> IO a
Ndeb.withDebouncer Display
notif_disp
    IO () -> ContT r IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ()) -> IO () -> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ Display -> EventMask -> EventMask -> IO ()
Xlib.selectInput Display
disp (Display -> EventMask
Xlib.defaultRootWindow Display
disp)
      (EventMask
Xlib.substructureNotifyMask EventMask -> EventMask -> EventMask
forall a. Bits a => a -> a -> a
.|. EventMask
Ndeb.xEventMask)
    IORef (Maybe ActiveWindow)
awin_ref <- IO (IORef (Maybe ActiveWindow))
-> ContT r IO (IORef (Maybe ActiveWindow))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe ActiveWindow))
 -> ContT r IO (IORef (Maybe ActiveWindow)))
-> IO (IORef (Maybe ActiveWindow))
-> ContT r IO (IORef (Maybe ActiveWindow))
forall a b. (a -> b) -> a -> b
$ Maybe ActiveWindow -> IO (IORef (Maybe ActiveWindow))
forall a. a -> IO (IORef a)
newIORef Maybe ActiveWindow
forall a. Maybe a
Nothing
    TChan (FrontEvent ActiveWindow k)
pending_events <- IO (TChan (FrontEvent ActiveWindow k))
-> ContT r IO (TChan (FrontEvent ActiveWindow k))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan (FrontEvent ActiveWindow k))
 -> ContT r IO (TChan (FrontEvent ActiveWindow k)))
-> IO (TChan (FrontEvent ActiveWindow k))
-> ContT r IO (TChan (FrontEvent ActiveWindow k))
forall a b. (a -> b) -> a -> b
$ IO (TChan (FrontEvent ActiveWindow k))
forall a. IO (TChan a)
newTChanIO
    IORef (GrabMan k)
grab_man <- IO (IORef (GrabMan k)) -> ContT r IO (IORef (GrabMan k))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (GrabMan k)) -> ContT r IO (IORef (GrabMan k)))
-> IO (IORef (GrabMan k)) -> ContT r IO (IORef (GrabMan k))
forall a b. (a -> b) -> a -> b
$ KeyMaskMap -> Display -> EventMask -> IO (IORef (GrabMan k))
forall k.
KeyMaskMap -> Display -> EventMask -> IO (IORef (GrabMan k))
GM.new KeyMaskMap
keymask_map Display
disp (Display -> EventMask
Xlib.defaultRootWindow Display
disp)
    IO () -> ContT r IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ContT r IO ()) -> IO () -> ContT r IO ()
forall a b. (a -> b) -> a -> b
$ Debouncer -> IO ()
Ndeb.notify Debouncer
debouncer
    X11Front k -> ContT r IO (X11Front k)
forall (m :: * -> *) a. Monad m => a -> m a
return (X11Front k -> ContT r IO (X11Front k))
-> X11Front k -> ContT r IO (X11Front k)
forall a b. (a -> b) -> a -> b
$ Display
-> Debouncer
-> IORef (Maybe ActiveWindow)
-> TChan (FrontEvent ActiveWindow k)
-> KeyMaskMap
-> IORef (GrabMan k)
-> X11Front k
forall k.
Display
-> Debouncer
-> IORef (Maybe ActiveWindow)
-> TChan (FrontEvent ActiveWindow k)
-> KeyMaskMap
-> IORef (GrabMan k)
-> X11Front k
X11Front Display
disp Debouncer
debouncer IORef (Maybe ActiveWindow)
awin_ref TChan (FrontEvent ActiveWindow k)
pending_events KeyMaskMap
keymask_map IORef (GrabMan k)
grab_man
  error_impl :: p -> IO a
error_impl p
_ = IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String
"You need to build with -threaded option when you use " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
func_name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" function.")
  doInitThreads :: IO ()
doInitThreads = do
    Status
ret <- IO Status
Xlib.initThreads
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Status
ret Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      IOError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String
"Failure in XInitThreads.")


tellElem :: Monad m => a -> WriterT [a] m ()
tellElem :: forall (m :: * -> *) a. Monad m => a -> WriterT [a] m ()
tellElem a
a = [a] -> WriterT [a] m ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell [a
a]

data InternalEvent = IEKey KeyEventType
                   | IEDebounced
                   | IEActiveWindow
                   | IEUnknown

identifyEvent :: Ndeb.Debouncer -> Xlib.XEventPtr -> IO InternalEvent
identifyEvent :: Debouncer -> XEventPtr -> IO InternalEvent
identifyEvent Debouncer
deb XEventPtr
xev = do
  EventType
xtype <- XEventPtr -> IO EventType
Xlib.get_EventType XEventPtr
xev
  EventType -> IO InternalEvent
identify EventType
xtype
  where
    identify :: EventType -> IO InternalEvent
identify EventType
xtype | EventType
xtype EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
Xlib.keyPress = InternalEvent -> IO InternalEvent
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalEvent -> IO InternalEvent)
-> InternalEvent -> IO InternalEvent
forall a b. (a -> b) -> a -> b
$ KeyEventType -> InternalEvent
IEKey KeyEventType
KeyPress
                   | EventType
xtype EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
Xlib.keyRelease = InternalEvent -> IO InternalEvent
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalEvent -> IO InternalEvent)
-> InternalEvent -> IO InternalEvent
forall a b. (a -> b) -> a -> b
$ KeyEventType -> InternalEvent
IEKey KeyEventType
KeyRelease
                   | EventType
xtype EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
Xlib.configureNotify Bool -> Bool -> Bool
|| EventType
xtype EventType -> EventType -> Bool
forall a. Eq a => a -> a -> Bool
== EventType
Xlib.destroyNotify = InternalEvent -> IO InternalEvent
forall (m :: * -> *) a. Monad m => a -> m a
return (InternalEvent -> IO InternalEvent)
-> InternalEvent -> IO InternalEvent
forall a b. (a -> b) -> a -> b
$ InternalEvent
IEActiveWindow
                   | Bool
otherwise = do
                       Bool
is_deb_event <- Debouncer -> XEventPtr -> IO Bool
Ndeb.isDebouncedEvent Debouncer
deb XEventPtr
xev
                       if Bool
is_deb_event
                         then InternalEvent -> IO InternalEvent
forall (m :: * -> *) a. Monad m => a -> m a
return InternalEvent
IEDebounced
                         else InternalEvent -> IO InternalEvent
forall (m :: * -> *) a. Monad m => a -> m a
return InternalEvent
IEUnknown

convertEvent :: (XKeyInput k) => KeyMaskMap -> Xlib.Display -> Ndeb.Debouncer -> Xlib.XEventPtr -> IO [FrontEvent ActiveWindow k]
convertEvent :: forall k.
XKeyInput k =>
KeyMaskMap
-> Display
-> Debouncer
-> XEventPtr
-> IO [FrontEvent ActiveWindow k]
convertEvent KeyMaskMap
kmmap Display
disp Debouncer
deb XEventPtr
xev = WriterT [FrontEvent ActiveWindow k] IO ()
-> IO [FrontEvent ActiveWindow k]
forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
execWriterT (WriterT [FrontEvent ActiveWindow k] IO ()
 -> IO [FrontEvent ActiveWindow k])
-> WriterT [FrontEvent ActiveWindow k] IO ()
-> IO [FrontEvent ActiveWindow k]
forall a b. (a -> b) -> a -> b
$ WriterT [FrontEvent ActiveWindow k] IO ()
forall k. XKeyInput k => WriterT [FrontEvent ActiveWindow k] IO ()
convertEventWriter where
  tellChangeEvent :: WriterT [FrontEvent ActiveWindow i] IO ()
tellChangeEvent = (FrontEvent ActiveWindow i
-> WriterT [FrontEvent ActiveWindow i] IO ()
forall (m :: * -> *) a. Monad m => a -> WriterT [a] m ()
tellElem (FrontEvent ActiveWindow i
 -> WriterT [FrontEvent ActiveWindow i] IO ())
-> (ActiveWindow -> FrontEvent ActiveWindow i)
-> ActiveWindow
-> WriterT [FrontEvent ActiveWindow i] IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActiveWindow -> FrontEvent ActiveWindow i
forall s i. s -> FrontEvent s i
FEChange) (ActiveWindow -> WriterT [FrontEvent ActiveWindow i] IO ())
-> WriterT [FrontEvent ActiveWindow i] IO ActiveWindow
-> WriterT [FrontEvent ActiveWindow i] IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO ActiveWindow
-> WriterT [FrontEvent ActiveWindow i] IO ActiveWindow
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ActiveWindow
 -> WriterT [FrontEvent ActiveWindow i] IO ActiveWindow)
-> IO ActiveWindow
-> WriterT [FrontEvent ActiveWindow i] IO ActiveWindow
forall a b. (a -> b) -> a -> b
$ Display -> IO ActiveWindow
getActiveWindow Display
disp)
  convertEventWriter :: XKeyInput k => WriterT [FrontEvent ActiveWindow k] IO ()
  convertEventWriter :: forall k. XKeyInput k => WriterT [FrontEvent ActiveWindow k] IO ()
convertEventWriter = do
    InternalEvent
in_event <- IO InternalEvent
-> WriterT [FrontEvent ActiveWindow k] IO InternalEvent
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InternalEvent
 -> WriterT [FrontEvent ActiveWindow k] IO InternalEvent)
-> IO InternalEvent
-> WriterT [FrontEvent ActiveWindow k] IO InternalEvent
forall a b. (a -> b) -> a -> b
$ Debouncer -> XEventPtr -> IO InternalEvent
identifyEvent Debouncer
deb XEventPtr
xev
    case InternalEvent
in_event of
     IEKey KeyEventType
ev_type -> do
       let key_ev :: XKeyEventPtr
key_ev = XEventPtr -> XKeyEventPtr
Xlib.asKeyEvent XEventPtr
xev
       WriterT [FrontEvent ActiveWindow k] IO ()
forall {i}. WriterT [FrontEvent ActiveWindow i] IO ()
tellChangeEvent
       (WriterT [FrontEvent ActiveWindow k] IO ()
-> (FrontEvent ActiveWindow k
    -> WriterT [FrontEvent ActiveWindow k] IO ())
-> Maybe (FrontEvent ActiveWindow k)
-> WriterT [FrontEvent ActiveWindow k] IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> WriterT [FrontEvent ActiveWindow k] IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) FrontEvent ActiveWindow k
-> WriterT [FrontEvent ActiveWindow k] IO ()
forall (m :: * -> *) a. Monad m => a -> WriterT [a] m ()
tellElem) (Maybe (FrontEvent ActiveWindow k)
 -> WriterT [FrontEvent ActiveWindow k] IO ())
-> WriterT
     [FrontEvent ActiveWindow k] IO (Maybe (FrontEvent ActiveWindow k))
-> WriterT [FrontEvent ActiveWindow k] IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO (Maybe (FrontEvent ActiveWindow k))
-> WriterT
     [FrontEvent ActiveWindow k] IO (Maybe (FrontEvent ActiveWindow k))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (FrontEvent ActiveWindow k))
 -> WriterT
      [FrontEvent ActiveWindow k] IO (Maybe (FrontEvent ActiveWindow k)))
-> IO (Maybe (FrontEvent ActiveWindow k))
-> WriterT
     [FrontEvent ActiveWindow k] IO (Maybe (FrontEvent ActiveWindow k))
forall a b. (a -> b) -> a -> b
$ MaybeT IO (FrontEvent ActiveWindow k)
-> IO (Maybe (FrontEvent ActiveWindow k))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (k -> FrontEvent ActiveWindow k
forall s i. i -> FrontEvent s i
FEInput (k -> FrontEvent ActiveWindow k)
-> MaybeT IO k -> MaybeT IO (FrontEvent ActiveWindow k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMaskMap -> KeyEventType -> XKeyEventPtr -> MaybeT IO k
forall k.
XKeyInput k =>
KeyMaskMap -> KeyEventType -> XKeyEventPtr -> MaybeT IO k
xKeyEventToXKeyInput KeyMaskMap
kmmap KeyEventType
ev_type XKeyEventPtr
key_ev))
     InternalEvent
IEDebounced -> WriterT [FrontEvent ActiveWindow k] IO ()
forall {i}. WriterT [FrontEvent ActiveWindow i] IO ()
tellChangeEvent
     InternalEvent
IEActiveWindow -> IO () -> WriterT [FrontEvent ActiveWindow k] IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Debouncer -> IO ()
Ndeb.notify Debouncer
deb) WriterT [FrontEvent ActiveWindow k] IO ()
-> WriterT [FrontEvent ActiveWindow k] IO ()
-> WriterT [FrontEvent ActiveWindow k] IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> WriterT [FrontEvent ActiveWindow k] IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     InternalEvent
IEUnknown -> () -> WriterT [FrontEvent ActiveWindow k] IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

isSignificantEvent :: X11Front k -> FrontEvent ActiveWindow k -> IO Bool
isSignificantEvent :: forall k. X11Front k -> FrontEvent ActiveWindow k -> IO Bool
isSignificantEvent X11Front k
front (FEChange ActiveWindow
new_state) = do
  Maybe ActiveWindow
m_old_state <- IO (Maybe ActiveWindow) -> IO (Maybe ActiveWindow)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ActiveWindow) -> IO (Maybe ActiveWindow))
-> IO (Maybe ActiveWindow) -> IO (Maybe ActiveWindow)
forall a b. (a -> b) -> a -> b
$ IORef (Maybe ActiveWindow) -> IO (Maybe ActiveWindow)
forall a. IORef a -> IO a
readIORef (IORef (Maybe ActiveWindow) -> IO (Maybe ActiveWindow))
-> IORef (Maybe ActiveWindow) -> IO (Maybe ActiveWindow)
forall a b. (a -> b) -> a -> b
$ X11Front k -> IORef (Maybe ActiveWindow)
forall k. X11Front k -> IORef (Maybe ActiveWindow)
x11PrevActiveWindow X11Front k
front
  case Maybe ActiveWindow
m_old_state of
   Maybe ActiveWindow
Nothing -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
   Just ActiveWindow
old_state -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ActiveWindow
new_state ActiveWindow -> ActiveWindow -> Bool
forall a. Eq a => a -> a -> Bool
== ActiveWindow
old_state)
isSignificantEvent X11Front k
_ FrontEvent ActiveWindow k
_ = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

updateState :: X11Front k -> FrontEvent ActiveWindow k -> IO ()
updateState :: forall k. X11Front k -> FrontEvent ActiveWindow k -> IO ()
updateState X11Front k
front FrontEvent ActiveWindow k
fev = case FrontEvent ActiveWindow k
fev of
  (FEInput k
_) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  (FEChange ActiveWindow
s) -> IORef (Maybe ActiveWindow) -> Maybe ActiveWindow -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (X11Front k -> IORef (Maybe ActiveWindow)
forall k. X11Front k -> IORef (Maybe ActiveWindow)
x11PrevActiveWindow X11Front k
front) (ActiveWindow -> Maybe ActiveWindow
forall a. a -> Maybe a
Just ActiveWindow
s)

nextEvent :: (XKeyInput k) => X11Front k -> IO (FrontEvent ActiveWindow k)
nextEvent :: forall k.
XKeyInput k =>
X11Front k -> IO (FrontEvent ActiveWindow k)
nextEvent X11Front k
handle = IO (FrontEvent ActiveWindow k)
loop where
  loop :: IO (FrontEvent ActiveWindow k)
loop = do
    Maybe (FrontEvent ActiveWindow k)
mpending <- X11Front k -> IO (Maybe (FrontEvent ActiveWindow k))
forall k. X11Front k -> IO (Maybe (FrontEvent ActiveWindow k))
x11PopPendingEvent X11Front k
handle
    case Maybe (FrontEvent ActiveWindow k)
mpending of
      Just FrontEvent ActiveWindow k
eve -> FrontEvent ActiveWindow k -> IO (FrontEvent ActiveWindow k)
forall (m :: * -> *) a. Monad m => a -> m a
return FrontEvent ActiveWindow k
eve
      Maybe (FrontEvent ActiveWindow k)
Nothing -> IO (FrontEvent ActiveWindow k)
nextEventFromX11
  nextEventFromX11 :: IO (FrontEvent ActiveWindow k)
nextEventFromX11 = (XEventPtr -> IO (FrontEvent ActiveWindow k))
-> IO (FrontEvent ActiveWindow k)
forall a. (XEventPtr -> IO a) -> IO a
Xlib.allocaXEvent ((XEventPtr -> IO (FrontEvent ActiveWindow k))
 -> IO (FrontEvent ActiveWindow k))
-> (XEventPtr -> IO (FrontEvent ActiveWindow k))
-> IO (FrontEvent ActiveWindow k)
forall a b. (a -> b) -> a -> b
$ \XEventPtr
xev -> do
    Display -> XEventPtr -> IO ()
Xlib.nextEvent (X11Front k -> Display
forall k. X11Front k -> Display
x11Display X11Front k
handle) XEventPtr
xev
    [FrontEvent ActiveWindow k]
got_events <- XEventPtr -> IO [FrontEvent ActiveWindow k]
processEvents XEventPtr
xev
    case [FrontEvent ActiveWindow k]
got_events of
      [] -> IO (FrontEvent ActiveWindow k)
loop
      (FrontEvent ActiveWindow k
eve : [FrontEvent ActiveWindow k]
rest) -> do
        X11Front k -> [FrontEvent ActiveWindow k] -> IO ()
forall k. X11Front k -> [FrontEvent ActiveWindow k] -> IO ()
x11UnshiftPendingEvents X11Front k
handle [FrontEvent ActiveWindow k]
rest
        FrontEvent ActiveWindow k -> IO (FrontEvent ActiveWindow k)
forall (m :: * -> *) a. Monad m => a -> m a
return FrontEvent ActiveWindow k
eve
  processEvents :: XEventPtr -> IO [FrontEvent ActiveWindow k]
processEvents XEventPtr
xev = do
    [FrontEvent ActiveWindow k]
fevents <- (FrontEvent ActiveWindow k -> IO Bool)
-> [FrontEvent ActiveWindow k] -> IO [FrontEvent ActiveWindow k]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (X11Front k -> FrontEvent ActiveWindow k -> IO Bool
forall k. X11Front k -> FrontEvent ActiveWindow k -> IO Bool
isSignificantEvent X11Front k
handle)
               ([FrontEvent ActiveWindow k] -> IO [FrontEvent ActiveWindow k])
-> IO [FrontEvent ActiveWindow k] -> IO [FrontEvent ActiveWindow k]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< KeyMaskMap
-> Display
-> Debouncer
-> XEventPtr
-> IO [FrontEvent ActiveWindow k]
forall k.
XKeyInput k =>
KeyMaskMap
-> Display
-> Debouncer
-> XEventPtr
-> IO [FrontEvent ActiveWindow k]
convertEvent (X11Front k -> KeyMaskMap
forall k. X11Front k -> KeyMaskMap
x11KeyMaskMap X11Front k
handle) (X11Front k -> Display
forall k. X11Front k -> Display
x11Display X11Front k
handle) (X11Front k -> Debouncer
forall k. X11Front k -> Debouncer
x11Debouncer X11Front k
handle) XEventPtr
xev
    (FrontEvent ActiveWindow k -> IO ())
-> [FrontEvent ActiveWindow k] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (X11Front k -> FrontEvent ActiveWindow k -> IO ()
forall k. X11Front k -> FrontEvent ActiveWindow k -> IO ()
updateState X11Front k
handle) [FrontEvent ActiveWindow k]
fevents
    [FrontEvent ActiveWindow k] -> IO [FrontEvent ActiveWindow k]
forall (m :: * -> *) a. Monad m => a -> m a
return [FrontEvent ActiveWindow k]
fevents

-- | Create 'FrontEnd' from 'X11Front' object.
--
-- @since 0.2.0.0
makeFrontEnd :: (XKeyInput k, WBD.Describable k, Ord k) => X11Front k -> FrontEnd ActiveWindow k
makeFrontEnd :: forall k.
(XKeyInput k, Describable k, Ord k) =>
X11Front k -> FrontEnd ActiveWindow k
makeFrontEnd X11Front k
f = FrontEnd :: forall s i.
(i -> ActionDescription)
-> (i -> IO ())
-> (i -> IO ())
-> IO (FrontEvent s i)
-> FrontEnd s i
FrontEnd { frontDefaultDescription :: k -> ActionDescription
frontDefaultDescription = k -> ActionDescription
forall d. Describable d => d -> ActionDescription
WBD.describe,
                            frontSetGrab :: k -> IO ()
frontSetGrab = GrabOp -> k -> IO ()
runGrab GrabOp
GM.DoSetGrab,
                            frontUnsetGrab :: k -> IO ()
frontUnsetGrab = GrabOp -> k -> IO ()
runGrab GrabOp
GM.DoUnsetGrab,
                            frontNextEvent :: IO (FrontEvent ActiveWindow k)
frontNextEvent = X11Front k -> IO (FrontEvent ActiveWindow k)
forall k.
XKeyInput k =>
X11Front k -> IO (FrontEvent ActiveWindow k)
nextEvent X11Front k
f
                          }
  where
    runGrab :: GrabOp -> k -> IO ()
runGrab = IORef (GrabMan k) -> GrabOp -> k -> IO ()
forall k.
(XKeyInput k, Ord k) =>
IORef (GrabMan k) -> GrabOp -> k -> IO ()
GM.modify (X11Front k -> IORef (GrabMan k)
forall k. X11Front k -> IORef (GrabMan k)
x11GrabMan X11Front k
f)

-- | Get the default root window.
--
-- @since 0.2.0.0
defaultRootWindow :: X11Front k -> Window
defaultRootWindow :: forall k. X11Front k -> ActiveWindow
defaultRootWindow = Display -> ActiveWindow
defaultRootWindowForDisplay (Display -> ActiveWindow)
-> (X11Front k -> Display) -> X11Front k -> ActiveWindow
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X11Front k -> Display
forall k. X11Front k -> Display
x11Display