bluetile-0.2: src/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
import System.FilePath(pathSeparator)

import Paths_bluetile

-- | The entry point into bluetile. Just launch with the default
-- configuration. Compiling a custom configuration is not supported for now.
main :: IO ()
main = do
    putStrLn "Welcome to Bluetile! The window manager is now attempting to start up."
    putStrLn "Information: Two helper applications should appear (Bluetile's dock and"
    putStrLn "a greeting screen). However, even if you see these applications, the actual"
    putStrLn "window manager might still have failed to start. Make sure to check the output"
    putStrLn "below for any errors and have a look at the window decorations, to be sure,"
    putStrLn "that Bluetile started successfully. Happy tiling!"
    putStrLn ""

    -- start docks and greeting screen
    binDir <- getBinDir
    dockHandle <- spawnPipe $ binDir ++ [pathSeparator] ++ "bluetiledock"
    spawnPipe $ binDir ++ [pathSeparator] ++ "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" }