path: root/Main.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Main.hs
-- Copyright   :  (c) Spencer Janssen 2007
-- License     :  BSD3-style (see LICENSE)
-- 
-- Maintainer  :  sjanssen@cse.unl.edu
-- Stability   :  unstable
-- Portability :  not portable, uses mtl, X11, posix
--
-----------------------------------------------------------------------------
--
-- thunk, a minimal window manager for X11
--

import qualified Data.Map as Map
import Data.Map (Map)

import Data.Bits

import System.IO
import System.Process (runCommand)
import System.Exit

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras

import Control.Monad.State

import W

------------------------------------------------------------------------

--
-- let's get underway
-- 
main :: IO ()
main = do
    dpy <- openDisplay ""
    runW realMain $ WState
            { display = dpy
            , screenWidth  = displayWidth  dpy (defaultScreen dpy)
            , screenHeight = displayHeight dpy (defaultScreen dpy)
            , windows      = []
            }
    return ()

--
-- Grab the display and input, and jump into the input loop
--
realMain :: W ()
realMain = do
    dpy <- getDisplay
    let screen = defaultScreen dpy
    io $ do root <- rootWindow dpy screen
            selectInput dpy root (substructureRedirectMask .|. substructureNotifyMask)
            sync dpy False
    grabkeys
    loop

--
-- The main event handling loop
--
loop :: W ()
loop = do
    dpy <- getDisplay
    forever $ do
        e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
        handler e

--
-- The event handler
-- 
handler :: Event -> W ()
handler (MapRequestEvent {window = w}) = manage w

handler (DestroyWindowEvent {window = w}) = do
    modifyWindows (filter (/= w))
    refresh

handler (KeyEvent {event_type = t, state = mod, keycode = code})
    | t == keyPress = do
        dpy <- getDisplay
        sym <- io $ keycodeToKeysym dpy code 0
        case filter (\(mod', sym', _) -> mod == mod' && sym == sym') keys of
            []              -> return ()
            ((_, _, act):_) -> act

handler _ = return ()

--
-- switch focus to next window in list.
--
switch :: W ()
switch = do
    ws <- getWindows
    case ws of
        []     -> return ()
        (x:xs) -> do
            setWindows (xs++[x]) -- snoc. polish this.
            refresh

--
-- | spawn. Launch an external application
--
spawn :: String -> W ()
spawn = io_ . runCommand

--
-- | Keys we understand.
--
keys :: [(KeyMask, KeySym, W ())]
keys =
    [ (mod1Mask .|. shiftMask, xK_Return, spawn "xterm")
    , (mod1Mask,               xK_p,      spawn "exe=`dmenu_path | dmenu` && exec $exe")
    , (controlMask,            xK_space,  spawn "gmrun")
    , (mod1Mask,               xK_Tab,    switch)
    , (mod1Mask .|. shiftMask, xK_q,      io $ exitWith ExitSuccess)
    ]

--
-- | grabkeys. Register key commands
--
grabkeys :: W ()
grabkeys = do
    dpy <- getDisplay
    root <- io $ rootWindow dpy (defaultScreen dpy)
    forM_ keys $ \(mod, sym, _) -> do
        code <- io $ keysymToKeycode dpy sym
        io $ grabKey dpy code mod root True grabModeAsync grabModeAsync

--
--
--
manage :: Window -> W ()
manage w = do
    trace "manage"
    d <- getDisplay
    ws <- getWindows
    when (w `notElem` ws) $ do
        trace "modifying"
        modifyWindows (w :)
        io $ mapWindow d w
        refresh

--
-- refresh the windows
--
refresh :: W ()
refresh = do
    ws <- getWindows
    case ws of
        []    -> return ()
        (w:_) -> do
            d  <- getDisplay
            sw <- getScreenWidth
            sh <- getScreenHeight
            io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
                    raiseWindow d w