bluetile-0.4: 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 XMonad.Util.Replace

import BluetileDock
import Config

import System.IO
import System.Environment
import System.Cmd
import System.Exit
import System.FilePath(pathSeparator)

import Paths_bluetile
import Data.Version(showVersion)

-- | The entry point into bluetile. Just launch with the default
-- configuration. Compiling a custom configuration is not supported for now.
main :: IO ()
main = do
    -- process arguments
    args <- getArgs
    case args of
        []                    -> launch
        ("--resume":_)        -> launch
        ["--help"]            -> usage
        ["--restart"]         -> sendRestart >> return ()
        ["--version"]         -> putStrLn ("bluetile " ++ showVersion version)
        _                     -> fail "unrecognized flags"

launch :: IO ()
launch = 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 { logHook = logHook bluetileConfig >> bluetileDock dockHandle }
    installSignalHandlers -- important to ignore SIGCHLD from now on to avoid zombies

    replace
    xmonad bluetileConfig'

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
    a <- internAtom dpy "XMONAD_COMMAND" False
    allocaXEvent $ \e -> do
        setEventType e clientMessage
        setClientMessageEvent e rw a 32 1 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" }