summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Main.hs28
-rw-r--r--W.hs9
2 files changed, 24 insertions, 13 deletions
diff --git a/Main.hs b/Main.hs
index 66afef8..16c7cee 100644
--- a/Main.hs
+++ b/Main.hs
@@ -15,16 +15,21 @@
import qualified Data.Map as Map
import Data.Map (Map)
+
import Data.Sequence as Seq
import qualified Data.Foldable as Fold
+
import Data.Bits
-import Control.Monad.State
+
import System.IO
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
import System.Process (runCommand)
import System.Exit
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+
+import Control.Monad.State
+
import W
------------------------------------------------------------------------
@@ -65,8 +70,6 @@ loop = do
forever $ do
e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
handler e
- where
- forever a = a >> forever a
--
-- The event handler
@@ -78,13 +81,14 @@ handler (DestroyWindowEvent {window = w}) = do
modifyWindows (Seq.fromList . filter (/= w) . Fold.toList)
refresh
-handler (KeyEvent {event_type = t, state = mod, keycode = code})
- | t == keyPress = do
- dpy <- getDisplay
- sym <- io $ keycodeToKeysym dpy code 0
- case filter (\(mod', sym', _) -> mod == mod' && sym == sym') keys of
- [] -> return ()
- ((_, _, act):_) -> act
+handler (KeyEvent {event_type = t, state = mod, keycode = code})
+ | t == keyPress = do
+ dpy <- getDisplay
+ sym <- io $ keycodeToKeysym dpy code 0
+ case filter (\(mod', sym', _) -> mod == mod' && sym == sym') keys of
+ [] -> return ()
+ ((_, _, act):_) -> act
+
handler _ = return ()
--
diff --git a/W.hs b/W.hs
index 0dc3e16..016baaa 100644
--- a/W.hs
+++ b/W.hs
@@ -10,7 +10,8 @@
--
-----------------------------------------------------------------------------
--
--- The W monad, a state monad transformer over IO, for the window manager state.
+-- The W monad, a state monad transformer over IO, for the window
+-- manager state, and support routines.
--
module W where
@@ -70,6 +71,12 @@ trace msg = io $ do
hPutStrLn stderr msg
hFlush stderr
+--
+-- | Run an action forever
+--
+forever :: (Monad m) => m a -> m b
+forever a = a >> forever a
+
-- ---------------------------------------------------------------------
-- Getting at the window manager state