From 98ad670927cb985df83755ca962c8d3e51d4842e Mon Sep 17 00:00:00 2001
From: polson2 <polson2@hawk.iit.edu>
Date: Mon, 16 Dec 2013 03:51:00 +0100
Subject: Generalized XMonad.Hooks.ServerMode
Ignore-this: e58da3b168a1058f32982833ea25a739
darcs-hash:20131216025100-92c7a-150574b67a1becbb0e5a09a9b2193d3dee5722dd.gz
---
XMonad/Hooks/ServerMode.hs | 149 ++++++++++++++++++++++++++++++++-------------
1 file changed, 108 insertions(+), 41 deletions(-)
(limited to 'XMonad')
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)
--
cgit v1.2.3