xmonad-contrib-0.11.4: Third party extensions for xmonad

Copyright(c) Andrea Rossato and David Roundy 2007
LicenseBSD-style (see xmonad/LICENSE)
Maintainerandrea.rossato@unibz.it
Stabilityunstable
Portabilityunportable
Safe HaskellNone
LanguageHaskell98

XMonad.Hooks.ServerMode

Contents

Description

This is an EventHook that will receive commands from an external client.

This is the example of a client:

import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras
import System.Environment
import Data.Char

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

main :: IO ()
main = do
  args <- getArgs
  pn <- getProgName
  let com = case args of
              [] -> error $ usage pn
              w -> (w !! 0)
  sendCommand com

sendCommand :: String -> IO ()
sendCommand s = do
  d   <- openDisplay ""
  rw  <- rootWindow d $ defaultScreen d
  a <- internAtom d "XMONAD_COMMAND" False
  allocaXEvent $ \e -> do
                  setEventType e clientMessage
                  setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime
                  sendEvent d rw False structureNotifyMask e
                  sync d False

compile with: ghc --make sendCommand.hs

run with

sendCommand command number

For instance:

sendCommand 0

will ask to xmonad to print the list of command numbers in stderr (so you can read it in ~/.xsession-errors).

Synopsis

Usage

You can use this module with the following in your ~/.xmonad/xmonad.hs:

import XMonad.Hooks.ServerMode
import XMonad.Actions.Commands

Then edit your handleEventHook by adding the serverModeEventHook:

main = xmonad defaultConfig { handleEventHook = serverModeEventHook }

serverModeEventHook :: Event -> X All Source

Executes a command of the list when receiving its index via a special ClientMessageEvent (indexing starts at 1)

serverModeEventHook' :: X [(String, X ())] -> Event -> X All Source

serverModeEventHook' additionally takes an action to generate the list of commands.