From b578d52a5dcfa89ab65c027478dbb553df4c34e5 Mon Sep 17 00:00:00 2001 From: Daniel Schoepe Date: Thu, 18 Jun 2009 12:43:18 +0200 Subject: Remove Hooks.EventHook Ignore-this: 14c32fddc8b7b0561e97eb1d09e27fd7 The Hooks.EventHook module is superseded by handleEventHook from core and should no longer be needed. darcs-hash:20090618104318-cb1c6-43b2f002f74c3eab3a8ea916caa17ea77bae0e16.gz --- XMonad/Doc/Extending.hs | 4 +- XMonad/Hooks/EventHook.hs | 107 ---------------------------------------------- 2 files changed, 1 insertion(+), 110 deletions(-) delete mode 100644 XMonad/Hooks/EventHook.hs (limited to 'XMonad') diff --git a/XMonad/Doc/Extending.hs b/XMonad/Doc/Extending.hs index 67dd8c6..39e11a2 100644 --- a/XMonad/Doc/Extending.hs +++ b/XMonad/Doc/Extending.hs @@ -243,8 +243,6 @@ Here is a list of the modules found in @XMonad.Hooks@: putting in a status bar of some sort. See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars". -* "XMonad.Hooks.EventHook": a hook to handle X events at the layout level. - * "XMonad.Hooks.EwmhDesktops": support for pagers in panel applications. * "XMonad.Hooks.ManageDocks": handle DOCK and STRUT windows (such as @@ -254,7 +252,7 @@ Here is a list of the modules found in @XMonad.Hooks@: * "XMonad.Hooks.ManageHelpers": provide helper functions to be used in @manageHook@. -* "XMonad.Hooks.ServerMode": example use of "XMonad.Hooks.EventHook". +* "XMonad.Hooks.ServerMode": Allows sending commands to a running xmonad process. * "XMonad.Hooks.SetWMName": set the WM name. Useful when e.g. running Java GUI programs. diff --git a/XMonad/Hooks/EventHook.hs b/XMonad/Hooks/EventHook.hs deleted file mode 100644 index 234de48..0000000 --- a/XMonad/Hooks/EventHook.hs +++ /dev/null @@ -1,107 +0,0 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} -- for deriving Typeable -{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-} - ------------------------------------------------------------------------------ --- | --- Module : XMonad.Hooks.EventHook --- Copyright : (c) 2007 Andrea Rossato --- License : BSD-style (see xmonad/LICENSE) --- --- Maintainer : andrea.rossato@unibz.it --- Stability : unstable --- Portability : unportable --- --- A layout modifier that implements an event hook at the layout level. --- --- Since it operates at the 'Workspace' level, it will install itself --- on the first current 'Workspace' and will broadcast a 'Message' to --- all other 'Workspace's not to handle events. ------------------------------------------------------------------------------ - -module XMonad.Hooks.EventHook - ( -- * Usage - -- $usage - - -- * Writing a hook - -- $hook - EventHook (..) - , eventHook - , HandleEvent - ) where - -import Data.Maybe - -import XMonad -import XMonad.StackSet (Workspace (..), currentTag) - --- $usage --- You can use this module with the following in your --- @~\/.xmonad\/xmonad.hs@: --- --- > import XMonad.Hooks.EventHook --- --- Then edit your @layoutHook@ by adding the 'eventHook': --- --- > layoutHook = eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc.. --- --- and then: --- --- > main = xmonad defaultConfig { layoutHook = myLayouts } --- --- For more detailed instructions on editing the layoutHook see: --- --- "XMonad.Doc.Extending#Editing_the_layout_hook" - --- $hook --- Writing a hook is very simple. --- --- This is a basic example to log all events: --- --- > data EventHookExample = EventHookExample deriving ( Show, Read ) --- > instance EventHook EventHookExample where --- > handleEvent _ e = io $ hPutStrLn stderr . show $ e --return () --- --- This is an 'EventHook' to log mouse button events: --- --- > data EventHookButton = EventHookButton deriving ( Show, Read ) --- > instance EventHook EventHookButton where --- > handleEvent _ (ButtonEvent {ev_window = w}) = do --- > io $ hPutStrLn stderr $ "This is a button event on window " ++ (show w) --- > handleEvent _ _ = return () --- --- Obviously you can compose event hooks: --- --- > layoutHook = eventHook EventHookButton $ eventHook EventHookExample $ avoidStruts $ simpleTabbed ||| Full ||| etc.. - -eventHook :: EventHook eh => eh -> l a -> (HandleEvent eh l) a -eventHook = HandleEvent Nothing True - -class (Read eh, Show eh) => EventHook eh where - handleEvent :: eh -> Event -> X () - handleEvent _ _ = return () - -data HandleEvent eh l a = HandleEvent (Maybe WorkspaceId) Bool eh (l a) deriving ( Show, Read ) - -data EventHandleMsg = HandlerOff deriving ( Typeable ) -instance Message EventHandleMsg - -instance (EventHook eh, LayoutClass l a) => LayoutClass (HandleEvent eh l) a where - runLayout (Workspace i (HandleEvent Nothing True eh l) ms) r = do - broadcastMessage HandlerOff - iws <- gets (currentTag . windowset) - (wrs, ml) <- runLayout (Workspace i l ms) r - return (wrs, Just $ HandleEvent (Just iws) True eh (fromMaybe l ml)) - - runLayout (Workspace i (HandleEvent mi b eh l) ms) r = do - (wrs, ml) <- runLayout (Workspace i l ms) r - return (wrs, Just $ HandleEvent mi b eh (fromMaybe l ml)) - - handleMessage (HandleEvent i True eh l) m - | Just HandlerOff <- fromMessage m = return . Just $ HandleEvent i False eh l - | Just e <- fromMessage m = handleMessage l (SomeMessage e) >>= \ml -> - handleEvent eh e >> - maybe (return Nothing) (\l' -> return . Just $ HandleEvent i True eh l') ml - handleMessage (HandleEvent i b eh l) m = handleMessage l m >>= - maybe (return Nothing) (\l' -> return . Just $ HandleEvent i b eh l') - - description (HandleEvent _ _ _ l) = description l -- cgit v1.2.3