From 1af7582b30d70ded97db92a69673849372c98fb9 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Tue, 12 Jun 2007 17:12:09 +0200 Subject: changes to work with Stacks that can't be empty. darcs-hash:20070612151209-72aca-62307f8565fc32ca80be8daf2c30fe414d49111e.gz --- Combo.hs | 8 ++++---- DwmPromote.hs | 8 ++++---- DynamicLog.hs | 5 +++-- FindEmptyWorkspace.hs | 5 ++--- NoBorders.hs | 2 +- RotView.hs | 9 ++------- Tabbed.hs | 5 ++--- 7 files changed, 18 insertions(+), 24 deletions(-) diff --git a/Combo.hs b/Combo.hs index fa9c6c6..449a837 100644 --- a/Combo.hs +++ b/Combo.hs @@ -13,14 +13,14 @@ combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modify where arrange _ [] = return [] arrange r [w] = return [(w,r)] arrange rinput origws = - do rs <- map snd `fmap` doLayout super rinput (differentiate $ take (length origls) origws) + do rs <- map snd `fmap` runLayout super rinput (differentiate $ take (length origls) origws) let wss [] _ = [] wss [_] ws = [ws] wss (n:ns) ws = take len1 ws : wss ns (drop len1 ws) where len1 = min n (length ws - length ns) - out <- sequence $ zipWith3 doLayout (map fst origls) rs - (map differentiate $ - wss (take (length rs) $ map snd origls) origws) + out <- sequence $ zipWith3 runLayout (map fst origls) rs + (map differentiate $ + wss (take (length rs) $ map snd origls) origws) return $ concat out message m = do msuper' <- modifyLayout super m case msuper' of diff --git a/DwmPromote.hs b/DwmPromote.hs index 946a80f..cfcdad2 100644 --- a/DwmPromote.hs +++ b/DwmPromote.hs @@ -33,7 +33,7 @@ dwmpromote :: X () dwmpromote = windows swap swap :: StackSet i a s -> StackSet i a s -swap = modify Empty $ \c -> case c of - Node _ [] [] -> c - Node t [] (x:rs) -> Node x [] (t:rs) - Node t ls rs -> Node t [] (ys ++ x : rs) where (x:ys) = reverse ls +swap = modify' $ \c -> case c of + Stack _ [] [] -> c + Stack t [] (x:rs) -> Stack x [] (t:rs) + Stack t ls rs -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls diff --git a/DynamicLog.hs b/DynamicLog.hs index 0ef5ada..41c82f9 100644 --- a/DynamicLog.hs +++ b/DynamicLog.hs @@ -20,6 +20,7 @@ module XMonadContrib.DynamicLog (dynamicLog, dynamicLogXinerama) where -- Useful imports -- import XMonad +import Data.Maybe ( isJust ) import Data.List import qualified StackSet as S @@ -45,7 +46,7 @@ dynamicLog = withWindowSet $ io . putStrLn . ppr fmt w | S.tag w == this = "[" ++ pprTag w ++ "]" | S.tag w `elem` visibles = "<" ++ pprTag w ++ ">" - | S.stack w /= S.Empty = " " ++ pprTag w ++ " " + | isJust (S.stack w) = " " ++ pprTag w ++ " " | otherwise = "" -- @@ -62,7 +63,7 @@ dynamicLogXinerama = withWindowSet $ io . putStrLn . ppr ppr ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen where onscreen = map (pprTag . S.workspace) . sortBy (compare `on` S.screen) $ S.current ws : S.visible ws - offscreen = map pprTag . filter ((/= S.Empty) . S.stack) + offscreen = map pprTag . filter (isJust . S.stack) . sortBy (compare `on` S.tag) $ S.hidden ws -- util functions diff --git a/FindEmptyWorkspace.hs b/FindEmptyWorkspace.hs index ca00366..d94d0a8 100644 --- a/FindEmptyWorkspace.hs +++ b/FindEmptyWorkspace.hs @@ -29,6 +29,7 @@ module XMonadContrib.FindEmptyWorkspace ( import Control.Monad.State import Data.List +import Data.Maybe ( isNothing ) import XMonad import StackSet @@ -40,10 +41,8 @@ import qualified Operations as O -- focused workspace, other visible workspaces (when in Xinerama) and -- hidden workspaces in this order. findEmptyWorkspace :: StackSet i a s -> Maybe (Workspace i a) -findEmptyWorkspace = find (isEmpty . stack) . allWorkspaces +findEmptyWorkspace = find (isNothing . stack) . allWorkspaces where - isEmpty Empty = True - isEmpty _ = False allWorkspaces ss = (workspace . current) ss : (map workspace . visible) ss ++ hidden ss diff --git a/NoBorders.hs b/NoBorders.hs index 1b8ae94..7d34cfe 100644 --- a/NoBorders.hs +++ b/NoBorders.hs @@ -32,5 +32,5 @@ withBorder bd l = l { doLayout = \r x -> setborders bd >> doLayout l r x setborders :: Dimension -> X () setborders bw = withDisplay $ \d -> - do ws <- gets (W.integrate . W.stack . W.workspace . W.current . windowset) + do ws <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset) mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws diff --git a/RotView.hs b/RotView.hs index 1fc421e..6a8fc7f 100644 --- a/RotView.hs +++ b/RotView.hs @@ -10,7 +10,7 @@ module XMonadContrib.RotView ( rotView ) where import Control.Monad.State ( gets ) import Data.List ( sortBy ) -import Data.Maybe ( listToMaybe ) +import Data.Maybe ( listToMaybe, isJust ) import XMonad import StackSet hiding (filter) @@ -22,10 +22,5 @@ rotView b = do let m = tag . workspace . current $ ws sortWs = sortBy (\x y -> compare (tag x) (tag y)) pivoted = uncurry (flip (++)) . span ((< m) . tag) . sortWs . hidden $ ws - nextws = listToMaybe . filter (not.isEmpty) . (if b then id else reverse) $ pivoted + nextws = listToMaybe . filter (isJust . stack) . (if b then id else reverse) $ pivoted whenJust nextws (O.view . tag) - -isEmpty :: Workspace i a -> Bool -isEmpty ws = case stack ws of - Empty -> True - _ -> False diff --git a/Tabbed.hs b/Tabbed.hs index d3ecc3b..adcb470 100644 --- a/Tabbed.hs +++ b/Tabbed.hs @@ -25,9 +25,8 @@ tabbed :: Layout tabbed = Layout { doLayout = dolay, modifyLayout = const (return Nothing) } dolay :: Rectangle -> W.Stack Window -> X [(Window, Rectangle)] -dolay _ W.Empty = return [] -dolay sc (W.Node w [] []) = return [(w,sc)] -dolay sc@(Rectangle x y wid _) s@(W.Node w _ _) = +dolay sc (W.Stack w [] []) = return [(w,sc)] +dolay sc@(Rectangle x y wid _) s@(W.Stack w _ _) = do let ws = W.integrate s ts = gentabs x y wid (length ws) tws = zip ts ws -- cgit v1.2.3