mirror of
https://github.com/xmonad/xmonad.git
synced 2025-05-19 08:30:21 -07:00
derive MonadState, removes most accessors
This commit is contained in:
parent
96184564d6
commit
bea5592b85
20
Main.hs
20
Main.hs
@ -78,23 +78,23 @@ handle :: Event -> W ()
|
|||||||
handle (MapRequestEvent {window = w}) = manage w
|
handle (MapRequestEvent {window = w}) = manage w
|
||||||
|
|
||||||
handle (DestroyWindowEvent {window = w}) = do
|
handle (DestroyWindowEvent {window = w}) = do
|
||||||
ws <- getWindows
|
ws <- gets windows
|
||||||
when (elem w ws) (unmanage w)
|
when (elem w ws) (unmanage w)
|
||||||
|
|
||||||
handle (UnmapEvent {window = w}) = do
|
handle (UnmapEvent {window = w}) = do
|
||||||
ws <- getWindows
|
ws <- gets windows
|
||||||
when (elem w ws) (unmanage w)
|
when (elem w ws) (unmanage w)
|
||||||
|
|
||||||
handle (KeyEvent {event_type = t, state = mod, keycode = code})
|
handle (KeyEvent {event_type = t, state = mod, keycode = code})
|
||||||
| t == keyPress = do
|
| t == keyPress = do
|
||||||
dpy <- getDisplay
|
dpy <- gets display
|
||||||
sym <- io $ keycodeToKeysym dpy code 0
|
sym <- io $ keycodeToKeysym dpy code 0
|
||||||
case filter (\(mod', sym', _) -> mod == mod' && sym == sym') keys of
|
case filter (\(mod', sym', _) -> mod == mod' && sym == sym') keys of
|
||||||
[] -> return ()
|
[] -> return ()
|
||||||
((_, _, act):_) -> act
|
((_, _, act):_) -> act
|
||||||
|
|
||||||
handle e@(ConfigureRequestEvent {}) = do
|
handle e@(ConfigureRequestEvent {}) = do
|
||||||
dpy <- getDisplay
|
dpy <- gets display
|
||||||
io $ configureWindow dpy (window e) (value_mask e) $
|
io $ configureWindow dpy (window e) (value_mask e) $
|
||||||
WindowChanges
|
WindowChanges
|
||||||
{ wcX = x e
|
{ wcX = x e
|
||||||
@ -121,7 +121,7 @@ withWindows f = do
|
|||||||
-- | Run an action on the currently focused window
|
-- | Run an action on the currently focused window
|
||||||
withCurrent :: (Window -> W ()) -> W ()
|
withCurrent :: (Window -> W ()) -> W ()
|
||||||
withCurrent f = do
|
withCurrent f = do
|
||||||
ws <- getWindows
|
ws <- gets windows
|
||||||
case ws of
|
case ws of
|
||||||
[] -> return ()
|
[] -> return ()
|
||||||
(w:_) -> f w
|
(w:_) -> f w
|
||||||
@ -132,9 +132,9 @@ withCurrent f = do
|
|||||||
--
|
--
|
||||||
refresh :: W ()
|
refresh :: W ()
|
||||||
refresh = withCurrent $ \w -> do
|
refresh = withCurrent $ \w -> do
|
||||||
d <- getDisplay
|
d <- gets display
|
||||||
sw <- getScreenWidth
|
sw <- gets screenWidth
|
||||||
sh <- getScreenHeight
|
sh <- gets screenHeight
|
||||||
io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
|
io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
|
||||||
raiseWindow d w
|
raiseWindow d w
|
||||||
|
|
||||||
@ -144,7 +144,7 @@ refresh = withCurrent $ \w -> do
|
|||||||
manage :: Window -> W ()
|
manage :: Window -> W ()
|
||||||
manage w = do
|
manage w = do
|
||||||
trace "manage"
|
trace "manage"
|
||||||
d <- getDisplay
|
d <- gets display
|
||||||
withWindows $ \ws -> if w `elem` ws then ws else w:ws -- a set
|
withWindows $ \ws -> if w `elem` ws then ws else w:ws -- a set
|
||||||
io $ mapWindow d w
|
io $ mapWindow d w
|
||||||
|
|
||||||
@ -153,7 +153,7 @@ manage w = do
|
|||||||
--
|
--
|
||||||
unmanage :: Window -> W ()
|
unmanage :: Window -> W ()
|
||||||
unmanage w = do
|
unmanage w = do
|
||||||
dpy <- getDisplay
|
dpy <- gets display
|
||||||
io $ grabServer dpy
|
io $ grabServer dpy
|
||||||
modifyWindows (filter (/= w))
|
modifyWindows (filter (/= w))
|
||||||
io $ sync dpy False
|
io $ sync dpy False
|
||||||
|
26
W.hs
26
W.hs
@ -34,7 +34,7 @@ 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
|
||||||
newtype W a = W { unW :: StateT WState IO a }
|
newtype W a = W { unW :: StateT WState IO a }
|
||||||
deriving (Functor, Monad, MonadIO)
|
deriving (Functor, Monad, MonadIO, MonadState WState)
|
||||||
|
|
||||||
-- | Run the W monad, given a chunk of W monad code, and an initial state
|
-- | Run the W monad, given a chunk of W monad code, and an initial state
|
||||||
-- Return the result, and final state
|
-- Return the result, and final state
|
||||||
@ -59,29 +59,9 @@ trace msg = io $ do
|
|||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
-- Getting at the window manager state
|
-- Getting at the window manager state
|
||||||
|
|
||||||
-- | Return the current dispaly
|
|
||||||
getDisplay :: W Display
|
|
||||||
getDisplay = W (gets display)
|
|
||||||
|
|
||||||
-- | Return the current windows
|
|
||||||
getWindows :: W Windows
|
|
||||||
getWindows = W (gets windows)
|
|
||||||
|
|
||||||
-- | Return the screen width
|
|
||||||
getScreenWidth :: W Int
|
|
||||||
getScreenWidth = W (gets screenWidth)
|
|
||||||
|
|
||||||
-- | Return the screen height
|
|
||||||
getScreenHeight :: W Int
|
|
||||||
getScreenHeight = W (gets screenHeight)
|
|
||||||
|
|
||||||
-- | Set the current window list
|
|
||||||
setWindows ::Windows -> W ()
|
|
||||||
setWindows x = W (modify (\s -> s {windows = x}))
|
|
||||||
|
|
||||||
-- | Modify the current window list
|
-- | Modify the current window list
|
||||||
modifyWindows :: (Windows -> Windows) -> W ()
|
modifyWindows :: (Windows -> Windows) -> W ()
|
||||||
modifyWindows f = W (modify (\s -> s {windows = f (windows s)}))
|
modifyWindows f = modify $ \s -> s {windows = f (windows s)}
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
-- Generic utilities
|
-- Generic utilities
|
||||||
|
Loading…
x
Reference in New Issue
Block a user