summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDavid Roundy <droundy@darcs.net>2007-09-21 23:21:59 +0200
committerDavid Roundy <droundy@darcs.net>2007-09-21 23:21:59 +0200
commit85dc84516e3848ca9d9a268c121220de164d0e9e (patch)
tree4b498023867881b8e7392235b7e39037a292b2b1
parent704ca55fc2de620d85929ca5cbcab5f2a03e77cc (diff)
downloadmetatile-85dc84516e3848ca9d9a268c121220de164d0e9e.tar
metatile-85dc84516e3848ca9d9a268c121220de164d0e9e.zip
add layout selection back into core xmonad using LayoutSelection.
This is just a reimplementation of LayoutChoice. darcs-hash:20070921212159-72aca-870bb8d3e596fcb9edc48f51bec538054b4165e6
-rw-r--r--Config.hs10
-rw-r--r--Config.hs-boot2
-rw-r--r--Main.hs5
-rw-r--r--Operations.hs63
-rw-r--r--XMonad.hs10
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