summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorSpencer Janssen <sjanssen@cse.unl.edu>2007-11-01 07:43:18 +0100
committerSpencer Janssen <sjanssen@cse.unl.edu>2007-11-01 07:43:18 +0100
commitc1dab22936b718b48f98b39befc6af6ce416fbf6 (patch)
tree5fca7a6c0b7cf81c19b8affca3c1a127dbfa673e
parent20c6b4b6684a7232021c0905bccc44f5946cb5d3 (diff)
downloadmetatile-c1dab22936b718b48f98b39befc6af6ce416fbf6.tar
metatile-c1dab22936b718b48f98b39befc6af6ce416fbf6.zip
This is a massive update, here's what has changed:
* Read is no longer a superclass of Layout * All of the core layouts have moved to the new Layouts.hs module * Select has been replaced by the new statically typed Choose combinator, which is heavily based on David Roundy's NewSelect proposal for XMonadContrib. Consequently: - Rather than a list of choosable layouts, we use the ||| combinator to combine several layouts into a single switchable layout - We've lost the capability to JumpToLayout and PrevLayout. Both can be added with some effort darcs-hash:20071101064318-a5988-c07c434c7a1108078d6123a4b36040ed6597772b
-rw-r--r--EventLoop.hs45
-rw-r--r--Layouts.hs166
-rw-r--r--Main.hs28
-rw-r--r--Main.hs-boot1
-rw-r--r--Operations.hs160
-rw-r--r--XMonad.hs59
-rw-r--r--tests/Properties.hs1
-rw-r--r--xmonad.cabal2
8 files changed, 227 insertions, 235 deletions
diff --git a/EventLoop.hs b/EventLoop.hs
index eec62fd..78e75b7 100644
--- a/EventLoop.hs
+++ b/EventLoop.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
----------------------------------------------------------------------------
-- |
-- Module : Main.hs
@@ -35,22 +36,23 @@ import Operations
import System.IO
-data XMonadConfig l = XMonadConfig { normalBorderColor :: !String
- , focusedBorderColor :: !String
- , defaultTerminal :: !String
- , layoutHook :: !(l Window)
- , workspaces :: ![String]
- , defaultGaps :: ![(Int,Int,Int,Int)]
- , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
- , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
- , borderWidth :: !Dimension
- , logHook :: !(X ())
- }
+data XMonadConfig = forall l. (LayoutClass l Window, Read (l Window)) =>
+ XMonadConfig { normalBorderColor :: !String
+ , focusedBorderColor :: !String
+ , defaultTerminal :: !String
+ , layoutHook :: !(l Window)
+ , workspaces :: ![String]
+ , defaultGaps :: ![(Int,Int,Int,Int)]
+ , keys :: !(M.Map (ButtonMask,KeySym) (X ()))
+ , mouseBindings :: !(M.Map (ButtonMask, Button) (Window -> X ()))
+ , borderWidth :: !Dimension
+ , logHook :: !(X ())
+ }
-- |
-- The main entry point
--
-makeMain :: LayoutClass l Window => XMonadConfig l -> IO ()
+makeMain :: XMonadConfig -> IO ()
makeMain xmc = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
@@ -62,17 +64,18 @@ makeMain xmc = do
hSetBuffering stdout NoBuffering
args <- getArgs
- let initialWinset = new (Layout $ layoutHook xmc) (workspaces xmc) $ zipWith SD xinesc gaps
+ let (layout, lreads) = case xmc of XMonadConfig {layoutHook = lh } -> (Layout lh, \s -> [(Layout (x `asTypeOf` lh), s') | (x, s') <- reads s])
+ initialWinset = new layout (workspaces xmc) $ zipWith SD xinesc gaps
- maybeRead s = case reads s of
- [(x, "")] -> Just x
- _ -> Nothing
+ maybeRead reads' s = case reads' s of
+ [(x, "")] -> Just x
+ _ -> Nothing
winset = fromMaybe initialWinset $ do
("--resume" : s : _) <- return args
- ws <- maybeRead s
- return . W.ensureTags (Layout $ layoutHook xmc) (workspaces xmc)
- $ W.mapLayout (fromMaybe (Layout $ layoutHook xmc) . maybeRead) ws
+ ws <- maybeRead reads s
+ return . W.ensureTags layout (workspaces xmc)
+ $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
gaps = take (length xinesc) $ defaultGaps xmc ++ repeat (0,0,0,0)
@@ -256,7 +259,7 @@ scan dpy rootw = do
&& (wa_map_state wa == waIsViewable || ic)
-- | Grab the keys back
-grabKeys :: XMonadConfig l -> X ()
+grabKeys :: XMonadConfig -> X ()
grabKeys xmc = do
XConf { display = dpy, theRoot = rootw } <- ask
let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
@@ -268,7 +271,7 @@ grabKeys xmc = do
when (kc /= '\0') $ mapM_ (grab kc . (mask .|.)) extraModifiers
-- | XXX comment me
-grabButtons :: XMonadConfig l -> X ()
+grabButtons :: XMonadConfig -> X ()
grabButtons xmc = do
XConf { display = dpy, theRoot = rootw } <- ask
let grab button mask = io $ grabButton dpy button mask rootw False buttonPressMask
diff --git a/Layouts.hs b/Layouts.hs
new file mode 100644
index 0000000..5605917
--- /dev/null
+++ b/Layouts.hs
@@ -0,0 +1,166 @@
+{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
+-- --------------------------------------------------------------------------
+-- |
+-- Module : Layouts.hs
+-- Copyright : (c) Spencer Janssen 2007
+-- License : BSD3-style (see LICENSE)
+--
+-- Maintainer : sjanssen@cse.unl.edu
+-- Stability : unstable
+-- Portability : not portable, Typeable deriving, mtl, posix
+--
+-- The collection of core layouts.
+--
+-----------------------------------------------------------------------------
+
+module Layouts (ChangeLayout(..), Choose, (|||), Resize(..), IncMasterN(..),
+ Full(..), Tall(..), Mirror(..), splitVertically,
+ splitHorizontally, splitHorizontallyBy, splitVerticallyBy) where
+
+import XMonad
+
+import Graphics.X11 (Rectangle(..))
+import qualified StackSet as W
+import Control.Arrow ((***), second)
+import Control.Monad
+import Data.Maybe (fromMaybe)
+
+
+------------------------------------------------------------------------
+-- LayoutClass selection manager
+
+-- | A layout that allows users to switch between various layout options.
+
+-- | Messages to change the current layout.
+data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable)
+
+instance Message ChangeLayout
+
+-- | The layout choice combinator
+(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a
+(|||) = flip SLeft
+infixr 5 |||
+
+data Choose l r a = SLeft (r a) (l a)
+ | SRight (l a) (r a) deriving (Read, Show)
+
+data NextNoWrap = NextNoWrap deriving (Eq, Show, Typeable)
+instance Message NextNoWrap
+
+-- This has lots of pseudo duplicated code, we must find a better way
+instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
+ doLayout (SLeft r l) = (fmap (second . fmap $ SLeft r) .) . doLayout l
+ doLayout (SRight l r) = (fmap (second . fmap $ SRight l) .) . doLayout r
+
+ description (SLeft _ l) = description l
+ description (SRight _ r) = description r
+
+ handleMessage lr m | Just FirstLayout <- fromMessage m = case lr of
+ SLeft {} -> return Nothing
+ SRight l r -> fmap (Just . flip SLeft l . fromMaybe r) $ handleMessage r m
+
+ handleMessage lr m | Just NextLayout <- fromMessage m = do
+ mlr <- handleMessage lr $ SomeMessage NextNoWrap
+ maybe (handleMessage lr $ SomeMessage FirstLayout) (return . Just) mlr
+
+ handleMessage (SLeft r l) m | Just NextNoWrap <- fromMessage m = do
+ handleMessage l (SomeMessage Hide)
+ mr <- handleMessage r (SomeMessage FirstLayout)
+ return . Just . SRight l $ fromMaybe r mr
+
+ -- The default cases for left and right:
+ handleMessage (SLeft r l) m = fmap (fmap $ SLeft r) $ handleMessage l m
+ handleMessage (SRight l r) m = fmap (fmap $ SRight l) $ handleMessage r m
+
+--
+-- | Builtin layout algorithms:
+--
+-- > fullscreen mode
+-- > tall mode
+--
+-- The latter algorithms support the following operations:
+--
+-- > Shrink
+-- > Expand
+--
+data Resize = Shrink | Expand deriving Typeable
+
+-- | You can also increase the number of clients in the master pane
+data IncMasterN = IncMasterN Int deriving Typeable
+
+instance Message Resize
+instance Message IncMasterN
+
+-- | Simple fullscreen mode, just render all windows fullscreen.
+data Full a = Full deriving (Show, Read)
+
+instance LayoutClass Full a
+
+-- | The inbuilt tiling mode of xmonad, and its operations.
+data Tall a = Tall Int Rational Rational deriving (Show, Read)
+
+instance LayoutClass Tall a where
+ pureLayout (Tall nmaster _ frac) r s = zip ws rs
+ where ws = W.integrate s
+ rs = tile frac r nmaster (length ws)
+
+ pureMessage (Tall nmaster delta frac) m = msum [fmap resize (fromMessage m)
+ ,fmap incmastern (fromMessage m)]
+ where resize Shrink = Tall nmaster delta (max 0 $ frac-delta)
+ resize Expand = Tall nmaster delta (min 1 $ frac+delta)
+ incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac
+ description _ = "Tall"
+
+-- | Mirror a rectangle
+mirrorRect :: Rectangle -> Rectangle
+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 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
+ description (Mirror l) = "Mirror "++ description l
+
+-- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.
+--
+-- The screen is divided (currently) into two panes. all clients are
+-- then partioned between these two panes. one pane, the `master', by
+-- convention has the least number of windows in it (by default, 1).
+-- the variable `nmaster' controls how many windows are rendered in the
+-- master pane.
+--
+-- `delta' specifies the ratio of the screen to resize by.
+--
+-- 'frac' specifies what proportion of the screen to devote to the
+-- master area.
+--
+tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
+tile f r nmaster n = if n <= nmaster || nmaster == 0
+ then splitVertically n r
+ else splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns
+ where (r1,r2) = splitHorizontallyBy f r
+
+--
+-- Divide the screen vertically into n subrectangles
+--
+splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]
+splitVertically n r | n < 2 = [r]
+splitVertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
+ splitVertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
+ where smallh = sh `div` fromIntegral n --hmm, this is a fold or map.
+
+splitHorizontally n = map mirrorRect . splitVertically n . mirrorRect
+
+-- Divide the screen into two rectangles, using a rational to specify the ratio
+splitHorizontallyBy, splitVerticallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
+splitHorizontallyBy f (Rectangle sx sy sw sh) =
+ ( Rectangle sx sy leftw sh
+ , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
+ where leftw = floor $ fromIntegral sw * f
+
+splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect
diff --git a/Main.hs b/Main.hs
index 8cdd0b0..f38eda6 100644
--- a/Main.hs
+++ b/Main.hs
@@ -21,6 +21,7 @@ module Main where
--
import Control.Monad.Reader ( asks )
import XMonad hiding ( logHook, borderWidth )
+import Layouts
import Operations
import qualified StackSet as W
import Data.Ratio
@@ -128,14 +129,11 @@ manageHook _ _ _ _ = return id
-- defaults, as xmonad preserves your old layout settings by default.
--
--- | 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:
- -- % Extension-provided layouts
- ]
+-- | The available layouts. Note that each layout is separated by |||, which
+-- denotes layout choice.
+layout = tiled ||| Mirror tiled ||| Full
+ -- Add extra layouts you want to use here:
+ -- % Extension-provided layouts
where
-- default tiling algorithm partitions the screen into two panes
tiled = Tall nmaster delta ratio
@@ -149,12 +147,6 @@ layouts = [ Layout tiled
-- Percent of screen to increment by when resizing panes
delta = 3%100
--- | 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 = Layout (layoutHook defaultConfig) : layouts
-
------------------------------------------------------------------------
-- Key bindings:
@@ -171,7 +163,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 $ layoutHook defaultConfig) -- %! Reset the layouts on the current workspace to default
+ , ((modMask .|. shiftMask, xK_space ), setLayout $ Layout layout) -- %! Reset the layouts on the current workspace to default
, ((modMask, xK_n ), refresh) -- %! Resize viewed windows to the correct size
@@ -238,7 +230,7 @@ mouseBindings = M.fromList $
-- % Extension-provided definitions
-defaultConfig :: XMonadConfig Select
+defaultConfig :: XMonadConfig
defaultConfig = XMonadConfig { borderWidth = 1 -- Width of the window border in pixels.
, EventLoop.workspaces = workspaces
, defaultGaps = [(0,0,0,0)] -- 15 for default dzen font
@@ -247,8 +239,8 @@ defaultConfig = XMonadConfig { borderWidth = 1 -- Width of the window border in
-- By default, we simply switch between the layouts listed in `layouts'
-- above, but you may program your own selection behaviour here. Layout
-- transformers, for example, would be hooked in here.
- --
- , layoutHook = Select layouts
+ --
+ , layoutHook = layout
, defaultTerminal = "xterm" -- The preferred terminal program.
, normalBorderColor = "#dddddd" -- Border color for unfocused windows.
, focusedBorderColor = "#ff0000" -- Border color for focused windows.
diff --git a/Main.hs-boot b/Main.hs-boot
index becb178..1ad5791 100644
--- a/Main.hs-boot
+++ b/Main.hs-boot
@@ -4,4 +4,3 @@ import XMonad
numlockMask :: KeyMask
workspaces :: [WorkspaceId]
manageHook :: Window -> String -> String -> String -> X (WindowSet -> WindowSet)
-serialisedLayouts :: [Layout Window]
diff --git a/Operations.hs b/Operations.hs
index ae5cd39..929ca9d 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -19,6 +19,7 @@
module Operations where
import XMonad
+import Layouts (Full(..))
import qualified StackSet as W
import Data.Maybe
@@ -37,7 +38,7 @@ import Graphics.X11.Xlib
import Graphics.X11.Xinerama (getScreenInfo)
import Graphics.X11.Xlib.Extras
-import {-# SOURCE #-} Main (manageHook,numlockMask,serialisedLayouts)
+import {-# SOURCE #-} Main (manageHook,numlockMask)
-- ---------------------------------------------------------------------
-- |
@@ -111,10 +112,6 @@ kill = withDisplay $ \d -> withFocused $ \w -> do
-- ---------------------------------------------------------------------
-- Managing windows
-data LayoutMessages = Hide | ReleaseResources deriving ( Typeable, Eq )
-
-instance Message LayoutMessages
-
-- | windows. Modify the current window list with a pure function, and refresh
windows :: (WindowSet -> WindowSet) -> X ()
windows f = do
@@ -353,159 +350,6 @@ setLayout l = do
handleMessage (W.layout ws) (SomeMessage ReleaseResources)
windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = Layout l } } }
--- | X Events are valid Messages
-instance Message Event
-
-------------------------------------------------------------------------
--- LayoutClass selection manager
-
--- | A layout that allows users to switch between various layout options.
--- This layout accepts three Messages:
---
--- > NextLayout
--- > PrevLayout
--- > JumpToLayout.
---
-data ChangeLayout = NextLayout | PrevLayout | JumpToLayout String
- deriving (Eq, Show, Typeable)
-
-instance Message ChangeLayout
-
-instance ReadableLayout Window where
- readTypes = Layout (Select []) :
- Layout Full : Layout (Tall 1 0.1 0.5) :
- Layout (Mirror $ Tall 1 0.1 0.5) :
- serialisedLayouts
-
-data Select a = Select [Layout a] deriving (Show, Read)
-
-instance ReadableLayout a => LayoutClass Select a where
- doLayout (Select (l:ls)) r s =
- second (fmap (Select . (:ls))) `fmap` doLayout l r s
- doLayout (Select []) r s =
- second (const Nothing) `fmap` doLayout Full r s
-
- -- respond to messages only when there's an actual choice:
- 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 -- each branch has a different type
- mlls' <- mapM (flip handleMessage m) (l:ls)
- let lls' = zipWith fromMaybe (l:ls) mlls'
- return (Just (Select lls'))
-
- where rls [] = []
- rls (x:xs) = xs ++ [x]
- rls' = reverse . rls . reverse
-
- j s zs = case partition ((s ==) . description) zs of (xs,ys) -> xs++ys
-
- switchl f = do ml' <- handleMessage l (SomeMessage Hide)
- 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 =
- fmap (Select . (:ls)) `fmap` handleMessage l m
-
- -- Unless there is no layout...
- handleMessage (Select []) _ = return Nothing
-
- description (Select (x:_)) = description x
- description _ = "default"
-
---
--- | Builtin layout algorithms:
---
--- > fullscreen mode
--- > tall mode
---
--- The latter algorithms support the following operations:
---
--- > Shrink
--- > Expand
---
-data Resize = Shrink | Expand deriving Typeable
-
--- | You can also increase the number of clients in the master pane
-data IncMasterN = IncMasterN Int deriving Typeable
-
-instance Message Resize
-instance Message IncMasterN
-
--- | Simple fullscreen mode, just render all windows fullscreen.
-data Full a = Full deriving (Show, Read)
-
-instance LayoutClass Full a
-
--- | The inbuilt tiling mode of xmonad, and its operations.
-data Tall a = Tall Int Rational Rational deriving (Show, Read)
-
-instance LayoutClass Tall a where
- pureLayout (Tall nmaster _ frac) r s = zip ws rs
- where ws = W.integrate s
- rs = tile frac r nmaster (length ws)
-
- pureMessage (Tall nmaster delta frac) m = msum [fmap resize (fromMessage m)
- ,fmap incmastern (fromMessage m)]
- where resize Shrink = Tall nmaster delta (max 0 $ frac-delta)
- resize Expand = Tall nmaster delta (min 1 $ frac+delta)
- incmastern (IncMasterN d) = Tall (max 0 (nmaster+d)) delta frac
- description _ = "Tall"
-
--- | Mirror a rectangle
-mirrorRect :: Rectangle -> Rectangle
-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 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
- description (Mirror l) = "Mirror "++ description l
-
--- | tile. Compute the positions for windows using the default 2 pane tiling algorithm.
---
--- The screen is divided (currently) into two panes. all clients are
--- then partioned between these two panes. one pane, the `master', by
--- convention has the least number of windows in it (by default, 1).
--- the variable `nmaster' controls how many windows are rendered in the
--- master pane.
---
--- `delta' specifies the ratio of the screen to resize by.
---
--- 'frac' specifies what proportion of the screen to devote to the
--- master area.
---
-tile :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
-tile f r nmaster n = if n <= nmaster || nmaster == 0
- then splitVertically n r
- else splitVertically nmaster r1 ++ splitVertically (n-nmaster) r2 -- two columns
- where (r1,r2) = splitHorizontallyBy f r
-
---
--- Divide the screen vertically into n subrectangles
---
-splitVertically, splitHorizontally :: Int -> Rectangle -> [Rectangle]
-splitVertically n r | n < 2 = [r]
-splitVertically n (Rectangle sx sy sw sh) = Rectangle sx sy sw smallh :
- splitVertically (n-1) (Rectangle sx (sy+fromIntegral smallh) sw (sh-smallh))
- where smallh = sh `div` fromIntegral n --hmm, this is a fold or map.
-
-splitHorizontally n = map mirrorRect . splitVertically n . mirrorRect
-
--- Divide the screen into two rectangles, using a rational to specify the ratio
-splitHorizontallyBy, splitVerticallyBy :: RealFrac r => r -> Rectangle -> (Rectangle, Rectangle)
-splitHorizontallyBy f (Rectangle sx sy sw sh) =
- ( Rectangle sx sy leftw sh
- , Rectangle (sx + fromIntegral leftw) sy (sw-fromIntegral leftw) sh)
- where leftw = floor $ fromIntegral sw * f
-
--- | XXX comment me
-splitVerticallyBy f = (mirrorRect *** mirrorRect) . splitHorizontallyBy f . mirrorRect
-
------------------------------------------------------------------------
-- Utilities
diff --git a/XMonad.hs b/XMonad.hs
index df0d78a..59f81ff 100644
--- a/XMonad.hs
+++ b/XMonad.hs
@@ -16,8 +16,8 @@
-----------------------------------------------------------------------------
module XMonad (
- X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..), ReadableLayout(..),
- Typeable, Message, SomeMessage(..), fromMessage, runLayout,
+ X, WindowSet, WindowSpace, WorkspaceId, ScreenId(..), ScreenDetail(..), XState(..), XConf(..), LayoutClass(..), Layout(..),
+ Typeable, Message, SomeMessage(..), fromMessage, runLayout, LayoutMessages(..),
runX, catchX, userCode, io, catchIO, withDisplay, withWindowSet, isRoot, getAtom, spawn, restart, trace, whenJust, whenX,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW
) where
@@ -28,14 +28,12 @@ import Prelude hiding ( catch )
import Control.Exception (catch, throw, Exception(ExitException))
import Control.Monad.State
import Control.Monad.Reader
-import Control.Arrow (first)
import System.IO
import System.Posix.Process (executeFile, forkProcess, getProcessStatus, createSession)
import System.Exit
import System.Environment
import Graphics.X11.Xlib
--- for Read instance
-import Graphics.X11.Xlib.Extras ()
+import Graphics.X11.Xlib.Extras (Event)
import Data.Typeable
import qualified Data.Map as M
@@ -49,13 +47,13 @@ data XState = XState
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
, dragging :: !(Maybe (Position -> Position -> X (), X ())) }
data XConf = XConf
- { display :: Display -- ^ the X11 display
- , logHook :: !(X ()) -- ^ the loghook function
- , terminal :: !String -- ^ the user's preferred terminal
- , theRoot :: !Window -- ^ the root window
- , borderWidth :: !Dimension -- ^ the preferred border width
- , normalBorder :: !Pixel -- ^ border color of unfocused windows
- , focusedBorder :: !Pixel } -- ^ border color of the focused window
+ { display :: Display -- ^ the X11 display
+ , logHook :: !(X ()) -- ^ the loghook function
+ , terminal :: !String -- ^ the user's preferred terminal
+ , theRoot :: !Window -- ^ the root window
+ , borderWidth :: !Dimension -- ^ the preferred border width
+ , normalBorder :: !Pixel -- ^ border color of unfocused windows
+ , focusedBorder :: !Pixel } -- ^ border color of the focused window
type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
type WindowSpace = Workspace WorkspaceId (Layout Window) Window
@@ -135,14 +133,9 @@ atom_WM_STATE = getAtom "WM_STATE"
-- | LayoutClass handling. See particular instances in Operations.hs
-- | An existential type that can hold any object that is in the LayoutClass.
-data Layout a = forall l. LayoutClass l a => Layout (l a)
+data Layout a = forall l. (LayoutClass l a) => Layout (l a)
--- | This class defines a set of layout types (held in Layout
--- objects) that are used when trying to read an existentially wrapped Layout.
-class ReadableLayout a where
- readTypes :: [Layout a]
-
-- | The different layout modes
--
-- 'doLayout': given a Rectangle and a Stack, layout the stack elements
@@ -150,7 +143,7 @@ class ReadableLayout a where
-- by 'doLayout', then it is not shown on screen. Windows are restacked
-- according to the order they are returned by 'doLayout'.
--
-class (Show (layout a), Read (layout a)) => LayoutClass layout a where
+class Show (layout a) => LayoutClass layout a where
-- | Given a Rectangle in which to place the windows, and a Stack of
-- windows, return a list of windows and their corresponding Rectangles.
@@ -184,22 +177,7 @@ class (Show (layout a), Read (layout a)) => LayoutClass layout a where
description :: layout a -> String
description = show
--- Here's the magic for parsing serialised state of existentially
--- wrapped layouts: attempt to parse using the Read instance from each
--- type in our list of types, if any suceed, take the first one.
-instance ReadableLayout a => Read (Layout a) where
-
- -- We take the first parse only, because multiple matches indicate a bad parse.
- readsPrec _ s = take 1 $ concatMap readLayout readTypes
- where
- readLayout (Layout x) = map (first Layout) $ readAsType x
-
- -- the type indicates which Read instance to dispatch to.
- -- That is, read asTypeOf the argument from the readTypes.
- readAsType :: LayoutClass l a => l a -> [(l a, String)]
- readAsType _ = reads s
-
-instance ReadableLayout a => LayoutClass Layout a where
+instance LayoutClass Layout Window where
doLayout (Layout l) r s = fmap (fmap Layout) `liftM` doLayout l r s
handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l
description (Layout l) = description l
@@ -229,6 +207,17 @@ data SomeMessage = forall a. Message a => SomeMessage a
fromMessage :: Message m => SomeMessage -> Maybe m
fromMessage (SomeMessage m) = cast m
+-- | X Events are valid Messages
+instance Message Event
+
+-- | LayoutMessages are core messages that all layouts (especially stateful
+-- layouts) should consider handling.
+data LayoutMessages = Hide -- ^ sent when a layout becomes non-visible
+ | ReleaseResources -- ^ sent when xmonad is exiting or restarting
+ deriving (Typeable, Eq)
+
+instance Message LayoutMessages
+
-- ---------------------------------------------------------------------
-- | General utilities
--
diff --git a/tests/Properties.hs b/tests/Properties.hs
index e62172d..0b3e728 100644
--- a/tests/Properties.hs
+++ b/tests/Properties.hs
@@ -3,7 +3,6 @@ module Properties where
import StackSet hiding (filter)
import qualified StackSet as S (filter)
-import Operations (tile)
import Debug.Trace
import Data.Word
diff --git a/xmonad.cabal b/xmonad.cabal
index 05eaed2..0663f24 100644
--- a/xmonad.cabal
+++ b/xmonad.cabal
@@ -23,7 +23,7 @@ extra-source-files: README TODO tests/loc.hs tests/Properties.hs man/xmonad.1.in
executable: xmonad
main-is: Main.hs
-other-modules: EventLoop Operations StackSet XMonad
+other-modules: EventLoop Layouts Operations StackSet XMonad
ghc-options: -funbox-strict-fields -O2 -fasm -Wall -optl-Wl,-s
ghc-prof-options: -prof -auto-all
extensions: GeneralizedNewtypeDeriving