twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-08-13 19:25:52 -07:00
Code Issues Packages Projects Releases Wiki Activity
Files
.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
CenterMainFluid.hs
CenteredIfSingle.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
FixedAspectRatio.hs
FixedColumn.hs
FocusTracking.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
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
SideBorderDecoration.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
.hlint.yaml
.mailmap
CHANGES.md
CONTRIBUTING.md
LICENSE
NIX.md
README.md
Setup.lhs
cabal.haskell-ci
cabal.project
flake.nix
stack-master.yaml
stack.yaml
xmonad-contrib.cabal
52a40f376c9647d3041d8fc9707a9938057d8828
xmonad-contrib/XMonad/Layout/WindowArranger.hs
Tony Zorman 3d65a6bf72 Refer to the tutorial instead of X.D.Extending more often 
Essentially, whenever the tutorial actually has decent material on the
subject matter.  The replacement is roughly done as follows:

  - logHook → tutorial
  - keybindings → tutorial, as this is thoroughly covered
  - manageHook → tutorial + X.D.Extending, as the manageHook stuff the
    tutorial talks about is a little bit of an afterthought.
  - X.D.Extending (on its own) → tutorial + X.D.Extending
  - layoutHook → tutorial + X.D.Extending, as the tutorial, while
    talking about layouts, doesn't necessarily have a huge focus there.
  - mouse bindings → leave this alone, as the tutorial does not at all
    talk about them.
2022-10-21 09:17:43 +02:00

204 lines
9.2 KiB
Haskell
Raw Blame History

{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.WindowArranger
-- Description : A layout modifier to move and resize windows with the keyboard.
-- Copyright : (c) Andrea Rossato 2007
-- License : BSD-style (see xmonad/LICENSE)
--
-- Maintainer : andrea.rossato@unibz.it
-- Stability : unstable
-- Portability : unportable
--
-- This is a pure layout modifier that will let you move and resize
-- windows with the keyboard in any layout.
-----------------------------------------------------------------------------
module XMonad.Layout.WindowArranger
( -- * Usage
-- $usage
windowArrange
, windowArrangeAll
, WindowArrangerMsg (..)
, WindowArranger
, memberFromList
, listFromList
, diff
) where
import XMonad
import XMonad.Prelude
import qualified XMonad.StackSet as S
import XMonad.Layout.LayoutModifier
import Control.Arrow ((***), (>>>), (&&&), first)
-- $usage
-- You can use this module with the following in your
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Layout.WindowArranger
-- > myLayout = layoutHook def
-- > main = xmonad def { layoutHook = windowArrange myLayout }
--
-- or
--
-- > main = xmonad def { layoutHook = windowArrangeAll myLayout }
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
--
-- You may also want to define some key binding to move or resize
-- windows. These are good defaults:
--
-- > , ((modm .|. controlMask , xK_s ), sendMessage Arrange )
-- > , ((modm .|. controlMask .|. shiftMask, xK_s ), sendMessage DeArrange )
-- > , ((modm .|. controlMask , xK_Left ), sendMessage (MoveLeft 1))
-- > , ((modm .|. controlMask , xK_Right), sendMessage (MoveRight 1))
-- > , ((modm .|. controlMask , xK_Down ), sendMessage (MoveDown 1))
-- > , ((modm .|. controlMask , xK_Up ), sendMessage (MoveUp 1))
-- > , ((modm .|. shiftMask, xK_Left ), sendMessage (IncreaseLeft 1))
-- > , ((modm .|. shiftMask, xK_Right), sendMessage (IncreaseRight 1))
-- > , ((modm .|. shiftMask, xK_Down ), sendMessage (IncreaseDown 1))
-- > , ((modm .|. shiftMask, xK_Up ), sendMessage (IncreaseUp 1))
-- > , ((modm .|. controlMask .|. shiftMask, xK_Left ), sendMessage (DecreaseLeft 1))
-- > , ((modm .|. controlMask .|. shiftMask, xK_Right), sendMessage (DecreaseRight 1))
-- > , ((modm .|. controlMask .|. shiftMask, xK_Down ), sendMessage (DecreaseDown 1))
-- > , ((modm .|. controlMask .|. shiftMask, xK_Up ), sendMessage (DecreaseUp 1))
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- | A layout modifier to float the windows in a workspace
windowArrange :: l a -> ModifiedLayout WindowArranger l a
windowArrange = ModifiedLayout (WA True False [])
-- | A layout modifier to float all the windows in a workspace
windowArrangeAll :: l a -> ModifiedLayout WindowArranger l a
windowArrangeAll = ModifiedLayout (WA True True [])
data WindowArrangerMsg = DeArrange
| Arrange
| IncreaseLeft Int
| IncreaseRight Int
| IncreaseUp Int
| IncreaseDown Int
| DecreaseLeft Int
| DecreaseRight Int
| DecreaseUp Int
| DecreaseDown Int
| MoveLeft Int
| MoveRight Int
| MoveUp Int
| MoveDown Int
| SetGeometry Rectangle
instance Message WindowArrangerMsg
data ArrangedWindow a = WR (a, Rectangle)
| AWR (a, Rectangle)
deriving (Read, Show)
type ArrangeAll = Bool
data WindowArranger a = WA Bool ArrangeAll [ArrangedWindow a] deriving (Read, Show)
instance (Show a, Read a, Eq a) => LayoutModifier WindowArranger a where
pureModifier (WA True b []) _ (Just _) wrs = arrangeWindows b wrs
pureModifier (WA True b awrs) _ (Just (S.Stack w _ _)) wrs = curry process wrs awrs
where
wins = map fst *** map awrWin
update (a,r) = mkNewAWRs b a *** removeAWRs r >>> uncurry (++)
process = wins &&& id >>> first diff >>> uncurry update >>>
replaceWR wrs >>> putOnTop w >>> map fromAWR &&& Just . WA True b
pureModifier _ _ _ wrs = (wrs, Nothing)
pureMess (WA True b (wr:wrs)) m
-- increase the window's size
| Just (IncreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (w + fi i) h
| Just (IncreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y (w + fi i) h
| Just (IncreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w (h + fi i)
| Just (IncreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (h + fi i)
-- decrease the window's size
| Just (DecreaseRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y (chk w i) h
| Just (DecreaseLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win x y (chk w i) h
| Just (DecreaseUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x y w (chk h i)
| Just (DecreaseDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w (chk h i)
--move the window around
| Just (MoveRight i) <- fm, (win, Rectangle x y w h) <- fa = res win (x + fi i) y w h
| Just (MoveLeft i) <- fm, (win, Rectangle x y w h) <- fa = res win (x - fi i) y w h
| Just (MoveUp i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y - fi i) w h
| Just (MoveDown i) <- fm, (win, Rectangle x y w h) <- fa = res win x (y + fi i) w h
where res wi x y w h = Just . WA True b $ AWR (wi,Rectangle x y w h):wrs
fm = fromMessage m
fa = fromAWR wr
chk x y = fi $ max 1 (fi x - y)
pureMess (WA t b (wr:wrs)) m
| Just (SetGeometry r) <- fromMessage m, (w,_) <- fromAWR wr = Just . WA t b $ AWR (w,r):wrs
pureMess (WA _ b l) m
| Just DeArrange <- fromMessage m = Just $ WA False b l
| Just Arrange <- fromMessage m = Just $ WA True b l
| otherwise = Nothing
arrangeWindows :: ArrangeAll -> [(a,Rectangle)] -> ([(a, Rectangle)], Maybe (WindowArranger a))
arrangeWindows b wrs = (wrs, Just $ WA True b (map t wrs))
where t = if b then AWR else WR
fromAWR :: ArrangedWindow a -> (a, Rectangle)
fromAWR (WR x) = x
fromAWR (AWR x) = x
awrWin :: ArrangedWindow a -> a
awrWin = fst . fromAWR
getAWR :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
getAWR = memberFromList awrWin (==)
getWR :: Eq a => a -> [(a,Rectangle)] -> [(a,Rectangle)]
getWR = memberFromList fst (==)
mkNewAWRs :: Eq a => ArrangeAll -> [a] -> [(a,Rectangle)] -> [ArrangedWindow a]
mkNewAWRs b w wrs = map t . concatMap (`getWR` wrs) $ w
where t = if b then AWR else WR
removeAWRs :: Eq a => [a] -> [ArrangedWindow a] -> [ArrangedWindow a]
removeAWRs = listFromList awrWin notElem
putOnTop :: Eq a => a -> [ArrangedWindow a] -> [ArrangedWindow a]
putOnTop w awrs = awr ++ nawrs
where awr = getAWR w awrs
nawrs = filter ((/=w) . awrWin) awrs
replaceWR :: Eq a => [(a, Rectangle)] -> [ArrangedWindow a] -> [ArrangedWindow a]
replaceWR wrs = foldr r []
where r x xs
| WR wr <- x = case fst wr `elemIndex` map fst wrs of
Just i -> WR (wrs !! i):xs
Nothing -> x:xs
| otherwise = x:xs
-- | Given a function to be applied to each member of a list, and a
-- function to check a condition by processing this transformed member
-- with the members of a list, you get the list of members that
-- satisfy the condition.
listFromList :: (b -> c) -> (c -> [a] -> Bool) -> [a] -> [b] -> [b]
listFromList f g l = foldr (h l) []
where h x y ys = if g (f y) x then y:ys else ys
-- | Given a function to be applied to each member of ta list, and a
-- function to check a condition by processing this transformed member
-- with something, you get the first member that satisfy the condition,
-- or an empty list.
memberFromList :: (b -> c) -> (c -> a -> Bool) -> a -> [b] -> [b]
memberFromList f g l = foldr (h l) []
where h x y ys = if g (f y) x then [y] else ys
-- | Get the list of elements to be deleted and the list of elements to
-- be added to the first list in order to get the second list.
diff :: Eq a => ([a],[a]) -> ([a],[a])
diff (x,y) = (x \\ y, y \\ x)
Reference in New Issue View Git Blame Copy Permalink