blob: 9a4a95db06500c255feb7f0e7c9f1ac7053294bd (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
|
-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.LayoutHooks
-- Copyright : (c) Stefan O'Rear <stefanor@cox.net>
-- License : BSD
--
-- Maintainer : Stefan O'Rear <stefanor@cox.net>
-- Stability : unstable
-- Portability : portable
--
-- General layout-level hooks.
-----------------------------------------------------------------------------
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 a -> Layout a
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) }
|
