diff options
Diffstat (limited to 'Operations.hs')
| -rw-r--r-- | Operations.hs | 160 |
1 files changed, 2 insertions, 158 deletions
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 |