use new StackSet api

This commit is contained in:
Don Stewart 2007-03-09 03:56:15 +00:00
parent 436fbd7865
commit 78407a3c26
2 changed files with 24 additions and 20 deletions

33
Main.hs
View File

@ -144,9 +144,12 @@ handle e = trace (eventName e)
-- | refresh. Refresh the currently focused window. Resizes to full -- | refresh. Refresh the currently focused window. Resizes to full
-- screen and raises the window. -- screen and raises the window.
refresh :: W () refresh :: W ()
refresh = whenJust W.peek $ \w -> withScreen $ \(d,sw,sh) -> io $ do refresh = do
moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen ws <- gets workspace
raiseWindow d w whenJust (W.peek ws) $ \w ->
withScreen $ \(d,sw,sh) -> io $ do
moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen
raiseWindow d w
-- | hide. Hide a list of windows by moving them offscreen. -- | hide. Hide a list of windows by moving them offscreen.
hide :: Window -> W () hide :: Window -> W ()
@ -167,8 +170,9 @@ windows f = modifyWorkspace f >> refresh
-- | manage. Add a new window to be managed in the current workspace. Bring it into focus. -- | manage. Add a new window to be managed in the current workspace. Bring it into focus.
-- If the window is already under management, it is just raised. -- If the window is already under management, it is just raised.
manage :: Window -> W () manage :: Window -> W ()
manage w = do withDisplay $ \d -> io $ mapWindow d w manage w = do
windows $ W.push w withDisplay $ io . flip mapWindow w
windows $ W.push w
-- | unmanage. A window no longer exists, remove it from the window -- | unmanage. A window no longer exists, remove it from the window
-- list, on whatever workspace it is. -- list, on whatever workspace it is.
@ -186,25 +190,30 @@ focus = windows . W.rotate
-- | Kill the currently focused client -- | Kill the currently focused client
kill :: W () kill :: W ()
kill = withDisplay $ \d -> whenJust W.peek $ io_ . killClient d kill = withDisplay $ \d -> do
ws <- gets workspace
whenJust (W.peek ws) $ io_ . killClient d
-- | tag. Move a window to a new workspace -- | tag. Move a window to a new workspace
tag :: Int -> W () tag :: Int -> W ()
tag o = do tag o = do
ws <- gets workspace ws <- gets workspace
when (n /= W.cursor ws) $ let m = W.current ws
whenJust W.peek $ \w -> do when (n /= m) $
whenJust (W.peek ws) $ \w -> do
hide w hide w
windows $ W.shift n windows $ W.shift n
where n = o -1 where n = o-1
-- | view. Change the current workspace to workspce at offset 'n-1'. -- | view. Change the current workspace to workspce at offset 'n-1'.
view :: Int -> W () view :: Int -> W ()
view o = do view o = do
ws <- gets workspace ws <- gets workspace
when (n /= W.cursor ws) $ let m = W.current ws
whenJust (flip W.index n) $ \new -> do when (n /= m) $
mapM_ hide (W.stack ws) whenJust (W.index n ws) $ \new ->
whenJust (W.index m ws) $ \old -> do
mapM_ hide old
mapM_ reveal new mapM_ reveal new
windows $ W.view n windows $ W.view n
where n = o-1 where n = o-1

View File

@ -16,7 +16,7 @@
module WMonad where module WMonad where
import StackSet import StackSet (StackSet)
import Control.Monad.State import Control.Monad.State
import System.IO import System.IO
@ -87,11 +87,6 @@ modifyWorkspace f = do
trace (show ws) -- log state changes to stderr trace (show ws) -- log state changes to stderr
-- | Run a side effecting action with the current workspace. Like 'when' but -- | Run a side effecting action with the current workspace. Like 'when' but
-- for (WorkSpace -> Maybe a). whenJust :: Maybe a -> (a -> W ()) -> W ()
whenJust :: (WorkSpace -> Maybe a) -> (a -> W ()) -> W () whenJust mg f = maybe (return ()) f mg
whenJust mg f = do
ws <- gets workspace
case mg ws of
Nothing -> return ()
Just w -> f w