Extended the sendMessage interface of X.L.Gaps to allow arbitrary modifications to the GapSpec.

This commit is contained in:
L.S. Leary
2017-11-22 07:58:41 +13:00
parent 89a0fdf7fe
commit cc9622ab28
2 changed files with 62 additions and 11 deletions

View File

@@ -71,6 +71,11 @@
### Bug Fixes and Minor Changes
* `XMonad.Layout.Gaps`
Extended the sendMessage interface with `ModifyGaps` to allow arbitrary
modifications to the `GapSpec`.
* `XMonad.Actions.Navigation2D`
Generalised (and hence deprecated) hybridNavigation to hybridOf.

View File

@@ -31,8 +31,8 @@ module XMonad.Layout.Gaps (
-- * Usage
-- $usage
Direction2D(..), Gaps,
GapSpec, gaps, gaps', GapMessage(..)
GapSpec, gaps, gaps', GapMessage(..),
weakModifyGaps, modifyGap, setGaps, setGap
) where
import XMonad.Core
@@ -57,10 +57,23 @@ import Data.List (delete)
-- You can additionally add some keybindings to toggle or modify the gaps,
-- for example:
--
-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps
-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap
-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap
-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps) -- toggle all gaps
-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R) -- increment the right-hand gap
-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R) -- decrement the right-hand gap
-- > , ((modm .|. controlMask, xK_r), sendMessage $ ModifyGaps rotateGaps) -- rotate gaps 90 degrees clockwise
-- > , ((modm .|. controlMask, xK_h), sendMessage $ weakModifyGaps halveHor) -- halve the left and right-hand gaps
-- > , ((modm .|. controlMask, xK_d), sendMessage $ modifyGap (*2) L) -- double the left-hand gap
-- > , ((modm .|. controlMask, xK_s), sendMessage $ setGaps [(U,18), (R,23)]) -- reset the GapSpec
-- > , ((modm .|. controlMask, xK_b), sendMessage $ setGap 30 D) -- set the bottom gap to 30
-- > ]
-- > where rotateGaps gs = zip (map (rotate . fst) gs) (map snd gs)
-- > rotate U = R
-- > rotate R = D
-- > rotate D = L
-- > rotate L = U
-- > halveHor d i | d `elem` [L, R] = i `div` 2
-- > | otherwise = i
--
-- If you want complete control over all gaps, you could include
-- something like this in your keybindings, assuming in this case you
@@ -95,6 +108,7 @@ data GapMessage = ToggleGaps -- ^ Toggle all gaps.
| ToggleGap !Direction2D -- ^ Toggle a single gap.
| IncGap !Int !Direction2D -- ^ Increase a gap by a certain number of pixels.
| DecGap !Int !Direction2D -- ^ Decrease a gap.
| ModifyGaps (GapSpec -> GapSpec) -- ^ Modify arbitrarily.
deriving (Typeable)
instance Message GapMessage
@@ -108,11 +122,46 @@ instance LayoutModifier Gaps a where
| Just (ToggleGap d) <- fromMessage m
= Just $ Gaps conf (toggleGap conf cur d)
| Just (IncGap i d) <- fromMessage m
= Just $ Gaps (incGap conf d i) cur
= Just $ Gaps (limit . continuation (+ i ) d $ conf) cur
| Just (DecGap i d) <- fromMessage m
= Just $ Gaps (incGap conf d (-i)) cur
= Just $ Gaps (limit . continuation (+(-i)) d $ conf) cur
| Just (ModifyGaps f) <- fromMessage m
= Just $ Gaps (limit . f $ conf) cur
| otherwise = Nothing
-- | Modifies gaps weakly, for convenience.
weakModifyGaps :: (Direction2D -> Int -> Int) -> GapMessage
weakModifyGaps = ModifyGaps . weakToStrong
-- | Arbitrarily modify a single gap with the given function.
modifyGap :: (Int -> Int) -> Direction2D -> GapMessage
modifyGap f d = ModifyGaps $ continuation f d
-- | Set the GapSpec.
setGaps :: GapSpec -> GapMessage
setGaps = ModifyGaps . const
-- | Set a gap to the given value.
setGap :: Int -> Direction2D -> GapMessage
setGap = modifyGap . const
-- | Imposes limits upon a GapSpec, ensuring gaps are at least 0. Not exposed.
limit :: GapSpec -> GapSpec
limit = weakToStrong $ \_ -> max 0
-- | Takes a weak gaps-modifying function f and returns a GapSpec modifying
-- function. Not exposed.
weakToStrong :: (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
weakToStrong f gs = zip (map fst gs) (map (uncurry f) gs)
-- | Given f as a definition for the behaviour of a gaps modifying function in
-- one direction d, produces a continuation of the function to the other
-- directions using the identity. Not exposed.
continuation :: (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
continuation f d1 = weakToStrong h
where h d2 | d2 == d1 = f
| otherwise = id
applyGaps :: Gaps a -> Rectangle -> Rectangle
applyGaps gs r = foldr applyGap r (activeGaps gs)
where
@@ -133,9 +182,6 @@ toggleGap conf cur d | d `elem` cur = delete d cur
| d `elem` (map fst conf) = d:cur
| otherwise = cur
incGap :: GapSpec -> Direction2D -> Int -> GapSpec
incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs
-- | Add togglable manual gaps to a layout.
gaps :: GapSpec -- ^ The gaps to allow, paired with their initial sizes.
-> l a -- ^ The layout to modify.