From 365e1400645e970fe1d4d07401235a9bf044dbb9 Mon Sep 17 00:00:00 2001 From: David Roundy Date: Fri, 21 Sep 2007 23:21:59 +0200 Subject: add layout selection back into core xmonad using LayoutSelection. This is just a reimplementation of LayoutChoice. darcs-hash:20070921212159-72aca-870bb8d3e596fcb9edc48f51bec538054b4165e6.gz --- Config.hs | 10 +++++----- Config.hs-boot | 2 +- Main.hs | 5 +++-- Operations.hs | 63 ++++++++++++++++++++++++++++++++++++++-------------------- XMonad.hs | 10 +++++++++- 5 files changed, 60 insertions(+), 30 deletions(-) diff --git a/Config.hs b/Config.hs index d603889..642a219 100644 --- a/Config.hs +++ b/Config.hs @@ -92,10 +92,10 @@ borderWidth = 1 -- | -- The default set of tiling algorithms -- -defaultLayouts :: [SomeLayout Window] -defaultLayouts = [ SomeLayout tiled - , SomeLayout $ Mirror tiled - , SomeLayout Full +defaultLayouts :: [(String, SomeLayout Window)] +defaultLayouts = [("tall", SomeLayout tiled) + ,("wide", SomeLayout $ Mirror tiled) + ,("full", SomeLayout Full) -- Extension-provided layouts ] @@ -135,7 +135,7 @@ keys = M.fromList $ , ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun , ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window - , ((modMask, xK_space ), switchLayout) -- %! Rotate through the available layout algorithms + , ((modMask, xK_space ), sendMessage NextLayout) -- %! Rotate through the available layout algorithms , ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size diff --git a/Config.hs-boot b/Config.hs-boot index 45d0850..3629ea2 100644 --- a/Config.hs-boot +++ b/Config.hs-boot @@ -6,4 +6,4 @@ borderWidth :: Dimension logHook :: X () numlockMask :: KeyMask workspaces :: [WorkspaceId] -defaultLayouts :: [SomeLayout Window] +defaultLayouts :: [(String, SomeLayout Window)] diff --git a/Main.hs b/Main.hs index e1bf529..c89b142 100644 --- a/Main.hs +++ b/Main.hs @@ -52,10 +52,11 @@ main = do let winset | ("--resume" : s : _) <- args , [(x, "")] <- reads s = x - | otherwise = new (fst safeLayouts) workspaces $ zipWith SD xinesc gaps + | otherwise = new (SomeLayout $ LayoutSelection safeLayouts) + workspaces $ zipWith SD xinesc gaps gaps = take (length xinesc) $ defaultGaps ++ repeat (0,0,0,0) - safeLayouts = case defaultLayouts of [] -> (SomeLayout Full, []); (x:xs) -> (x,xs) + safeLayouts = if null defaultLayouts then [("full",SomeLayout Full)] else defaultLayouts cf = XConf { display = dpy , theRoot = rootw diff --git a/Operations.hs b/Operations.hs index dc7a16b..86f0680 100644 --- a/Operations.hs +++ b/Operations.hs @@ -21,7 +21,7 @@ import qualified StackSet as W import {-# SOURCE #-} Config (borderWidth,logHook,numlockMask,defaultLayouts) import Data.Maybe -import Data.List (nub, (\\), find) +import Data.List (nub, (\\), find, partition) import Data.Bits ((.|.), (.&.), complement) import Data.Ratio import qualified Data.Map as M @@ -105,11 +105,6 @@ 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 () @@ -296,21 +291,6 @@ setFocusX w = withWindowSet $ \ws -> do -- raiseWindow dpy w io $ setWindowBorder dpy w fbc --- --------------------------------------------------------------------- --- Managing layout - --- | switchLayout. Switch to another layout scheme. Switches the --- layout of the current workspace. By convention, a window set as --- master in Tall mode remains as master in Wide mode. When switching --- from full screen to a tiling mode, the currently focused window --- becomes a master. When switching back , the focused window is --- uppermost. --- --- Note that the new layout's deconstructor will be called, so it should be --- idempotent. -switchLayout :: X () -switchLayout = return () - -- | Throw a message to the current Layout possibly modifying how we -- layout the windows, then refresh. -- @@ -338,6 +318,47 @@ runOnWorkspaces job = do ws <- gets windowset instance Message Event +-- Layout selection manager + +-- This is a layout that allows users to switch between various layout +-- options. This layout accepts three Messages, NextLayout, PrevLayout and +-- JumpToLayout. + +data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String + deriving ( Eq, Show, Typeable ) +instance Message ChangeLayout + +instance ReadableSomeLayout Window where + defaults = map snd defaultLayouts + +data LayoutSelection a = LayoutSelection [(String, SomeLayout a)] + deriving ( Show, Read ) + +instance ReadableSomeLayout a => Layout LayoutSelection a where + doLayout (LayoutSelection ((n,l):ls)) r s = + do (x,ml') <- doLayout l r s + return (x, (\l' -> LayoutSelection ((n,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: + modifyLayout (LayoutSelection ((n,l):ls@(_:_))) m + | Just NextLayout <- fromMessage m = switchl rls + | Just PrevLayout <- fromMessage m = switchl rls' + | Just (JumpToLayout x) <- fromMessage m = switchl (j x) + where rls (x:xs) = xs ++ [x] + rls [] = [] + rls' = reverse . rls . reverse + j s zs = case partition (\z -> s == fst z) zs of + (xs,ys) -> xs++ys + switchl f = do ml' <- modifyLayout l (SomeMessage UnDoLayout) + return $ Just (LayoutSelection $ f $ (n,fromMaybe l ml'):ls) + -- otherwise, or if we don't understand the message, pass it along to the real + -- layout: + modifyLayout (LayoutSelection ((n,l):ls)) m + = do ml' <- modifyLayout l m + return $ (\l' -> LayoutSelection ((n,l'):ls)) `fmap` ml' + -- Unless there is no layout... + modifyLayout (LayoutSelection []) _ = return Nothing -- -- Builtin layout algorithms: -- diff --git a/XMonad.hs b/XMonad.hs index f288469..3a6f298 100644 --- a/XMonad.hs +++ b/XMonad.hs @@ -15,7 +15,7 @@ ----------------------------------------------------------------------------- module XMonad ( - X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..), SomeLayout(..), readLayout, + X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), Layout(..), SomeLayout(..), ReadableSomeLayout(..), 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 @@ -132,6 +132,14 @@ atom_WM_STATE = getAtom "WM_STATE" -- data SomeLayout a = forall l. Layout l a => SomeLayout (l a) +class ReadableSomeLayout a where + defaults :: [SomeLayout a] +instance ReadableSomeLayout a => Read (SomeLayout 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 + modifyLayout (SomeLayout l) = fmap (fmap SomeLayout) . modifyLayout l + instance Show (SomeLayout a) where show (SomeLayout l) = show l -- cgit v1.2.3