moved screen <-> workspace mapping from XMonad to StackSet

darcs-hash:20070410062731-b9aa7-e1768a3fe6c0e3c749400dffc4a5a5e33e6a08c4

6 files changed, 79 insertions, 59 deletions

diff --git a/Config.hs b/Config.hs
index 47257cc..be28d1f 100644
--- a/Config.hs
+++ b/Config.hs
@@ -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)]]
 
diff --git a/Main.hs b/Main.hs
index 05cb69d..e7c24a6 100644
--- a/Main.hs
+++ b/Main.hs
@@ -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
diff --git a/XMonad.hs b/XMonad.hs
index 972169d..537f212 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -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