Add support for multiple workspaces

Everything is in place for multiple workspaces, bar one thing:
the view function. It updates thunk's idea of the current visible
windows, but I don't know how to tell X to hide the current set, and
instead treat the new window list as the only ones visible.

See notes for 'view' at bottom of Main.hs. If we can, say, switch to a
new workspace, which is empty, 'refresh' should spot this only display
the root window.
This commit is contained in:
Don Stewart 2007-03-07 11:12:47 +00:00
parent 27bc6b5b10
commit c6ddcd6dcd
2 changed files with 72 additions and 41 deletions

78
Main.hs
View File

@ -15,7 +15,8 @@
import Data.Bits hiding (rotate) import Data.Bits hiding (rotate)
import Data.List import Data.List
import qualified Data.Sequence as S
import qualified Data.Foldable as F
import qualified Data.Map as M import qualified Data.Map as M
import System.IO import System.IO
@ -40,8 +41,15 @@ keys = M.fromList
, ((mod1Mask, xK_Tab ), focus 1) , ((mod1Mask, xK_Tab ), focus 1)
, ((mod1Mask, xK_j ), focus 1) , ((mod1Mask, xK_j ), focus 1)
, ((mod1Mask, xK_k ), focus (-1)) , ((mod1Mask, xK_k ), focus (-1))
, ((mod1Mask .|. shiftMask, xK_c ), kill) , ((mod1Mask .|. shiftMask, xK_c ), kill)
, ((mod1Mask .|. shiftMask, xK_q ), io $ exitWith ExitSuccess) , ((mod1Mask .|. shiftMask, xK_q ), io $ exitWith ExitSuccess)
, ((mod1Mask, xK_1 ), view 1)
, ((mod1Mask, xK_2 ), view 2)
, ((mod1Mask, xK_3 ), view 3)
, ((mod1Mask, xK_4 ), view 4)
, ((mod1Mask, xK_5 ), view 5)
] ]
-- --
@ -55,7 +63,8 @@ main = do
{ display = dpy { display = dpy
, screenWidth = displayWidth dpy dflt , screenWidth = displayWidth dpy dflt
, screenHeight = displayHeight dpy dflt , screenHeight = displayHeight dpy dflt
, windows = [] } , workspace = (0,S.fromList (replicate 5 []))
}
runW initState $ do runW initState $ do
r <- io $ rootWindow dpy dflt r <- io $ rootWindow dpy dflt
@ -77,12 +86,12 @@ main = do
grabKey dpy kc m r True grabModeAsync grabModeAsync grabKey dpy kc m r True grabModeAsync grabModeAsync
-- --
-- The event handler -- | handle. Handle X events
-- --
handle :: Event -> W () handle :: Event -> W ()
handle (MapRequestEvent {window = w}) = manage w handle (MapRequestEvent {window = w}) = manage w
handle (DestroyWindowEvent {window = w}) = unmanage w handle (DestroyWindowEvent {window = w}) = unmanage w
handle (UnmapEvent {window = w}) = unmanage w handle (UnmapEvent {window = w}) = unmanage w
handle (KeyEvent {event_type = t, state = m, keycode = code}) handle (KeyEvent {event_type = t, state = m, keycode = code})
| t == keyPress = do | t == keyPress = do
@ -116,14 +125,17 @@ handle _ = return ()
-- --
refresh :: W () refresh :: W ()
refresh = do refresh = do
ws <- gets windows (n,wks) <- gets workspace
let ws = wks `S.index` n
case ws of case ws of
[] -> return () [] -> return () -- do nothing. hmm. so no empty workspaces?
-- we really need to hide all non-visible windows
-- ones on other screens
(w:_) -> do (w:_) -> do
d <- gets display d <- gets display
sw <- liftM fromIntegral (gets screenWidth) sw <- liftM fromIntegral (gets screenWidth)
sh <- liftM fromIntegral (gets screenHeight) sh <- liftM fromIntegral (gets screenHeight)
io $ do moveResizeWindow d w 0 0 sw sh io $ do moveResizeWindow d w 0 0 sw sh -- size
raiseWindow d w raiseWindow d w
-- | Modify the current window list with a pure funtion, and refresh -- | Modify the current window list with a pure funtion, and refresh
@ -132,23 +144,26 @@ withWindows f = do
modifyWindows f modifyWindows f
refresh refresh
-- | manage. Add a new window to be managed. Bring it into focus. -- | manage. Add a new window to be managed in the current workspace. Bring it into focus.
manage :: Window -> W () manage :: Window -> W ()
manage w = do manage w = do
d <- gets display d <- gets display
io $ mapWindow d w io $ mapWindow d w
withWindows (nub . (w :)) withWindows (nub . (w :))
-- | unmanage, a window no longer exists, remove it from the stack -- | unmanage. A window no longer exists, remove it from the window
-- list, on whatever workspace
unmanage :: Window -> W () unmanage :: Window -> W ()
unmanage w = do unmanage w = do
ws <- gets windows (_,wks) <- gets workspace
when (w `elem` ws) $ do mapM_ rm (F.toList wks)
dpy <- gets display where
io $ do grabServer dpy rm ws = when (w `elem` ws) $ do
sync dpy False dpy <- gets display
ungrabServer dpy io $ do grabServer dpy
withWindows $ filter (/= w) sync dpy False
ungrabServer dpy
withWindows $ filter (/= w)
-- | focus. focus to window at offset 'n' in list. -- | focus. focus to window at offset 'n' in list.
-- The currently focused window is always the head of the list -- The currently focused window is always the head of the list
@ -162,8 +177,9 @@ spawn = io_ . runCommand
-- | Kill the currently focused client -- | Kill the currently focused client
kill :: W () kill :: W ()
kill = do kill = do
ws <- gets windows dpy <- gets display
dpy <- gets display (n,wks) <- gets workspace
let ws = wks `S.index` n
case ws of case ws of
[] -> return () [] -> return ()
(w:_) -> do (w:_) -> do
@ -171,3 +187,25 @@ kill = do
-- sendevent(sel->win, wmatom[WMProtocols], wmatom[WMDelete]); -- sendevent(sel->win, wmatom[WMProtocols], wmatom[WMDelete]);
io $ killClient dpy w -- ignoring result io $ killClient dpy w -- ignoring result
return () return ()
-- | Change the current workspace to workspce at offset 'n-1'.
view :: Int -> W ()
view n = return ()
--
-- So the problem is that I don't quite understand X here.
-- The following code will set the right list of windows to be current,
-- according to our view of things.
--
-- We just need to tell X that it is only those in the current window
-- list that are indeed visible, and everything else is hidden.
--
-- In particular, if we switch to a new empty workspace, nothing should
-- be visible but the root. So: how do we hide windows?
--
{- do
let m = n-1
modifyWorkspaces $ \old@(_,wks) ->
if m < S.length wks && m >= 0 then (m,wks) else old
refresh
-}

35
W.hs
View File

@ -19,6 +19,7 @@ module W where
import Control.Monad.State import Control.Monad.State
import System.IO import System.IO
import Graphics.X11.Xlib (Display,Window) import Graphics.X11.Xlib (Display,Window)
import qualified Data.Sequence as S
-- | WState, the window manager state. -- | WState, the window manager state.
-- Just the display, width, height and a window list -- Just the display, width, height and a window list
@ -26,18 +27,11 @@ data WState = WState
{ display :: Display { display :: Display
, screenWidth :: !Int , screenWidth :: !Int
, screenHeight :: !Int , screenHeight :: !Int
, windows :: !Windows , workspace :: !WorkSpaces -- ^ workspace list
} }
-- type WorkSpaces = (Int, S.Seq Windows)
-- Multithreaded issues: type Windows = [Window]
--
-- We'll want a status bar, it will probably read from stdin
-- but will thus need to run in its own thread, and modify its status
-- bar window
--
type Windows = [Window]
-- | The W monad, a StateT transformer over IO encapuslating the window -- | The W monad, a StateT transformer over IO encapuslating the window
-- manager state -- manager state
@ -67,9 +61,13 @@ trace msg = io $ do
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Getting at the window manager state -- Getting at the window manager state
-- | Modify the workspace list
modifyWorkspaces :: (WorkSpaces -> WorkSpaces) -> W ()
modifyWorkspaces f = modify $ \s -> s { workspace = f (workspace s) }
-- | Modify the current window list -- | Modify the current window list
modifyWindows :: (Windows -> Windows) -> W () modifyWindows :: (Windows -> Windows) -> W ()
modifyWindows f = modify $ \s -> s {windows = f (windows s)} modifyWindows f = modifyWorkspaces $ \(i,wk) -> (i, S.adjust f i wk)
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Generic utilities -- Generic utilities
@ -80,16 +78,11 @@ forever a = a >> forever a
-- | Rotate a list by 'n' elements. -- | Rotate a list by 'n' elements.
-- --
-- for xs = [5..8] ++ [1..4] -- rotate 0 --> [5,6,7,8,1,2,3,4]
-- rotate 1 --> [6,7,8,1,2,3,4,5]
-- rotate (-1) --> [4,5,6,7,8,1,2,3]
-- --
-- rotate 0 -- where xs = [5..8] ++ [1..4]
-- [5,6,7,8,1,2,3,4]
--
-- rotate 1
-- [6,7,8,1,2,3,4,5]
--
-- rotate (-1)
-- [4,5,6,7,8,1,2,3]
-- --
rotate :: Int -> [a] -> [a] rotate :: Int -> [a] -> [a]
rotate n xs = take l . drop offset . cycle $ xs rotate n xs = take l . drop offset . cycle $ xs