From fd7a7cd8d88ef7ba1a5905b927094afcaf2a9c1b Mon Sep 17 00:00:00 2001 From: Andrea Rossato Date: Sun, 24 Feb 2008 14:37:06 +0100 Subject: Add Hooks.ServerMode: an event hook to execute commands sent by an external client darcs-hash:20080224133706-32816-aa862084a86ac6769123c4d3760be42d857d3c8d.gz --- XMonad/Hooks/ServerMode.hs | 103 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) create mode 100644 XMonad/Hooks/ServerMode.hs (limited to 'XMonad') diff --git a/XMonad/Hooks/ServerMode.hs b/XMonad/Hooks/ServerMode.hs new file mode 100644 index 0000000..4ff9c95 --- /dev/null +++ b/XMonad/Hooks/ServerMode.hs @@ -0,0 +1,103 @@ +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Hooks.ServerMode +-- Copyright : (c) Andrea Rossato and David Roundy 2007 +-- License : BSD-style (see xmonad/LICENSE) +-- +-- Maintainer : andrea.rossato@unibz.it +-- Stability : unstable +-- Portability : unportable +-- +-- 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@). +----------------------------------------------------------------------------- + +module XMonad.Hooks.ServerMode + ( -- * Usage + -- $usage + ServerMode (..) + , eventHook + ) where + +import Control.Monad (when) +import Data.List +import System.IO + +import XMonad +import XMonad.Actions.Commands +import XMonad.Hooks.EventHook + +-- $usage +-- You can use this module with the following in your +-- @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Hooks.ServerMode +-- +-- Then edit your @layoutHook@ by adding the 'eventHook': +-- +-- > layoutHook = eventHook ServerMode $ avoidStruts $ simpleTabbed ||| Full ||| etc.. +-- +-- and then: +-- +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +data ServerMode = ServerMode deriving ( Show, Read ) + +instance EventHook ServerMode where + handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do + d <- asks display + a <- io $ internAtom d "XMONAD_COMMAND" False + when (mt == a && dt /= []) $ do + cl <- defaultCommands + let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst) + case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of + Just (c,_) -> runCommand' c + Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl + handleEvent _ _ = return () -- cgit v1.2.3