-----------------------------------------------------------------------------
-- |
-- 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
                                 serverMode
                                ) where

import Control.Monad.Reader
import Data.Char
import Data.Maybe

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import XMonad
import XMonadContrib.Commands

import XMonadContrib.LayoutHelpers

-- $usage
-- in Config.hs write:
--
-- > import XMonadContrib.ServerMode
--
--
-- In defaultLayouts set the layout the will be in serverMode. For
-- instance:
--
-- > defaultLayouts = [ serverMode tiled , mirror tiled , full ]
--
--  more layouts can be set in 'serverMode':
--
-- > defaultLayouts = [ serverMode tiled , serverMode $ mirror tiled , serverMode full ]
--

serverMode :: Layout a -> Layout a
serverMode l =
    layoutModify idModDo hook l

hook :: SomeMessage -> X (Maybe (ModLay a))
hook sm
    | Just e <- fromMessage sm :: Maybe Event = do handle e >> return Nothing
    | otherwise = return Nothing

handle :: Event -> X ()
handle (AnyEvent {ev_window = w, ev_event_type = t})
    | t == propertyNotify = do
  isr <- isRoot w
  when isr runCom
handle _ = return ()

runCom :: X ()
runCom = do
  conf <- ask
  let dpy = display conf
      rw = theRoot conf
  c <- io $ internAtom dpy "XM_COMMAND" False
  -- retrieve the command string and run it
  c' <- io $ getWindowProperty8 dpy c rw
  let com = map (chr . fromIntegral) . fromMaybe [] $  c'
  runCommand' com


--------------------------- ( To Send Commands ) ----------------------------
{-
-----------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (c) Andrea Rossato
-- License     :  BSD3
-- 
-- Maintainer  :  Andrea Rossato <andrea.rossato@unibz.it>
-- Stability   :  unstable
-- Portability :  unportable
--
--  Send commands to XMonad
--  compile with:
-- 
--  ghc --make -o filename filename.hs
--
-----------------------------------------------------------------------------

module Main where

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import System.Environment
import System.Exit
import Control.Monad
import Data.Maybe
import Data.Char
import Data.Word

usage :: String -> String
usage n = "Usage: " ++ n ++ " command\nSend a command to a running instance of XMonad"

main :: IO ()
main = do
  args <- getArgs
  pn <- getProgName
  d <- getEnv "DISPLAY"
  let com = case args of
              [] -> error $ usage pn
              w -> (w !! 0)
  dpy <- openDisplay d
  rootw  <- rootWindow dpy $ defaultScreen dpy
  c <- internAtom dpy "XM_COMMAND" False
  
  -- set the XM_COMMAND
  changeProperty8 dpy rootw c sTRING propModeReplace $ map (fromIntegral . ord) com
  sync dpy False
  exitWith ExitSuccess

-}