From 27118254b4df157247dbcbca620542ba551b4f20 Mon Sep 17 00:00:00 2001 From: jecaro Date: Sat, 4 May 2024 14:02:28 +0200 Subject: [PATCH 1/3] Add a new layout Columns This layout organizes windows in columns and allows to move/resize them in every directions. --- CHANGES.md | 5 + XMonad/Layout/Columns.hs | 478 +++++++++++++++++++++++++++++++++++++++ xmonad-contrib.cabal | 2 + 3 files changed, 485 insertions(+) create mode 100644 XMonad/Layout/Columns.hs diff --git a/CHANGES.md b/CHANGES.md index 2d3983dbc..e4226b682 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -34,6 +34,11 @@ applications (Steam, rxvt-unicode, anything that tries to restore absolute position of floats). + * `XMonad.Layout.Columns` + + - Organize windows in columns. This layout allows to move/resize windows in + every directions. + ### Bug Fixes and Minor Changes * Fix build-with-cabal.sh when XDG_CONFIG_HOME is defined. diff --git a/XMonad/Layout/Columns.hs b/XMonad/Layout/Columns.hs new file mode 100644 index 000000000..40cf1ad4d --- /dev/null +++ b/XMonad/Layout/Columns.hs @@ -0,0 +1,478 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} + +-- | +-- Module: XMonad.Layout.Columns +-- Description: A layout which tiles the windows in columns. +-- Copyright: Jean-Charles Quillet +-- License: BSD-style (see LICENSE) +-- +-- Maintainer: none +-- Stability: unstable +-- Portability: unportable +-- +-- A layout which tiles the windows in columns. The windows can be moved and +-- resized in every directions. +-- +-- The first window appears: +-- +-- * in the center on wide screens +-- * fullscreen otherwise +-- +-- The second window appears on a second column. +-- +-- Subsequent windows appear on the bottom of the last columns. +module XMonad.Layout.Columns + ( -- * Usage + -- $usage + ColumnsLayout (..), + + -- * Messages + Focus (..), + Move (..), + Resize (..), + + -- * Tools + focusDown, + focusUp, + ) +where + +import Control.Applicative ((<|>)) +import Control.Arrow (Arrow (first), second) +import Control.Monad (guard) +import Control.Monad.State (modify) +import Control.Monad.Trans.Maybe (MaybeT (..)) +import Data.Foldable (Foldable (..)) +import Data.List (scanl', singleton) +import Data.Maybe (listToMaybe) +import Data.Ratio ((%)) +import XMonad + ( LayoutClass (..), + Message, + Rectangle (..), + SomeMessage, + Window, + WindowSet, + X, + XState (..), + fromMessage, + gets, + scaleRationalRect, + sendMessage, + ) +import qualified XMonad.Operations as O +import XMonad.StackSet + ( RationalRect (..), + Screen (..), + Stack (..), + StackSet (..), + integrate, + peek, + ) +import qualified XMonad.StackSet as StackSet + +-- $usage +-- Add 'Columns' to your @layoutHook@ with an initial empty state: +-- +-- > myLayout = Full ||| Columns [] +-- +-- Here is an example of keybindings: +-- +-- > -- Focus up/down +-- > ((modm, xK_Tab), focusDown), +-- > ((modm .|. shiftMask, xK_Tab), focusUp), +-- > -- Move windows around +-- > ((modm .|. shiftMask, xK_l), sendMessage MoveRight), +-- > ((modm .|. shiftMask, xK_h), sendMessage MoveLeft), +-- > ((modm .|. shiftMask, xK_k), sendMessage MoveUp), +-- > ((modm .|. shiftMask, xK_j), sendMessage MoveDown), +-- > -- Resize them +-- > ((modm .|. controlMask, xK_l), sendMessage HorizontalExpand), +-- > ((modm .|. controlMask, xK_h), sendMessage HorizontalShrink), +-- > ((modm .|. controlMask, xK_k), sendMessage VerticalExpand), +-- > ((modm .|. controlMask, xK_j), sendMessage VerticalShrink), +-- +-- This layout is known to work with: +-- +-- * "XMonad.Layout.WindowNavigation" for changing focus with a direction using +-- 'XMonad.Layout.WindowNavigation.Go' messages. +-- * 'XMonad.Layout.SubLayouts.subTabbed' for docking windows together with +-- tabs. Note that sometimes when undocking windows, the layout is reset. This is +-- a minor annoyance caused by the difficulty to track windows in the sublayout. + +-- | The windows can be moved in every directions. +-- +-- Horizontally, a window alone in its column cannot be moved before the first +-- or after the last column. If not alone, moving the window outside those +-- limits will create a new column. +-- The windows can also be moved vertically in their column. +data Move = MoveLeft | MoveRight | MoveUp | MoveDown deriving (Show, Read) + +instance Message Move + +-- | The windows can be resized in every directions. +-- +-- When resizing horizontally: +-- +-- * if the window to be resized is not in the last column +-- +-- * then the right side of the window will be moved +-- * the last column will compensate the size change +-- +-- * if the window is in the last column +-- +-- * then the left side of the window will be moved +-- * the column on the left of the current one will compensate the size change +-- +-- The same applies when resizing vertically using the bottom side of the +-- window unless it is the last window in the column in which case we use the +-- top side. +data Resize + = VerticalShrink + | VerticalExpand + | HorizontalShrink + | HorizontalExpand + deriving (Show, Read) + +instance Message Resize + +-- | The layout handles focus change messages. +-- +-- Built-in focus cannot be used here because @XMonad@ does not make it easy to +-- change the order of windows in the focus list. See also 'focusUp' and +-- 'focusDown' functions. +data Focus = FocusUp | FocusDown + deriving (Show, Read) + +instance Message Focus + +-- | A column is a list of windows with their relative vertical dimensions. +type Column = [(Rational, Window)] + +-- | The layout is a list of 'Column' with their relative horizontal dimensions. +type Columns = [(Rational, Column)] + +newtype ColumnsLayout a = Columns Columns + deriving (Show, Read) + +instance LayoutClass ColumnsLayout Window where + description _ = layoutDescription + + emptyLayout _ _ = pure ([], Just $ Columns []) + + doLayout (Columns columns) rectangle stack = + pure (rectangles, Just (Columns columns')) + where + hackedColumns = hackForTabs columns stack + columns' = updateWindowList hackedColumns stack + rectangles = toRectangles rectangle' columns' + -- If there is only one window and the screen is big, we reduce the + -- destination rectangle to put the window on the center of the screen. + rectangle' + | rect_width rectangle > 2000 && (length . toList $ stack) == 1 = + scaleRationalRect rectangle singleColumnRR + | otherwise = rectangle + singleColumnWidth = 1 % 2 + singleColumnOffset = (1 - singleColumnWidth) / 2 + singleColumnRR = RationalRect singleColumnOffset 0 singleColumnWidth 1 + + handleMessage layout@(Columns columns) message = do + mbStack <- runMaybeT $ handleFocus' =<< getStack + changedFocus <- traverse updateStack' mbStack + + movedOrResized <- + runMaybeT $ + Columns + <$> (handleMoveOrResize' =<< peekFocus) + + pure $ movedOrResized <|> changedFocus + where + getStack = MaybeT . gets $ StackSet.stack . workspace . current . windowset + handleFocus' = hoistMaybe . handleFocus columns message + -- A 'Just' needs to be return for the new stack to be taken into account + updateStack' s = modify (setStack s) >> pure layout + peekFocus = MaybeT . gets $ peek . windowset + handleMoveOrResize' = hoistMaybe . handleMoveOrResize columns message + hoistMaybe = MaybeT . pure + +layoutDescription :: String +layoutDescription = "Columns" + +-- | Change the keyboard focus to the previous window +focusUp :: X () +focusUp = + sendMsgOrOnWindowsSet FocusUp StackSet.focusUp + =<< getCurrentLayoutDescription + +-- | Change the keyboard focus to the next window +focusDown :: X () +focusDown = + sendMsgOrOnWindowsSet FocusDown StackSet.focusDown + =<< getCurrentLayoutDescription + +sendMsgOrOnWindowsSet :: (Message a) => a -> (WindowSet -> WindowSet) -> String -> X () +sendMsgOrOnWindowsSet message f description' + | description' == layoutDescription = sendMessage message + | otherwise = O.windows f + +getCurrentLayoutDescription :: X String +getCurrentLayoutDescription = + gets + ( description + . StackSet.layout + . workspace + . current + . windowset + ) + +setStack :: Stack Window -> XState -> XState +setStack stack state = + state + { windowset = + (windowset state) + { current = + (current $ windowset state) + { workspace = + (workspace . current $ windowset state) + { StackSet.stack = Just stack + } + } + } + } + +handleFocus :: Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window) +handleFocus columns message stack + | Just FocusDown <- fromMessage message = setFocus' stack <$> mbNext + | Just FocusUp <- fromMessage message = setFocus' stack <$> mbPrevious + | otherwise = Nothing + where + focused = focus stack + windows = columnsToWindows columns + exists = focused `elem` windows + mbNext = guard exists >> next focused windows + mbPrevious = guard exists >> previous focused windows + setFocus' = flip setFocus + previous a = next a . reverse + setFocus w = until ((==) w . focus) StackSet.focusDown' + next _ [] = Nothing + next a (x : xs) + | a == x = listToMaybe xs + | otherwise = next a (xs <> [x]) + +oldNewWindows :: Columns -> Stack Window -> ([Window], [Window]) +oldNewWindows columns stack = (old, new) + where + old = filter (`notElem` stackList) windows + new = filter (`notElem` windows) stackList + stackList = toList stack + windows = columnsToWindows columns + +-- | Add the new windows to the layout and remove the old ones. +updateWindowList :: Columns -> Stack Window -> Columns +updateWindowList columns stack = addWindows newWindows (removeWindows oldWindows columns) + where + (oldWindows, newWindows) = oldNewWindows columns stack + +-- | If one window disappeared and another appeared, we assume that the sublayout +-- tabs just changed focused. +hackForTabs :: Columns -> Stack Window -> Columns +hackForTabs columns stack = mapWindow replace columns + where + replace window + | (w1 : _, [w2]) <- oldNewWindows columns stack = + if window == w1 + then w2 + else window + | otherwise = window + +toRectangles :: Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)] +toRectangles rectangle columns = + second (scaleRationalRect rectangle) <$> windowsAndRectangles + where + offsetsAndRatios = toOffsetRatio (second toOffsetRatio <$> columns) + windowsAndRectangles = foldMap toWindowAndRectangle offsetsAndRatios + toWindowAndRectangle (x, w, cs) = (\(y, h, ws) -> (ws, RationalRect x y w h)) <$> cs + +onFocused :: (a -> a) -> Stack a -> Stack a +onFocused f (Stack a before after) = Stack (f a) before after + +onFocusedM :: (Monad m) => (a -> m a) -> Stack a -> m (Stack a) +onFocusedM f (Stack a before after) = Stack <$> f a <*> pure before <*> pure after + +onFocusedOrPrevious :: (a -> a) -> Stack a -> Stack a +onFocusedOrPrevious f (Stack a (a' : others) []) = Stack a (f a' : others) [] +onFocusedOrPrevious f stack = onFocused f stack + +handleMoveOrResize :: Columns -> SomeMessage -> Window -> Maybe Columns +handleMoveOrResize columns message window + | Just msg <- fromMessage message = move msg window columns + | Just HorizontalShrink <- fromMessage message = + onFocusedOrPrevious' shrink <$> findInColumns window columns + | Just HorizontalExpand <- fromMessage message = + onFocusedOrPrevious' expand <$> findInColumns window columns + | Just VerticalExpand <- fromMessage message = + onFocusedM' + (fmap (onFocusedOrPrevious' shrink) . findInColumn window) + =<< findInColumns window columns + | Just VerticalShrink <- fromMessage message = + onFocusedM' + (fmap (onFocusedOrPrevious' expand) . findInColumn window) + =<< findInColumns window columns + | otherwise = Nothing + where + expand = first $ flip (+) (3 / 100) + shrink = first $ flip (-) (3 / 100) + onFocusedM' f = fmap integrate . onFocusedM (sequence . second f) + onFocusedOrPrevious' f = sanitize . integrate . onFocusedOrPrevious f + +move :: Move -> Window -> Columns -> Maybe Columns +move direction window columns = + case (direction, findInColumns window columns) of + (MoveRight, Just (Stack (_, [(_, _)]) _ [])) -> Nothing + (MoveLeft, Just (Stack (_, [(_, _)]) [] _)) -> Nothing + (MoveRight, Just (Stack column@(_, [(_, _)]) before (next : others))) -> + let (column', next') = swapWindowBetween window column next + in Just . integrate $ Stack column' before (next' : others) + (MoveLeft, Just (Stack column@(_, [(_, _)]) (previous : others) after)) -> + let (column', previous') = swapWindowBetween window column previous + in Just . integrate $ Stack column' (previous' : others) after + (MoveRight, Just stack) -> + let (newColumns', Stack column before after) = rationalize newColumns stack + windows = removeWindow window column + in Just . integrate $ Stack windows before (newColumns' <> after) + (MoveLeft, Just stack) -> + let (newColumns', Stack column before after) = rationalize newColumns stack + windows = removeWindow window column + in Just . integrate $ Stack windows (newColumns' <> before) after + (MoveUp, Just stack) -> integrate <$> onFocusedM (swapWindowUp window) stack + (MoveDown, Just stack) -> integrate <$> onFocusedM (swapWindowDown window) stack + _ -> Nothing + where + newColumns = [[(1, window)]] + +mapWindow :: (Window -> Window) -> Columns -> Columns +mapWindow = fmap . fmap . fmap . fmap + +columnsToWindows :: Columns -> [Window] +columnsToWindows = foldMap (singleton . snd) . foldMap snd + +swapWindowBetween :: + Window -> + (Rational, Column) -> + (Rational, Column) -> + ((Rational, Column), (Rational, Column)) +swapWindowBetween window from to = (removed, added) + where + removed = removeWindow window from + added = appendWindows [window] to + +swapWindowUp :: Window -> (Rational, Column) -> Maybe (Rational, Column) +swapWindowUp window (width, column) + | Just (Stack (height, _) (previous : before') after) <- findInColumn window column = + Just (width, integrate $ Stack previous ((height, window) : before') after) + | otherwise = Nothing + +swapWindowDown :: Window -> (Rational, Column) -> Maybe (Rational, Column) +swapWindowDown window (width, column) + | Just (Stack (height, _) before (next : others)) <- findInColumn window column = + Just (width, integrate $ Stack next before ((height, window) : others)) + | otherwise = Nothing + +-- | Adjust the ratio of a list or a stack of elts so that when adding new +-- elements: +-- - the new elements are distributed according to the total number of elements +-- - the existing elements keep their proportion in the remaining space +rationalize :: + (Functor f, Foldable f) => + [a] -> + f (Rational, a) -> + ([(Rational, a)], f (Rational, a)) +rationalize new existing = (new', existing') + where + nbNew = fromIntegral $ length new + nbInColumn = fromIntegral $ length existing + newRatio = nbNew % (nbNew + nbInColumn) + existingRatio = 1 - newRatio + new' = fitElements newRatio new + existing' = first (* existingRatio) <$> existing + +append :: [a] -> [(Rational, a)] -> [(Rational, a)] +append new existing = uncurry (flip mappend) (rationalize new existing) + +appendWindows :: + [Window] -> + (Rational, [(Rational, Window)]) -> + (Rational, [(Rational, Window)]) +appendWindows windows = second (append windows) + +fitElements :: Rational -> [a] -> [(Rational, a)] +fitElements dimension elts = (dimension',) <$> elts + where + dimension' = dimension / fromIntegral (length elts) + +singleColumn :: Rational -> Rational -> [Window] -> Columns +singleColumn width height windows = [(width, fitElements height windows)] + +findElement' :: (a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a)) +findElement' predicate list + | (before, c : after) <- break (predicate . snd) list = + Just $ Stack c (reverse before) after + | otherwise = Nothing + +findInColumns :: Window -> Columns -> Maybe (Stack (Rational, Column)) +findInColumns window = findElement' (any ((== window) . snd)) + +findInColumn :: Window -> Column -> Maybe (Stack (Rational, Window)) +findInColumn window = findElement' (== window) + +removeWindows :: [Window] -> Columns -> Columns +removeWindows windows = removeEmptyColumns . fmap (second removeWindows') + where + inWindows (_, window) = window `notElem` windows + removeWindows' = normalize . filter inWindows + removeEmptyColumns = normalize . filter (not . null . snd) + +removeWindow :: Window -> (Rational, Column) -> (Rational, Column) +removeWindow window = second (normalize . filter ((/= window) . snd)) + +addWindows :: [Window] -> Columns -> Columns +addWindows [] columns = columns +-- When there is only one column, create a new one on the right +addWindows windows [(_, windows')] = (1 % 2, windows') : singleColumn (1 % 2) 1 windows +-- When there is more, append the windows to the last column +addWindows windows columns + | Just (columns', column) <- unsnoc columns = + sanitizeColumns $ columns' <> [appendWindows windows column] + | otherwise = singleColumn 1 1 windows + +-- | Make sure the sum of all dimensions is 1 +normalize :: [(Rational, a)] -> [(Rational, a)] +normalize elts = fmap (first (/ total)) elts + where + total = sum (fst <$> elts) + +-- | Update the last dimension so that the sum of all dimensions is 1 +sanitize :: [(Rational, a)] -> [(Rational, a)] +sanitize list + | Just (elts, (_, a)) <- unsnoc list = elts <> [(1 - sum (fst <$> elts), a)] + | otherwise = [] + +-- | Same on the whole layout +sanitizeColumns :: Columns -> Columns +sanitizeColumns = sanitize . fmap (second sanitize) + +toOffsetRatio :: [(Rational, a)] -> [(Rational, Rational, a)] +toOffsetRatio ra = zipWith toTruple ra positions + where + toTruple (dimension, a) position = (position, dimension, a) + positions = scanl' (\position (dimension, _) -> position + dimension) 0 ra + +unsnoc :: [a] -> Maybe ([a], a) +unsnoc [] = Nothing +unsnoc (x : xs) + | Just (is, l) <- unsnoc xs = Just (x : is, l) + | otherwise = Just ([], x) diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 1882eb9db..89fa77ee8 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -63,6 +63,7 @@ library process, random, mtl >= 1 && < 3, + transformers, unix, X11 >= 1.10 && < 1.11, xmonad >= 0.16.99999 && < 0.19, @@ -236,6 +237,7 @@ library XMonad.Layout.Circle XMonad.Layout.CircleEx XMonad.Layout.Column + XMonad.Layout.Columns XMonad.Layout.Combo XMonad.Layout.ComboP XMonad.Layout.Cross From 0028efde19129a9fbe154e70472338b3ac1821f6 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 6 May 2024 11:18:36 +0200 Subject: [PATCH 2/3] Remove the call to singleton --- XMonad/Layout/Columns.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/XMonad/Layout/Columns.hs b/XMonad/Layout/Columns.hs index 40cf1ad4d..8acdc55b3 100644 --- a/XMonad/Layout/Columns.hs +++ b/XMonad/Layout/Columns.hs @@ -47,7 +47,7 @@ import Control.Monad (guard) import Control.Monad.State (modify) import Control.Monad.Trans.Maybe (MaybeT (..)) import Data.Foldable (Foldable (..)) -import Data.List (scanl', singleton) +import Data.List (scanl') import Data.Maybe (listToMaybe) import Data.Ratio ((%)) import XMonad @@ -358,7 +358,7 @@ mapWindow :: (Window -> Window) -> Columns -> Columns mapWindow = fmap . fmap . fmap . fmap columnsToWindows :: Columns -> [Window] -columnsToWindows = foldMap (singleton . snd) . foldMap snd +columnsToWindows = foldMap ((:[]) . snd) . foldMap snd swapWindowBetween :: Window -> From a1ef65ff957cc97ca0d237c2f07802a5f90a5117 Mon Sep 17 00:00:00 2001 From: jecaro Date: Mon, 20 May 2024 20:54:47 +0200 Subject: [PATCH 3/3] Make the width of the fst column configurable --- XMonad/Layout/Columns.hs | 42 +++++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 20 deletions(-) diff --git a/XMonad/Layout/Columns.hs b/XMonad/Layout/Columns.hs index 8acdc55b3..cd11bb945 100644 --- a/XMonad/Layout/Columns.hs +++ b/XMonad/Layout/Columns.hs @@ -17,12 +17,11 @@ -- A layout which tiles the windows in columns. The windows can be moved and -- resized in every directions. -- --- The first window appears: +-- The first window appears in a single column in the center of the screen. Its +-- width is configurable (See 'coOneWindowWidth'). -- --- * in the center on wide screens --- * fullscreen otherwise --- --- The second window appears on a second column. +-- The second window appears in a second column. Starting with two columns, they +-- fill up the screen. -- -- Subsequent windows appear on the bottom of the last columns. module XMonad.Layout.Columns @@ -78,7 +77,7 @@ import qualified XMonad.StackSet as StackSet -- $usage -- Add 'Columns' to your @layoutHook@ with an initial empty state: -- --- > myLayout = Full ||| Columns [] +-- > myLayout = Full ||| Columns 1 [] -- -- Here is an example of keybindings: -- @@ -156,37 +155,40 @@ type Column = [(Rational, Window)] -- | The layout is a list of 'Column' with their relative horizontal dimensions. type Columns = [(Rational, Column)] -newtype ColumnsLayout a = Columns Columns +data ColumnsLayout a = Columns + { -- | With of the first column when there is only one window. Usefull on wide + -- screens. + coOneWindowWidth :: Rational, + -- | The current state + coColumns :: Columns + } deriving (Show, Read) instance LayoutClass ColumnsLayout Window where description _ = layoutDescription - emptyLayout _ _ = pure ([], Just $ Columns []) - - doLayout (Columns columns) rectangle stack = - pure (rectangles, Just (Columns columns')) + doLayout (Columns oneWindowWidth columns) rectangle stack = + pure (rectangles, Just (Columns oneWindowWidth columns')) where hackedColumns = hackForTabs columns stack columns' = updateWindowList hackedColumns stack rectangles = toRectangles rectangle' columns' - -- If there is only one window and the screen is big, we reduce the - -- destination rectangle to put the window on the center of the screen. + -- If there is only one window, we set the destination rectangle according + -- to the width in the layout setting. rectangle' - | rect_width rectangle > 2000 && (length . toList $ stack) == 1 = + | (length . toList $ stack) == 1 = scaleRationalRect rectangle singleColumnRR | otherwise = rectangle - singleColumnWidth = 1 % 2 - singleColumnOffset = (1 - singleColumnWidth) / 2 - singleColumnRR = RationalRect singleColumnOffset 0 singleColumnWidth 1 + singleColumnOffset = (1 - oneWindowWidth) / 2 + singleColumnRR = RationalRect singleColumnOffset 0 oneWindowWidth 1 - handleMessage layout@(Columns columns) message = do + handleMessage layout@(Columns oneWindowWidth columns) message = do mbStack <- runMaybeT $ handleFocus' =<< getStack changedFocus <- traverse updateStack' mbStack movedOrResized <- runMaybeT $ - Columns + Columns oneWindowWidth <$> (handleMoveOrResize' =<< peekFocus) pure $ movedOrResized <|> changedFocus @@ -358,7 +360,7 @@ mapWindow :: (Window -> Window) -> Columns -> Columns mapWindow = fmap . fmap . fmap . fmap columnsToWindows :: Columns -> [Window] -columnsToWindows = foldMap ((:[]) . snd) . foldMap snd +columnsToWindows = foldMap ((: []) . snd) . foldMap snd swapWindowBetween :: Window ->