refactoring. heads up: depends on withServer in X11-extras

This commit is contained in:
Don Stewart 2007-03-08 12:26:13 +00:00
parent 87ee0cc151
commit 39f52d8fa8
2 changed files with 24 additions and 30 deletions

42
Main.hs
View File

@ -100,8 +100,7 @@ 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 = withDisplay $ \dpy -> do
dpy <- gets display
s <- io $ keycodeToKeysym dpy code 0 s <- io $ keycodeToKeysym dpy code 0
maybe (return ()) id (M.lookup (m,s) keys) maybe (return ()) id (M.lookup (m,s) keys)
@ -126,32 +125,22 @@ handle e = trace (eventName e) -- return ()
-- | 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 -> do refresh = whenJust W.peek $ \w -> withScreen $ \(d,sw,sh) -> io $ do
d <- gets display moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen
sw <- liftM fromIntegral (gets screenWidth) raiseWindow d w
sh <- liftM fromIntegral (gets screenHeight)
io $ do moveResizeWindow d w 0 0 sw 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 ()
hide w = do hide w = withScreen $ \(dpy,sw,sh) -> io $
dpy <- gets display moveWindow dpy w (2*fromIntegral sw) (2*fromIntegral sh)
sw <- liftM fromIntegral (gets screenWidth)
sh <- liftM fromIntegral (gets screenHeight)
io $ moveWindow dpy w (2*sw) (2*sh)
-- | reveal. Expose a list of windows, moving them on screen -- | reveal. Expose a list of windows, moving them on screen
reveal :: Window -> W () reveal :: Window -> W ()
reveal w = do reveal w = withDisplay $ \d -> io $ moveWindow d w 0 0
dpy <- gets display
io $ moveWindow dpy w 0 0
-- | windows. Modify the current window list with a pure function, and refresh -- | windows. Modify the current window list with a pure function, and refresh
windows :: (WorkSpace -> WorkSpace) -> W () windows :: (WorkSpace -> WorkSpace) -> W ()
windows f = do windows f = modifyWorkspace f >> refresh
modifyWorkspace f
refresh
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Window operations -- Window operations
@ -159,10 +148,8 @@ windows f = do
-- | 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 manage w = do withDisplay $ \d -> io $ mapWindow d w
d <- gets display windows $ W.push w
io $ mapWindow d 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.
@ -170,10 +157,7 @@ unmanage :: Window -> W ()
unmanage w = do unmanage w = do
ws <- gets workspace ws <- gets workspace
when (W.member w ws) $ do when (W.member w ws) $ do
dpy <- gets display withDisplay $ \d -> io $ withServer d $ sync d False
io $ do grabServer dpy
sync dpy False
ungrabServer dpy
windows $ W.delete w windows $ W.delete w
-- | focus. focus to window at offset 'n' in list. -- | focus. focus to window at offset 'n' in list.
@ -183,9 +167,7 @@ focus = windows . W.rotate
-- | Kill the currently focused client -- | Kill the currently focused client
kill :: W () kill :: W ()
kill = do kill = withDisplay $ \d -> whenJust W.peek $ io_ . killClient d
dpy <- gets display
whenJust W.peek $ io_ . killClient dpy
-- | tag. Move a window to a new workspace -- | tag. Move a window to a new workspace
tag :: Int -> W () tag :: Int -> W ()

View File

@ -67,6 +67,18 @@ trace msg = io $ do
hPutStrLn stderr msg hPutStrLn stderr msg
hFlush stderr hFlush stderr
-- | Run a monad action with the current display settings
withDisplay :: (Display -> W ()) -> W ()
withDisplay f = gets display >>= f
-- | Run a monadic action with the display, screen width and height
withScreen :: ((Display,Int,Int) -> W ()) -> W ()
withScreen f = do
d <- gets display
sw <- gets screenWidth
sh <- gets screenHeight
f (d,sw,sh)
-- | Modify the workspace list. -- | Modify the workspace list.
modifyWorkspace :: (WorkSpace -> WorkSpace) -> W () modifyWorkspace :: (WorkSpace -> WorkSpace) -> W ()
modifyWorkspace f = do modifyWorkspace f = do