mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-01 04:31:52 -07:00
make everything work with new doLayout.
This modifies all the contrib modules to work (so far as I know) with the new contrib layout. The exception is the LayoutHooks module, which isn't used. It exports an API that is inherently unsafe, so far as I can tell (and always has been).
This commit is contained in:
30
Combo.hs
30
Combo.hs
@@ -18,9 +18,9 @@ module XMonadContrib.Combo (
|
||||
combo
|
||||
) where
|
||||
|
||||
import Data.Maybe ( isJust )
|
||||
import XMonad
|
||||
import StackSet ( integrate, differentiate )
|
||||
import Operations ( UnDoLayout(UnDoLayout) )
|
||||
|
||||
-- $usage
|
||||
--
|
||||
@@ -37,10 +37,11 @@ import Operations ( UnDoLayout(UnDoLayout) )
|
||||
|
||||
combo :: [(Layout a, Int)] -> Layout a -> Layout a
|
||||
combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message }
|
||||
where arrange _ [] = return []
|
||||
arrange r [w] = return [(w,r)]
|
||||
where arrange _ [] = return ([], Nothing)
|
||||
arrange r [w] = return ([(w,r)], Nothing)
|
||||
arrange rinput origws =
|
||||
do rs <- map snd `fmap` runLayout super rinput (differentiate $ take (length origls) origws)
|
||||
do rs <- (map snd . fst) `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)
|
||||
@@ -48,13 +49,16 @@ combo origls super = Layout { doLayout = \r s -> arrange r (integrate s), modify
|
||||
out <- sequence $ zipWith3 runLayout (map fst origls) rs
|
||||
(map differentiate $
|
||||
wss (take (length rs) $ map snd origls) origws)
|
||||
return $ concat out
|
||||
message m = case fromMessage m of
|
||||
Just UnDoLayout -> fmap (\(super':ls') -> Just $ combo (zip ls' $ map snd origls) super')
|
||||
(broadcastPrivate UnDoLayout (super:map fst origls))
|
||||
_ -> fmap (maybe Nothing (Just . combo origls)) (modifyLayout super m)
|
||||
let origls' = zipWith foo (out++repeat ([],Nothing)) origls
|
||||
foo (_, Nothing) x = x
|
||||
foo (_, Just l') (_, n) = (l', n)
|
||||
return (concat $ map fst out, Just $ combo origls' super)
|
||||
message m = do mls <- broadcastPrivate m (super:map fst origls)
|
||||
return $ (\(super':ls') -> combo (zip ls' $ map snd origls) super') `fmap` mls
|
||||
|
||||
broadcastPrivate :: Message a => a -> [Layout b] -> X [Layout b]
|
||||
broadcastPrivate a ol = mapM f ol
|
||||
where f l = do ml' <- modifyLayout l (SomeMessage a) `catchX` return (Just l)
|
||||
return $ maybe l id ml'
|
||||
broadcastPrivate :: SomeMessage -> [Layout b] -> X (Maybe [Layout b])
|
||||
broadcastPrivate a ol = do nml <- mapM f ol
|
||||
if any isJust nml
|
||||
then return $ Just $ zipWith ((flip maybe) id) ol nml
|
||||
else return Nothing
|
||||
where f l = modifyLayout l a `catchX` return Nothing
|
||||
|
Reference in New Issue
Block a user