module WildBind.X11.Internal.FrontEnd
(
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
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
""
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)
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
-> (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
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)
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