diff options
| -rw-r--r-- | Config.hs | 12 | ||||
| -rw-r--r-- | Main.hs | 2 | ||||
| -rw-r--r-- | Operations.hs | 139 | ||||
| -rw-r--r-- | XMonad.hs | 46 |
4 files changed, 44 insertions, 155 deletions
@@ -64,6 +64,13 @@ sizeDelta = 3%100 numlockMask :: KeyMask numlockMask = lockMask +-- What layout to start in, and what the default proportion for the +-- left pane should be in the tiled layout. See LayoutDesc and +-- friends in XMonad.hs for options. +startingLayoutDesc :: LayoutDesc +startingLayoutDesc = + LayoutDesc { layoutType = Full + , tileFraction = 1%2 } -- The keys list. keys :: M.Map (KeyMask, KeySym) (X ()) @@ -79,8 +86,9 @@ keys = M.fromList $ , ((modMask, xK_h ), changeHorz (negate defaultDelta)) , ((modMask, xK_l ), changeHorz defaultDelta) - , ((modMask .|. shiftMask, xK_j ), changeVert defaultDelta) - , ((modMask .|. shiftMask, xK_k ), changeVert (negate defaultDelta)) + -- Not implemented yet: + -- , ((modMask .|. shiftMask, xK_j ), changeVert defaultDelta) + -- , ((modMask .|. shiftMask, xK_k ), changeVert (negate defaultDelta)) , ((modMask .|. shiftMask, xK_c ), kill) @@ -52,8 +52,8 @@ main = do , dimensions = (fromIntegral (displayWidth dpy dflt), fromIntegral (displayHeight dpy dflt)) , workspace = W.empty workspaces + , defaultLayoutDesc = startingLayoutDesc , layoutDescs = M.empty - , dispositions = M.empty } xSetErrorHandler -- in C, I'm too lazy to write the binding diff --git a/Operations.hs b/Operations.hs index ad8eaf0..5c7a3e9 100644 --- a/Operations.hs +++ b/Operations.hs @@ -14,7 +14,6 @@ import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import XMonad -import Data.Ratio import qualified StackSet as W @@ -31,135 +30,49 @@ refresh = do xinesc <- gets xineScreens d <- gets display fls <- gets layoutDescs - let move w (Rectangle p q r s) = io $ moveResizeWindow d w p q r s - flipRect (Rectangle p q r s) = Rectangle q p s r + dfltfl <- gets defaultLayoutDesc flip mapM_ (M.assocs ws2sc) $ \(n, scn) -> do let sc = xinesc !! scn - fl = M.findWithDefault basicLayoutDesc n fls - l = layoutType fl - fullWindow w = move w sc >> io (raiseWindow d w) - - -- runRects draws the windows, figuring out their rectangles. - -- The code here is for a horizontal split, and tr is possibly - -- used to convert to the vertical case. The comments - -- speak in terms of the horizontal case. - runRects :: Rectangle -> (Rectangle -> Rectangle) - -> (Rational -> Disposition -> Disposition) - -> (Disposition -> Rational) -> Rational -> [Window] -> X () - runRects _ _ _ _ _ [] = return () -- impossible - runRects (Rectangle sx sy sw sh) tr dfix fracFn tf (w:s) = do - -- get the dispositions in the relevant direction (vert/horz) - -- as specified by fracFn. - ds <- mapM (liftM fracFn . gets . disposition) s - - -- do some math. - let lw = round (fromIntegral sw * tf) -- lhs width - rw = sw - fromIntegral lw -- rhs width - ns = map (/ sum ds) ds -- normalized ratios for rhs. - - -- Normalize dispositions while we have the opportunity. - -- This is bad. Rational numbers might space leak each - -- time we make an adjustment. Floating point numbers are - -- better here. I am being paranoid. - zipWithM_ (\ratio a -> disposeW a (dfix ratio)) ns s - - -- do some more math. - let ps = map (round . (* fromIntegral sh)) . scanl (+) 0 $ ns - -- ps are the vertical positions, [p1 = 0, p2, ..., pn, sh] - xs = map fromIntegral . zipWith (-) (tail ps) $ ps - -- xs are the heights of windows, [p2-p1,p3-p2,...,sh-pn] - rects = zipWith (\p q -> Rectangle (sx + lw) p rw q) ps xs - -- rects are the rectangles of our windows. - - -- Move our lhs window, the big main one. - move w (tr (Rectangle sx sy (fromIntegral lw) sh)) - - -- Move our rhs windows. - zipWithM_ (\r a -> move a (tr r)) rects s - - -- And raise this one, for good measure. - whenJust (W.peek ws) (io . raiseWindow d) - case l of - Full -> whenJust (W.peekStack n ws) fullWindow - _ -> case W.index n ws of - [] -> return () - [w] -> fullWindow w - s -> case l of - Horz -> (runRects sc - id - (\r dp -> dp {horzFrac = r}) - horzFrac - (horzTileFrac fl) - s) - Vert -> (runRects (flipRect sc) - flipRect - (\r dp -> dp {vertFrac = r}) - vertFrac - (vertTileFrac fl) - s) - _ -> error "Operations.refresh: the absurdly \ - \impossible happened. Please \ - \complain about this." + fl = M.findWithDefault dfltfl n fls + mapM_ (\(w, Rectangle a b c e) -> io $ moveResizeWindow d w a b c e) $ + case layoutType fl of + Full -> fmap (flip (,) sc) $ maybeToList $ W.peekStack n ws + Horz -> tile (tileFraction fl) sc $ W.index n ws + whenJust (W.peekStack n ws) (io . raiseWindow d) whenJust (W.peek ws) setFocus +tile :: Rational -> Rectangle -> [Window] -> [(Window, Rectangle)] +tile _ _ [] = [] +tile _ d [w] = [(w, d)] +tile r (Rectangle sx sy sw sh) (w:s) + = (w, Rectangle sx sy (fromIntegral lw) sh) : zipWith f [sy, sy + rh ..] s + where + lw = floor $ fromIntegral sw * r + rw = sw - fromIntegral lw + rh = fromIntegral sh `div` fromIntegral (length s) + f i a = (a, Rectangle (sx + lw) i rw (fromIntegral rh)) + -- | switchLayout. Switch to another layout scheme. Switches the -- current workspace. switchLayout :: X () switchLayout = layout $ \fl -> fl { layoutType = rot (layoutType fl) } --- | changeVert. Changes the vertical split, if it's visible. -changeVert :: Rational -> X () -changeVert delta = do - l <- gets (layoutType . currentDesc) - case l of - Vert -> layout $ \d -> d {vertTileFrac = min 1 $ - max 0 $ - vertTileFrac d + delta} - _ -> return () - --- | changeHorz. Changes the horizontal split, if it's visible. +-- | changeHorz. Changes the horizontal split. changeHorz :: Rational -> X () -changeHorz delta = do - l <- gets (layoutType . currentDesc) - case l of - Horz -> layout $ \d -> d {horzTileFrac = min 1 $ - max 0 $ - horzTileFrac d + delta} - _ -> return () - --- | changeSize. Changes the size of the window, except in Full mode, with the --- size remaining above the given mini-mum. -changeSize :: Rational -> Rational -> X () -changeSize delta mini = do - l <- gets (layoutType . currentDesc) - mw <- gets (W.peek . workspace) - whenJust mw $ \w -> do -- This is always Just. - case l of - Full -> return () - Horz -> disposeW w $ \d -> d {horzFrac = max mini $ - horzFrac d + delta} - Vert -> disposeW w $ \d -> d {vertFrac = max mini $ - vertFrac d + delta} -- hrm... - refresh +changeHorz delta = layout $ \fl -> + fl { tileFraction = min 1 (max 0 (tileFraction fl + delta)) } -- | layout. Modify the current workspace's layout with a pure -- function and refresh. layout :: (LayoutDesc -> LayoutDesc) -> X () layout f = do modify $ \s -> - let n = W.current . workspace $ s - fl = currentDesc s - in s { layoutDescs = M.insert n (f fl) (layoutDescs s) } + let fls = layoutDescs s + n = W.current . workspace $ s + fl = M.findWithDefault (defaultLayoutDesc s) n fls + in s { layoutDescs = M.insert n (f fl) fls } refresh --- | disposeW. Changes the disposition of a particular window. -disposeW :: Window -> (Disposition -> Disposition) -> X () -disposeW w f = modify $ \s -> let d = f (disposition w s) - in s {dispositions = M.insert w d (dispositions s)} - -- NO refresh. Do not put refresh here. - -- refresh calls this function. - - -- | windows. Modify the current window list with a pure function, and refresh windows :: (WorkSpace -> WorkSpace) -> X () windows f = do @@ -267,7 +180,7 @@ raise :: Ordering -> X () raise = windows . W.rotate -- | promote. Make the focused window the master window in its --- workspace , in non-fullscreen mode. +-- workspace -- -- TODO: generic cycling clockwise and anticlockwise -- @@ -15,15 +15,12 @@ -- module XMonad ( - X, WorkSpace, XState(..), Layout(..), LayoutDesc(..), Disposition(..), - basicLayoutDesc, currentDesc, disposition, + X, WorkSpace, XState(..), Layout(..), LayoutDesc(..), runX, io, withDisplay, isRoot, spawn, trace, whenJust, rot ) where import StackSet (StackSet) -import qualified StackSet as W -import Data.Ratio import Control.Monad.State import System.IO @@ -46,52 +43,25 @@ data XState = XState , wmprotocols :: {-# UNPACK #-} !Atom , dimensions :: {-# UNPACK #-} !(Int,Int) , workspace :: {-# UNPACK #-} !WorkSpace -- ^ workspace list + , defaultLayoutDesc :: {-# UNPACK #-} !LayoutDesc , layoutDescs :: {-# UNPACK #-} !(M.Map Int LayoutDesc) - , dispositions :: {-# UNPACK #-} !(M.Map Window Disposition) -- ^ mapping of workspaces to descriptions of their layouts } type WorkSpace = StackSet Window - --- --------------------------------------------------------------------- --- Display Positions and Layout - --- | Disposition. Short for 'Display Position,' it describes how much --- of the screen a window would like to occupy, when tiled with others. -data Disposition - = Disposition { vertFrac, horzFrac :: {-# UNPACK #-} !Rational } - -basicDisposition :: Disposition -basicDisposition = Disposition (1%3) (1%3) - -- | The different layout modes -data Layout = Full | Horz | Vert +data Layout = Full | Horz deriving (Enum, Bounded) -- | 'rot' for Layout. rot :: Layout -> Layout -rot Full = Horz -rot Horz = Vert -rot Vert = Full +rot x = toEnum $ (fromEnum x + 1) `mod` (fromEnum (maxBound `asTypeOf` x) + 1) -- | A full description of a particular workspace's layout parameters. -data LayoutDesc = LayoutDesc { layoutType :: !Layout, - horzTileFrac :: !Rational, - vertTileFrac :: !Rational } +data LayoutDesc = LayoutDesc { layoutType :: !Layout + , tileFraction :: !Rational + } -basicLayoutDesc :: LayoutDesc -basicLayoutDesc = LayoutDesc { layoutType = Full, - horzTileFrac = 1%2, - vertTileFrac = 1%2 } - --- | disposition. Gets the disposition of a particular window. -disposition :: Window -> XState -> Disposition -disposition w s = M.findWithDefault basicDisposition w (dispositions s) - --- | Gets the current layoutDesc. -currentDesc :: XState -> LayoutDesc -currentDesc s = M.findWithDefault basicLayoutDesc n (layoutDescs s) - where n = (W.current . workspace $ s) @@ -116,8 +86,6 @@ withDisplay f = gets display >>= f isRoot :: Window -> X Bool isRoot w = liftM (w==) (gets theRoot) - - -- --------------------------------------------------------------------- -- Utilities |