diff options
| -rw-r--r-- | Config.hs | 48 | ||||
| -rw-r--r-- | Config.hs-boot | 4 | ||||
| -rw-r--r-- | Main.hs | 6 | ||||
| -rw-r--r-- | Operations.hs | 51 |
4 files changed, 58 insertions, 51 deletions
@@ -115,22 +115,13 @@ focusedBorderColor = "#ff0000" borderWidth :: Dimension borderWidth = 1 --- | --- The default Layout, a selector between the layouts listed below in --- defaultLayouts. --- -defaultLayout :: Layout Window -defaultLayout = Layout $ LayoutSelection defaultLayouts - --- | --- The list of selectable layouts -defaultLayouts :: [Layout Window] -defaultLayouts = [ Layout tiled - , Layout $ Mirror tiled - , Layout Full - - -- Extension-provided layouts - ] +-- | The list of possible layouts. Add your custom layouts to this list. +layouts :: [Layout Window] +layouts = [ Layout tiled + , Layout $ Mirror tiled + , Layout Full + -- Add extra layouts you want to use here: + ] where -- default tiling algorithm partitions the screen into two panes tiled = Tall nmaster delta ratio @@ -145,11 +136,24 @@ defaultLayouts = [ Layout tiled delta = 3%100 -- | --- A list of layouts which xmonad can deserialize. -possibleLayouts :: [Layout Window] -possibleLayouts = [defaultLayout - -- Extension-provided layouts - ] ++ defaultLayouts +-- The top level layout switcher. By default, we simply switch between +-- the layouts listed in `layouts', but you may program your own selection +-- behaviour here. Layout transformers would be hooked in here. +-- +layoutHook :: Layout Window +layoutHook = Layout $ Select layouts + +-- | +-- The default Layout, a selector between the layouts listed below in +-- defaultLayouts. +-- +-- defaultLayout :: Layout Window +-- defaultLayout = Layout $ LayoutSelection defaultLayouts + +-- | Register with xmonad a list of layouts whose state we can preserve over restarts. +-- There is typically no need to modify this list, the defaults are fine. +serialisedLayouts :: [Layout Window] +serialisedLayouts = layoutHook : layouts -- | -- Perform an arbitrary action on each state change. @@ -175,7 +179,7 @@ keys = M.fromList $ , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window , ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms - , ((modMask .|. shiftMask, xK_space ), setLayout defaultLayout) -- %! Reset the layouts on the current workspace to default + , ((modMask .|. shiftMask, xK_space ), setLayout layoutHook) -- %! Reset the layouts on the current workspace to default , ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size diff --git a/Config.hs-boot b/Config.hs-boot index b6151c8..6d631c5 100644 --- a/Config.hs-boot +++ b/Config.hs-boot @@ -3,8 +3,8 @@ import Graphics.X11.Xlib.Types (Dimension) import Graphics.X11.Xlib (KeyMask,Window) import XMonad borderWidth :: Dimension -logHook :: X () numlockMask :: KeyMask workspaces :: [WorkspaceId] -possibleLayouts :: [Layout Window] +logHook :: X () manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet) +serialisedLayouts :: [Layout Window] @@ -50,7 +50,7 @@ main = do hSetBuffering stdout NoBuffering args <- getArgs - let initialWinset = new defaultLayout workspaces $ zipWith SD xinesc gaps + let initialWinset = new layoutHook workspaces $ zipWith SD xinesc gaps maybeRead s = case reads s of [(x, "")] -> Just x @@ -59,8 +59,8 @@ main = do winset = fromMaybe initialWinset $ do ("--resume" : s : _) <- return args ws <- maybeRead s - return . W.ensureTags defaultLayout workspaces - $ W.mapLayout (fromMaybe defaultLayout . maybeRead) ws + return . W.ensureTags layoutHook workspaces + $ W.mapLayout (fromMaybe layoutHook . maybeRead) ws gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0) diff --git a/Operations.hs b/Operations.hs index 223257d..ec2dd04 100644 --- a/Operations.hs +++ b/Operations.hs @@ -20,7 +20,7 @@ module Operations where import XMonad import qualified StackSet as W -import {-# SOURCE #-} Config (borderWidth,logHook,manageHook,numlockMask,possibleLayouts) +import {-# SOURCE #-} Config (borderWidth,logHook,manageHook,numlockMask,serialisedLayouts) import Data.Maybe import Data.List (nub, (\\), find, partition) @@ -360,46 +360,49 @@ data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String instance Message ChangeLayout instance ReadableLayout Window where - defaults = Layout (LayoutSelection []) : + defaults = Layout (Select []) : Layout Full : Layout (Tall 1 0.1 0.5) : Layout (Mirror $ Tall 1 0.1 0.5) : - possibleLayouts + serialisedLayouts -data LayoutSelection a = LayoutSelection [Layout a] - deriving ( Show, Read ) +data Select a = Select [Layout a] deriving (Show, Read) + +instance ReadableLayout a => LayoutClass Select a where + doLayout (Select (l:ls)) r s = do + (x,ml') <- doLayout l r s + return (x, (\l' -> Select (l':ls)) `fmap` ml') + + doLayout (Select []) r s = do + (x,_) <- doLayout Full r s + return (x,Nothing) -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') - doLayout (LayoutSelection []) r s = do (x,_) <- doLayout Full r s - return (x,Nothing) -- respond to messages only when there's an actual choice: - handleMessage (LayoutSelection (l:ls@(_:_))) m + handleMessage (Select (l:ls@(_:_))) m | Just NextLayout <- fromMessage m = switchl rls | Just PrevLayout <- fromMessage m = switchl rls' | Just (JumpToLayout x) <- fromMessage m = switchl (j x) | Just ReleaseResources <- fromMessage m = do mlls' <- mapM (\ll -> handleMessage ll m) (l:ls) let lls' = zipWith (\x mx -> maybe x id mx) (l:ls) mlls' - return $ Just $ LayoutSelection lls' + return $ Just $ Select lls' where rls (x:xs) = xs ++ [x] rls [] = [] rls' = reverse . rls . reverse - j s zs = case partition (\z -> s == description z) zs of - (xs,ys) -> xs++ys + j s zs = case partition ((s ==) . description) zs of (xs,ys) -> xs++ys + switchl f = do ml' <- handleMessage l (SomeMessage Hide) - return $ Just (LayoutSelection $ f $ fromMaybe l ml':ls) - -- otherwise, or if we don't understand the message, pass it along to the real - -- layout: - handleMessage (LayoutSelection (l:ls)) m - = do ml' <- handleMessage l m - return $ (\l' -> LayoutSelection (l':ls)) `fmap` ml' + return $ Just (Select $ f $ fromMaybe l ml':ls) + + -- otherwise, or if we don't understand the message, pass it along to the real layout: + handleMessage (Select (l:ls)) m = do + ml' <- handleMessage l m + return $ (\l' -> Select (l':ls)) `fmap` ml' + -- Unless there is no layout... - handleMessage (LayoutSelection []) _ = return Nothing + handleMessage (Select []) _ = return Nothing - description (LayoutSelection (x:_)) = description x - description _ = "default" + description (Select (x:_)) = description x + description _ = "default" -- -- Builtin layout algorithms: -- |