From 704ca55fc2de620d85929ca5cbcab5f2a03e77cc Mon Sep 17 00:00:00 2001 From: David Roundy Date: Fri, 21 Sep 2007 22:43:16 +0200 Subject: make layouts preserved over restart darcs-hash:20070921204316-72aca-6f8cabc516cc87345bfa73be0e060b206aa2a207 --- Config.hs-boot | 3 ++- Operations.hs | 8 +++++++- XMonad.hs | 7 +------ 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/Config.hs-boot b/Config.hs-boot index ae05ea4..45d0850 100644 --- a/Config.hs-boot +++ b/Config.hs-boot @@ -1,8 +1,9 @@ module Config where import Graphics.X11.Xlib.Types (Dimension) -import Graphics.X11.Xlib (KeyMask) +import Graphics.X11.Xlib (KeyMask,Window) import XMonad borderWidth :: Dimension logHook :: X () numlockMask :: KeyMask workspaces :: [WorkspaceId] +defaultLayouts :: [SomeLayout Window] diff --git a/Operations.hs b/Operations.hs index 8b470e7..dc7a16b 100644 --- a/Operations.hs +++ b/Operations.hs @@ -18,7 +18,7 @@ module Operations where import XMonad import qualified StackSet as W -import {-# SOURCE #-} Config (borderWidth,logHook,numlockMask) +import {-# SOURCE #-} Config (borderWidth,logHook,numlockMask,defaultLayouts) import Data.Maybe import Data.List (nub, (\\), find) @@ -105,6 +105,12 @@ kill = withDisplay $ \d -> withFocused $ \w -> do data UnDoLayout = UnDoLayout deriving ( Typeable, Eq ) instance Message UnDoLayout +instance Read (SomeLayout Window) where + readsPrec _ = readLayout defaultLayouts +instance Layout SomeLayout Window where + doLayout (SomeLayout l) r s = fmap (fmap $ fmap SomeLayout) $ doLayout l r s + modifyLayout (SomeLayout l) = fmap (fmap SomeLayout) . modifyLayout l + -- | windows. Modify the current window list with a pure function, and refresh windows :: (WindowSet -> WindowSet) -> X () windows f = do diff --git a/XMonad.hs b/XMonad.hs index cec0574..f288469 100644 --- a/XMonad.hs +++ b/XMonad.hs @@ -131,10 +131,9 @@ atom_WM_STATE = getAtom "WM_STATE" -- returns an updated 'Layout' and the screen is refreshed. -- data SomeLayout a = forall l. Layout l a => SomeLayout (l a) + instance Show (SomeLayout a) where show (SomeLayout l) = show l -instance Read (SomeLayout a) where - readsPrec _ _ = [] -- We can't read an existential type!!! readLayout :: [SomeLayout a] -> String -> [(SomeLayout a, String)] readLayout ls s = concatMap rl ls @@ -146,10 +145,6 @@ class (Show (layout a), Read (layout a)) => Layout layout a where doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a)) modifyLayout :: layout a -> SomeMessage -> X (Maybe (layout a)) -instance Layout SomeLayout a where - doLayout (SomeLayout l) r s = fmap (fmap $ fmap SomeLayout) $ doLayout l r s - modifyLayout (SomeLayout l) = fmap (fmap SomeLayout) . modifyLayout l - runLayout :: Layout l a => l a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (l a)) runLayout l r = maybe (return ([], Nothing)) (doLayout l r) -- cgit v1.2.3