refactoring. less code

darcs-hash:20070307055007-9c5c1-2dc9d077773b25f22954c41856e670f3b5583e9f

1 files changed, 76 insertions, 91 deletions

diff --git a/Main.hs b/Main.hs
index bf5562c..6fdfbd3 100644
--- a/Main.hs
+++ b/Main.hs
@@ -13,10 +13,7 @@
 -- thunk, a minimal window manager for X11
 --
 
-import qualified Data.Map as Map
-import Data.Map (Map)
-
-import Data.Bits
+import Data.Bits hiding (rotate)
 
 import System.IO
 import System.Process (runCommand)
@@ -29,56 +26,62 @@ import Control.Monad.State
 
 import W
 
-------------------------------------------------------------------------
-
 --
 -- let's get underway
 -- 
 main :: IO ()
 main = do
     dpy <- openDisplay ""
-    runW realMain $ WState
-            { display = dpy
-            , screenWidth  = displayWidth  dpy (defaultScreen dpy)
-            , screenHeight = displayHeight dpy (defaultScreen dpy)
-            , windows      = []
-            }
+    let dflt      = defaultScreen dpy
+        initState = WState
+            { display      = dpy
+            , screenWidth  = displayWidth  dpy dflt
+            , screenHeight = displayHeight dpy dflt
+            , windows      = [] }
+
+    runW initState $ do
+        root <- io $ rootWindow dpy dflt
+        io $ do selectInput dpy root (substructureRedirectMask .|. substructureNotifyMask)
+                sync dpy False
+        registerKeys dpy root
+        go dpy
+
     return ()
+  where
+    -- The main loop
+    go dpy = forever $ do
+        e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
+        handle e
 
 --
--- Grab the display and input, and jump into the input loop
+-- | grabkeys. Register key commands
 --
-realMain :: W ()
-realMain = do
-    dpy <- getDisplay
-    let screen = defaultScreen dpy
-    io $ do root <- rootWindow dpy screen
-            selectInput dpy root (substructureRedirectMask .|. substructureNotifyMask)
-            sync dpy False
-    grabkeys
-    loop
+registerKeys :: Display -> Window -> W ()
+registerKeys dpy root =
+    forM_ keys $ \(mod, sym, _) -> do
+        kc <- io (keysymToKeycode dpy sym)
+        io $ grabKey dpy kc mod root True grabModeAsync grabModeAsync
 
---
--- The main event handling loop
---
-loop :: W ()
-loop = do
-    dpy <- getDisplay
-    forever $ do
-        e <- io $ allocaXEvent $ \ev -> nextEvent dpy ev >> getEvent ev
-        handler e
+keys :: [(KeyMask, KeySym, W ())]
+keys =
+    [ (mod1Mask .|. shiftMask, xK_Return, spawn "xterm")
+    , (mod1Mask,               xK_p,      spawn "exe=`dmenu_path | dmenu` && exec $exe")
+    , (controlMask,            xK_space,  spawn "gmrun")
+    , (mod1Mask,               xK_Tab,    switch)
+    , (mod1Mask .|. shiftMask, xK_q,      io $ exitWith ExitSuccess)
+    ]
 
 --
 -- The event handler
 -- 
-handler :: Event -> W ()
-handler (MapRequestEvent {window = w}) = manage w
+handle :: Event -> W ()
+handle (MapRequestEvent {window = w}) = manage w
 
-handler (DestroyWindowEvent {window = w}) = do
+handle (DestroyWindowEvent {window = w}) = do
     modifyWindows (filter (/= w))
     refresh
 
-handler (KeyEvent {event_type = t, state = mod, keycode = code})
+handle (KeyEvent {event_type = t, state = mod, keycode = code})
     | t == keyPress = do
         dpy <- getDisplay
         sym <- io $ keycodeToKeysym dpy code 0
@@ -86,75 +89,57 @@ handler (KeyEvent {event_type = t, state = mod, keycode = code})
             []              -> return ()
             ((_, _, act):_) -> act
 
-handler _ = return ()
+handle _ = return ()
 
---
--- switch focus to next window in list.
---
-switch :: W ()
-switch = do
-    ws <- getWindows
-    case ws of
-        []     -> return ()
-        (x:xs) -> do
-            setWindows (xs++[x]) -- snoc. polish this.
-            refresh
+-- ---------------------------------------------------------------------
+-- Managing windows
 
---
--- | spawn. Launch an external application
---
-spawn :: String -> W ()
-spawn = io_ . runCommand
+-- | Modify the current window list with a pure funtion, and refresh
+withWindows :: (Windows -> Windows) -> W ()
+withWindows f = do
+    modifyWindows f
+    refresh
 
---
--- | Keys we understand.
---
-keys :: [(KeyMask, KeySym, W ())]
-keys =
-    [ (mod1Mask .|. shiftMask, xK_Return, spawn "xterm")
-    , (mod1Mask,               xK_p,      spawn "exe=`dmenu_path | dmenu` && exec $exe")
-    , (controlMask,            xK_space,  spawn "gmrun")
-    , (mod1Mask,               xK_Tab,    switch)
-    , (mod1Mask .|. shiftMask, xK_q,      io $ exitWith ExitSuccess)
-    ]
+-- |  Run an action on the currently focused window
+withCurrent :: (Window -> W ()) -> W ()
+withCurrent f = do
+    ws <- getWindows
+    case ws of
+        []    -> return ()
+        (w:_) -> f w
 
 --
--- | grabkeys. Register key commands
+-- | refresh. Refresh the currently focused window. Resizes to full
+-- screen and raises the window.
 --
-grabkeys :: W ()
-grabkeys = do
-    dpy <- getDisplay
-    root <- io $ rootWindow dpy (defaultScreen dpy)
-    forM_ keys $ \(mod, sym, _) -> do
-        code <- io $ keysymToKeycode dpy sym
-        io $ grabKey dpy code mod root True grabModeAsync grabModeAsync
+refresh :: W ()
+refresh = withCurrent $ \w -> do
+    d  <- getDisplay
+    sw <- getScreenWidth
+    sh <- getScreenHeight
+    io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
+            raiseWindow d w
 
 --
---
+-- | manage. Add a new window to be managed
 --
 manage :: Window -> W ()
 manage w = do
     trace "manage"
-    d <- getDisplay
-    ws <- getWindows
-    when (w `notElem` ws) $ do
-        trace "modifying"
-        modifyWindows (w :)
-        io $ mapWindow d w
-        refresh
+    d  <- getDisplay
+    withWindows $ \ws -> if w `elem` ws then ws else w:ws -- a set
+    io $ mapWindow d w
+
 
 --
--- refresh the windows
+-- | switch. switch focus to next window in list.
+-- The currently focused window is always the head of the list
 --
-refresh :: W ()
-refresh = do
-    ws <- getWindows
-    case ws of
-        []    -> return ()
-        (w:_) -> do
-            d  <- getDisplay
-            sw <- getScreenWidth
-            sh <- getScreenHeight
-            io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh)
-                    raiseWindow d w
+switch :: W ()
+switch = withWindows rotate
 
+--
+-- | spawn. Launch an external application
+--
+spawn :: String -> W ()
+spawn = io_ . runCommand