Refactor Decoration into a general layout-level hooks interface, and a decoration support module on top of that

darcs-hash:20070612060210-e3110-054f8159e36a5b60e8fdac6293dc0294d1f5f918.gz

1 files changed, 31 insertions, 0 deletions

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) }