mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-10 17:52:09 -07:00
.github
XMonad
Actions
Config
Doc
Hooks
Layout
Groups
MultiToggle
Accordion.hs
AutoMaster.hs
AvoidFloats.hs
BinaryColumn.hs
BinarySpacePartition.hs
BorderResize.hs
BoringWindows.hs
ButtonDecoration.hs
CenteredMaster.hs
Circle.hs
Column.hs
Combo.hs
ComboP.hs
Cross.hs
Decoration.hs
DecorationAddons.hs
DecorationMadness.hs
Dishes.hs
DragPane.hs
DraggingVisualizer.hs
Drawer.hs
Dwindle.hs
DwmStyle.hs
FixedColumn.hs
Fullscreen.hs
Gaps.hs
Grid.hs
GridVariants.hs
Groups.hs
Hidden.hs
HintedGrid.hs
HintedTile.hs
IM.hs
IfMax.hs
ImageButtonDecoration.hs
IndependentScreens.hs
LayoutBuilder.hs
LayoutBuilderP.hs
LayoutCombinators.hs
LayoutHints.hs
LayoutModifier.hs
LayoutScreens.hs
LimitWindows.hs
MagicFocus.hs
Magnifier.hs
Master.hs
Maximize.hs
MessageControl.hs
Minimize.hs
Monitor.hs
Mosaic.hs
MosaicAlt.hs
MouseResizableTile.hs
MultiColumns.hs
MultiDishes.hs
MultiToggle.hs
Named.hs
NoBorders.hs
NoFrillsDecoration.hs
OnHost.hs
OneBig.hs
PerScreen.hs
PerWorkspace.hs
PositionStoreFloat.hs
Reflect.hs
Renamed.hs
ResizableThreeColumns.hs
ResizableTile.hs
ResizeScreen.hs
Roledex.hs
ShowWName.hs
SimpleDecoration.hs
SimpleFloat.hs
Simplest.hs
SimplestFloat.hs
SortedLayout.hs
Spacing.hs
Spiral.hs
Square.hs
StackTile.hs
StateFull.hs
Stoppable.hs
SubLayouts.hs
TabBarDecoration.hs
Tabbed.hs
TallMastersCombo.hs
ThreeColumns.hs
ToggleLayouts.hs
TrackFloating.hs
TwoPane.hs
TwoPanePersistent.hs
VoidBorders.hs
WindowArranger.hs
WindowNavigation.hs
WindowSwitcherDecoration.hs
WorkspaceDir.hs
ZoomRow.hs
Prompt
Util
Doc.hs
Prelude.hs
Prompt.hs
scripts
tests
.gitignore
.mailmap
CHANGES.md
LICENSE
README.md
Setup.lhs
cabal.haskell-ci
cabal.project
stack-master.yaml
stack.yaml
xmonad-contrib.cabal
This is a convenience module in order to have less import noise. It re-exports the following: a) Commonly used modules in full (Data.Foldable, Data.Applicative, and so on); though only those that play nicely with each other, so that XMonad.Prelude can be imported unqualified without any problems. This prevents things like `Prelude.(.)` and `Control.Category.(.)` fighting with each other. b) Helper functions that don't necessarily fit in any other module; e.g., the often used abbreviation `fi = fromIntegral`.
57 lines
1.9 KiB
Haskell
57 lines
1.9 KiB
Haskell
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.Dishes
|
|
-- Copyright : (c) Jeremy Apthorp
|
|
-- License : BSD-style (see LICENSE)
|
|
--
|
|
-- Maintainer : Jeremy Apthorp <nornagon@gmail.com>
|
|
-- Stability : unstable
|
|
-- Portability : portable
|
|
--
|
|
-- Dishes is a layout that stacks extra windows underneath the master
|
|
-- windows.
|
|
--
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Layout.Dishes (
|
|
-- * Usage
|
|
-- $usage
|
|
Dishes (..)
|
|
) where
|
|
|
|
import XMonad
|
|
import XMonad.StackSet (integrate)
|
|
import XMonad.Prelude (ap)
|
|
|
|
-- $usage
|
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
--
|
|
-- > import XMonad.Layout.Dishes
|
|
--
|
|
-- Then edit your @layoutHook@ by adding the Dishes layout:
|
|
--
|
|
-- > myLayout = Dishes 2 (1/6) ||| Full ||| etc..
|
|
-- > main = xmonad def { layoutHook = myLayout }
|
|
--
|
|
-- For more detailed instructions on editing the layoutHook see:
|
|
--
|
|
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
|
|
|
data Dishes a = Dishes Int Rational deriving (Show, Read)
|
|
instance LayoutClass Dishes a where
|
|
doLayout (Dishes nmaster h) r =
|
|
return . (\x->(x,Nothing)) .
|
|
ap zip (dishes h r nmaster . length) . integrate
|
|
pureMessage (Dishes nmaster h) m = fmap incmastern (fromMessage m)
|
|
where incmastern (IncMasterN d) = Dishes (max 0 (nmaster+d)) h
|
|
|
|
dishes :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
|
|
dishes h s nmaster n = if n <= nmaster
|
|
then splitHorizontally n s
|
|
else ws
|
|
where
|
|
(m,rest) = splitVerticallyBy (1 - (fromIntegral $ n - nmaster) * h) s
|
|
ws = splitHorizontally nmaster m ++ splitVertically (n - nmaster) rest
|