Add readsLayout, remove the existential from XConfig

This commit is contained in:
Spencer Janssen
2007-11-01 08:21:55 +00:00
parent 22aacf9bf6
commit 8a5d2490bb
4 changed files with 24 additions and 22 deletions

View File

@@ -50,7 +50,8 @@ makeMain xmc = do
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
args <- getArgs args <- getArgs
let (layout, lreads) = case xmc of XConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s]) let layout = layoutHook xmc
lreads = readsLayout layout
initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
maybeRead reads' s = case reads' s of maybeRead reads' s = case reads' s of

View File

@@ -240,7 +240,7 @@ defaultConfig = XConfig { borderWidth = 1 -- Width of the window border in pixel
-- above, but you may program your own selection behaviour here. Layout -- above, but you may program your own selection behaviour here. Layout
-- transformers, for example, would be hooked in here. -- transformers, for example, would be hooked in here.
-- --
, layoutHook = layout , layoutHook = Layout layout
, terminal = "xterm" -- The preferred terminal program. , terminal = "xterm" -- The preferred terminal program.
, normalBorderColor = "#dddddd" -- Border color for unfocused windows. , normalBorderColor = "#dddddd" -- Border color for unfocused windows.
, focusedBorderColor = "#ff0000" -- Border color for focused windows. , focusedBorderColor = "#ff0000" -- Border color for focused windows.

View File

@@ -342,11 +342,11 @@ runOnWorkspaces job =do
modify $ \s -> s { windowset = ws { W.current = c, W.visible = v, W.hidden = h } } modify $ \s -> s { windowset = ws { W.current = c, W.visible = v, W.hidden = h } }
-- | Set the layout of the currently viewed workspace -- | Set the layout of the currently viewed workspace
setLayout :: LayoutClass l Window => l Window -> X () setLayout :: Layout Window -> X ()
setLayout l = do setLayout l = do
ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset
handleMessage (W.layout ws) (SomeMessage ReleaseResources) handleMessage (W.layout ws) (SomeMessage ReleaseResources)
windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = Layout l } } } windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Utilities -- Utilities

View File

@@ -16,8 +16,7 @@
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad ( module XMonad (
X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), XConfig(..), LayoutClass(..), Layout(..), X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), XConfig(..), LayoutClass(..), Layout(..), readsLayout, Typeable, Message, SomeMessage(..), fromMessage, runLayout, LayoutMessages(..),
Typeable, Message, SomeMessage(..), fromMessage, runLayout, LayoutMessages(..),
runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX, runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
) where ) where
@@ -55,20 +54,18 @@ data XConf = XConf
, focusedBorder :: !Pixel } -- ^ border color of the focused window , focusedBorder :: !Pixel } -- ^ border color of the focused window
-- todo, better name -- todo, better name
data XConfig = forall l. (LayoutClass l Window, Read (l Window)) => data XConfig = XConfig { normalBorderColor :: !String
XConfig { normalBorderColor :: !String , focusedBorderColor :: !String
, focusedBorderColor :: !String , terminal :: !String
, terminal :: !String , layoutHook :: !(Layout Window)
, layoutHook :: !(l Window) , manageHook :: !(Window -> String -> String -> String -> X (WindowSet -> WindowSet))
, manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet) , workspaces :: ![String]
, workspaces :: ![String] , defaultGaps :: ![(Int,Int,Int,Int)]
, defaultGaps :: ![(Int,Int,Int,Int)] , numlockMask :: KeyMask
, numlockMask :: KeyMask , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
, keys :: !(M.Map (ButtonMask,KeySym) (X ())) , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
, mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ())) , borderWidth :: !Dimension
, borderWidth :: !Dimension , logHook :: !(X ()) }
, logHook :: !(X ())
}
type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
type WindowSpace = Workspace WorkspaceId (Layout Window) Window type WindowSpace = Workspace WorkspaceId (Layout Window) Window
@@ -147,9 +144,13 @@ atom_WM_STATE = getAtom "WM_STATE"
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | LayoutClass handling. See particular instances in Operations.hs -- | LayoutClass handling. See particular instances in Operations.hs
-- | An existential type that can hold any object that is in the LayoutClass. -- | An existential type that can hold any object that is in Read and LayoutClass.
data Layout a = forall l. (LayoutClass l a) => Layout (l a) data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)
-- | Using the 'Layout' as a witness, parse existentially wrapped windows
-- from a 'String'
readsLayout :: Layout a -> String -> [(Layout a, String)]
readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
-- | The different layout modes -- | The different layout modes
-- --