bluetile-0.1: Main.hs

----------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- bluetile - a modern tiling window manager with a gentle learning curve
--
-----------------------------------------------------------------------------

module Main (main) where

import XMonad
import XMonad.Util.Run (spawnPipe)

import Config

import System.IO
import System.Environment
import System.Cmd
import System.Exit

-- | The entry point into bluetile. Just launch with the default
-- configuration. Compiling a custom configuration is not supported for now.
main :: IO ()
main = do
    -- start docks and greeting screen
    dockHandle <- spawnPipe "bluetiledock"
    spawnPipe "bluetilegreet"

    -- check terminal
    uninstallSignalHandlers -- make sure we can receive SIGCHLD to check terminal
    blueTileConfig' <- checkTerminal $ blueTileConfig dockHandle
    installSignalHandlers -- important to ignore SIGCHLD from now on to avoid zombies

    -- process arguments
    let launch = xmonad blueTileConfig'
    args <- getArgs
    case args of
        []                    -> launch
        ["--resume", _]       -> launch
        ["--help"]            -> usage
        ["--restart"]         -> sendRestart >> return ()
        ["--version"]         -> putStrLn ("bluetile 0.1")
        _                     -> fail "unrecognized flags"

usage :: IO ()
usage = do
    self <- getProgName
    putStr . unlines $
        concat ["Usage: ", self, " [OPTION]"] :
        "Options:" :
        "  --help                       Print this message" :
        "  --version                    Print the version number" :
        "  --restart                    Request a running xmonad process to restart" :
        []

sendRestart :: IO ()
sendRestart = do
    dpy <- openDisplay ""
    rw <- rootWindow dpy $ defaultScreen dpy
    xmonad_restart <- internAtom dpy "XMONAD_CUSTOM_RESTART" False
    allocaXEvent $ \e -> do
        setEventType e clientMessage
        setClientMessageEvent e rw xmonad_restart 32 0 currentTime
        sendEvent dpy rw False structureNotifyMask e
    sync dpy False

checkTerminal :: XConfig l -> IO (XConfig l)
checkTerminal conf = do
    let term = XMonad.terminal conf
    status <- system $ "which " ++ term ++ " > /dev/null"
    if status == ExitSuccess
        then return conf
        else return conf { terminal = "xterm" }