Preserve backwards compatibility with H.ServerMode

This commit is contained in:
Adam Vogt 2009-08-25 22:03:48 +00:00
parent 28e0adcde7
commit afecca6561
2 changed files with 11 additions and 6 deletions

View File

@ -24,7 +24,6 @@ import qualified Data.Map as M
import XMonad hiding ( (|||) ) import XMonad hiding ( (|||) )
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Actions.Commands
import XMonad.Actions.CycleWS import XMonad.Actions.CycleWS
import XMonad.Hooks.DynamicLog hiding (xmobar) import XMonad.Hooks.DynamicLog hiding (xmobar)
import XMonad.Hooks.ManageDocks import XMonad.Hooks.ManageDocks
@ -99,7 +98,7 @@ arossatoConfig = do
, normalBorderColor = "white" , normalBorderColor = "white"
, focusedBorderColor = "black" , focusedBorderColor = "black"
, keys = newKeys , keys = newKeys
, handleEventHook = serverModeEventHook defaultCommands , handleEventHook = serverModeEventHook
, focusFollowsMouse = False , focusFollowsMouse = False
} }
where where

View File

@ -60,6 +60,7 @@ module XMonad.Hooks.ServerMode
-- $usage -- $usage
ServerMode (..) ServerMode (..)
, serverModeEventHook , serverModeEventHook
, serverModeEventHook'
) where ) where
import Control.Monad (when) import Control.Monad (when)
@ -79,15 +80,20 @@ import XMonad.Actions.Commands
-- --
-- Then edit your @handleEventHook@ by adding the 'serverModeEventHook': -- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
-- --
-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook defaultCommands } -- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }
-- --
data ServerMode = ServerMode deriving ( Show, Read ) data ServerMode = ServerMode deriving ( Show, Read )
-- | Executes a command of the list when receiving its index via a special ClientMessageEvent -- | Executes a command of the list when receiving its index via a special ClientMessageEvent
-- (indexing starts at 1) -- (indexing starts at 1)
serverModeEventHook :: X [(String,X ())] -> Event -> X All serverModeEventHook :: Event -> X All
serverModeEventHook cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do 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
d <- asks display d <- asks display
a <- io $ internAtom d "XMONAD_COMMAND" False a <- io $ internAtom d "XMONAD_COMMAND" False
when (mt == a && dt /= []) $ do when (mt == a && dt /= []) $ do
@ -97,4 +103,4 @@ serverModeEventHook cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data
Just (c,_) -> runCommand' c Just (c,_) -> runCommand' c
Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
return (All True) return (All True)
serverModeEventHook _ _ = return (All True) serverModeEventHook' _ _ = return (All True)