[Xmonad] Remote Controlling XMonad: Cases and Materials

[Andrea Rossato]

On Tue, Aug 07, 2007 at 03:45:56PM +0200, Andrea Rossato wrote:
> Well, I build up such a case... typical of a lawyer I'd say...;-)

As I promised this is a module that works without patching XMonad.

I feel a bit ashamed, because it also highlights my basic ignorance of
the layout system... but I must confess I do not care that much:
tabbed, tall and full are definitely enough for me, so I never thought
about writing a layout.

This module exports a function that takes a layout and will make that
layout respond to commands send with the application that is commented
out at the end of the file.

The layout must be actually in use. More layout can be set in
"serverMode". 

If you use tabbed you should not use this module. This is also the
reason why I'm not sending it as a patch proposal: I want to
investigate where the problems with tabbed arises (btw, the problems
are not related to the specific use of LayoutHelpers., since I tried
also different approaches).

Andrea
-------------- next part --------------
-----------------------------------------------------------------------------
-- |
-- 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 at 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

-}