diff --git a/CHANGES.md b/CHANGES.md index 68f6078bc..438a6d6b6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -76,6 +76,11 @@ - Deprecated the entire module, use `XMonad.Actions.WithAll` instead. + * `XMonad.Layout.Circle`: + + - Deprecated the entire module, use the `circle` function from + `XMonad.Layout.CircleEx` instead. + * `XMonad.Hooks.EwmhDesktops` - `_NET_CLIENT_LIST_STACKING` puts windows in the current workspace at the @@ -135,6 +140,11 @@ There's both an action to be bound to a key, and hooks that plug into `XMonad.Hooks.EwmhDesktops`. + * `XMonad.Layout.CircleEx`: + + - A new window layout, similar to X.L.Circle, but with more + possibilities for customisation. + ### Bug Fixes and Minor Changes * `XMonad.Layout.Magnifier` diff --git a/XMonad/Layout/Circle.hs b/XMonad/Layout/Circle.hs index 29dfb1b75..511e92f31 100644 --- a/XMonad/Layout/Circle.hs +++ b/XMonad/Layout/Circle.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} +{-# LANGUAGE PatternSynonyms #-} ----------------------------------------------------------------------------- -- | @@ -15,15 +16,14 @@ -- ----------------------------------------------------------------------------- -module XMonad.Layout.Circle ( - -- * Usage - -- $usage - Circle (..) - ) where -- actually it's an ellipse +module XMonad.Layout.Circle {-# DEPRECATED "Use XMonad.Layout.CircleEx instead" #-} + ( -- * Usage + -- $usage + pattern Circle + ) where -- actually it's an ellipse -import XMonad.Prelude -import XMonad -import XMonad.StackSet (integrate, peek) +import GHC.Real (Ratio(..)) +import XMonad.Layout.CircleEx -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: @@ -39,37 +39,6 @@ import XMonad.StackSet (integrate, peek) -- and -- "XMonad.Doc.Extending#Editing_the_layout_hook". -data Circle a = Circle deriving ( Read, Show ) +pattern Circle :: CircleEx a +pattern Circle = CircleEx 1 (70 :% 99) (2 :% 5) 1 0 -instance LayoutClass Circle Window where - doLayout Circle r s = do layout <- raiseFocus $ circleLayout r $ integrate s - return (layout, Nothing) - -circleLayout :: Rectangle -> [a] -> [(a, Rectangle)] -circleLayout _ [] = [] -circleLayout r (w:ws) = master : rest - where master = (w, center r) - rest = zip ws $ map (satellite r) [0, pi * 2 / fromIntegral (length ws) ..] - -raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)] -raiseFocus xs = do focused <- withWindowSet (return . peek) - return $ case find ((== focused) . Just . fst) xs of - Just x -> x : delete x xs - Nothing -> xs - -center :: Rectangle -> Rectangle -center (Rectangle sx sy sw sh) = Rectangle x y w h - where s = sqrt 2 :: Double - w = round (fromIntegral sw / s) - h = round (fromIntegral sh / s) - x = sx + fromIntegral (sw - w) `div` 2 - y = sy + fromIntegral (sh - h) `div` 2 - -satellite :: Rectangle -> Double -> Rectangle -satellite (Rectangle sx sy sw sh) a = Rectangle (sx + round (rx + rx * cos a)) - (sy + round (ry + ry * sin a)) - w h - where rx = fromIntegral (sw - w) / 2 - ry = fromIntegral (sh - h) / 2 - w = sw * 10 `div` 25 - h = sh * 10 `div` 25 diff --git a/XMonad/Layout/CircleEx.hs b/XMonad/Layout/CircleEx.hs new file mode 100644 index 000000000..34bb69bbc --- /dev/null +++ b/XMonad/Layout/CircleEx.hs @@ -0,0 +1,189 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RecordWildCards #-} +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.CircleEx +-- Description : An elliptical, overlapping layout—extended version. +-- Copyright : (c) Peter De Wachter, Ilya V. Portnov +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Ilya V. Portnov +-- Stability : unstable +-- Portability : unportable +-- +-- Circle is an elliptical, overlapping layout. Original code by Peter De Wachter, +-- extended by Ilya Porntov. +----------------------------------------------------------------------------- + +module XMonad.Layout.CircleEx ( + -- * Usage + -- $usage + CircleEx (..), circle, circleEx, + CircleExMsg (..) + ) + where + +import Data.Ratio + +import XMonad +import XMonad.StackSet (Stack) +import XMonad.Prelude +import qualified XMonad.StackSet as W + +-- $usage +-- +-- The layout puts the first N windows (called master) into the center of +-- screen. All others (called secondary, or stack) are organized in a circle +-- (well, ellipse). When opening a new secondary window, its size will be +-- slightly smaller than that of its predecessor (this is configurable). If +-- the number of master windows is set to zero, all windows will be arranged +-- in a circle. If there is more than one master window, they will be stacked +-- in the center on top of each other. The size of each additional master +-- window will again be slightly smaller than that of the former. +-- +-- Since a picture says more than a thousand words, you see one +-- . +-- +-- You can use this module with the following in your @xmonad.hs@: +-- +-- > import XMonad.Layout.CircleEx +-- +-- Then edit your @layoutHook@ by adding the 'CircleEx' layout: +-- +-- > myCircle = circleEx {cDelta = -3*pi/4} +-- > myLayout = myCircle ||| Full ||| etc.. +-- > main = xmonad def { layoutHook = myLayout } +-- +-- This layout understands standard messages: +-- +-- * 'IncMasterN': increase or decrease the number of master windows. +-- * 'Shrink' and 'Expand': change the size of master windows. +-- +-- More layout-specific messages are also supported, see 'CircleExMsg' below. +-- +-- For more detailed instructions on editing the layoutHook see: +-- "XMonad.Doc.Extending#Editing_the_layout_hook" + +-- | The layout data type. It is recommended to not use the 'CircleEx' data +-- constructor directly, and instead rely on record update syntax; for +-- example: @circleEx {cMasterRatio = 4%5}@. In this way you can avoid nasty +-- surprises if one day additional fields are added to @CircleEx@. +data CircleEx a = CircleEx + { cNMaster :: !Int -- ^ Number of master windows. Default value is 1. + , cMasterRatio :: !Rational -- ^ Size of master window in relation to screen size. + -- Default value is @4%5@. + , cStackRatio :: !Rational -- ^ Size of first secondary window in relation to screen size. + -- Default value is @3%5@. + , cMultiplier :: !Rational -- ^ Coefficient used to calculate the sizes of subsequent secondary + -- windows. The size of the next window is calculated as the + -- size of the previous one multiplied by this value. + -- This value is also used to scale master windows, in case + -- there is more than one. + -- Default value is @5%6@. Set this to 1 if you want all secondary + -- windows to have the same size. + , cDelta :: !Double -- ^ Angle of rotation of the whole circle layout. Usual values + -- are from 0 to 2π, although it will work outside + -- this range as well. Default value of 0 means that the first + -- secondary window will be placed at the right side of screen. + } deriving (Eq, Show, Read) + +-- | Circle layout with default settings: +-- +-- * Number of master windows is set to 1 +-- * @cMasterRatio@ is set to @70/99@, which is nearly @1/sqrt(2)@ +-- * @cStackRatio@ is set to @2/5@ +-- * @cMultiplier@ is set to 1, which means all secondary windows +-- will have the same size +-- +-- This can be used as a drop-in replacement for "XMonad.Layout.Circle". +circle :: CircleEx a +circle = CircleEx 1 (70%99) (2%5) 1 0 + +-- | Another variant of default settings for circle layout: +-- +-- * Number of master windows is set to 1 +-- * @cMasterRatio@ is set to @4/5@ +-- * @cStackRatio@ is set to @3/5@ +-- * @cMultiplier@ is set to @5/6@ +-- +circleEx :: CircleEx a +circleEx = CircleEx 1 (4%5) (3%5) (5%6) 0 + +-- | Specific messages understood by CircleEx layout. +data CircleExMsg + = Rotate !Double -- ^ Rotate secondary windows by specific angle + | IncStackRatio !Rational -- ^ Increase (or decrease, with negative value) sizes of secondary windows + | IncMultiplier !Rational -- ^ Increase 'cMultiplier'. + deriving (Eq, Show, Typeable) + +instance Message CircleExMsg + +instance LayoutClass CircleEx Window where + doLayout :: CircleEx Window -> Rectangle -> Stack Window -> X ([(Window, Rectangle)], Maybe (CircleEx Window)) + doLayout layout rect stack = do + result <- raiseFocus $ circleLayout layout rect $ W.integrate stack + return (result, Nothing) + + pureMessage :: CircleEx Window -> SomeMessage -> Maybe (CircleEx Window) + pureMessage layout m = + msum [changeMasterN <$> fromMessage m, + resize <$> fromMessage m, + specific <$> fromMessage m] + where + deltaSize = 11 % 10 + + resize :: Resize -> CircleEx a + resize Shrink = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout / deltaSize} + resize Expand = layout {cMasterRatio = max 0.1 $ min 1.0 $ cMasterRatio layout * deltaSize} + + changeMasterN :: IncMasterN -> CircleEx a + changeMasterN (IncMasterN d) = layout {cNMaster = max 0 (cNMaster layout + d)} + + specific :: CircleExMsg -> CircleEx a + specific (Rotate delta) = layout {cDelta = delta + cDelta layout} + specific (IncStackRatio delta) = layout {cStackRatio = max 0.1 $ min 2.0 $ delta + cStackRatio layout} + specific (IncMultiplier delta) = layout {cMultiplier = max 0.1 $ min 2.0 $ delta + cMultiplier layout} + +circleLayout :: CircleEx a -> Rectangle -> [a] -> [(a, Rectangle)] +circleLayout _ _ [] = [] +circleLayout (CircleEx {..}) rectangle wins = + master (take cNMaster wins) ++ rest (drop cNMaster wins) + where + master :: [a] -> [(a, Rectangle)] + master ws = zip ws $ map (placeCenter cMasterRatio cMultiplier rectangle) + [cNMaster-1, cNMaster-2 .. 0] + rest :: [a] -> [(a, Rectangle)] + rest ws = zip ws $ zipWith (placeSatellite cStackRatio cMultiplier rectangle) + (map (+ cDelta) [0, pi*2 / fromIntegral (length ws) ..]) + [0 ..] + + +raiseFocus :: [(Window, Rectangle)] -> X [(Window, Rectangle)] +raiseFocus wrs = do + focused <- withWindowSet (return . W.peek) + return $ case find ((== focused) . Just . fst) wrs of + Just x -> x : delete x wrs + Nothing -> wrs + +placeCenter :: Rational -> Rational -> Rectangle -> Int -> Rectangle +placeCenter ratio multiplier (Rectangle x y width height) n = Rectangle x' y' width' height' + where + m = ratio * multiplier ^ n + width' = round (m * fromIntegral width) + height' = round (m * fromIntegral height) + x' = x + fromIntegral (width - width') `div` 2 + y' = y + fromIntegral (height - height') `div` 2 + +placeSatellite :: Rational -> Rational -> Rectangle -> Double -> Int -> Rectangle +placeSatellite ratio multiplier (Rectangle x y width height) alpha n = + Rectangle x' y' width' height' + where + m = ratio * multiplier ^ n + x' = x + round (rx + rx * cos alpha) + y' = y + round (ry + ry * sin alpha) + rx = fromIntegral (width - width') / 2 + ry = fromIntegral (height - height') / 2 + width' = round (fromIntegral width * m) + height' = round (fromIntegral height * m) diff --git a/XMonad/Layout/DecorationMadness.hs b/XMonad/Layout/DecorationMadness.hs index d17e621f0..ea2663eb1 100644 --- a/XMonad/Layout/DecorationMadness.hs +++ b/XMonad/Layout/DecorationMadness.hs @@ -17,7 +17,7 @@ module XMonad.Layout.DecorationMadness ( -- * Usage -- $usage - -- * Decorated layouts based on Circle + -- * Decorated layouts based on CircleEx -- $circle circleSimpleDefault , circleDefault @@ -94,7 +94,7 @@ import XMonad.Layout.SimpleDecoration import XMonad.Layout.TabBarDecoration import XMonad.Layout.Accordion -import XMonad.Layout.Circle +import XMonad.Layout.CircleEx import XMonad.Layout.WindowArranger import XMonad.Layout.SimpleFloat @@ -132,39 +132,39 @@ import XMonad.Layout.SimpleFloat -- "XMonad.Util.Themes" -- $circle --- Here you will find 'Circle' based decorated layouts. +-- Here you will find 'CircleEx' based decorated layouts. --- | A 'Circle' layout with the xmonad default decoration, default +-- | A 'CircleEx' layout with the xmonad default decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- -circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window -circleSimpleDefault = decoration shrinkText def DefaultDecoration Circle +circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) CircleEx Window +circleSimpleDefault = decoration shrinkText def DefaultDecoration circle -- | Similar to 'circleSimpleDefault' but with the possibility of -- setting a custom shrinker and a custom theme. circleDefault :: Shrinker s => s -> Theme - -> ModifiedLayout (Decoration DefaultDecoration s) Circle Window -circleDefault s t = decoration s t DefaultDecoration Circle + -> ModifiedLayout (Decoration DefaultDecoration s) CircleEx Window +circleDefault s t = decoration s t DefaultDecoration circle --- | A 'Circle' layout with the xmonad simple decoration, default +-- | A 'CircleEx' layout with the xmonad simple decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- -circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window -circleSimpleDeco = decoration shrinkText def (Simple True) Circle +circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) CircleEx Window +circleSimpleDeco = decoration shrinkText def (Simple True) circle -- | Similar to 'circleSimpleDece' but with the possibility of -- setting a custom shrinker and a custom theme. circleDeco :: Shrinker s => s -> Theme - -> ModifiedLayout (Decoration SimpleDecoration s) Circle Window -circleDeco s t = decoration s t (Simple True) Circle + -> ModifiedLayout (Decoration SimpleDecoration s) CircleEx Window +circleDeco s t = decoration s t (Simple True) circle --- | A 'Circle' layout with the xmonad default decoration, default +-- | A 'CircleEx' layout with the xmonad default decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- @@ -172,17 +172,17 @@ circleDeco s t = decoration s t (Simple True) Circle -- -- circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Circle) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window +circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange circle) -- | Similar to 'circleSimpleDefaultResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDefaultResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration DefaultDecoration s) - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange Circle) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window +circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windowArrange circle) --- | A 'Circle' layout with the xmonad simple decoration, default +-- | A 'CircleEx' layout with the xmonad simple decoration, default -- theme and default shrinker, but with the possibility of moving -- windows with the mouse, and resize\/move them with the keyboard. -- @@ -190,45 +190,45 @@ circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ win -- -- circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Circle) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window +circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange circle) -- | Similar to 'circleSimpleDecoResizable' but with the -- possibility of setting a custom shrinker and a custom theme. circleDecoResizable :: Shrinker s => s -> Theme -> ModifiedLayout (Decoration SimpleDecoration s) - (ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window -circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange Circle) + (ModifiedLayout MouseResize (ModifiedLayout WindowArranger CircleEx)) Window +circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrange circle) --- | A 'Circle' layout with the xmonad DwmStyle decoration, default +-- | A 'CircleEx' layout with the xmonad DwmStyle decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- -circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window -circleSimpleDwmStyle = decoration shrinkText def Dwm Circle +circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) CircleEx Window +circleSimpleDwmStyle = decoration shrinkText def Dwm circle -- | Similar to 'circleSimpleDwmStyle' but with the -- possibility of setting a custom shrinker and a custom theme. circleDwmStyle :: Shrinker s => s -> Theme - -> ModifiedLayout (Decoration DwmStyle s) Circle Window -circleDwmStyle s t = decoration s t Dwm Circle + -> ModifiedLayout (Decoration DwmStyle s) CircleEx Window +circleDwmStyle s t = decoration s t Dwm circle --- | A 'Circle' layout with the xmonad tabbed decoration, default +-- | A 'CircleEx' layout with the xmonad tabbed decoration, default -- theme and default shrinker. -- -- Here you can find a screen shot: -- -- -circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen Circle) Window -circleSimpleTabbed = simpleTabBar Circle +circleSimpleTabbed :: ModifiedLayout (Decoration TabBarDecoration DefaultShrinker) (ModifiedLayout ResizeScreen CircleEx) Window +circleSimpleTabbed = simpleTabBar circle -- | Similar to 'circleSimpleTabbed' but with the -- possibility of setting a custom shrinker and a custom theme. circleTabbed :: Shrinker s => s -> Theme - -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen Circle) Window -circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle) + -> ModifiedLayout (Decoration TabBarDecoration s) (ModifiedLayout ResizeScreen CircleEx) Window +circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) circle) -- $accordion diff --git a/XMonad/Layout/SubLayouts.hs b/XMonad/Layout/SubLayouts.hs index 495561196..c12829e04 100644 --- a/XMonad/Layout/SubLayouts.hs +++ b/XMonad/Layout/SubLayouts.hs @@ -47,8 +47,6 @@ module XMonad.Layout.SubLayouts ( ) where -import XMonad.Layout.Circle () -- so haddock can find the link - import XMonad.Layout.Decoration(Decoration, DefaultShrinker) import XMonad.Layout.LayoutModifier(LayoutModifier(handleMess, modifyLayout, redoLayout), @@ -184,11 +182,11 @@ import qualified Data.Set as S -- [@outerLayout@] The layout that determines the rectangles given to each -- group. -- --- Ex. The second group is 'Tall', the third is 'Circle', all others are tabbed --- with: +-- Ex. The second group is 'Tall', the third is 'XMonad.Layout.CircleEx.circle', +-- all others are tabbed with: -- -- > myLayout = addTabs shrinkText def --- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| Circle) +-- > $ subLayout [0,1,2] (Simplest ||| Tall 1 0.2 0.5 ||| circle) -- > $ Tall 1 0.2 0.5 ||| Full subLayout :: [Int] -> subl a -> l a -> ModifiedLayout (Sublayout subl) l a subLayout nextLayout sl = ModifiedLayout (Sublayout (I []) (nextLayout,sl) []) diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 4c0dab93c..62080598f 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -232,6 +232,7 @@ library XMonad.Layout.CenteredIfSingle XMonad.Layout.CenteredMaster XMonad.Layout.Circle + XMonad.Layout.CircleEx XMonad.Layout.Column XMonad.Layout.Combo XMonad.Layout.ComboP