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
|
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards, DeriveDataTypeable #-}
module ConfigurableBorders ( configureBorders
, configBorderWidth
, resetBorderWidth
, doConfigBorderWidth
, doConfigBorderOff
) where
import qualified XMonad.Core as XM
import XMonad.Operations (sendMessage)
import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
import Graphics.X11.Types (Window)
import Graphics.X11.Xlib.Types (Dimension)
import Graphics.X11.Xlib.Window (setWindowBorderWidth)
import Control.Monad.Reader
import Data.Monoid
import Data.Typeable
import qualified Data.Map as M
import qualified Data.Set as S
defaultBorderWidth :: XM.X Dimension
defaultBorderWidth = asks (XM.borderWidth . XM.config)
data BorderWidth = BorderWidth Window Dimension deriving Typeable
instance XM.Message BorderWidth
configBorderWidth :: Dimension -> Window -> XM.X ()
configBorderWidth w win = sendMessage $ BorderWidth win w
resetBorderWidth :: Window -> XM.X ()
resetBorderWidth win = do
defBW <- defaultBorderWidth
configBorderWidth defBW win
doConfigBorderWidth :: Dimension -> XM.ManageHook
doConfigBorderWidth w = XM.Query $ do
win <- ask
lift $ configBorderWidth w win
return $ Endo id
doConfigBorderOff :: XM.ManageHook
doConfigBorderOff = doConfigBorderWidth 0
data ConfigureBorders a = ConfigureBorders (M.Map a Dimension) (M.Map a Dimension)
deriving (Show, Read)
configureBorders :: (XM.LayoutClass l a) =>
l a
-> ModifiedLayout ConfigureBorders l a
configureBorders = ModifiedLayout $ ConfigureBorders M.empty M.empty
instance LayoutModifier ConfigureBorders Window where
modifierDescription _ = "ConfigureBorders"
pureMess (ConfigureBorders wm wmlast) m
| Just (BorderWidth win width) <- XM.fromMessage m = do
let wmnew = M.insert win width wm
return $ ConfigureBorders wmnew wmlast
pureMess _ _ = Nothing
redoLayout (ConfigureBorders wm wmlast) _ _ wrs = do
setBorders wmlast
return (wrs, Just $ ConfigureBorders M.empty wm)
where
ws = S.fromList $ map fst wrs
setBorders :: (M.Map Window Dimension) -> XM.X ()
setBorders wm = forM_ (M.toList wm) $ \(win,width) -> setBorder win width
setBorder :: Window -> Dimension -> XM.X ()
setBorder w width = XM.withDisplay $ \dpy -> XM.io $ setWindowBorderWidth dpy w width
|
