From 50ce9ae458b6de5533a2576f49a7c358cbd478f6 Mon Sep 17 00:00:00 2001 From: Anders Engstrom Date: Sat, 24 Oct 2009 19:51:55 +0200 Subject: New Layout X.L.MultiColumns Ignore-this: a2d3d2eee52c28eab7d125f6b621cada New layout inspired the realization that I was switching between Mirror Tall and Mirror ThreeCol depending on how many windows there were on the workspace. This layout will make those changes automatically. darcs-hash:20091024175155-8978f-ca27106c89b726393f366f6e2d5182ae0afb665c.gz --- XMonad/Layout/MultiColumns.hs | 143 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 143 insertions(+) create mode 100644 XMonad/Layout/MultiColumns.hs (limited to 'XMonad/Layout/MultiColumns.hs') diff --git a/XMonad/Layout/MultiColumns.hs b/XMonad/Layout/MultiColumns.hs new file mode 100644 index 0000000..03303f1 --- /dev/null +++ b/XMonad/Layout/MultiColumns.hs @@ -0,0 +1,143 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MultiColumns +-- Copyright : (c) Anders Engstrom +-- License : BSD3-style (see LICENSE) +-- +-- Maintainer : Anders Engstrom +-- Stability : unstable +-- Portability : unportable +-- +-- This layout tiles windows in a growing number of columns. The number of +-- windows in each column can be controlled by messages. +----------------------------------------------------------------------------- + +module XMonad.Layout.MultiColumns ( + -- * Usage + -- $usage + + multiCol + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import Control.Monad + +-- $usage +-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: +-- +-- > import XMonad.Layout.MultiColumns +-- +-- Then edit your @layoutHook@ by adding the multiCol layout: +-- +-- > myLayouts = multiCol [1] 4 0.01 0.5 ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- Or alternatively: +-- +-- > myLayouts = Mirror (multiCol [1] 2 0.01 (-0.25)) ||| etc.. +-- > main = xmonad defaultConfig { layoutHook = myLayouts } +-- +-- The maximum number of windows in a column can be controlled using the +-- IncMasterN messages and the column containing the focused window will be +-- modified. If the value is 0, all remaining windows will be placed in that +-- column when all columns before that has been filled. +-- +-- The size can be set to between 1 and -0.5. If the value is positive, the +-- master column will be of that size. The rest of the screen is split among +-- the other columns. But if the size is negative, it instead indicates the +-- size of all non-master columns and the master column will cover the rest of +-- the screen. If the master column would become smaller than the other +-- columns, the screen is instead split equally among all columns. Therefore, +-- if equal size among all columns are desired, set the size to -0.5. +-- +-- For more detailed instructions on editing the layoutHook see: +-- +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | Layout creator. +multiCol + :: [Int] -- ^ Windows in each column, starting with master. Set to 0 to catch the rest. + -> Int -- ^ Default value for all following columns. + -> Rational -- ^ How much to change size each time. + -> Rational -- ^ Initial size of master area, or column area if the size is negative. + -> MultiCol a +multiCol n defn ds s = MultiCol (map (max 1) n) (max 1 defn) ds s 0 + +data MultiCol a = MultiCol + { multiColNWin :: ![Int] + , multiColDefWin :: !Int + , multiColDeltaSize :: !Rational + , multiColSize :: !Rational + , multiColActive :: !Int + } deriving (Show,Read,Eq) + +instance LayoutClass MultiCol a where + doLayout l r s = return (zip w rlist, resl) + where rlist = doL (multiColNWin l') (multiColSize l') r wlen + w = W.integrate s + wlen = length w + -- Make sure the list of columns is big enough and update active column + nw = multiColNWin l ++ repeat (multiColDefWin l) + l' = l { multiColNWin = take (getCol (wlen-1) nw + 1) nw + , multiColActive = getCol (length $ W.up s) (multiColNWin l) + } + -- Only return new layout if it has been modified + resl = if l'==l + then Nothing + else Just l' + handleMessage l m = + return $ msum [fmap resize (fromMessage m) + ,fmap incmastern (fromMessage m)] + where resize Shrink = l { multiColSize = max (-0.5) $ s-ds } + resize Expand = l { multiColSize = min 1 $ s+ds } + incmastern (IncMasterN x) + = l { multiColNWin = take a n ++ [newval] ++ tail r } + where newval = max 0 $ head r + x + r = drop a n + n = multiColNWin l + ds = multiColDeltaSize l + s = multiColSize l + a = multiColActive l + description _ = "MultiCol" + + +-- Get which column a window is in. +getCol :: Int -> [Int] -> Int +getCol w (n:ns) = if n<1 || w < n + then 0 + else 1 + getCol (w-n) ns +-- Should never occur... +getCol _ _ = -1 + +doL :: [Int] -> Rational -> Rectangle -> Int -> [Rectangle] +doL nwin s r n = rlist + where -- Number of columns to tile + size = floor $ abs s * fromIntegral (rect_width r) + ncol = getCol (n-1) nwin + 1 + -- Extract all but last column to tile + c = take (ncol-1) nwin + -- Compute number of windows in last column and add it to the others + col = c ++ [n-sum c] + -- Compute width of columns + width = if s>0 + then if ncol==1 + then [fromIntegral $ rect_width r] + else size:replicate (ncol-1) ((fromIntegral (rect_width r) - size) `div` (ncol-1)) + else if fromIntegral ncol * abs s >= 1 + -- Split equally + then replicate ncol $ fromIntegral (rect_width r) `div` ncol + -- Let the master cover what is left... + else (fromIntegral (rect_width r) - (ncol-1)*size):replicate (ncol-1) size + -- Compute the horizontal position of columns + xpos = accumEx (fromIntegral $ rect_x r) width + -- Exclusive accumulation + accumEx a (x:xs) = a:accumEx (a+x) xs + accumEx _ _ = [] + -- Create a rectangle for each column + cr = zipWith (\x w -> r { rect_x=fromIntegral x, rect_width=fromIntegral w }) xpos width + -- Split the columns into the windows + rlist = concat $ zipWith (\num rect -> splitVertically num rect) col cr -- cgit v1.2.3