diff options
author | Don Stewart <dons@cse.unsw.edu.au> | 2007-03-08 13:26:13 +0100 |
---|---|---|
committer | Don Stewart <dons@cse.unsw.edu.au> | 2007-03-08 13:26:13 +0100 |
commit | fc7791f96abe49af78c3d6ae1be86bd933dffa1d (patch) | |
tree | 3de2c25f67d8f01c8e842c3154928d1eee0e5abe | |
parent | fbae7e44a693103919fb2393016249dc059eef16 (diff) | |
download | metatile-fc7791f96abe49af78c3d6ae1be86bd933dffa1d.tar metatile-fc7791f96abe49af78c3d6ae1be86bd933dffa1d.zip |
refactoring. heads up: depends on withServer in X11-extras
darcs-hash:20070308122613-9c5c1-9d1492a54b2186edcc3c6c5f178254a00a969a6c
-rw-r--r-- | Main.hs | 42 | ||||
-rw-r--r-- | WMonad.hs | 12 |
2 files changed, 24 insertions, 30 deletions
@@ -100,8 +100,7 @@ handle (DestroyWindowEvent {window = w}) = unmanage w handle (UnmapEvent {window = w}) = unmanage w handle (KeyEvent {event_type = t, state = m, keycode = code}) - | t == keyPress = do - dpy <- gets display + | t == keyPress = withDisplay $ \dpy -> do s <- io $ keycodeToKeysym dpy code 0 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 -- screen and raises the window. refresh :: W () -refresh = whenJust W.peek $ \w -> do - d <- gets display - sw <- liftM fromIntegral (gets screenWidth) - sh <- liftM fromIntegral (gets screenHeight) - io $ do moveResizeWindow d w 0 0 sw sh -- fullscreen - raiseWindow d w +refresh = whenJust W.peek $ \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 :: Window -> W () -hide w = do - dpy <- gets display - sw <- liftM fromIntegral (gets screenWidth) - sh <- liftM fromIntegral (gets screenHeight) - io $ moveWindow dpy w (2*sw) (2*sh) +hide w = withScreen $ \(dpy,sw,sh) -> io $ + moveWindow dpy w (2*fromIntegral sw) (2*fromIntegral sh) -- | reveal. Expose a list of windows, moving them on screen reveal :: Window -> W () -reveal w = do - dpy <- gets display - io $ moveWindow dpy w 0 0 +reveal w = withDisplay $ \d -> io $ moveWindow d w 0 0 -- | windows. Modify the current window list with a pure function, and refresh windows :: (WorkSpace -> WorkSpace) -> W () -windows f = do - modifyWorkspace f - refresh +windows f = modifyWorkspace f >> refresh -- --------------------------------------------------------------------- -- 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. -- If the window is already under management, it is just raised. manage :: Window -> W () -manage w = do - d <- gets display - io $ mapWindow d w - windows $ W.push w +manage w = do withDisplay $ \d -> io $ mapWindow d w + windows $ W.push w -- | unmanage. A window no longer exists, remove it from the window -- list, on whatever workspace it is. @@ -170,10 +157,7 @@ unmanage :: Window -> W () unmanage w = do ws <- gets workspace when (W.member w ws) $ do - dpy <- gets display - io $ do grabServer dpy - sync dpy False - ungrabServer dpy + withDisplay $ \d -> io $ withServer d $ sync d False windows $ W.delete w -- | focus. focus to window at offset 'n' in list. @@ -183,9 +167,7 @@ focus = windows . W.rotate -- | Kill the currently focused client kill :: W () -kill = do - dpy <- gets display - whenJust W.peek $ io_ . killClient dpy +kill = withDisplay $ \d -> whenJust W.peek $ io_ . killClient d -- | tag. Move a window to a new workspace tag :: Int -> W () @@ -67,6 +67,18 @@ trace msg = io $ do hPutStrLn stderr msg 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. modifyWorkspace :: (WorkSpace -> WorkSpace) -> W () modifyWorkspace f = do |