mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-09-01 03:43:47 -07:00
improvements in Combo.
This commit is contained in:
25
Combo.hs
25
Combo.hs
@@ -24,7 +24,9 @@ import Control.Arrow ( first )
|
||||
import Data.List ( delete )
|
||||
import Data.Maybe ( isJust )
|
||||
import XMonad
|
||||
import Operations ( LayoutMessages(ReleaseResources) )
|
||||
import StackSet ( integrate, Stack(..) )
|
||||
import XMonadContrib.Invisible
|
||||
import qualified StackSet as W ( differentiate )
|
||||
|
||||
-- $usage
|
||||
@@ -51,16 +53,16 @@ import qualified StackSet as W ( differentiate )
|
||||
|
||||
combo :: (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int))
|
||||
=> (l (Layout a, Int)) -> [(Layout a, Int)] -> Combo l a
|
||||
combo = Combo []
|
||||
combo = Combo (I [])
|
||||
|
||||
data Combo l a = Combo [a] (l (Layout a, Int)) [(Layout a, Int)]
|
||||
data Combo l a = Combo (Invisible [] a) (l (Layout a, Int)) [(Layout a, Int)]
|
||||
deriving (Show, Read)
|
||||
|
||||
instance (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int))
|
||||
instance (Eq a, ReadableLayout a, LayoutClass l (Layout a, Int))
|
||||
=> LayoutClass (Combo l) a where
|
||||
doLayout (Combo f super origls) rinput s = arrange (integrate s)
|
||||
where arrange [] = return ([], Just $ Combo [] super origls)
|
||||
arrange [w] = return ([(w,rinput)], Just $ Combo [w] super origls)
|
||||
doLayout (Combo (I f) super origls) rinput s = arrange (integrate s)
|
||||
where arrange [] = return ([], Just $ Combo (I []) super origls)
|
||||
arrange [w] = return ([(w,rinput)], Just $ Combo (I [w]) super origls)
|
||||
arrange origws =
|
||||
do (lrs, msuper') <- runLayout super rinput (W.differentiate $ take (length origws) origls)
|
||||
let super' = maybe super id msuper'
|
||||
@@ -73,20 +75,23 @@ instance (Eq a, Show a, Read a, ReadableLayout a, LayoutClass l (Layout a, Int))
|
||||
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 f' super' origls')
|
||||
return (concat $ map fst out, Just $ Combo (I f') super' origls')
|
||||
differentiate :: Eq q => [q] -> [q] -> Maybe (Stack q)
|
||||
differentiate (z:zs) xs | z `elem` xs = Just $ Stack { focus=z
|
||||
, up = reverse $ takeWhile (/=z) xs
|
||||
, down = tail $ dropWhile (/=z) xs }
|
||||
| otherwise = differentiate zs xs
|
||||
differentiate [] xs = W.differentiate xs
|
||||
handleMessage (Combo f super origls) m =
|
||||
handleMessage (Combo (I f) super origls) m =
|
||||
do mls <- broadcastPrivate m (map fst origls)
|
||||
let mls' = (\x->zipWith first (map const x) origls) `fmap` mls
|
||||
f' = case fromMessage m of
|
||||
Just ReleaseResources -> []
|
||||
_ -> f
|
||||
msuper <- broadcastPrivate m [super]
|
||||
case msuper of
|
||||
Just [super'] -> return $ Just $ Combo f super' $ maybe origls id mls'
|
||||
_ -> return $ Combo f super `fmap` mls'
|
||||
Just [super'] -> return $ Just $ Combo (I f') super' $ maybe origls id mls'
|
||||
_ -> return $ Combo (I f') super `fmap` mls'
|
||||
|
||||
broadcastPrivate :: LayoutClass l b => SomeMessage -> [l b] -> X (Maybe [l b])
|
||||
broadcastPrivate a ol = do nml <- mapM f ol
|
||||
|
Reference in New Issue
Block a user