diff options
| -rw-r--r-- | Config.hs | 4 | ||||
| -rw-r--r-- | Main.hs | 3 | ||||
| -rw-r--r-- | Operations.hs | 42 | ||||
| -rw-r--r-- | StackSet.hs | 62 | ||||
| -rw-r--r-- | XMonad.hs | 1 | ||||
| -rw-r--r-- | tests/Properties.hs | 26 |
6 files changed, 79 insertions, 59 deletions
@@ -136,7 +136,7 @@ keys = M.fromList $ -- Keybindings to each screen : -- mod-wer (underneath 123) switches to physical/Xinerama screens 1 2 and 3 ++ - [((m .|. modMask, key), screenWS sc >>= f) - | (key, sc) <- zip [xK_w, xK_e, xK_r] [1..] + [((m .|. modMask, key), gets workspace >>= f . (+1) . fromMaybe 0 . W.workspace sc) + | (key, sc) <- zip [xK_s, xK_d, xK_f] [0..] , (f, m) <- [(view, 0), (tag, shiftMask)]] @@ -43,14 +43,13 @@ main = do let st = XState { display = dpy , xineScreens = xinesc - , wsOnScreen = M.fromList $ map (\n -> (n,n)) [0.. length xinesc - 1] , theRoot = rootw , wmdelete = wmdelt , wmprotocols = wmprot -- fromIntegral needed for X11 versions that use Int instead of CInt. , dimensions = (fromIntegral (displayWidth dpy dflt), fromIntegral (displayHeight dpy dflt)) - , workspace = W.empty workspaces + , workspace = W.empty workspaces (length xinesc) , defaultLayoutDesc = startingLayoutDesc , layoutDescs = M.empty } diff --git a/Operations.hs b/Operations.hs index 132c959..86d6da1 100644 --- a/Operations.hs +++ b/Operations.hs @@ -25,10 +25,10 @@ import qualified StackSet as W -- screen and raises the window. refresh :: X () refresh = do - XState {workspace = ws, wsOnScreen = ws2sc, xineScreens = xinesc + XState {workspace = ws, xineScreens = xinesc ,display = d ,layoutDescs = fls ,defaultLayoutDesc = dfltfl } <- get - flip mapM_ (M.assocs ws2sc) $ \(n, scn) -> do + flip mapM_ (M.assocs (W.screen2ws ws)) $ \(scn, n) -> do let sc = xinesc !! scn fl = M.findWithDefault dfltfl n fls mapM_ (\(w, rect) -> io $ moveWindowInside d w rect) $ @@ -159,10 +159,10 @@ safeFocus w = do ws <- gets workspace -- | Explicitly set the keyboard focus to the given window setFocus :: Window -> X () setFocus w = do - XState { workspace = ws, wsOnScreen = ws2sc} <- get + ws <- gets workspace -- clear mouse button grab and border on other windows - flip mapM_ (M.keys ws2sc) $ \n -> do + flip mapM_ (W.visibleWorkspaces ws) $ \n -> do flip mapM_ (W.index n ws) $ \otherw -> do setButtonGrab True otherw setBorder otherw 0xdddddd @@ -228,22 +228,13 @@ tag o = do -- | view. Change the current workspace to workspce at offset 'n-1'. view :: Int -> X () view o = do - XState { workspace = ws, wsOnScreen = ws2sc } <- get + ws <- gets workspace let m = W.current ws - -- is the workspace we want to switch to currently visible? - if M.member n ws2sc - then windows $ W.view n - else do - sc <- case M.lookup m ws2sc of - Nothing -> do - trace "Current workspace isn't visible! This should never happen!" - -- we don't know what screen to use, just use the first one. - return 0 - Just sc -> return sc - modify $ \s -> s { wsOnScreen = M.insert n sc (M.filter (/=sc) ws2sc) } - gets wsOnScreen >>= trace . show - windows $ W.view n - mapM_ hide (W.index m ws) + windows $ W.view n + ws' <- gets workspace + -- If the old workspace isn't visible anymore, we have to hide the windows + -- in case we're switching to an empty workspace. + when (m `notElem` (W.visibleWorkspaces ws')) (mapM_ hide (W.index m ws)) setTopFocus where n = o-1 @@ -251,15 +242,6 @@ view o = do isClient :: Window -> X Bool isClient w = liftM (W.member w) (gets workspace) --- | screenWS. Returns the workspace currently visible on screen n -screenWS :: Int -> X Int -screenWS n = do - ws2sc <- gets wsOnScreen - -- FIXME: It's ugly to have to query this way. We need a different way to - -- keep track of screen <-> workspace mappings. - let ws = fmap fst $ find (\(_, scn) -> scn == (n-1)) (M.assocs ws2sc) - return $ (fromMaybe 0 ws) + 1 - -- | Restart xmonad by exec()'ing self. This doesn't save state and xmonad has -- to be in PATH for this to work. restart :: IO () @@ -272,8 +254,8 @@ restart = do -- and -w options.) dmenu :: X () dmenu = do - XState { xineScreens = xinesc, workspace = ws, wsOnScreen = ws2sc } <- get - let curscreen = fromMaybe 0 (M.lookup (W.current ws) ws2sc) + XState { xineScreens = xinesc, workspace = ws } <- get + let curscreen = fromMaybe 0 (M.lookup (W.current ws) (W.ws2screen ws)) sc = xinesc !! curscreen spawn $ concat [ "exe=`dmenu_path | dmenu -x ", show (rect_x sc) , " -w " , show (rect_width sc) , "` && exec $exe" ] diff --git a/StackSet.hs b/StackSet.hs index bcea8c8..2e1c936 100644 --- a/StackSet.hs +++ b/StackSet.hs @@ -35,10 +35,12 @@ import qualified Data.Map as M -- | The StackSet data structure. A table of stacks, with a current pointer data StackSet a = StackSet - { current:: {-# UNPACK #-} !Int -- ^ the currently visible stack - , stacks :: {-# UNPACK #-} !(M.Map Int [a]) -- ^ the separate stacks - , focus :: {-# UNPACK #-} !(M.Map Int a) -- ^ the window focused in each stack - , cache :: {-# UNPACK #-} !(M.Map a Int) -- ^ a cache of windows back to their stacks + { current :: !Int -- ^ the currently visible stack + , ws2screen:: !(M.Map Int Int) -- ^ workspace -> screen map + , screen2ws:: !(M.Map Int Int) -- ^ screen -> workspace + , stacks :: !(M.Map Int [a]) -- ^ the separate stacks + , focus :: !(M.Map Int a) -- ^ the window focused in each stack + , cache :: !(M.Map a Int) -- ^ a cache of windows back to their stacks } deriving Eq instance Show a => Show (StackSet a) where @@ -51,14 +53,17 @@ instance Show a => Show (StackSet a) where ------------------------------------------------------------------------ --- | /O(n)/. Create a new empty stacks of size 'n', indexed from 0. The --- 0-indexed stack will be current. -empty :: Int -> StackSet a -empty n = StackSet { current = 0 - , stacks = M.fromList (zip [0..n-1] (repeat [])) - , focus = M.empty - , cache = M.empty } - +-- | /O(n)/. Create a new empty stacks of size 'n', indexed from 0, with 'm' +-- screens. (also indexed from 0) The 0-indexed stack will be current. +empty :: Int -> Int -> StackSet a +empty n m = StackSet { current = 0 + , ws2screen = wsScreenAssn + , screen2ws = wsScreenAssn + , stacks = M.fromList (zip [0..n-1] (repeat [])) + , focus = M.empty + , cache = M.empty } + where wsScreenAssn = M.fromList $ map (\x -> (x,x)) [0..m-1] + -- | /O(log w)/. True if x is somewhere in the StackSet member :: Ord a => a -> StackSet a -> Bool member a w = M.member a (cache w) @@ -75,6 +80,7 @@ size = M.size . stacks -- | fromList. Build a new StackSet from a list of list of elements -- If there are duplicates in the list, the last occurence wins. +-- FIXME: This always makes a StackSet with 1 screen. fromList :: Ord a => (Int,[[a]]) -> StackSet a fromList (_,[]) = error "Cannot build a StackSet from an empty list" @@ -83,7 +89,7 @@ fromList (n,xs) | n < 0 || n >= length xs fromList (o,xs) = view o $ foldr (\(i,ys) s -> foldr (\a t -> insert a i t) s ys) - (empty (length xs)) (zip [0..] xs) + (empty (length xs) 1) (zip [0..] xs) -- | toList. Flatten a stackset to a list of lists toList :: StackSet a -> (Int,[[a]]) @@ -111,12 +117,34 @@ peekStack n w = M.lookup n (focus w) index :: Int -> StackSet a -> [a] index k w = fromJust (M.lookup k (stacks w)) --- | /O(1)/. view. Set the stack specified by the Int argument as being the --- current StackSet. If the index is out of range an exception is thrown. +-- | view. Set the stack specified by the Int argument as being visible and the +-- current StackSet. If the stack wasn't previously visible, it will become +-- visible on the current screen. If the index is out of range an exception is +-- thrown. view :: Int -> StackSet a -> StackSet a -view n w | n >= 0 && n < M.size (stacks w) = w { current = n } +view n w | n >= 0 && n < M.size (stacks w) = if M.member n (ws2screen w) + then w { current = n } + else tweak (fromJust $ screen (current w) w) | otherwise = error $ "view: index out of bounds: " ++ show n + where + tweak sc = w { screen2ws = M.insert sc n (screen2ws w) + , ws2screen = M.insert n sc (M.filter (/=sc) (ws2screen w)) + , current = n + } + +-- | That screen that workspace 'n' is visible on, if any. +screen :: Int -> StackSet a -> Maybe Int +screen n w = M.lookup n (ws2screen w) +-- | The workspace visible on screen 'sc'. Nothing if screen is out of bounds. +workspace :: Int -> StackSet a -> Maybe Int +workspace sc w = M.lookup sc $ ws2screen w + +-- | A list of the currently visible workspaces. +visibleWorkspaces :: StackSet a -> [Int] +visibleWorkspaces = M.keys . ws2screen + +-- -- | /O(log n)/. rotate. cycle the current window list up or down. -- -- rotate EQ --> [5,6,7,8,1,2,3,4] @@ -171,7 +199,7 @@ delete k w = maybe w tweak (M.lookup k (cache w)) raiseFocus :: Ord a => a -> StackSet a -> StackSet a raiseFocus k w = case M.lookup k (cache w) of Nothing -> w - Just i -> w { focus = M.insert i k (focus w), current = i } + Just i -> (view i w) { focus = M.insert i k (focus w) } -- | Move a window to the top of its workspace. promote :: Ord a => a -> StackSet a -> StackSet a @@ -37,7 +37,6 @@ data XState = XState , xineScreens :: ![Rectangle] -- ^ dimensions of each screen - , wsOnScreen :: !(M.Map Int Int) -- ^ mapping of workspaces to xinerama screen numbers , theRoot :: !Window -- ^ the root window , wmdelete :: !Atom -- ^ window deletion atom , wmprotocols :: !Atom -- ^ wm protocols atom diff --git a/tests/Properties.hs b/tests/Properties.hs index 9e5a0fd..41f729d 100644 --- a/tests/Properties.hs +++ b/tests/Properties.hs @@ -31,22 +31,22 @@ instance (Ord a, Arbitrary a) => Arbitrary (StackSet a) where prop_id x = fromList (toList x) == x where _ = x :: T -prop_member1 i n = member i (push i x) - where x = empty n :: T +prop_member1 i n m = member i (push i x) + where x = empty n m :: T prop_member2 i x = not (member i (delete i x)) where _ = x :: T -prop_member3 i n = member i (empty n :: T) == False +prop_member3 i n m = member i (empty n m :: T) == False -prop_sizepush is n = n > 0 ==> size (foldr push x is ) == n - where x = empty n :: T +prop_sizepush is n m = n > 0 ==> size (foldr push x is ) == n + where x = empty n m :: T -prop_currentpush is n = n > 0 ==> +prop_currentpush is n m = n > 0 ==> height (current x) (foldr push x js) == length js where js = nub is - x = empty n :: T + x = empty n m :: T prop_pushpeek x is = not (null is) ==> fromJust (peek (foldr push x is)) == head is where _ = x :: T @@ -86,6 +86,16 @@ prop_fullcache x = cached == allvals where allvals = sort . concat . elems $ stacks x _ = x :: T +prop_currentwsvisible x = (current x) `elem` (visibleWorkspaces x) + where _ = x :: T + +prop_ws2screen_screen2ws x = (ws == ws') && (sc == sc') + where ws = sort . keys $ ws2screen x + ws' = sort . elems $ screen2ws x + sc = sort . keys $ screen2ws x + sc' = sort . elems $ ws2screen x + _ = x :: T + ------------------------------------------------------------------------ main :: IO () @@ -110,6 +120,8 @@ main = do ,("rotate/rotate ", mytest prop_rotaterotate) ,("view/view ", mytest prop_viewview) ,("fullcache ", mytest prop_fullcache) + ,("currentwsvisible ", mytest prop_currentwsvisible) + ,("ws screen mapping", mytest prop_ws2screen_screen2ws) ] debug = False |