Fix float behaviour, add shiftWin.

First, if float is called with window which is on a hidden workspace,
then the window will remain on that hidden workspace.

Now the focus should change more as expected:
float w = (view current) . (shiftWin ws w)
    where
        current is the current screen/workspace
        shiftWin ws w is: - view the workspace w is on
            - set focus on w
            - shift ws
            - set focus back to window it was on that workspace
                unless w was focused

shiftWin was add to StackSet.hs

Main.hs

@@ -29,7 +29,7 @@ import Graphics.X11.Xinerama    (getScreenInfo)
 
 import XMonad
 import Config
-import StackSet (new, floating, member, findIndex, workspace, tag, current, visible)
+import StackSet (new, floating, member)
 import qualified StackSet as W
 import Operations
 
@@ -226,10 +226,7 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
     ws <- gets windowset
     wa <- io $ getWindowAttributes dpy w
 
-    -- TODO temporary workaround for some bugs in float.  Don't call 'float' on
+    if M.member w (floating ws)
-    -- windows that aren't visible, because it changes the focused screen
-    let vis = any ((== findIndex w ws) . Just . tag . workspace) (current ws : visible ws)
-    if (M.member w (floating ws) && vis)
         || not (member w ws)
         then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
                     { wc_x            = ev_x e

Operations.hs

@@ -472,10 +472,6 @@ sink :: Window -> X ()
 sink = windows . W.sink
 
 -- | Make a tiled window floating, using its suggested rectangle
---
--- TODO: float changes the set of visible workspaces when we call it for an
--- invisible window -- this should not happen.  See 'temporary workaround' in
--- the handler for ConfigureRequestEvent also.
 float :: Window -> X ()
 float w = withDisplay $ \d -> do
     ws <- gets windowset
@@ -485,12 +481,14 @@ float w = withDisplay $ \d -> do
         sr = screenRect . W.screenDetail $ sc
         sw = W.tag . W.workspace $ sc
         bw = fi . wa_border_width $ wa
+        rr = (W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
+                             ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
+                             (fi (wa_width  wa + bw*2) % fi (rect_width sr))
+                             (fi (wa_height wa + bw*2) % fi (rect_height sr)))
 
-    windows $ maybe id W.focusWindow (W.peek ws) . W.shift sw . W.focusWindow w . W.float w
+    if maybe False (`elem` (map W.tag . W.hidden $ ws)) (W.findIndex w ws)
-        (W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
+        then windows $ W.float w rr
-                        ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
+        else windows $ maybe id W.focusWindow (W.peek ws) . W.shiftWin sw w . W.float w rr
-                        (fi (wa_width  wa + bw*2) % fi (rect_width sr))
-                        (fi (wa_height wa + bw*2) % fi (rect_height sr)))
   where fi x = fromIntegral x
         pointWithin :: Integer -> Integer -> Rectangle -> Bool
         pointWithin x y r = x >= fi (rect_x r) &&

StackSet.hs

@@ -32,11 +32,11 @@ module StackSet (
         swapMaster, swapUp, swapDown, modify, modify', float, sink, -- needed by users
         -- * Composite operations
         -- $composite
-        shift
+        shift, shiftWin
     ) where
 
 import Prelude hiding (filter)
-import Data.Maybe   (listToMaybe)
+import Data.Maybe   (listToMaybe,fromJust)
 import qualified Data.List as L (delete,deleteBy,find,splitAt,filter)
 import qualified Data.Map  as M (Map,insert,delete,empty)
 
@@ -502,3 +502,12 @@ shift n s | n `tagMember` s && n /= curtag = maybe s go (peek s)
           | otherwise                      = s
     where go w = view curtag . insertUp w . view n . delete' w $ s
           curtag = tag (workspace (current s))
+
+shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i a s sd -> StackSet i a s sd
+shiftWin n w s | from == Nothing                     = s
+               | n `tagMember` s && (Just n) /= from = go
+               | otherwise                           = s
+    where go = on n (insertUp w) . on (fromJust from) (delete' w) $ s
+          curtag = tag (workspace (current s))
+          from = findIndex w s
+          on i f = view curtag . f . view i

tests/Properties.hs

@@ -167,6 +167,9 @@ prop_swap_right_I (n :: NonNegative Int) (x :: T) =
 prop_shift_I (n :: NonNegative Int) (x :: T) =
     n `tagMember` x ==> invariant $ shift (fromIntegral n) x
 
+prop_shift_win_I (n :: NonNegative Int) (w :: Char) (x :: T) =
+    n `tagMember` x && w `member` x ==> invariant $ shiftWin (fromIntegral n) w x
+
 
 -- ---------------------------------------------------------------------
 -- 'new'
@@ -493,6 +496,23 @@ prop_shift_reversible i (x :: T) =
         y = swapMaster x
         n = tag (workspace $ current y)
 
+-- ---------------------------------------------------------------------
+-- shiftWin
+
+-- shiftWin on current window is the same as shift
+prop_shift_win_focus i (x :: T) =
+    i `tagMember` x ==> case peek x of
+                          Nothing -> True
+                          Just w  -> shiftWin i w x == shift i x
+
+-- shiftWin leaves the current screen as it is, if neither i is the tag
+-- of the current workspace nor w on the current workspace
+prop_shift_win_fix_current i w (x :: T) =
+    i `tagMember` x && w `member` x && i /= n && findIndex w x /= Just n 
+        ==> (current $ x) == (current $ shiftWin i w x)
+    where
+        n = tag (workspace $ current x)
+
 ------------------------------------------------------------------------
 -- some properties for layouts:
 
@@ -611,6 +631,9 @@ main = do
 
         ,("shift: invariant"    , mytest prop_shift_I)
         ,("shift is reversible" , mytest prop_shift_reversible)
+        ,("shiftWin: invariant" , mytest prop_shift_win_I)
+        ,("shiftWin is shift on focus" , mytest prop_shift_win_focus)
+        ,("shiftWin fix current" , mytest prop_shift_win_fix_current)
 
 {-
         ,("tile 1 window fullsize", mytest prop_tile_fullscreen)