{-# LANGUAGE FlexibleContexts #-}
{-# OPTIONS -fno-warn-missing-signatures #-}
module XMonad.Config.Bluetile (
bluetileConfig
) where
import XMonad
import XMonad.Layout.BorderResize
import XMonad.Layout.BoringWindows hiding (Replace)
import XMonad.Layout.ButtonDecoration
import XMonad.Layout.Decoration
import XMonad.Layout.DecorationAddons
import XMonad.Layout.DraggingVisualizer
import XMonad.Layout.Maximize
import XMonad.Layout.Minimize
import XMonad.Layout.MouseResizableTile
import XMonad.Layout.Renamed
import XMonad.Layout.NoBorders
import XMonad.Layout.PositionStoreFloat
import XMonad.Layout.WindowSwitcherDecoration
import XMonad.Actions.BluetileCommands
import XMonad.Actions.CycleWS
import XMonad.Actions.Minimize
import XMonad.Actions.WindowMenu
import XMonad.Hooks.CurrentWorkspaceOnTop
import XMonad.Hooks.EwmhDesktops
import XMonad.Hooks.ManageDocks
import XMonad.Hooks.ManageHelpers
import XMonad.Hooks.PositionStoreHooks
import XMonad.Hooks.Minimize
import XMonad.Hooks.ServerMode
import XMonad.Hooks.WorkspaceByPos
import XMonad.Config.Gnome
import qualified XMonad.StackSet as W
import qualified Data.Map as M
import System.Exit
import XMonad.Prelude(when)
bluetileWorkspaces :: [String]
bluetileWorkspaces :: [String]
bluetileWorkspaces = [String
"1",String
"2",String
"3",String
"4",String
"5",String
"6",String
"7",String
"8",String
"9",String
"0"]
bluetileKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
bluetileKeys :: XConfig Layout -> Map (KeyMask, Window) (X ())
bluetileKeys conf :: XConfig Layout
conf@XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
XMonad.modMask = KeyMask
modMask'} = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$
[ ((KeyMask
modMask' , Window
xK_Return), forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> String
XMonad.terminal XConfig Layout
conf)
, ((KeyMask
modMask', Window
xK_p ), X ()
gnomeRun)
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_c ), X ()
kill)
, ((KeyMask
modMask', Window
xK_F5 ), X ()
refresh)
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_F5 ), Layout Window -> X ()
setLayout forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). XConfig l -> l Window
XMonad.layoutHook XConfig Layout
conf)
, ((KeyMask
modMask', Window
xK_o ), X ()
windowMenu)
, ((KeyMask
modMask', Window
xK_Tab ), X ()
focusDown)
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_Tab ), X ()
focusUp)
, ((KeyMask
modMask', Window
xK_j ), X ()
focusDown)
, ((KeyMask
modMask', Window
xK_k ), X ()
focusUp)
, ((KeyMask
modMask', Window
xK_space ), X ()
focusMaster)
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_space ), (WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapMaster)
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_j ), (WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapDown )
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_k ), (WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.swapUp )
, ((KeyMask
modMask', Window
xK_h ), forall a. Message a => a -> X ()
sendMessage Resize
Shrink)
, ((KeyMask
modMask', Window
xK_l ), forall a. Message a => a -> X ()
sendMessage Resize
Expand)
, ((KeyMask
modMask', Window
xK_u ), forall a. Message a => a -> X ()
sendMessage MRTMessage
ShrinkSlave)
, ((KeyMask
modMask', Window
xK_i ), forall a. Message a => a -> X ()
sendMessage MRTMessage
ExpandSlave)
, ((KeyMask
modMask', Window
xK_t ), (Window -> X ()) -> X ()
withFocused forall a b. (a -> b) -> a -> b
$ (WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a i l s sd.
Ord a =>
a -> StackSet i l a s sd -> StackSet i l a s sd
W.sink)
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_t ), (Window -> X ()) -> X ()
withFocused Window -> X ()
float )
, ((KeyMask
modMask' , Window
xK_comma ), forall a. Message a => a -> X ()
sendMessage (Int -> IncMasterN
IncMasterN Int
1))
, ((KeyMask
modMask' , Window
xK_period), forall a. Message a => a -> X ()
sendMessage (Int -> IncMasterN
IncMasterN (-Int
1)))
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_q ), forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a. IO a
exitSuccess)
, ((KeyMask
modMask' , Window
xK_q ), String -> Bool -> X ()
restart String
"xmonad" Bool
True)
, ((KeyMask
mod1Mask forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, Window
xK_Left), X ()
prevWS)
, ((KeyMask
mod1Mask forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask, Window
xK_Right), X ()
nextWS)
, ((KeyMask
mod1Mask forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_Left), X ()
shiftToPrev forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
prevWS)
, ((KeyMask
mod1Mask forall a. Bits a => a -> a -> a
.|. KeyMask
controlMask forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_Right), X ()
shiftToNext forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> X ()
nextWS)
, ((KeyMask
mod1Mask , Window
xK_F2), X ()
gnomeRun)
, ((KeyMask
mod1Mask , Window
xK_F4), X ()
kill)
, ((KeyMask
modMask' , Window
xK_a), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ String -> JumpToLayout
JumpToLayout String
"Floating")
, ((KeyMask
modMask' , Window
xK_s), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ String -> JumpToLayout
JumpToLayout String
"Tiled1")
, ((KeyMask
modMask' , Window
xK_d), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ String -> JumpToLayout
JumpToLayout String
"Tiled2")
, ((KeyMask
modMask' , Window
xK_f), forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ String -> JumpToLayout
JumpToLayout String
"Fullscreen")
, ((KeyMask
modMask' , Window
xK_z), (Window -> X ()) -> X ()
withFocused (forall a. Message a => a -> X ()
sendMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> MaximizeRestore
maximizeRestore))
, ((KeyMask
modMask', Window
xK_m ), (Window -> X ()) -> X ()
withFocused Window -> X ()
minimizeWindow)
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Window
xK_m ), (Window -> X ()) -> X ()
withLastMinimized Window -> X ()
maximizeWindow)
]
forall a. [a] -> [a] -> [a]
++
[((KeyMask
m forall a. Bits a => a -> a -> a
.|. KeyMask
modMask', Window
k), (WindowSet -> WindowSet) -> X ()
windows forall a b. (a -> b) -> a -> b
$ String -> WindowSet -> WindowSet
f String
i)
| (String
i, Window
k) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall (l :: * -> *). XConfig l -> [String]
XMonad.workspaces XConfig Layout
conf) ([Window
xK_1 .. Window
xK_9] forall a. [a] -> [a] -> [a]
++ [Window
xK_0])
, (String -> WindowSet -> WindowSet
f, KeyMask
m) <- [(forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.greedyView, KeyMask
0), (forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift, KeyMask
shiftMask)]]
forall a. [a] -> [a] -> [a]
++
[((KeyMask
m forall a. Bits a => a -> a -> a
.|. KeyMask
modMask', Window
key), ScreenId -> X (Maybe String)
screenWorkspace ScreenId
sc forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust ((WindowSet -> WindowSet) -> X ()
windows forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WindowSet -> WindowSet
f))
| (Window
key, ScreenId
sc) <- forall a b. [a] -> [b] -> [(a, b)]
zip [Window
xK_w, Window
xK_e, Window
xK_r] [ScreenId
0..]
, (String -> WindowSet -> WindowSet
f, KeyMask
m) <- [(forall s i l a sd.
(Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.view, KeyMask
0), (forall a s i l sd.
(Ord a, Eq s, Eq i) =>
i -> StackSet i l a s sd -> StackSet i l a s sd
W.shift, KeyMask
shiftMask)]]
bluetileMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
bluetileMouseBindings :: XConfig Layout -> Map (KeyMask, Button) (Window -> X ())
bluetileMouseBindings XConfig{modMask :: forall (l :: * -> *). XConfig l -> KeyMask
XMonad.modMask = KeyMask
modMask'} = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
[ ((KeyMask
modMask', Button
button1), \Window
w -> Window -> X Bool
isFloating Window
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
isF -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isF forall a b. (a -> b) -> a -> b
$
Window -> X ()
focus Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
mouseMoveWindow Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster)
, ((KeyMask
modMask', Button
button2), \Window
_ -> forall a. Message a => a -> X ()
sendMessage ChangeLayout
NextLayout)
, ((KeyMask
modMask' forall a. Bits a => a -> a -> a
.|. KeyMask
shiftMask, Button
button2), \Window
_ -> forall a. Message a => a -> X ()
sendMessage forall a b. (a -> b) -> a -> b
$ String -> JumpToLayout
JumpToLayout String
"Floating")
, ((KeyMask
modMask', Button
button3), \Window
w -> Window -> X Bool
isFloating Window
w forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
isF -> forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isF forall a b. (a -> b) -> a -> b
$
Window -> X ()
focus Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Window -> X ()
mouseResizeWindow Window
w forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (WindowSet -> WindowSet) -> X ()
windows forall i l a s sd. StackSet i l a s sd -> StackSet i l a s sd
W.shiftMaster)
]
isFloating :: Window -> X Bool
isFloating :: Window -> X Bool
isFloating Window
w = do
WindowSet
ws <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState -> WindowSet
windowset
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Bool
M.member Window
w (forall i l a sid sd. StackSet i l a sid sd -> Map a RationalRect
W.floating WindowSet
ws)
bluetileManageHook :: ManageHook
bluetileManageHook :: ManageHook
bluetileManageHook = forall m. Monoid m => [m] -> m
composeAll
[ ManageHook
workspaceByPos, Maybe Theme -> ManageHook
positionStoreManageHook (forall a. a -> Maybe a
Just Theme
defaultThemeWithButtons)
, Query String
className forall a. Eq a => Query a -> a -> Query Bool
=? String
"MPlayer" forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> ManageHook
doFloat
, Query Bool
isFullscreen forall (m :: * -> *) a. (Monad m, Monoid a) => m Bool -> m a -> m a
--> ManageHook
doFullFloat]
bluetileLayoutHook :: ModifiedLayout
AvoidStruts
(ModifiedLayout
Minimize
(ModifiedLayout
BoringWindows
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration ButtonDecoration DefaultShrinker)
(ModifiedLayout
Maximize (ModifiedLayout BorderResize PositionStoreFloat))))
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))))
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))))
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer
(ModifiedLayout Maximize (ModifiedLayout SmartBorder Full))))))))))
Window
bluetileLayoutHook = forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout AvoidStruts l a
avoidStruts forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *). l Window -> ModifiedLayout Minimize l Window
minimize forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
(LayoutClass l a, Eq a) =>
l a -> ModifiedLayout BoringWindows l a
boringWindows forall a b. (a -> b) -> a -> b
$
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Floating"] ModifiedLayout
(Decoration ButtonDecoration DefaultShrinker)
(ModifiedLayout
Maximize (ModifiedLayout BorderResize PositionStoreFloat))
Window
floating forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
|||
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Tiled1"] ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))
Window
tiled1 forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
|||
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Tiled2"] ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))
Window
tiled2 forall (l :: * -> *) a (r :: * -> *). l a -> r a -> Choose l r a
|||
forall a (l :: * -> *).
[Rename a] -> l a -> ModifiedLayout Rename l a
renamed [forall a. String -> Rename a
Replace String
"Fullscreen"] ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer
(ModifiedLayout Maximize (ModifiedLayout SmartBorder Full)))
Window
fullscreen
where
floating :: ModifiedLayout
(Decoration ButtonDecoration DefaultShrinker)
(ModifiedLayout
Maximize (ModifiedLayout BorderResize PositionStoreFloat))
Window
floating = forall {l :: * -> *}.
l Window
-> ModifiedLayout
(Decoration ButtonDecoration DefaultShrinker) l Window
floatingDeco forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *).
LayoutClass l Window =>
l Window -> ModifiedLayout Maximize l Window
maximize forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a. l a -> ModifiedLayout BorderResize l a
borderResize forall a. PositionStoreFloat a
positionStoreFloat
tiled1 :: ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))
Window
tiled1 = forall {l :: * -> *}.
LayoutClass l Window =>
l Window
-> ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout DraggingVisualizer l)
Window
tilingDeco forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *).
LayoutClass l Window =>
l Window -> ModifiedLayout Maximize l Window
maximize forall a. MouseResizableTile a
mouseResizableTileMirrored
tiled2 :: ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))
Window
tiled2 = forall {l :: * -> *}.
LayoutClass l Window =>
l Window
-> ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout DraggingVisualizer l)
Window
tilingDeco forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *).
LayoutClass l Window =>
l Window -> ModifiedLayout Maximize l Window
maximize forall a. MouseResizableTile a
mouseResizableTile
fullscreen :: ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer
(ModifiedLayout Maximize (ModifiedLayout SmartBorder Full)))
Window
fullscreen = forall {l :: * -> *}.
LayoutClass l Window =>
l Window
-> ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout DraggingVisualizer l)
Window
tilingDeco forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *).
LayoutClass l Window =>
l Window -> ModifiedLayout Maximize l Window
maximize forall a b. (a -> b) -> a -> b
$ forall (l :: * -> *) a.
LayoutClass l a =>
l a -> ModifiedLayout SmartBorder l a
smartBorders forall a. Full a
Full
tilingDeco :: l Window
-> ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout DraggingVisualizer l)
Window
tilingDeco l Window
l = forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration WindowSwitcherDecoration s) l a
windowSwitcherDecorationWithButtons DefaultShrinker
shrinkText Theme
defaultThemeWithButtons (forall (l :: * -> *).
LayoutClass l Window =>
l Window -> ModifiedLayout DraggingVisualizer l Window
draggingVisualizer l Window
l)
floatingDeco :: l Window
-> ModifiedLayout
(Decoration ButtonDecoration DefaultShrinker) l Window
floatingDeco = forall a s (l :: * -> *).
(Eq a, Shrinker s) =>
s
-> Theme
-> l a
-> ModifiedLayout (Decoration ButtonDecoration s) l a
buttonDeco DefaultShrinker
shrinkText Theme
defaultThemeWithButtons
bluetileConfig :: XConfig
(ModifiedLayout
AvoidStruts
(ModifiedLayout
Minimize
(ModifiedLayout
BoringWindows
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration ButtonDecoration DefaultShrinker)
(ModifiedLayout
Maximize (ModifiedLayout BorderResize PositionStoreFloat))))
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))))
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))))
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer
(ModifiedLayout
Maximize (ModifiedLayout SmartBorder Full)))))))))))
bluetileConfig =
forall (a :: * -> *). XConfig a -> XConfig a
docks forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> *). XConfig a -> XConfig a
ewmhFullscreen forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> *). XConfig a -> XConfig a
ewmh forall a b. (a -> b) -> a -> b
$
forall a. Default a => a
def
{ modMask :: KeyMask
modMask = KeyMask
mod4Mask,
manageHook :: ManageHook
manageHook = ManageHook
bluetileManageHook,
layoutHook :: ModifiedLayout
AvoidStruts
(ModifiedLayout
Minimize
(ModifiedLayout
BoringWindows
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration ButtonDecoration DefaultShrinker)
(ModifiedLayout
Maximize (ModifiedLayout BorderResize PositionStoreFloat))))
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))))
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))))
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer
(ModifiedLayout Maximize (ModifiedLayout SmartBorder Full))))))))))
Window
layoutHook = ModifiedLayout
AvoidStruts
(ModifiedLayout
Minimize
(ModifiedLayout
BoringWindows
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration ButtonDecoration DefaultShrinker)
(ModifiedLayout
Maximize (ModifiedLayout BorderResize PositionStoreFloat))))
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))))
(Choose
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer (ModifiedLayout Maximize MouseResizableTile))))
(ModifiedLayout
Rename
(ModifiedLayout
(Decoration WindowSwitcherDecoration DefaultShrinker)
(ModifiedLayout
DraggingVisualizer
(ModifiedLayout Maximize (ModifiedLayout SmartBorder Full))))))))))
Window
bluetileLayoutHook,
logHook :: X ()
logHook = X ()
currentWorkspaceOnTop,
handleEventHook :: Event -> X All
handleEventHook = Event -> X All
minimizeEventHook
forall a. Monoid a => a -> a -> a
`mappend` X [(String, X ())] -> Event -> X All
serverModeEventHook' X [(String, X ())]
bluetileCommands
forall a. Monoid a => a -> a -> a
`mappend` Event -> X All
positionStoreEventHook,
workspaces :: [String]
workspaces = [String]
bluetileWorkspaces,
keys :: XConfig Layout -> Map (KeyMask, Window) (X ())
keys = XConfig Layout -> Map (KeyMask, Window) (X ())
bluetileKeys,
mouseBindings :: XConfig Layout -> Map (KeyMask, Button) (Window -> X ())
mouseBindings = XConfig Layout -> Map (KeyMask, Button) (Window -> X ())
bluetileMouseBindings,
focusFollowsMouse :: Bool
focusFollowsMouse = Bool
False,
focusedBorderColor :: String
focusedBorderColor = String
"#000000",
terminal :: String
terminal = String
"gnome-terminal"
}