From c1dab22936b718b48f98b39befc6af6ce416fbf6 Mon Sep 17 00:00:00 2001
From: Spencer Janssen <sjanssen@cse.unl.edu>
Date: Thu, 1 Nov 2007 07:43:18 +0100
Subject: This is a massive update, here's what has changed:

 * Read is no longer a superclass of Layout
 * All of the core layouts have moved to the new Layouts.hs module
 * Select has been replaced by the new statically typed Choose combinator,
   which is heavily based on David Roundy's NewSelect proposal for
   XMonadContrib.  Consequently:
    - Rather than a list of choosable layouts, we use the ||| combinator to
      combine several layouts into a single switchable layout
    - We've lost the capability to JumpToLayout and PrevLayout.  Both can be
      added with some effort

darcs-hash:20071101064318-a5988-c07c434c7a1108078d6123a4b36040ed6597772b
---
 EventLoop.hs | 45 ++++++++++++++++++++++++---------------------
 1 file changed, 24 insertions(+), 21 deletions(-)

(limited to 'EventLoop.hs')

diff --git a/EventLoop.hs b/EventLoop.hs
index eec62fd..78e75b7 100644
--- a/EventLoop.hs
+++ b/EventLoop.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  Main.hs
@@ -35,22 +36,23 @@ import Operations
 
 import System.IO
 
-data XMonadConfig l = XMonadConfig { normalBorderColor :: !String
-                                   , focusedBorderColor :: !String
-                                   , defaultTerminal :: !String
-                                   , layoutHook :: !(l Window)
-                                   , workspaces :: ![String]
-                                   , defaultGaps :: ![(Int,Int,Int,Int)]
-                                   , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
-                                   , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
-                                   , borderWidth :: !Dimension
-                                   , logHook :: !(X ())
-                                   }
+data XMonadConfig = forall l. (LayoutClass l Window, Read (l Window)) =>
+                        XMonadConfig { normalBorderColor :: !String
+                                     , focusedBorderColor :: !String
+                                     , defaultTerminal :: !String
+                                     , layoutHook :: !(l Window)
+                                     , workspaces :: ![String]
+                                     , defaultGaps :: ![(Int,Int,Int,Int)]
+                                     , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
+                                     , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
+                                     , borderWidth :: !Dimension
+                                     , logHook :: !(X ())
+                                     }
 
 -- |
 -- The main entry point
 --
-makeMain :: LayoutClass l Window => XMonadConfig l -> IO ()
+makeMain :: XMonadConfig -> IO ()
 makeMain xmc = do
     dpy   <- openDisplay ""
     let dflt = defaultScreen dpy
@@ -62,17 +64,18 @@ makeMain xmc = do
     hSetBuffering stdout NoBuffering
     args <- getArgs
 
-    let initialWinset = new (Layout $ layoutHook xmc) (workspaces xmc) $ zipWith SD xinesc gaps
+    let (layout, lreads) = case xmc of XMonadConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s])
+        initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
 
-        maybeRead s = case reads s of
-                            [(x, "")] -> Just x
-                            _         -> Nothing
+        maybeRead reads' s = case reads' s of
+                                [(x, "")] -> Just x
+                                _         -> Nothing
 
         winset = fromMaybe initialWinset $ do
                     ("--resume" : s : _) <- return args
-                    ws                   <- maybeRead s
-                    return . W.ensureTags (Layout $ layoutHook xmc) (workspaces xmc)
-                           $ W.mapLayout (fromMaybe (Layout $ layoutHook xmc) . maybeRead) ws
+                    ws                   <- maybeRead reads s
+                    return . W.ensureTags layout (workspaces xmc)
+                           $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
 
         gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0)
 
@@ -256,7 +259,7 @@ scan dpy rootw = do
                          && (wa_map_state wa == waIsViewable || ic)
 
 -- | Grab the keys back
-grabKeys :: XMonadConfig l -> X ()
+grabKeys :: XMonadConfig -> X ()
 grabKeys xmc = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
@@ -268,7 +271,7 @@ grabKeys xmc = do
          when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers
 
 -- | XXX comment me
-grabButtons :: XMonadConfig l -> X ()
+grabButtons :: XMonadConfig -> X ()
 grabButtons xmc = do
     XConf { display = dpy, theRoot = rootw } <- ask
     let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask
-- 
cgit v1.2.3