From 34fc4a5028643602e4556f37b5a5de113bb22131 Mon Sep 17 00:00:00 2001 From: Joachim Breitner Date: Mon, 31 Dec 2007 19:06:28 +0100 Subject: Ignore cloned screens This patch ignores screens that are just clones of existing ones, or are completely contained in another. Currently only for rescreen, not yet for xmonad start. darcs-hash:20071231180628-23c07-9c55cedfc5e1e22d1bddaae13c296900558e8849.gz --- XMonad/Operations.hs | 15 +++++++++++++-- 1 file changed, 13 insertions(+), 2 deletions(-) (limited to 'XMonad/Operations.hs') diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs index 844202c..71b9c31 100644 --- a/XMonad/Operations.hs +++ b/XMonad/Operations.hs @@ -250,11 +250,22 @@ tileWindow w r = withDisplay $ \d -> do -- xrandr), update the state and refresh the screen, and reset the gap. rescreen :: X () rescreen = do - xinesc <- withDisplay (io . getScreenInfo) + xinesc' <- withDisplay (io . getScreenInfo) + let xinescN' = zip [0..] xinesc' + containedIn :: Rectangle -> Rectangle -> Bool + containedIn (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) = + x1 >= x2 && + y1 >= y2 && + fromIntegral x1 + w1 <= fromIntegral x2 + w2 && + fromIntegral y1 + h1 <= fromIntegral y2 + h2 + -- remove all screens completely contained in another. + xinescS' = filter (\(_,r1) -> not (any (\r2 -> r1 `containedIn` r2 && r1 /= r2) xinesc')) xinescN' + -- removes all duplicate screens but the first + xinesc = foldr (\r l -> if snd r `elem` map snd l then l else r:l) [] xinescS' windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) -> let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs - (a:as) = zipWith3 W.Screen xs [0..] $ zipWith SD xinesc gs + (a:as) = zipWith3 (\x (n,s) g -> W.Screen x n (SD s g)) xs xinesc gs sgs = map (statusGap . W.screenDetail) (v:vs) gs = take (length xinesc) (sgs ++ repeat (0,0,0,0)) in ws { W.current = a -- cgit v1.2.3