------------------------------------------------------------------------------
-- |
-- Module      :  ServerMode
-- Copyright   :  (c) Mads N Noe 2009
--                (c) Andrea Rossato and David Roundy 2007
-- Maintainer  :  mntnoe (@) gmail.com
-- License     :  BSD-style (see xmonad\/LICENSE)
--
-- Modification of XMonad.Hooks.ServerMode with custom actions.
--
------------------------------------------------------------------------------

module ServerMode ( 
      ServerMode (..)
    , eventHook
    ) where

-- Haskell modules
import Control.Monad (when)
import Data.List
import Data.Maybe
import System.IO
import qualified Data.Map as M

-- XMonad modules
import XMonad
import XMonad.Actions.Commands hiding (runCommand')
import XMonad.Hooks.EventHook
import XMonad.Actions.CycleWS
import qualified XMonad.StackSet as W

-- My modules
import Util

-- | Custom commands.
commands :: X [(String, X ())]
commands = do
    return $ 
        [ ("prev-empty-ws"       , doWithWS W.greedyView    Prev EmptyWS)
        , ("prev-nonempty-ws"    , doWithWS W.greedyView    Prev NonEmptyWS)
        , ("next-nonempty-ws"    , doWithWS W.greedyView    Next NonEmptyWS)
        , ("next-empty-ws"       , doWithWS W.greedyView    Next EmptyWS)
        ]

data ServerMode = ServerMode deriving ( Show, Read )

instance EventHook ServerMode where
    handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
        d <- asks display
        a <- io $ internAtom d "XMONAD_COMMAND" False
        when (mt == a && dt /= []) $ do
             cl <- commands
             let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst)
             case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
                  Just (c,_) -> runCommand' c
                  Nothing    -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
    handleEvent _ _ = return ()

-- | Given the name of a command from 'defaultCommands', return the
--   corresponding action (or the null action if the command is not
--   found).
runCommand' :: String -> X ()
runCommand' c = do
  m <- fmap commandMap commands
  fromMaybe (return ()) (M.lookup c m)