-----------------------------------------------------------------------------
-- |
-- Module      :  XMonadContrib.ServerMode
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD-style (see xmonad/LICENSE)
-- 
-- Maintainer  :  andrea.rossato#unibz.it
-- Stability   :  unstable
-- Portability :  unportable
--
-- A server Mode for the Xmonad Window Manager 
--
-----------------------------------------------------------------------------

module XMonadContrib.ServerMode  
                             -- * Usage:
                             -- $usage
                             where

import Control.Monad.Reader

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

import Data.Bits
import Data.Char
import Data.Maybe

import XMonad
import Operations

import qualified Data.Map as M
import System.Exit


-- $usage
-- You can use this module with the following in your configuration file:
--

startServer :: X ()
startServer = do
  c <- ask
  let dpy = display c
      rootw = theRoot c
  win <- io $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw
              0 0 1 1
  io $ setTextProperty dpy win "ServerWindow" wM_NAME
  io $ selectInput dpy win (propertyNotify .|. buttonPress .|. exposureMask)
  io $ mapWindow dpy win
  io $ sync dpy False
  eventLoop dpy win
  return ()

eventLoop :: Display -> Window -> X ()
eventLoop dpy win = do
  c <- io $ allocaXEvent $ \e -> do 
                  nextEvent dpy e
                  ev <- getEvent e
                  putStrLn $ eventName ev
                  pp <- getWindowProperty8 dpy wM_COMMAND win
                  let command = map (chr . fromIntegral)  . fromMaybe [] $  pp
                  putStrLn command
                  return command
  runCommand_ c
  eventLoop dpy win

runCommand_ :: String -> X ()
runCommand_ c = do
  fromMaybe (return ()) (M.lookup c commandMap_)

commandMap_ = M.fromList basicCommands_

basicCommands_ :: [(String, X ())]
basicCommands_ = [ ("restart-wm", restart Nothing True)
                , ("restart-wm-no-resume", restart Nothing False)
                , ("layout", switchLayout)
                , ("xterm", spawn "xterm")
                , ("run", spawn "exe=`dmenu_path | dmenu -b` && exec $exe")
                , ("kill", kill)
                , ("refresh", refresh)
                , ("focus-up", focusUp)
                , ("focus-down", focusDown)
                , ("swap-up", swapUp)
                , ("swap-down", swapDown)
                , ("swap-master", swapMaster)
                , ("sink", withFocused sink)
                , ("quit-wm", io $ exitWith ExitSuccess)
                ]


-- | Creates a window with the attribute override_redirect set to True.
-- Windows Managers should not touch this kind of windows.
mkUnmanagedWindow :: Display
                  -> Screen
                  -> Window
                  -> Position
                  -> Position
                  -> Dimension
                  -> Dimension
                  -> IO Window
mkUnmanagedWindow dpy scr rw x y w h = do
  let visual = defaultVisualOfScreen scr
      attrmask = cWOverrideRedirect
  win <- allocaSetWindowAttributes $ 
         \attributes -> do
           set_override_redirect attributes True
           createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr) 
                        inputOutput visual attrmask attributes                                
  return win