From aa9df9970c262b1e4ff0e349e5f28e1fdb73b460 Mon Sep 17 00:00:00 2001
From: David Roundy <droundy@darcs.net>
Date: Thu, 1 Nov 2007 19:11:28 +0100
Subject: reenable JumpToLayout in NewSelect.

darcs-hash:20071101181128-72aca-c8fa9adb8a820baea5af41ff17c37d323b34dfe1.gz
---
 LayoutCombinators.hs | 38 +++++++++++++++++++++++++++++++++++---
 1 file changed, 35 insertions(+), 3 deletions(-)

(limited to 'LayoutCombinators.hs')

diff --git a/LayoutCombinators.hs b/LayoutCombinators.hs
index 8009f62..a368481 100644
--- a/LayoutCombinators.hs
+++ b/LayoutCombinators.hs
@@ -17,14 +17,13 @@
 module XMonadContrib.LayoutCombinators (
     -- * Usage
     -- $usage
-    (<|>), (</>), (<||>), (<//>), (|||)
+    (<|>), (</>), (<||>), (<//>), (|||), JumpToLayout(JumpToLayout)
     ) where
 
 import Data.Maybe ( isJust )
 
 import XMonad
-import Operations ( Tall(..), Mirror(..),
-                    ChangeLayout(NextLayout,JumpToLayout), LayoutMessages(..) )
+import Layouts ( Tall(..), Mirror(..), ChangeLayout(NextLayout) )
 import XMonadContrib.Combo
 import XMonadContrib.DragPane
 
@@ -51,6 +50,9 @@ 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
 
+data JumpToLayout = JumpToLayout String deriving ( Read, Show, Typeable )
+instance Message JumpToLayout
+
 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')
@@ -81,6 +83,36 @@ instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a
                       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,
+          d == description l2 = do ml1' <- handleMessage l1 (SomeMessage Hide)
+                                   return $ Just $ NewSelect False (maybe l1 id ml1') l2
+    handleMessage (NewSelect True l1 l2) m
+        | Just (JumpToLayout d) <- fromMessage m
+        = do ml1' <- handleMessage l1 m
+             case ml1' of
+               Just l1' -> return $ Just $ NewSelect True l1' l2
+               Nothing ->
+                   do ml2' <- handleMessage l2 m
+                      case ml2' of
+                        Nothing -> return Nothing
+                        Just l2' -> do ml1'' <- handleMessage l1 (SomeMessage Hide)
+                                       return $ Just $ NewSelect False (maybe l1 id ml1'') l2'
+    handleMessage (NewSelect False l1 l2) m
+        | Just (JumpToLayout d) <- fromMessage m,
+          d == description l1 = do ml2' <- handleMessage l2 (SomeMessage Hide)
+                                   return $ Just $ NewSelect True l1 (maybe l2 id ml2')
+    handleMessage (NewSelect False l1 l2) m
+        | Just (JumpToLayout d) <- fromMessage m
+        = do ml2' <- handleMessage l2 m
+             case ml2' of
+               Just l2' -> return $ Just $ NewSelect False l1 l2'
+               Nothing ->
+                   do ml1' <- handleMessage l1 m
+                      case ml1' of
+                        Nothing -> return Nothing
+                        Just l1' -> do ml2'' <- handleMessage l2 (SomeMessage Hide)
+                                       return $ Just $ NewSelect True l1' (maybe l2 id ml2'')
     handleMessage (NewSelect b l1 l2) m
         | Just ReleaseResources  <- fromMessage m =
         do ml1' <- handleMessage l1 m
-- 
cgit v1.2.3