diff options
author | Spencer Janssen <sjanssen@cse.unl.edu> | 2007-11-01 07:43:18 +0100 |
---|---|---|
committer | Spencer Janssen <sjanssen@cse.unl.edu> | 2007-11-01 07:43:18 +0100 |
commit | cad84bdf1518c173d76fd0de04ace22eb886821a (patch) | |
tree | 5fca7a6c0b7cf81c19b8affca3c1a127dbfa673e /EventLoop.hs | |
parent | 2c21308fc9cafa27ab95b38bd3712f5b7939fa37 (diff) | |
download | xmonad-cad84bdf1518c173d76fd0de04ace22eb886821a.tar.gz xmonad-cad84bdf1518c173d76fd0de04ace22eb886821a.tar.xz xmonad-cad84bdf1518c173d76fd0de04ace22eb886821a.zip |
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.gz
Diffstat (limited to 'EventLoop.hs')
-rw-r--r-- | EventLoop.hs | 45 |
1 files changed, 24 insertions, 21 deletions
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 |