Adjustments to use the new event hook feature instead of Hooks.EventHook

This commit is contained in:
Daniel Schoepe 2009-02-03 16:00:46 +00:00
parent 4700b44c2c
commit 9a7dcbbabb
6 changed files with 30 additions and 40 deletions

View File

@ -90,8 +90,7 @@ arossatoConfig = do
map show [7 .. 9 :: Int] map show [7 .. 9 :: Int]
, logHook = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed! , logHook = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!
, manageHook = newManageHook , manageHook = newManageHook
, layoutHook = eventHook ServerMode $ , layoutHook = avoidStruts $
avoidStruts $
decorated ||| decorated |||
noBorders mytabs ||| noBorders mytabs |||
otherLays otherLays
@ -99,6 +98,7 @@ arossatoConfig = do
, normalBorderColor = "white" , normalBorderColor = "white"
, focusedBorderColor = "black" , focusedBorderColor = "black"
, keys = newKeys , keys = newKeys
, handleEventHook = serverModeEventHook
, focusFollowsMouse = False , focusFollowsMouse = False
} }
where where

View File

@ -27,9 +27,10 @@ desktopConfig = defaultConfig
{ logHook = ewmhDesktopsLogHook { logHook = ewmhDesktopsLogHook
, layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig , layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig
, manageHook = manageHook defaultConfig <+> manageDocks , manageHook = manageHook defaultConfig <+> manageDocks
, handleEventHook = ewmhDesktopsEventHook
, keys = \c -> desktopKeys c `M.union` keys defaultConfig c } , keys = \c -> desktopKeys c `M.union` keys defaultConfig c }
desktopKeys (XConfig {modMask = modm}) = M.fromList $ desktopKeys (XConfig {modMask = modm}) = M.fromList $
[ ((modm, xK_b), sendMessage ToggleStruts) ] [ ((modm, xK_b), sendMessage ToggleStruts) ]
desktopLayoutModifiers layout = avoidStruts $ ewmhDesktopsLayout layout desktopLayoutModifiers layout = avoidStruts layout

View File

@ -44,7 +44,7 @@ import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks ) import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks )
import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook, import XMonad.Hooks.EwmhDesktops ( ewmhDesktopsLogHook,
ewmhDesktopsLayout ) ewmhDesktopsEventHook )
myXPConfig :: XPConfig myXPConfig :: XPConfig
myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*" myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
@ -121,7 +121,7 @@ keys x = M.fromList $
config = defaultConfig config = defaultConfig
{ borderWidth = 1 -- Width of the window border in pixels. { borderWidth = 1 -- Width of the window border in pixels.
, XMonad.workspaces = ["mutt","iceweasel"] , XMonad.workspaces = ["mutt","iceweasel"]
, layoutHook = ewmhDesktopsLayout $ showWName $ workspaceDir "~" $ , layoutHook = showWName $ workspaceDir "~" $
boringWindows $ smartBorders $ windowNavigation $ boringWindows $ smartBorders $ windowNavigation $
maximizeVertical $ toggleLayouts Full $ avoidStruts $ maximizeVertical $ toggleLayouts Full $ avoidStruts $
named "tabbed" mytab ||| named "tabbed" mytab |||
@ -135,6 +135,7 @@ config = defaultConfig
, terminal = "xterm" -- The preferred terminal program. , terminal = "xterm" -- The preferred terminal program.
, normalBorderColor = "#222222" -- Border color for unfocused windows. , normalBorderColor = "#222222" -- Border color for unfocused windows.
, focusedBorderColor = "#00ff00" -- Border color for focused windows. , focusedBorderColor = "#00ff00" -- Border color for focused windows.
, handleEventHook = ewmhDesktopsEventHook
, XMonad.modMask = mod1Mask , XMonad.modMask = mod1Mask
, XMonad.keys = keys , XMonad.keys = keys
} }

View File

@ -15,14 +15,14 @@
module XMonad.Hooks.EwmhDesktops ( module XMonad.Hooks.EwmhDesktops (
-- * Usage -- * Usage
-- $usage -- $usage
EwmhDesktopsHook,
ewmhDesktopsLogHook, ewmhDesktopsLogHook,
ewmhDesktopsLogHookCustom, ewmhDesktopsLogHookCustom,
ewmhDesktopsLayout ewmhDesktopsEventHook
) where ) where
import Data.List import Data.List
import Data.Maybe import Data.Maybe
import Data.Monoid
import XMonad import XMonad
import Control.Monad import Control.Monad
@ -30,7 +30,6 @@ import qualified XMonad.StackSet as W
import XMonad.Hooks.SetWMName import XMonad.Hooks.SetWMName
import XMonad.Util.WorkspaceCompare import XMonad.Util.WorkspaceCompare
import XMonad.Hooks.EventHook
-- $usage -- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@ -41,9 +40,9 @@ import XMonad.Hooks.EventHook
-- > myLogHook :: X () -- > myLogHook :: X ()
-- > myLogHook = ewmhDesktopsLogHook -- > myLogHook = ewmhDesktopsLogHook
-- > -- >
-- > myLayoutHook = ewmhDesktopsLayout $ avoidStruts $ layoutHook defaultConfig -- > myHandleEventHook = ewmhDesktopsEventHook
-- > -- >
-- > main = xmonad defaultConfig { layoutHook = myLayouts, logHook = myLogHook } -- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook, logHook = myLogHook }
-- --
-- 'avoidStruts' is used to automatically leave space for dock programs, and -- 'avoidStruts' is used to automatically leave space for dock programs, and
-- can be found in 'XMonad.Hooks.ManageDocks'. -- can be found in 'XMonad.Hooks.ManageDocks'.
@ -119,13 +118,8 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
-- --
-- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed) -- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
-- --
ewmhDesktopsLayout :: layout a -> HandleEvent EwmhDesktopsHook layout a ewmhDesktopsEventHook :: Event -> X All
ewmhDesktopsLayout = eventHook EwmhDesktopsHook ewmhDesktopsEventHook e = handle e >> return (All True)
data EwmhDesktopsHook = EwmhDesktopsHook deriving ( Show, Read )
instance EventHook EwmhDesktopsHook where
handleEvent _ e@ClientMessageEvent {} = do handle e
handleEvent _ _ = return ()
handle :: Event -> X () handle :: Event -> X ()
handle ClientMessageEvent { handle ClientMessageEvent {

View File

@ -59,16 +59,16 @@ module XMonad.Hooks.ServerMode
( -- * Usage ( -- * Usage
-- $usage -- $usage
ServerMode (..) ServerMode (..)
, eventHook , serverModeEventHook
) where ) where
import Control.Monad (when) import Control.Monad (when)
import Data.List import Data.List
import Data.Monoid
import System.IO import System.IO
import XMonad import XMonad
import XMonad.Actions.Commands import XMonad.Actions.Commands
import XMonad.Hooks.EventHook
-- $usage -- $usage
-- You can use this module with the following in your -- You can use this module with the following in your
@ -76,22 +76,15 @@ import XMonad.Hooks.EventHook
-- --
-- > import XMonad.Hooks.ServerMode -- > import XMonad.Hooks.ServerMode
-- --
-- Then edit your @layoutHook@ by adding the 'eventHook': -- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
-- --
-- > layoutHook = eventHook ServerMode $ avoidStruts $ simpleTabbed ||| Full ||| etc.. -- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }
-- --
-- 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 ) data ServerMode = ServerMode deriving ( Show, Read )
instance EventHook ServerMode where serverModeEventHook :: Event -> X All
handleEvent _ (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do serverModeEventHook (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
@ -100,4 +93,5 @@ instance EventHook ServerMode where
case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
Just (c,_) -> runCommand' c Just (c,_) -> runCommand' c
Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
handleEvent _ _ = return () return (All True)
serverModeEventHook _ = return (All True)

View File

@ -70,7 +70,6 @@ module XMonad.Hooks.UrgencyHook (
import XMonad import XMonad
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Hooks.EventHook
import XMonad.Util.Dzen (dzenWithArgs, seconds) import XMonad.Util.Dzen (dzenWithArgs, seconds)
import XMonad.Util.NamedWindows (getName) import XMonad.Util.NamedWindows (getName)
import XMonad.Util.Timer (TimerId, startTimer, handleTimer) import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
@ -199,7 +198,7 @@ import Foreign (unsafePerformIO)
-- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook' -- 'urgencyConfig' to control behavior. To change this, use 'withUrgencyHook'
-- instead. -- instead.
withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) => withUrgencyHook :: (LayoutClass l Window, UrgencyHook h) =>
h -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l) h -> XConfig l -> XConfig l
withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
-- | This lets you modify the defaults set in 'urgencyConfig'. An example: -- | This lets you modify the defaults set in 'urgencyConfig'. An example:
@ -208,9 +207,9 @@ withUrgencyHook hook conf = withUrgencyHookC hook urgencyConfig conf
-- --
-- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration. -- (Don't type the @...@, you dolt.) See 'UrgencyConfig' for details on configuration.
withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) => withUrgencyHookC :: (LayoutClass l Window, UrgencyHook h) =>
h -> UrgencyConfig -> XConfig l -> XConfig (HandleEvent (WithUrgencyHook h) l) h -> UrgencyConfig -> XConfig l -> XConfig l
withUrgencyHookC hook urgConf conf = conf { withUrgencyHookC hook urgConf conf = conf {
layoutHook = eventHook (WithUrgencyHook hook urgConf) $ layoutHook conf, handleEventHook = \e -> handleEvent (WithUrgencyHook hook urgConf) e >> handleEventHook conf e,
logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf logHook = cleanupUrgents (suppressWhen urgConf) >> logHook conf
} }
@ -322,9 +321,10 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
-- ourselves, allowing us to clear urgency when a window is visible, and not to -- ourselves, allowing us to clear urgency when a window is visible, and not to
-- set urgency if a window is visible. If you have a better idea, please, let us -- set urgency if a window is visible. If you have a better idea, please, let us
-- know! -- know!
instance UrgencyHook h => EventHook (WithUrgencyHook h) where handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
handleEvent wuh event = case event of handleEvent wuh event =
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do case event of
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
WMHints { wmh_flags = flags } <- io $ getWMHints dpy w WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
if (testBit flags urgencyHintBit) then do if (testBit flags urgencyHintBit) then do
@ -333,9 +333,9 @@ instance UrgencyHook h => EventHook (WithUrgencyHook h) where
else else
clearUrgency w clearUrgency w
userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified userCodeDef () =<< asks (logHook . config) -- call *after* IORef has been modified
DestroyWindowEvent {ev_window = w} -> DestroyWindowEvent {ev_window = w} ->
clearUrgency w clearUrgency w
_ -> _ ->
mapM_ handleReminder =<< readReminders mapM_ handleReminder =<< readReminders
where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder