diff options
author | Matthias Schiffer <mschiffer@universe-factory.net> | 2013-09-11 21:48:00 +0200 |
---|---|---|
committer | Matthias Schiffer <mschiffer@universe-factory.net> | 2013-09-11 21:48:00 +0200 |
commit | 29e342c4985744cc2538d85cdbb248e6dd5f5ff8 (patch) | |
tree | 123e2ce9e38de16f5e3f56989a37879da93dd96a | |
parent | f05f53f9057508ff274f5ee51b866e68fb09824a (diff) | |
download | metatile-29e342c4985744cc2538d85cdbb248e6dd5f5ff8.tar metatile-29e342c4985744cc2538d85cdbb248e6dd5f5ff8.zip |
Let the layout decide about the border width
-rw-r--r-- | MetaTile/Core.hs | 9 | ||||
-rw-r--r-- | MetaTile/Operations.hs | 18 |
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 |