From a5b811e4ed0361558eaedd8e52f51aeceabb0c26 Mon Sep 17 00:00:00 2001
From: David Roundy <droundy@darcs.net>
Date: Sat, 20 Oct 2007 21:17:48 +0200
Subject: introduce new combineTwo layout combinator.

This layout combinator is similar in spirit (and in code) to
the old combo combinator, but only allows two sublayouts.  As
a result, we don't need to wrap these in existentials, and reading
works seamlessly.  Also, we add the feature (which could also be
added to combo) of being able to change which sublayout a given
window is in through integration with WindowNavigation.

I envision combo being deprecated soon.  combineTwo isn't quite
so flexible, but it's much easier and is better-coded also.

darcs-hash:20071020191748-72aca-b431b4f7c13f63a2060c7b19b4404245b6939251.gz
---
 WindowNavigation.hs | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

(limited to 'WindowNavigation.hs')

diff --git a/WindowNavigation.hs b/WindowNavigation.hs
index 54661de..e66e2bd 100644
--- a/WindowNavigation.hs
+++ b/WindowNavigation.hs
@@ -20,12 +20,14 @@ module XMonadContrib.WindowNavigation (
                                    -- $usage
                                    windowNavigation, configurableNavigation,
                                    Navigate(..), Direction(..),
+                                   MoveWindowToWindow(..),
                                    navigateColor, navigateBrightness,
                                    noNavigateBorders, defaultWNConfig
                                   ) where
 
 import Graphics.X11.Xlib ( Rectangle(..), Window, Pixel, setWindowBorder )
 import Control.Monad.Reader ( ask )
+import Control.Monad.State ( gets )
 import Data.List ( nub, sortBy, (\\) )
 import XMonad
 import qualified StackSet as W
@@ -67,8 +69,10 @@ import XMonadContrib.XUtils
 -- %layout -- or
 -- %layout -- layoutHook = Layout $ configurableNavigation (navigateBorder "green") $ ...
 
+data MoveWindowToWindow a = MoveWindowToWindow a a deriving ( Read, Show, Typeable )
+instance Typeable a => Message (MoveWindowToWindow a)
 
-data Navigate = Go Direction | Swap Direction deriving ( Read, Show, Typeable )
+data Navigate = Go Direction | Swap Direction | Move Direction deriving ( Read, Show, Typeable )
 data Direction = U | D | R | L deriving ( Read, Show, Eq )
 instance Message Navigate
 
@@ -136,12 +140,12 @@ instance LayoutModifier WindowNavigation Window where
            mapM_ (\(win,c) -> sc c win) wnavigablec
            return (wrs, Just $ WindowNavigation conf $ I $ Just $ NS pt wnavigable)
 
-    handleMess (WindowNavigation conf (I (Just (NS pt wrs)))) m
+    handleMessOrMaybeModifyIt (WindowNavigation conf (I (Just (NS pt wrs)))) m
         | Just (Go d) <- fromMessage m =
                          case sortby d $ filter (inr d pt . snd) wrs of
                          []        -> return Nothing
                          ((w,r):_) -> do focus w
-                                         return $ Just $ WindowNavigation conf $ I $ Just $
+                                         return $ Just $ Left $ WindowNavigation conf $ I $ Just $
                                                 NS (centerd d pt r) wrs
         | Just (Swap d) <- fromMessage m =
              case sortby d $ filter (inr d pt . snd) wrs of
@@ -159,13 +163,19 @@ instance LayoutModifier WindowNavigation Window where
                                                            , W.up = [] }
                              windows $ W.modify' swap
                              return Nothing
+        | Just (Move d) <- fromMessage m =
+             case sortby d $ filter (inr d pt . snd) wrs of
+             []        -> return Nothing
+             ((w,_):_) -> do mst <- gets (W.stack . W.workspace . W.current . windowset)
+                             return $ do st <- mst
+                                         Just $ Right $ SomeMessage $ MoveWindowToWindow (W.focus st) w
         | Just Hide <- fromMessage m =
                        do XConf { normalBorder = nbc } <- ask
                           mapM_ (sc nbc . fst) wrs
-                          return $ Just $ WindowNavigation conf $ I $ Just $ NS pt []
+                          return $ Just $ Left $ WindowNavigation conf $ I $ Just $ NS pt []
         | Just ReleaseResources <- fromMessage m =
-               handleMess (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)
-    handleMess _ _ = return Nothing
+               handleMessOrMaybeModifyIt (WindowNavigation conf (I $ Just (NS pt wrs))) (SomeMessage Hide)
+    handleMessOrMaybeModifyIt _ _ = return Nothing
 
 truncHead :: [a] -> [a]
 truncHead (x:_) = [x]
-- 
cgit v1.2.3