summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2013-09-11 21:48:00 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2013-09-11 21:48:00 +0200
commit29e342c4985744cc2538d85cdbb248e6dd5f5ff8 (patch)
tree123e2ce9e38de16f5e3f56989a37879da93dd96a
parentf05f53f9057508ff274f5ee51b866e68fb09824a (diff)
downloadmetatile-29e342c4985744cc2538d85cdbb248e6dd5f5ff8.tar
metatile-29e342c4985744cc2538d85cdbb248e6dd5f5ff8.zip
Let the layout decide about the border width
-rw-r--r--MetaTile/Core.hs9
-rw-r--r--MetaTile/Operations.hs18
2 files changed, 21 insertions, 6 deletions
diff --git a/MetaTile/Core.hs b/MetaTile/Core.hs
index e116ccf..5596ec3 100644
--- a/MetaTile/Core.hs
+++ b/MetaTile/Core.hs
@@ -291,6 +291,14 @@ readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
-- that any 'LayoutClass' instance chooses to define.
class Show (layout a) => LayoutClass layout a where
+ runBorderLayout :: Workspace WorkspaceId (layout a) a
+ -> Rectangle
+ -> X ([(a, Rectangle, BorderWidth)], Maybe (layout a))
+ runBorderLayout ws r = do
+ bw <- asks (defaultBorderWidth . config)
+ (as, l) <- runLayout ws r
+ return ([(a, ar, bw) | (a, ar) <- as], l)
+
-- | By default, 'runLayout' calls 'doLayout' if there are any
-- windows to be laid out, and 'emptyLayout' otherwise. Most
-- instances of 'LayoutClass' probably do not need to implement
@@ -356,6 +364,7 @@ class Show (layout a) => LayoutClass layout a where
description = show
instance LayoutClass Layout Window where
+ runBorderLayout (Workspace i (Layout l) ms) r = fmap (fmap Layout) `fmap` runBorderLayout (Workspace i l ms) r
runLayout (Workspace i (Layout l) ms) r = fmap (fmap Layout) `fmap` runLayout (Workspace i l ms) r
doLayout (Layout l) r s = fmap (fmap Layout) `fmap` doLayout l r s
emptyLayout (Layout l) r = fmap (fmap Layout) `fmap` emptyLayout l r
diff --git a/MetaTile/Operations.hs b/MetaTile/Operations.hs
index 5b3a598..db2e264 100644
--- a/MetaTile/Operations.hs
+++ b/MetaTile/Operations.hs
@@ -92,7 +92,7 @@ windows f = do
let oldvisible = concatMap (W.integrate' . W.stack . W.screenWorkspace) $ W.screens old
newwindows = W.allWindows ws \\ W.allWindows old
ws = f old
- XConf { display = d , normalBorder = nbc, focusedBorder = fbc, config = XConfig { defaultBorderWidth = bw } } <- ask
+ XConf { display = d, normalBorder = nbc, focusedBorder = fbc } <- ask
mapM_ setInitialProperties newwindows
@@ -117,17 +117,17 @@ windows f = do
-- just the tiled windows:
-- now tile the windows on this workspace, modified by the gap
- (rs, ml') <- runLayout wsp { W.stack = tiled } viewrect `catchX`
- runLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect
+ (rs, ml') <- runBorderLayout wsp { W.stack = tiled } viewrect `catchX`
+ runBorderLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect
updateLayout n ml'
- io $ restackWindows d (map fst rs)
+ io $ restackWindows d (map fst3 rs)
-- return the visible windows for this workspace:
return rs
- let visible = map fst rects
+ let visible = map fst3 rects
- mapM_ (\(w, r) -> tileWindow w r bw) rects
+ mapM_ (uncurry3 tileWindow) rects
whenJust (W.peek ws) $ \w -> setFrameBackground d w fbc
@@ -147,6 +147,12 @@ windows f = do
unless isMouseFocused $ clearEvents enterWindowMask
asks (logHook . config) >>= userCodeDef ()
where
+ fst3 :: (a, b, c) -> a
+ fst3 (a, _, _) = a
+
+ uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d
+ uncurry3 x (a, b, c) = x a b c
+
setFrameBackground :: Display -> Window -> Pixel -> X ()
setFrameBackground d w p = do
frame <- getsWindowState wsFrame w