diff options
| -rw-r--r-- | Main.hs | 7 | ||||
| -rw-r--r-- | Operations.hs | 18 | ||||
| -rw-r--r-- | StackSet.hs | 13 | ||||
| -rw-r--r-- | tests/Properties.hs | 23 |
4 files changed, 44 insertions, 17 deletions
@@ -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 - - 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))) + 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))) + + 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) |