mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-02 05:01:51 -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.project
stack-master.yaml
stack.yaml
xmonad-contrib.cabal
63 lines
2.2 KiB
Haskell
63 lines
2.2 KiB
Haskell
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
|
|
|
-----------------------------------------------------------------------------
|
|
-- |
|
|
-- Module : XMonad.Layout.TwoPane
|
|
-- Copyright : (c) Spencer Janssen <spencerjanssen@gmail.com>
|
|
-- License : BSD3-style (see LICENSE)
|
|
--
|
|
-- Maintainer : Spencer Janssen <spencerjanssen@gmail.com>
|
|
-- Stability : unstable
|
|
-- Portability : unportable
|
|
--
|
|
-- A layout that splits the screen horizontally and shows two windows. The
|
|
-- left window is always the master window, and the right is either the
|
|
-- currently focused window or the second window in layout order.
|
|
--
|
|
-----------------------------------------------------------------------------
|
|
|
|
module XMonad.Layout.TwoPane (
|
|
-- * Usage
|
|
-- $usage
|
|
TwoPane (..)
|
|
) where
|
|
|
|
import XMonad hiding (focus)
|
|
import XMonad.StackSet ( focus, up, down)
|
|
|
|
-- $usage
|
|
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
|
--
|
|
-- > import XMonad.Layout.TwoPane
|
|
--
|
|
-- Then edit your @layoutHook@ by adding the TwoPane layout:
|
|
--
|
|
-- > myLayout = TwoPane (3/100) (1/2) ||| Full ||| etc..
|
|
-- > main = xmonad def { layoutHook = myLayout }
|
|
--
|
|
-- For more detailed instructions on editing the layoutHook see:
|
|
--
|
|
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
|
|
|
data TwoPane a =
|
|
TwoPane Rational Rational
|
|
deriving ( Show, Read )
|
|
|
|
instance LayoutClass TwoPane a where
|
|
doLayout (TwoPane _ split) r s = return (arrange r s,Nothing)
|
|
where
|
|
arrange rect st = case reverse (up st) of
|
|
(master:_) -> [(master,left),(focus st,right)]
|
|
[] -> case down st of
|
|
(next:_) -> [(focus st,left),(next,right)]
|
|
[] -> [(focus st, rect)]
|
|
where (left, right) = splitHorizontallyBy split rect
|
|
|
|
handleMessage (TwoPane delta split) x =
|
|
return $ case fromMessage x of
|
|
Just Shrink -> Just (TwoPane delta (split - delta))
|
|
Just Expand -> Just (TwoPane delta (split + delta))
|
|
_ -> Nothing
|
|
|
|
description _ = "TwoPane"
|