diff options
Diffstat (limited to '')
| -rw-r--r-- | XMonad/Hooks/ServerMode.hs | 149 |
1 files changed, 108 insertions, 41 deletions
diff --git a/XMonad/Hooks/ServerMode.hs b/XMonad/Hooks/ServerMode.hs index bbe1097..daff6df 100644 --- a/XMonad/Hooks/ServerMode.hs +++ b/XMonad/Hooks/ServerMode.hs @@ -1,10 +1,10 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Hooks.ServerMode --- Copyright : (c) Andrea Rossato and David Roundy 2007 +-- Copyright : (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007 -- License : BSD-style (see xmonad/LICENSE) -- --- Maintainer : andrea.rossato@unibz.it +-- Maintainer : polson2@hawk.iit.edu -- Stability : unstable -- Portability : unportable -- @@ -16,54 +16,88 @@ -- > import Graphics.X11.Xlib -- > import Graphics.X11.Xlib.Extras -- > import System.Environment +-- > import System.IO -- > 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 +-- > main = parse True "XMONAD_COMMAND" =<< getArgs +-- > +-- > parse :: Bool -> String -> [String] -> IO () +-- > parse input addr args = case args of +-- > ["--"] | input -> repl addr +-- > | otherwise -> return () +-- > ("--":xs) -> sendAll addr xs +-- > ("-a":a:xs) -> parse input a xs +-- > ("-h":_) -> showHelp +-- > ("--help":_) -> showHelp +-- > ("-?":_) -> showHelp +-- > (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a) +-- > +-- > (x:xs) -> sendCommand addr x >> parse False addr xs +-- > [] | input -> repl addr +-- > | otherwise -> return () +-- > +-- > +-- > repl :: String -> IO () +-- > repl addr = do e <- isEOF +-- > case e of +-- > True -> return () +-- > False -> do l <- getLine +-- > sendCommand addr l +-- > repl addr +-- > +-- > sendAll :: String -> [String] -> IO () +-- > sendAll addr ss = foldr (\a b -> sendCommand addr a >> b) (return ()) ss +-- > +-- > sendCommand :: String -> String -> IO () +-- > sendCommand addr s = do -- > d <- openDisplay "" -- > rw <- rootWindow d $ defaultScreen d --- > a <- internAtom d "XMONAD_COMMAND" False +-- > a <- internAtom d addr False +-- > m <- internAtom d s False -- > allocaXEvent $ \e -> do -- > setEventType e clientMessage --- > setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime +-- > setClientMessageEvent e rw a 32 m currentTime -- > sendEvent d rw False structureNotifyMask e -- > sync d False +-- > +-- > showHelp :: IO () +-- > showHelp = do pn <- getProgName +-- > putStrLn ("Send commands to a running instance of xmonad. xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.\n-a atomname can be used at any point in the command line arguments to change which atom it is sending on.\nIf sent with no arguments or only -a atom arguments, it will read commands from stdin.\nEx:\n" ++ pn ++ " cmd1 cmd2\n" ++ pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world\n" ++ pn ++ " -a XMONAD_PRINT # will read data from stdin.\nThe atom defaults to XMONAD_COMMAND.") -- --- compile with: @ghc --make sendCommand.hs@ +-- +-- compile with: @ghc --make xmonadctl.hs@ -- -- run with -- --- > sendCommand command number +-- > xmonadctl command +-- +-- or with -- --- For instance: +-- > $ xmonadctl +-- > command1 +-- > command2 +-- > . +-- > . +-- > . +-- > ^D -- --- > sendCommand 0 +-- Usage will change depending on which event hook(s) you use. More examples are shown below. -- --- 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 (..) - , serverModeEventHook + serverModeEventHook , serverModeEventHook' + , serverModeEventHookCmd + , serverModeEventHookCmd' + , serverModeEventHookF ) where import Control.Monad (when) +import Data.Maybe import Data.Monoid import System.IO @@ -75,31 +109,64 @@ import XMonad.Actions.Commands -- @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Hooks.ServerMode --- > import XMonad.Actions.Commands -- --- Then edit your @handleEventHook@ by adding the 'serverModeEventHook': +-- Then edit your @handleEventHook@ by adding the appropriate event hook from below + +-- | Executes a command of the list when receiving its index via a special ClientMessageEvent +-- (indexing starts at 1). Sending index 0 will ask xmonad to print the list of command numbers +-- in stderr (so that you can read it in @~\/.xsession-errors@). Uses "XMonad.Actions.Commands#defaultCommands" as the default. -- -- > main = xmonad def { handleEventHook = serverModeEventHook } +-- +-- > xmonadctl 0 # tells xmonad to output command list +-- > xmonadctl 1 # tells xmonad to switch to workspace 1 -- - -data ServerMode = ServerMode deriving ( Show, Read ) - --- | Executes a command of the list when receiving its index via a special ClientMessageEvent --- (indexing starts at 1) serverModeEventHook :: Event -> X All serverModeEventHook = serverModeEventHook' defaultCommands -- | serverModeEventHook' additionally takes an action to generate the list of -- commands. serverModeEventHook' :: X [(String,X ())] -> Event -> X All -serverModeEventHook' cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do +serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev + where helper cmd = do cl <- cmdAction + case lookup cmd (zip (map show [1..]) cl) of + Just (_,action) -> action + Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl + listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl + + +-- | Executes a command of the list when receiving its name via a special ClientMessageEvent. +-- Uses "XMonad.Actions.Commands#defaultCommands" as the default. +-- +-- > main = xmonad def { handleEventHook = serverModeEventHookCmd } +-- +-- > xmonadctl run # Tells xmonad to generate a run prompt +-- +serverModeEventHookCmd :: Event -> X All +serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands + +-- | Additionally takes an action to generate the list of commands +serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All +serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev + where helper cmd = do cl <- cmdAction + fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl) + +-- | Listens for an atom, then executes a callback function whenever it hears it. +-- A trivial example that prints everything supplied to it on xmonad's standard out: +-- +-- > main = xmonad def { handleEventHook = serverModeEventHookF "XMONAD_PRINT" (io . putStrLn) } +-- +-- > xmonadctl -a XMONAD_PRINT "hello world" +-- +serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All +serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do d <- asks display - a <- io $ internAtom d "XMONAD_COMMAND" False + a <- io $ internAtom d key False when (mt == a && dt /= []) $ do - cl <- cmdAction - let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst) - case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of - Just (_,action) -> action - Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl + let atom = fromIntegral $ toInteger $ foldr1 (\a b -> a + (b*2^32)) dt + cmd <- io $ getAtomName d atom + case cmd of + Just command -> func command + Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom)) return (All True) -serverModeEventHook' _ _ = return (All True) +serverModeEventHookF _ _ _ = return (All True) |