{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Hooks.ServerMode
-- Description :  Send commands to a running xmonad process.
-- Copyright   :  (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007
-- License     :  BSD-style (see xmonad/LICENSE)
--
-- Maintainer  :  polson2@hawk.iit.edu
-- Stability   :  unstable
-- Portability :  unportable
--
-- This is an 'EventHook' that will receive commands from an external
-- client. Also consider "XMonad.Hooks.EwmhDesktops" together with
-- @wmctrl@.
--
-- See @scripts/xmonadctl.hs@ for the client.
--
-----------------------------------------------------------------------------

module XMonad.Hooks.ServerMode
    ( -- * Usage
      -- $usage
      serverModeEventHook
    , serverModeEventHook'
    , serverModeEventHookCmd
    , serverModeEventHookCmd'
    , serverModeEventHookF
    ) where

import System.IO

import XMonad
import XMonad.Prelude
import XMonad.Actions.Commands

-- $usage
-- You can use this module with the following in your
-- @xmonad.hs@:
--
-- > import XMonad.Hooks.ServerMode
--
-- Then edit your @handleEventHook@ by adding the appropriate event hook from below

-- | Executes a command of the list when receiving its index via a special ClientMessageEvent
-- (indexing starts at 1). Sending index 0 will ask xmonad to print the list of command numbers
-- in stderr (so that you can read it in @~\/.xsession-errors@). Uses "XMonad.Actions.Commands#defaultCommands" as the default.
--
-- > main = xmonad def { handleEventHook = serverModeEventHook }
--
-- > xmonadctl 0 # tells xmonad to output command list
-- > xmonadctl 1 # tells xmonad to switch to workspace 1
--
serverModeEventHook :: Event -> X All
serverModeEventHook :: Event -> X All
serverModeEventHook = X [(String, X ())] -> Event -> X All
serverModeEventHook' X [(String, X ())]
defaultCommands

-- | serverModeEventHook' additionally takes an action to generate the list of
-- commands.
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" (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> X ()
helper forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
        where helper :: String -> X ()
helper String
cmd = do [(String, X ())]
cl <- X [(String, X ())]
cmdAction
                              case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
cmd (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Integer
1 :: Integer ..]) [(String, X ())]
cl) of
                                Just (String
_,X ()
action) -> X ()
action
                                Maybe (String, X ())
Nothing         -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> String -> IO ()
hPutStrLn Handle
stderr) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [(String, b)] -> [String]
listOfCommands forall a b. (a -> b) -> a -> b
$ [(String, X ())]
cl
              listOfCommands :: [(String, b)] -> [String]
listOfCommands [(String, b)]
cl = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. [a] -> [a] -> [a]
(++) (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Int
1 :: Int ..]) (forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a] -> [a]
(++) String
" - " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, b)]
cl)


-- | Executes a command of the list when receiving its name via a special ClientMessageEvent.
-- Uses "XMonad.Actions.Commands#defaultCommands" as the default.
--
-- > main = xmonad def { handleEventHook = serverModeEventHookCmd }
--
-- > xmonadctl run # Tells xmonad to generate a run prompt
--
serverModeEventHookCmd :: Event -> X All
serverModeEventHookCmd :: Event -> X All
serverModeEventHookCmd = X [(String, X ())] -> Event -> X All
serverModeEventHookCmd' X [(String, X ())]
defaultCommands

-- | Additionally takes an action to generate the list of commands
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" (forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> X ()
helper forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
        where helper :: String -> X ()
helper String
cmd = do [(String, X ())]
cl <- X [(String, X ())]
cmdAction
                              forall a. a -> Maybe a -> a
fromMaybe (forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Couldn't find command " forall a. [a] -> [a] -> [a]
++ String
cmd)) (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
cmd [(String, X ())]
cl)

-- | Listens for an atom, then executes a callback function whenever it hears it.
-- A trivial example that prints everything supplied to it on xmonad's standard out:
--
-- > main = xmonad def { handleEventHook = serverModeEventHookF "XMONAD_PRINT" (io . putStrLn) }
--
-- > xmonadctl -a XMONAD_PRINT "hello world"
--
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
  Display
d <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks XConf -> Display
display
  Atom
atm <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> String -> Bool -> IO Atom
internAtom Display
d String
key Bool
False
  if | Atom
mt forall a. Eq a => a -> a -> Bool
== Atom
atm, Just CInt
dth <- forall a. [a] -> Maybe a
listToMaybe [CInt]
dt -> do
         let atom :: Atom
atom = forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
dth
         Maybe String
cmd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Display -> Atom -> IO (Maybe String)
getAtomName Display
d Atom
atom
         case Maybe String
cmd of
           Just String
command -> String -> X ()
func String
command
           Maybe String
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Couldn't retrieve atom " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Atom
atom)
     | Bool
otherwise -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)
serverModeEventHookF String
_ String -> X ()
_ Event
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> All
All Bool
True)