From b72c096bc6cd8adc80e629b07a373f385b689460 Mon Sep 17 00:00:00 2001
From: Karsten Schoelzel <kuser@gmx.de>
Date: Mon, 10 Sep 2007 09:03:29 +0000
Subject: [PATCH] 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 | 7 ++-----
Operations.hs | 16 +++++++---------
StackSet.hs | 13 +++++++++++--
tests/Properties.hs | 23 +++++++++++++++++++++++
4 files changed, 43 insertions(+), 16 deletions(-)
diff --git a/Main.hs b/Main.hs
index d7ce8c9..ead2a96 100644
--- a/Main.hs
+++ b/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
- -- 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)
+ if M.member w (floating ws)
|| not (member w ws)
then do io $ configureWindow dpy w (ev_value_mask e) $ WindowChanges
{ wc_x = ev_x e
diff --git a/Operations.hs b/Operations.hs
index d7f6639..39dc253 100644
--- a/Operations.hs
+++ b/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
- (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)))
+ if maybe False (`elem` (map W.tag . W.hidden $ ws)) (W.findIndex w ws)
+ then windows $ W.float w rr
+ else windows $ maybe id W.focusWindow (W.peek ws) . W.shiftWin sw w . W.float w rr
where fi x = fromIntegral x
pointWithin :: Integer -> Integer -> Rectangle -> Bool
pointWithin x y r = x >= fi (rect_x r) &&
diff --git a/StackSet.hs b/StackSet.hs
index 48006dd..05f8ff2 100644
--- a/StackSet.hs
+++ b/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
diff --git a/tests/Properties.hs b/tests/Properties.hs
index e11b448..3207f95 100644
--- a/tests/Properties.hs
+++ b/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)