diff options
| -rw-r--r-- | Config.hs | 16 | ||||
| -rw-r--r-- | Config.hs-boot | 2 | ||||
| -rw-r--r-- | Operations.hs | 26 | ||||
| -rw-r--r-- | XMonad.hs | 40 |
4 files changed, 42 insertions, 42 deletions
@@ -107,7 +107,7 @@ borderWidth = 1 -- | -- A list of layouts which, in addition to the defaultLayouts, xmonad can -- deserialize. -possibleLayouts :: [SomeLayout Window] +possibleLayouts :: [Layout Window] possibleLayouts = [defaultLayout -- Extension-provided layouts ] ++ defaultLayouts @@ -115,13 +115,13 @@ possibleLayouts = [defaultLayout -- | -- The default tiling algorithm -- -defaultLayout :: SomeLayout Window -defaultLayout = SomeLayout $ LayoutSelection defaultLayouts +defaultLayout :: Layout Window +defaultLayout = Layout $ LayoutSelection defaultLayouts -defaultLayouts :: [SomeLayout Window] -defaultLayouts = [ SomeLayout tiled - , SomeLayout $ Mirror tiled - , SomeLayout Full +defaultLayouts :: [Layout Window] +defaultLayouts = [ Layout tiled + , Layout $ Mirror tiled + , Layout Full -- Extension-provided layouts ] @@ -141,7 +141,7 @@ defaultLayouts = [ SomeLayout tiled -- | -- A list of layouts which, in addition to the defaultLayouts, xmonad can -- deserialize. -otherPossibleLayouts :: [SomeLayout Window] +otherPossibleLayouts :: [Layout Window] otherPossibleLayouts = [] -- | diff --git a/Config.hs-boot b/Config.hs-boot index f9d8ecd..d216fbc 100644 --- a/Config.hs-boot +++ b/Config.hs-boot @@ -7,5 +7,5 @@ borderWidth :: Dimension logHook :: X () numlockMask :: KeyMask workspaces :: [WorkspaceId] -possibleLayouts :: [SomeLayout Window] +possibleLayouts :: [Layout Window] manageHook :: Window -> (String, String, String) -> X (WindowSet -> WindowSet) diff --git a/Operations.hs b/Operations.hs index 69a28a6..8c2623f 100644 --- a/Operations.hs +++ b/Operations.hs @@ -148,7 +148,7 @@ windows f = do -- just the tiled windows: -- now tile the windows on this workspace, modified by the gap - (rs, ml') <- runLayout l viewrect tiled `catchX` runLayout (SomeLayout Full) viewrect tiled + (rs, ml') <- runLayout l viewrect tiled `catchX` runLayout (Layout Full) viewrect tiled mapM_ (uncurry tileWindow) rs whenJust ml' $ \l' -> runOnWorkspaces (\ww -> if W.tag ww == n then return $ ww { W.layout = l'} @@ -301,7 +301,7 @@ setFocusX w = withWindowSet $ \ws -> do io $ do setInputFocus dpy w revertToPointerRoot 0 -- raiseWindow dpy w --- | Throw a message to the current Layout possibly modifying how we +-- | Throw a message to the current LayoutClass possibly modifying how we -- layout the windows, then refresh. -- sendMessage :: Message a => a -> X () @@ -337,13 +337,13 @@ runOnWorkspaces job = do ws <- gets windowset instance Message Event -- | Set the layout of the currently viewed workspace -setLayout :: SomeLayout Window -> X () +setLayout :: Layout Window -> X () setLayout l = do ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset handleMessage (W.layout ws) (SomeMessage ReleaseResources) windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } } --- Layout selection manager +-- LayoutClass selection manager -- This is a layout that allows users to switch between various layout -- options. This layout accepts three Messages, NextLayout, PrevLayout and @@ -353,16 +353,16 @@ data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String deriving ( Eq, Show, Typeable ) instance Message ChangeLayout -instance ReadableSomeLayout Window where - defaults = SomeLayout (LayoutSelection []) : - SomeLayout Full : SomeLayout (Tall 1 0.1 0.5) : - SomeLayout (Mirror $ Tall 1 0.1 0.5) : +instance ReadableLayout Window where + defaults = Layout (LayoutSelection []) : + Layout Full : Layout (Tall 1 0.1 0.5) : + Layout (Mirror $ Tall 1 0.1 0.5) : possibleLayouts -data LayoutSelection a = LayoutSelection [SomeLayout a] +data LayoutSelection a = LayoutSelection [Layout a] deriving ( Show, Read ) -instance ReadableSomeLayout a => Layout LayoutSelection a where +instance ReadableLayout a => LayoutClass LayoutSelection a where doLayout (LayoutSelection (l:ls)) r s = do (x,ml') <- doLayout l r s return (x, (\l' -> LayoutSelection (l':ls)) `fmap` ml') @@ -414,12 +414,12 @@ instance Message IncMasterN -- simple fullscreen mode, just render all windows fullscreen. -- a plea for tuple sections: map . (,sc) data Full a = Full deriving ( Show, Read ) -instance Layout Full a +instance LayoutClass Full a -- -- The tiling mode of xmonad, and its operations. -- data Tall a = Tall Int Rational Rational deriving ( Show, Read ) -instance Layout Tall a where +instance LayoutClass Tall a where doLayout (Tall nmaster _ frac) r = return . (\x->(x,Nothing)) . ap zip (tile frac r nmaster . length) . W.integrate @@ -438,7 +438,7 @@ mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw) -- | Mirror a layout, compute its 90 degree rotated form. data Mirror l a = Mirror (l a) deriving (Show, Read) -instance Layout l a => Layout (Mirror l) a where +instance LayoutClass l a => LayoutClass (Mirror l) a where doLayout (Mirror l) r s = (map (second mirrorRect) *** fmap Mirror) `fmap` doLayout l (mirrorRect r) s handleMessage (Mirror l) = fmap (fmap Mirror) . handleMessage l @@ -16,7 +16,7 @@ ----------------------------------------------------------------------------- module XMonad ( - X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..), SomeLayout(..), ReadableSomeLayout(..), + X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..), ReadableLayout(..), Typeable, Message, SomeMessage(..), fromMessage, runLayout, runX, catchX, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX, atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW @@ -51,8 +51,8 @@ data XConf = XConf , normalBorder :: !Pixel -- ^ border color of unfocused windows , focusedBorder :: !Pixel } -- ^ border color of the focused window -type WindowSet = StackSet WorkspaceId (SomeLayout Window) Window ScreenId ScreenDetail -type WindowSpace = Workspace WorkspaceId (SomeLayout Window) Window +type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail +type WindowSpace = Workspace WorkspaceId (Layout Window) Window -- | Virtual workspace indicies type WorkspaceId = String @@ -118,7 +118,7 @@ atom_WM_DELETE_WINDOW = getAtom "WM_DELETE_WINDOW" atom_WM_STATE = getAtom "WM_STATE" ------------------------------------------------------------------------ --- | Layout handling +-- | LayoutClass handling -- The different layout modes -- 'doLayout': given a Rectangle and a Stack, layout the stack elements @@ -129,31 +129,31 @@ atom_WM_STATE = getAtom "WM_STATE" -- 'handleMessage' performs message handling for that layout. If -- 'handleMessage' returns Nothing, then the layout did not respond to -- that message and the screen is not refreshed. Otherwise, 'handleMessage' --- returns an updated 'Layout' and the screen is refreshed. +-- returns an updated 'LayoutClass' and the screen is refreshed. -- -data SomeLayout a = forall l. Layout l a => SomeLayout (l a) +data Layout a = forall l. LayoutClass l a => Layout (l a) -class ReadableSomeLayout a where - defaults :: [SomeLayout a] -instance ReadableSomeLayout a => Read (SomeLayout a) where +class ReadableLayout a where + defaults :: [Layout a] +instance ReadableLayout a => Read (Layout a) where readsPrec _ = readLayout defaults -instance ReadableSomeLayout a => Layout SomeLayout a where - doLayout (SomeLayout l) r s = fmap (fmap $ fmap SomeLayout) $ doLayout l r s - handleMessage (SomeLayout l) = fmap (fmap SomeLayout) . handleMessage l - description (SomeLayout l) = description l +instance ReadableLayout a => LayoutClass Layout a where + doLayout (Layout l) r s = fmap (fmap $ fmap Layout) $ doLayout l r s + handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l + description (Layout l) = description l -instance Show (SomeLayout a) where - show (SomeLayout l) = show l +instance Show (Layout a) where + show (Layout l) = show l -readLayout :: [SomeLayout a] -> String -> [(SomeLayout a, String)] +readLayout :: [Layout a] -> String -> [(Layout a, String)] readLayout ls s = take 1 $ concatMap rl ls -- We take the first parse only, because multiple matches -- indicate a bad parse. - where rl (SomeLayout x) = map (\(l,s') -> (SomeLayout l,s')) $ rl' x - rl' :: Layout l a => l a -> [(l a,String)] + where rl (Layout x) = map (\(l,s') -> (Layout l,s')) $ rl' x + rl' :: LayoutClass l a => l a -> [(l a,String)] rl' _ = reads s -class (Show (layout a), Read (layout a)) => Layout layout a where +class (Show (layout a), Read (layout a)) => LayoutClass layout a where doLayout :: layout a -> Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (layout a)) doLayout l r s = return (pureLayout l r s, Nothing) pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)] @@ -164,7 +164,7 @@ class (Show (layout a), Read (layout a)) => Layout layout a where description :: layout a -> String description = show -runLayout :: Layout l a => l a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (l a)) +runLayout :: LayoutClass l a => l a -> Rectangle -> StackOrNot a -> X ([(a, Rectangle)], Maybe (l a)) runLayout l r = maybe (return ([], Nothing)) (doLayout l r) -- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of Exceptions/, |