blob: ba460e17d891f6518aad80a0e2edd8ad5df01ed6 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ServerMode
-- Copyright : (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007
-- License : BSD-style (see xmonad/LICENSE)
--
-- Maintainer : polson2@hawk.iit.edu
-- Stability : unstable
-- Portability : unportable
--
-- This is an 'EventHook' that will receive commands from an external
-- client. Also consider "XMonad.Hooks.EwmhDesktops" together with
-- @wmctrl@.
--
-- This is the example of a client:
--
-- > import Graphics.X11.Xlib
-- > import Graphics.X11.Xlib.Extras
-- > import System.Environment
-- > import System.IO
-- > import Data.Char
-- >
-- > main :: IO ()
-- > 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 addr False
-- > m <- internAtom d s False
-- > allocaXEvent $ \e -> do
-- > setEventType e clientMessage
-- > 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 xmonadctl.hs@
--
-- run with
--
-- > xmonadctl command
--
-- or with
--
-- > $ xmonadctl
-- > command1
-- > command2
-- > .
-- > .
-- > .
-- > ^D
--
-- Usage will change depending on which event hook(s) you use. More examples are shown below.
--
-----------------------------------------------------------------------------
module XMonad.Hooks.ServerMode
( -- * Usage
-- $usage
serverModeEventHook
, serverModeEventHook'
, serverModeEventHookCmd
, serverModeEventHookCmd'
, serverModeEventHookF
) where
import Control.Monad (when)
import Data.Maybe
import Data.Monoid
import System.IO
import XMonad
import XMonad.Actions.Commands
-- $usage
-- You can use this module with the following in your
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.ServerMode
--
-- 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
--
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 ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
where helper cmd = do cl <- cmdAction
case lookup cmd (zip (map show [1 :: Integer ..]) 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
atm <- io $ internAtom d key False
when (mt == atm && dt /= []) $ do
let atom = fromIntegral $ toInteger $ foldr1 (\a b -> a + (b*2^(32::Int))) 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)
serverModeEventHookF _ _ _ = return (All True)
|
