----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.BluetileCommands
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-----------------------------------------------------------------------------

module XMonad.Actions.BluetileCommands (
                             bluetileCommands
                              ) where

import XMonad
import qualified XMonad.StackSet as W
import XMonad.Layout.LayoutCombinators
import System.Exit

-- | Generate a list of commands to switch to workspaces (on the given screen).
workspaceCommands :: Int -> X [(String, X ())]
workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return
                            [(("greedyView" ++ show i),
                                activateScreen sid >> windows (W.greedyView i))
                                | i <- spaces ]

layoutCommands :: Int -> [(String, X ())]
layoutCommands sid = [ ("layout floating"    , activateScreen sid >>
                                                    sendMessage (JumpToLayout "Floating"))
                     , ("layout tiled1"      , activateScreen sid >>
                                                    sendMessage (JumpToLayout "Tiled1"))
                     , ("layout tiled2"      , activateScreen sid >>
                                                    sendMessage (JumpToLayout "Tiled2"))
                     , ("layout fullscreen"  , activateScreen sid >>
                                                    sendMessage (JumpToLayout "Fullscreen"))
                     ]

masterAreaCommands :: Int -> [(String, X ())]
masterAreaCommands sid = [ ("increase master n", activateScreen sid >>
                                                    sendMessage (IncMasterN 1))
                         , ("decrease master n", activateScreen sid >>
                                                    sendMessage (IncMasterN (-1)))
                         ]

quitCommands :: [(String, X ())]
quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))
               , ("quit bluetile and start metacity", restart "metacity" False)
               ]

bluetileCommands :: X [(String, X ())]
bluetileCommands = do
    wscmds0 <- workspaceCommands 0
    wscmds1 <- workspaceCommands 1
    return $ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands
                ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands

activateScreen :: Int -> X ()
activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view)