From 0d2a4165b0d6546f63ef83f43c9c04d7aedf6cfd Mon Sep 17 00:00:00 2001 From: Stefan O'Rear Date: Tue, 12 Jun 2007 08:02:10 +0200 Subject: Refactor Decoration into a general layout-level hooks interface, and a decoration support module on top of that darcs-hash:20070612060210-e3110-054f8159e36a5b60e8fdac6293dc0294d1f5f918.gz --- LayoutHooks.hs | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) create mode 100644 LayoutHooks.hs (limited to 'LayoutHooks.hs') diff --git a/LayoutHooks.hs b/LayoutHooks.hs new file mode 100644 index 0000000..da66761 --- /dev/null +++ b/LayoutHooks.hs @@ -0,0 +1,31 @@ +module XMonadContrib.LayoutHooks ( addLayoutMessageHook ) where + +import qualified Data.Map as M ( adjust ) +import Control.Arrow ( first ) +import Control.Monad.State ( modify ) + +import XMonad +import qualified StackSet as W + +install :: (SomeMessage -> X Bool) -> Layout -> Layout +install hk lay = lay{ modifyLayout = mod' } + where + mod' msg = do reinst <- hk msg + nlay <- modifyLayout lay msg + + return $ cond_reinst reinst nlay + + -- no need to make anything change + cond_reinst True Nothing = Nothing + -- reinstall + cond_reinst True (Just nlay) = Just (install hk nlay) + -- restore inner layout + cond_reinst False Nothing = Just lay + -- let it rot + cond_reinst False (Just nlay) = Just nlay + +-- Return True each time you want the hook reinstalled +addLayoutMessageHook :: (SomeMessage -> X Bool) -> X () +addLayoutMessageHook hk = modify $ \ s -> + let nr = W.tag . W.workspace . W.current . windowset $ s + in s { layouts = M.adjust (first $ install hk) nr (layouts s) } -- cgit v1.2.3