{-# LANGUAGE MultiWayIf #-}
module XMonad.Hooks.ServerMode
(
serverModeEventHook
, serverModeEventHook'
, serverModeEventHookCmd
, serverModeEventHookCmd'
, serverModeEventHookF
) where
import System.IO
import XMonad
import XMonad.Prelude
import XMonad.Actions.Commands
serverModeEventHook :: Event -> X All
serverModeEventHook :: Event -> X All
serverModeEventHook = X [(String, X ())] -> Event -> X All
serverModeEventHook' X [(String, X ())]
defaultCommands
serverModeEventHook' :: X [(String,X ())] -> Event -> X All
serverModeEventHook' :: X [(String, X ())] -> Event -> X All
serverModeEventHook' X [(String, X ())]
cmdAction = String -> (String -> X ()) -> Event -> X All
serverModeEventHookF String
"XMONAD_COMMAND" ((String -> X ()) -> [String] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> X ()
helper ([String] -> X ()) -> (String -> [String]) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
where helper :: String -> X ()
helper String
cmd = do cl <- X [(String, X ())]
cmdAction
case lookup cmd (zip (map show [1 :: Integer ..]) cl) of
Just (String
_,X ()
action) -> X ()
action
Maybe (String, X ())
Nothing -> (String -> X ()) -> [String] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> (String -> IO ()) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr) ([String] -> X ())
-> ([(String, X ())] -> [String]) -> [(String, X ())] -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, X ())] -> [String]
forall {b}. [(String, b)] -> [String]
listOfCommands ([(String, X ())] -> X ()) -> [(String, X ())] -> X ()
forall a b. (a -> b) -> a -> b
$ [(String, X ())]
cl
listOfCommands :: [(String, b)] -> [String]
listOfCommands [(String, b)]
cl = (String -> String -> String) -> [String] -> [String] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith String -> String -> String
forall a. [a] -> [a] -> [a]
(++) ((Int -> String) -> [Int] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Int -> String
forall a. Show a => a -> String
show [Int
1 :: Int ..]) (((String, b) -> String) -> [(String, b)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
(++) String
" - " (String -> String)
-> ((String, b) -> String) -> (String, b) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, b) -> String
forall a b. (a, b) -> a
fst) [(String, b)]
cl)
serverModeEventHookCmd :: Event -> X All
serverModeEventHookCmd :: Event -> X All
serverModeEventHookCmd = X [(String, X ())] -> Event -> X All
serverModeEventHookCmd' X [(String, X ())]
defaultCommands
serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All
serverModeEventHookCmd' :: X [(String, X ())] -> Event -> X All
serverModeEventHookCmd' X [(String, X ())]
cmdAction = String -> (String -> X ()) -> Event -> X All
serverModeEventHookF String
"XMONAD_COMMAND" ((String -> X ()) -> [String] -> X ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> X ()
helper ([String] -> X ()) -> (String -> [String]) -> String -> X ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
where helper :: String -> X ()
helper String
cmd = do cl <- X [(String, X ())]
cmdAction
fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl)
serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
serverModeEventHookF String
key String -> X ()
func ClientMessageEvent {ev_message_type :: Event -> Atom
ev_message_type = Atom
mt, ev_data :: Event -> [CInt]
ev_data = [CInt]
dt} = do
d <- (XConf -> Display) -> X Display
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
atm <- io $ internAtom d key False
if | mt == atm, Just dth <- listToMaybe dt -> do
let atom = CInt -> Atom
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
dth
cmd <- io $ getAtomName d atom
case cmd of
Just String
command -> String -> X ()
func String
command
Maybe String
Nothing -> IO () -> X ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Couldn't retrieve atom " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Atom -> String
forall a. Show a => a -> String
show Atom
atom)
| otherwise -> pure ()
return (All True)
serverModeEventHookF String
_ String -> X ()
_ Event
_ = All -> X All
forall a. a -> X a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)