From f0acb2ef136cb269da499a67004459b4e14fbb02 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Tue, 12 Jun 2007 15:30:27 +0200 Subject: make combo sort of work with new doLayout. For some reason (not entirely clear to me) this doesn't work properly just yet with the tabbed layout. :( But at least it'll compile. The trouble is that we have no way of tracking which tab ought to be visible without adding a *lot* of infrastructure. I'd rather have that infrastructure in xmonad proper than reimplement all the focus-handling in combo, so for now I'll just delay upgrading my xmonad at work... darcs-hash:20070612133027-72aca-666344cb28934cd2b226240fec42d1c1b3a5a12c.gz --- Combo.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'Combo.hs') diff --git a/Combo.hs b/Combo.hs index 4a9598d..fa9c6c6 100644 --- a/Combo.hs +++ b/Combo.hs @@ -6,19 +6,21 @@ module XMonadContrib.Combo where import XMonad +import StackSet ( integrate, differentiate ) combo :: [(Layout, Int)] -> Layout -> Layout -combo origls super = Layout { doLayout = arrange, modifyLayout = message } +combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message } where arrange _ [] = return [] arrange r [w] = return [(w,r)] arrange rinput origws = - do rs <- map snd `fmap` doLayout super rinput (take (length origls) origws) + do rs <- map snd `fmap` doLayout 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 - (wss (take (length rs) $ map snd origls) origws) + (map differentiate $ + wss (take (length rs) $ map snd origls) origws) return $ concat out message m = do msuper' <- modifyLayout super m case msuper' of -- cgit v1.2.3