diff options
author | David Roundy <droundy@darcs.net> | 2007-10-24 17:26:48 +0200 |
---|---|---|
committer | David Roundy <droundy@darcs.net> | 2007-10-24 17:26:48 +0200 |
commit | 27bab2df6fe1195afacc7e7fc6231d3fc684ac77 (patch) | |
tree | 6492fdf8f3881af55be1195f21bd0470399d8d7a | |
parent | d9f1cca00d91edaca34d8deb885912d9f8ed7b6d (diff) | |
download | XMonadContrib-27bab2df6fe1195afacc7e7fc6231d3fc684ac77.tar.gz XMonadContrib-27bab2df6fe1195afacc7e7fc6231d3fc684ac77.tar.xz XMonadContrib-27bab2df6fe1195afacc7e7fc6231d3fc684ac77.zip |
add NewSelect layout combinator.
This patch adds a selection layout combinator ||| which
replaces Select, and makes the Layout data type unnecessary.
This combinator isn't yet feature-complete, as I didn't implement
backwards rotation (PrevLayout), but that's obviously doable. This
patch requires the descriptions function be added to LayoutClass in
core.
darcs-hash:20071024152648-72aca-4ca84d747697ceee68e33f0afed95821d4b90229.gz
Diffstat (limited to '')
-rw-r--r-- | LayoutCombinators.hs | 80 |
1 files changed, 78 insertions, 2 deletions
diff --git a/LayoutCombinators.hs b/LayoutCombinators.hs index c7e065d..19271f7 100644 --- a/LayoutCombinators.hs +++ b/LayoutCombinators.hs @@ -17,11 +17,14 @@ module XMonadContrib.LayoutCombinators ( -- * Usage -- $usage - (<|>), (</>), (<||>), (<//>) + (<|>), (</>), (<||>), (<//>), (|||) ) where +import Data.Maybe ( isJust ) + import XMonad -import Operations ( Tall(..), Mirror(..) ) +import Operations ( Tall(..), Mirror(..), + ChangeLayout(NextLayout,JumpToLayout), LayoutMessages(..) ) import XMonadContrib.Combo import XMonadContrib.DragPane @@ -39,3 +42,76 @@ import XMonadContrib.DragPane (<//>) = combineTwo (dragPane Horizontal 0.1 0.5) (<|>) = combineTwo (Tall 1 0.1 0.5) (</>) = combineTwo (Mirror $ Tall 1 0.1 0.5) + +(|||) :: (LayoutClass l1 a, LayoutClass l2 a) => l1 a -> l2 a -> NewSelect l1 l2 a +(|||) = NewSelect True + +data NewSelect l1 l2 a = NewSelect Bool (l1 a) (l2 a) deriving ( Read, Show ) + +data NoWrap = NextLayoutNoWrap | Wrap deriving ( Read, Show, Typeable ) +instance Message NoWrap + +instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where + doLayout (NewSelect True l1 l2) r s = do (wrs, ml1') <- doLayout l1 r s + return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1') + doLayout (NewSelect False l1 l2) r s = do (wrs, ml2') <- doLayout l2 r s + return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2') + description (NewSelect True l1 _) = description l1 + description (NewSelect False _ l2) = description l2 + descriptions (NewSelect _ l1 l2) = descriptions l1 ++ descriptions l2 + handleMessage (NewSelect False l1 l2) m + | Just Wrap <- fromMessage m = + do ml2' <- handleMessage l2 (SomeMessage Hide) + ml1' <- handleMessage l1 m + return $ Just $ NewSelect True (maybe l1 id ml1') (maybe l2 id ml2') + handleMessage (NewSelect True l1 l2) m + | Just NextLayoutNoWrap <- fromMessage m = + do ml1' <- handleMessage l1 m + case ml1' of + Just l1' -> return $ Just (NewSelect True l1' l2) + Nothing -> do ml1'' <- handleMessage l1 (SomeMessage Hide) + ml2' <- handleMessage l2 (SomeMessage Wrap) + return $ Just $ NewSelect False (maybe l1 id ml1'') (maybe l2 id ml2') + handleMessage l@(NewSelect True _ _) m + | Just NextLayout <- fromMessage m = handleMessage l (SomeMessage NextLayoutNoWrap) + handleMessage l@(NewSelect False l1 l2) m + | Just NextLayout <- fromMessage m = + do ml' <- handleMessage l (SomeMessage NextLayoutNoWrap) + case ml' of + Just l' -> return $ Just l' + Nothing -> do ml2' <- handleMessage l2 (SomeMessage Hide) + ml1' <- handleMessage l1 (SomeMessage Wrap) + return $ Just $ NewSelect True (maybe l1 id ml1') (maybe l2 id ml2') + handleMessage (NewSelect True l1 l2) m + | Just (JumpToLayout d) <- fromMessage m = + if d `elem` descriptions l2 + then do ml1' <- handleMessage l1 (SomeMessage Hide) + ml2' <- handleMessage l2 m + return $ Just $ NewSelect False (maybe l1 id ml1') (maybe l2 id ml2') + else if d `elem` descriptions l1 + then do ml1' <- handleMessage l1 m + return $ (\l1' -> NewSelect True l1' l2) `fmap` ml1' + else return Nothing + handleMessage (NewSelect False l1 l2) m + | Just (JumpToLayout d) <- fromMessage m = + if d `elem` descriptions l1 + then do ml2' <- handleMessage l2 (SomeMessage Hide) + ml1' <- handleMessage l1 m + return $ Just $ NewSelect False (maybe l1 id ml1') (maybe l2 id ml2') + else if d `elem` descriptions l2 + then do ml2' <- handleMessage l2 m + return $ (\l2' -> NewSelect True l1 l2') `fmap` ml2' + else return Nothing + handleMessage (NewSelect b l1 l2) m + | Just ReleaseResources <- fromMessage m = + do ml1' <- handleMessage l1 m + ml2' <- handleMessage l2 m + return $ if isJust ml1' || isJust ml2' + then Just $ NewSelect b (maybe l1 id ml1') (maybe l2 id ml2') + else Nothing + handleMessage (NewSelect True l1 l2) m = + do ml1' <- handleMessage l1 m + return $ (\l1' -> NewSelect True l1' l2) `fmap` ml1' + handleMessage (NewSelect False l1 l2) m = + do ml2' <- handleMessage l2 m + return $ (\l2' -> NewSelect False l1 l2') `fmap` ml2' |