X.A.WindowNavigation: implement swap, extract withTargetWindow commonality

Why doesn't mapWindows exist already?

darcs-hash:20080512064715-78224-61fd294027e65d7db5675e7879b2e79c1ba524da.gz

1 files changed, 28 insertions, 11 deletions

diff --git a/XMonad/Actions/WindowNavigation.hs b/XMonad/Actions/WindowNavigation.hs
index 5cbc216..421300f 100644
--- a/XMonad/Actions/WindowNavigation.hs
+++ b/XMonad/Actions/WindowNavigation.hs
@@ -43,6 +43,7 @@ import Graphics.X11.Xlib
 -- Don't use it! What, are you crazy?
 
 -- TODO:
+--  - 1. 2x2, top right; 2. a,j,d 3. error!
 --  - implement swap
 --  - cleanup
 --  - documentation :)
@@ -53,10 +54,14 @@ import Graphics.X11.Xlib
 -- TODO: more flexible api
 withWindowNavigation :: (KeySym, KeySym, KeySym, KeySym) -> XConfig l -> IO (XConfig l)
 withWindowNavigation (u,l,d,r) conf =
-    withWindowNavigationKeys [ ((modMask conf, u), WNGo U),
-                               ((modMask conf, l), WNGo L),
-                               ((modMask conf, d), WNGo D),
-                               ((modMask conf, r), WNGo R) ]
+    withWindowNavigationKeys [ ((modMask conf              , u), WNGo   U),
+                               ((modMask conf              , l), WNGo   L),
+                               ((modMask conf              , d), WNGo   D),
+                               ((modMask conf              , r), WNGo   R),
+                               ((modMask conf .|. shiftMask, u), WNSwap U),
+                               ((modMask conf .|. shiftMask, l), WNSwap L),
+                               ((modMask conf .|. shiftMask, d), WNSwap D),
+                               ((modMask conf .|. shiftMask, r), WNSwap R) ]
                              conf
 
 withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
@@ -77,17 +82,29 @@ type WNState = Map WorkspaceId Point
 -- 3. focus window
 -- 4. set new position
 go :: IORef WNState -> Direction -> X ()
-go posRef dir = fromCurrentPoint $ \win pos -> do
+go = withTargetWindow W.focusWindow
+
+swap :: IORef WNState -> Direction -> X ()
+swap = withTargetWindow swapWithFocused
+  where swapWithFocused targetWin winSet =
+            case W.peek winSet of
+                Just currentWin -> W.focusWindow currentWin $
+                                   mapWindows (swapWin currentWin targetWin) winSet
+                Nothing -> winSet
+        mapWindows f ss = W.mapWorkspace (mapWindows' f) ss
+        mapWindows' f ws@(W.Workspace { W.stack = s }) = ws { W.stack = mapWindows'' f <$> s }
+        mapWindows'' f (W.Stack focused up down) = W.Stack (f focused) (map f up) (map f down)
+        swapWin win1 win2 win = if win == win1 then win2 else if win == win2 then win1 else win
+
+withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction -> X ()
+withTargetWindow adj posRef dir = fromCurrentPoint $ \win pos -> do
     targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
-    whenJust (listToMaybe targets) $ \(tw, tr) -> do
-      windows (W.focusWindow tw)
-      setPosition posRef pos tr
+    whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
+      windows (adj targetWin)
+      setPosition posRef pos targetRect
   where fromCurrentPoint f = withFocused $ \win -> do
                                  currentPosition posRef >>= f win
 
-swap :: IORef WNState -> Direction -> X ()
-swap _ _ = return ()
-
 -- Gets the current position from the IORef passed in, or if nothing (say, from
 -- a restart), derives the current position from the current window. Also,
 -- verifies that the position is congruent with the current window (say, if you