Add SplitShiftDirectional message into BinarySpacePartition layout.

This commit is contained in:
Obszczymucha 2019-05-17 14:54:15 +10:00
parent db80842e65
commit 6b68ec5c00
2 changed files with 73 additions and 14 deletions

View File

@ -89,6 +89,11 @@
Add adwaitaTheme and adwaitaDarkTheme to match their respective Add adwaitaTheme and adwaitaDarkTheme to match their respective
GTK themes. GTK themes.
* 'XMonad.Layout.BinarySpacePartition'
Add a new `SplitShiftDirectional` message that allows moving windows by
splitting its neighbours.
## 0.15 ## 0.15

View File

@ -6,6 +6,7 @@
-- Module : XMonad.Layout.BinarySpacePartition -- Module : XMonad.Layout.BinarySpacePartition
-- Copyright : (c) 2013 Ben Weitzman <benweitzman@gmail.com> -- Copyright : (c) 2013 Ben Weitzman <benweitzman@gmail.com>
-- 2015 Anton Pirogov <anton.pirogov@gmail.com> -- 2015 Anton Pirogov <anton.pirogov@gmail.com>
-- 2019 Mateusz Karbowy <obszczymucha@gmail.com
-- License : BSD3-style (see LICENSE) -- License : BSD3-style (see LICENSE)
-- --
-- Maintainer : Ben Weitzman <benweitzman@gmail.com> -- Maintainer : Ben Weitzman <benweitzman@gmail.com>
@ -29,6 +30,7 @@ module XMonad.Layout.BinarySpacePartition (
, FocusParent(..) , FocusParent(..)
, SelectMoveNode(..) , SelectMoveNode(..)
, Direction2D(..) , Direction2D(..)
, SplitShiftDirectional(..)
) where ) where
import XMonad import XMonad
@ -66,19 +68,21 @@ import Data.Ratio ((%))
-- --
-- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard: -- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard:
-- --
-- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R) -- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R)
-- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L) -- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L)
-- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D) -- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D)
-- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U) -- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U)
-- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R) -- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R)
-- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L) -- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L)
-- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D) -- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D)
-- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U) -- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U)
-- > , ((modm, xK_r ), sendMessage Rotate) -- > , ((modm, xK_r ), sendMessage Rotate)
-- > , ((modm, xK_s ), sendMessage Swap) -- > , ((modm, xK_s ), sendMessage Swap)
-- > , ((modm, xK_n ), sendMessage FocusParent) -- > , ((modm, xK_n ), sendMessage FocusParent)
-- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode) -- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode)
-- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode) -- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode)
-- > , ((modm .|. shiftMask .|. ctrlMask , xK_j ), sendMessage $ SplitShift Prev)
-- > , ((modm .|. shiftMask .|. ctrlMask , xK_k ), sendMessage $ SplitShift Next)
-- --
-- Here's an alternative key mapping, this time using additionalKeysP, -- Here's an alternative key mapping, this time using additionalKeysP,
-- arrow keys, and slightly different behavior when resizing windows -- arrow keys, and slightly different behavior when resizing windows
@ -92,7 +96,9 @@ import Data.Ratio ((%))
-- > , ("M-M1-C-<Up>", sendMessage $ ShrinkFrom D) -- > , ("M-M1-C-<Up>", sendMessage $ ShrinkFrom D)
-- > , ("M-M1-C-<Down>", sendMessage $ ExpandTowards D) -- > , ("M-M1-C-<Down>", sendMessage $ ExpandTowards D)
-- > , ("M-s", sendMessage $ BSP.Swap) -- > , ("M-s", sendMessage $ BSP.Swap)
-- > , ("M-M1-s", sendMessage $ Rotate) ] -- > , ("M-M1-s", sendMessage $ Rotate)
-- > , ("M-S-C-j", sendMessage $ SplitShift Prev)
-- > , ("M-S-C-k", sendMessage $ SplitShift Next)
-- --
-- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance' -- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance'
-- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that -- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that
@ -133,6 +139,10 @@ instance Message SelectMoveNode
data Axis = Horizontal | Vertical deriving (Show, Read, Eq) data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
-- |Message for shifting window by splitting its neighbour
data SplitShiftDirectional = SplitShift Direction1D deriving Typeable
instance Message SplitShiftDirectional
oppositeDirection :: Direction2D -> Direction2D oppositeDirection :: Direction2D -> Direction2D
oppositeDirection U = D oppositeDirection U = D
oppositeDirection D = U oppositeDirection D = U
@ -273,6 +283,42 @@ swapCurrent :: Zipper a -> Maybe (Zipper a)
swapCurrent l@(_, []) = Just l swapCurrent l@(_, []) = Just l
swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs) swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs)
insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertLeftLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)
insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs)
insertLeftLeaf (Node _ _ _) z = Just z
insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
insertRightLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs)
insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs)
insertRightLeaf (Node _ _ _) z = Just z
findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
findRightLeaf n@(Node _ _ _, _) = goRight n >>= findRightLeaf
findRightLeaf l@(Leaf _, _) = Just l
findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
findLeftLeaf n@(Node _ _ _, _) = goLeft n
findLeftLeaf l@(Leaf _, _) = Just l
findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestLeftmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= goLeft >>= findRightLeaf
findTheClosestLeftmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= findTheClosestLeftmostLeaf
findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
findTheClosestRightmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= findTheClosestRightmostLeaf
findTheClosestRightmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= goRight >>= findLeftLeaf
splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftLeftCurrent l@(_, []) = Just l
splitShiftLeftCurrent l@(_, (RightCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.
splitShiftLeftCurrent l@(n, c:cs) = removeCurrent l >>= findTheClosestLeftmostLeaf >>= insertRightLeaf n
splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split)
splitShiftRightCurrent l@(_, []) = Just l
splitShiftRightCurrent l@(_, (LeftCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.
splitShiftRightCurrent l@(n, c:cs) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n
isAllTheWay :: Direction2D -> Zipper Split -> Bool isAllTheWay :: Direction2D -> Zipper Split -> Bool
isAllTheWay _ (_, []) = True isAllTheWay _ (_, []) = True
isAllTheWay R (_, LeftCrumb s _:_) isAllTheWay R (_, LeftCrumb s _:_)
@ -513,6 +559,12 @@ swapNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP
swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
swapNth b = doToNth swapCurrent b swapNth b = doToNth swapCurrent b
splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
splitShiftNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
splitShiftNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
splitShiftNth Prev b = doToNth splitShiftLeftCurrent b
splitShiftNth Next b = doToNth splitShiftRightCurrent b
growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
@ -687,6 +739,7 @@ instance LayoutClass BinarySpacePartition Window where
, fmap rotateTr (fromMessage m) , fmap rotateTr (fromMessage m)
, fmap (balanceTr r) (fromMessage m) , fmap (balanceTr r) (fromMessage m)
, fmap move (fromMessage m) , fmap move (fromMessage m)
, fmap splitShift (fromMessage m)
] ]
resize (ExpandTowards dir) = growNthTowards dir b resize (ExpandTowards dir) = growNthTowards dir b
resize (ShrinkFrom dir) = shrinkNthFrom dir b resize (ShrinkFrom dir) = shrinkNthFrom dir b
@ -699,6 +752,7 @@ instance LayoutClass BinarySpacePartition Window where
balanceTr r Balance = resetFoc $ rebalanceNth b r balanceTr r Balance = resetFoc $ rebalanceNth b r
move MoveNode = resetFoc $ moveNode b move MoveNode = resetFoc $ moveNode b
move SelectNode = b --should not happen here, is done above, as we need X monad move SelectNode = b --should not happen here, is done above, as we need X monad
splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b
b = numerateLeaves b_orig b = numerateLeaves b_orig
resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)} resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)}