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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.LayoutModifier
-- Copyright : (c) David Roundy <droundy@darcs.net>
-- License : BSD
--
-- Maintainer : David Roundy <droundy@darcs.net>
-- Stability : unstable
-- Portability : portable
--
-- A module for writing easy Llayouts and layout modifiers
-----------------------------------------------------------------------------
module XMonad.Layout.LayoutModifier (
-- * Usage
-- $usage
LayoutModifier(..), ModifiedLayout(..)
) where
import XMonad
import XMonad.StackSet ( Stack )
-- $usage
-- Use LayoutModifier to help write easy Layouts.
--
-- LayouModifier defines a class 'LayoutModifier'. Each method as a
-- default implementation.
--
-- For usage examples you can see "XMonad.Layout.WorkspaceDir",
-- "XMonad.Layout.Magnifier", "XMonad.Layout.NoBorder",
class (Show (m a), Read (m a)) => LayoutModifier m a where
modifyLayout :: (LayoutClass l a) => m a -> l a -> Rectangle
-> Stack a -> X ([(a, Rectangle)], Maybe (l a))
modifyLayout _ l r s = doLayout l r s
handleMess :: m a -> SomeMessage -> X (Maybe (m a))
handleMess m mess | Just Hide <- fromMessage mess = doUnhook
| Just ReleaseResources <- fromMessage mess = doUnhook
| otherwise = return $ pureMess m mess
where doUnhook = do unhook m; return Nothing
handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
return (Left `fmap` mm')
pureMess :: m a -> SomeMessage -> Maybe (m a)
pureMess _ _ = Nothing
redoLayout :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (m a))
redoLayout m r s wrs = do hook m; return $ pureModifier m r s wrs
pureModifier :: m a -> Rectangle -> Stack a -> [(a, Rectangle)]
-> ([(a, Rectangle)], Maybe (m a))
pureModifier _ _ _ wrs = (wrs, Nothing)
emptyLayoutMod :: m a -> Rectangle -> [(a, Rectangle)]
-> X ([(a, Rectangle)], Maybe (m a))
emptyLayoutMod _ _ _ = return ([], Nothing)
hook :: m a -> X ()
hook _ = return ()
unhook :: m a -> X ()
unhook _ = return ()
modifierDescription :: m a -> String
modifierDescription = const ""
modifyDescription :: (LayoutClass l a) => m a -> l a -> String
modifyDescription m l = modifierDescription m <> description l
where "" <> x = x
x <> y = x ++ " " ++ y
instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
doLayout (ModifiedLayout m l) r s =
do (ws, ml') <- modifyLayout m l r s
(ws', mm') <- redoLayout m r s ws
let ml'' = case mm' of
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
Nothing -> ModifiedLayout m `fmap` ml'
return (ws', ml'')
emptyLayout (ModifiedLayout m l) r =
do (ws, ml') <- emptyLayout l r
(ws',mm') <- emptyLayoutMod m r ws
let ml'' = case mm' of
Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
Nothing -> ModifiedLayout m `fmap` ml'
return (ws', ml'')
handleMessage (ModifiedLayout m l) mess =
do mm' <- handleMessOrMaybeModifyIt m mess
ml' <- case mm' of
Just (Right mess') -> handleMessage l mess'
_ -> handleMessage l mess
return $ case mm' of
Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
_ -> (ModifiedLayout m) `fmap` ml'
description (ModifiedLayout m l) = modifyDescription m l
data ModifiedLayout m l a = ModifiedLayout (m a) (l a) deriving ( Read, Show )
|
