mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-05-19 03:20:21 -07:00
Rewrite of 'XMonad.Layout.Spacing':
* Independent screen/window borders * Configurable top/bottom/right/left borders
This commit is contained in:
parent
5f2afb08e9
commit
6ae7c2c8b4
@ -1,139 +1,163 @@
|
|||||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
|
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE PatternGuards #-}
|
|
||||||
|
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Layout.Spacing
|
-- Module : XMonad.Layout.Spacing
|
||||||
-- Copyright : (c) Brent Yorgey
|
-- Copyright : (C) -- Brent Yorgey
|
||||||
|
-- 2018 Yclept Nemo
|
||||||
-- License : BSD-style (see LICENSE)
|
-- License : BSD-style (see LICENSE)
|
||||||
--
|
--
|
||||||
-- Maintainer : <byorgey@gmail.com>
|
-- Maintainer : <byorgey@gmail.com>
|
||||||
-- Stability : unstable
|
-- Stability : unstable
|
||||||
-- Portability : portable
|
-- Portability : unportable
|
||||||
--
|
--
|
||||||
-- Add a configurable amount of space around windows.
|
-- Add a configurable amount of space around windows.
|
||||||
--
|
--
|
||||||
-- Note: For space\/gaps along edges of the /screen/ see "XMonad.Layout.Gaps".
|
-- Note: For space\/gaps along edges of the /screen/ see "XMonad.Layout.Gaps".
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module XMonad.Layout.Spacing (
|
module XMonad.Layout.Spacing
|
||||||
-- * Usage
|
( -- * Usage
|
||||||
-- $usage
|
-- $usage
|
||||||
|
Border (..)
|
||||||
|
, Spacing (..)
|
||||||
|
, ModifySpacing (..)
|
||||||
|
, spacing
|
||||||
|
, setWindowSpacing, setScreenSpacing
|
||||||
|
, toggleSmartSpacing
|
||||||
|
, incWindowSpacing, incScreenSpacing
|
||||||
|
, decWindowSpacing, decScreenSpacing
|
||||||
|
, borderIncrementBy
|
||||||
|
) where
|
||||||
|
|
||||||
spacing, Spacing,
|
import XMonad
|
||||||
spacingWithEdge, SpacingWithEdge,
|
import qualified XMonad.StackSet as W
|
||||||
smartSpacing, SmartSpacing,
|
import XMonad.Layout.LayoutModifier
|
||||||
smartSpacingWithEdge, SmartSpacingWithEdge,
|
import qualified XMonad.Util.Rectangle as R
|
||||||
ModifySpacing(..), setSpacing, incSpacing
|
|
||||||
) where
|
|
||||||
|
|
||||||
import Graphics.X11 (Rectangle(..))
|
import Control.Arrow
|
||||||
import Control.Arrow (second)
|
|
||||||
import XMonad.Operations (sendMessage)
|
|
||||||
import XMonad.Core (X,runLayout,Message,fromMessage,Typeable)
|
|
||||||
import XMonad.StackSet (up, down, Workspace(..))
|
|
||||||
import XMonad.Util.Font (fi)
|
|
||||||
|
|
||||||
import XMonad.Layout.LayoutModifier
|
|
||||||
|
|
||||||
-- $usage
|
-- $usage
|
||||||
-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
|
-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@
|
||||||
|
-- file:
|
||||||
--
|
--
|
||||||
-- > import XMonad.Layout.Spacing
|
-- > import XMonad.Layout.Spacing
|
||||||
--
|
--
|
||||||
-- and modifying your layoutHook as follows (for example):
|
-- and modifying your layoutHook as follows (for example):
|
||||||
--
|
--
|
||||||
-- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2)
|
-- > layoutHook = spacing True (Border 0 10 10 10) (Border 10 10 10 10) $
|
||||||
-- > -- put a 2px space around every window
|
-- > layoutHook def
|
||||||
--
|
|
||||||
|
|
||||||
-- | Surround all windows by a certain number of pixels of blank space.
|
-- | Represent the borders of a rectangle.
|
||||||
spacing :: Int -> l a -> ModifiedLayout Spacing l a
|
data Border = Border
|
||||||
spacing p = ModifiedLayout (Spacing p)
|
{ top :: Integer
|
||||||
|
, bottom :: Integer
|
||||||
|
, right :: Integer
|
||||||
|
, left :: Integer
|
||||||
|
} deriving (Read,Show)
|
||||||
|
|
||||||
data Spacing a = Spacing Int deriving (Show, Read)
|
-- | A 'LayoutModifier' providing customizable screen and window borders.
|
||||||
|
-- Borders are clamped to @[0,Infinity]@ before being applied.
|
||||||
-- | Message to dynamically modify (e.g. increase/decrease/set) the size of the window spacing
|
data Spacing a = Spacing
|
||||||
data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable)
|
{ smartBorder :: Bool -- ^ When @True@ borders are not applied if
|
||||||
instance Message ModifySpacing
|
-- there fewer than two windows.
|
||||||
|
, screenBorder :: Border -- ^ The screen border.
|
||||||
-- | Set spacing to given amount
|
, windowBorder :: Border -- ^ The window borders.
|
||||||
setSpacing :: Int -> X ()
|
} deriving (Show,Read)
|
||||||
setSpacing n = sendMessage $ ModifySpacing $ const n
|
|
||||||
|
|
||||||
-- | Increase spacing by given amount
|
|
||||||
incSpacing :: Int -> X ()
|
|
||||||
incSpacing n = sendMessage $ ModifySpacing $ (+n)
|
|
||||||
|
|
||||||
instance LayoutModifier Spacing a where
|
instance LayoutModifier Spacing a where
|
||||||
|
pureModifier (Spacing True _ _) _ _ [x] =
|
||||||
|
([x], Nothing)
|
||||||
|
pureModifier (Spacing _ _ wb) _ _ wrs =
|
||||||
|
let wb' = borderClampGTZero wb
|
||||||
|
in (map (second $ withBorder' wb' 2) wrs, Nothing)
|
||||||
|
|
||||||
pureModifier (Spacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
|
modifyLayout (Spacing b sb _) wsp lr
|
||||||
|
| b == True
|
||||||
|
, null . drop 1 . W.integrate' . W.stack $ wsp
|
||||||
|
= runLayout wsp lr
|
||||||
|
| otherwise
|
||||||
|
= let sb' = borderClampGTZero sb
|
||||||
|
in runLayout wsp (withBorder' sb' 2 lr)
|
||||||
|
|
||||||
pureMess (Spacing px) m
|
pureMess (Spacing b sb wb) m
|
||||||
| Just (ModifySpacing f) <- fromMessage m = Just $ Spacing $ max 0 $ f px
|
| Just (ModifyWindowSpacing f) <- fromMessage m
|
||||||
| otherwise = Nothing
|
= Just $ Spacing b sb (f wb)
|
||||||
|
| Just (ModifyScreenSpacing f) <- fromMessage m
|
||||||
|
= Just $ Spacing b (f sb) wb
|
||||||
|
| Just (ModifySmartSpacing f) <- fromMessage m
|
||||||
|
= Just $ Spacing (f b) sb wb
|
||||||
|
| otherwise
|
||||||
|
= Nothing
|
||||||
|
|
||||||
modifierDescription (Spacing p) = "Spacing " ++ show p
|
modifierDescription Spacing {} =
|
||||||
|
"Spacing"
|
||||||
|
|
||||||
-- | Surround all windows by a certain number of pixels of blank space, and
|
|
||||||
-- additionally adds the same amount of spacing around the edge of the screen.
|
|
||||||
spacingWithEdge :: Int -> l a -> ModifiedLayout SpacingWithEdge l a
|
|
||||||
spacingWithEdge p = ModifiedLayout (SpacingWithEdge p)
|
|
||||||
|
|
||||||
data SpacingWithEdge a = SpacingWithEdge Int deriving (Show, Read)
|
-- | Generate the 'ModifiedLayout', exposing all initial state of 'Spacing'.
|
||||||
|
spacing :: Bool -- ^ The 'smartBorder'.
|
||||||
|
-> Border -- ^ The 'screenBorder'.
|
||||||
|
-> Border -- ^ The 'windowBorder'.
|
||||||
|
-> l a -> ModifiedLayout Spacing l a
|
||||||
|
spacing b sb wb = ModifiedLayout (Spacing b sb wb)
|
||||||
|
|
||||||
instance LayoutModifier SpacingWithEdge a where
|
-- | Messages to alter the state of 'Spacing' using the endomorphic function
|
||||||
|
-- arguments.
|
||||||
|
data ModifySpacing
|
||||||
|
= ModifyWindowSpacing (Border -> Border)
|
||||||
|
| ModifyScreenSpacing (Border -> Border)
|
||||||
|
| ModifySmartSpacing (Bool -> Bool)
|
||||||
|
deriving (Typeable)
|
||||||
|
|
||||||
pureModifier (SpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
|
instance Message ModifySpacing
|
||||||
|
|
||||||
pureMess (SpacingWithEdge px) m
|
-- | Set 'windowBorder' to the given 'Border'.
|
||||||
| Just (ModifySpacing f) <- fromMessage m = Just $ SpacingWithEdge $ max 0 $ f px
|
setWindowSpacing :: Border -> X ()
|
||||||
| otherwise = Nothing
|
setWindowSpacing = sendMessage . ModifyWindowSpacing . const
|
||||||
|
|
||||||
modifyLayout (SpacingWithEdge p) w r = runLayout w (shrinkRect p r)
|
-- | Set 'screenBorder' to the given 'Border'.
|
||||||
|
setScreenSpacing :: Border -> X ()
|
||||||
|
setScreenSpacing = sendMessage . ModifyScreenSpacing . const
|
||||||
|
|
||||||
modifierDescription (SpacingWithEdge p) = "SpacingWithEdge " ++ show p
|
-- | Toggle 'smartBorder'.
|
||||||
|
toggleSmartSpacing :: X ()
|
||||||
|
toggleSmartSpacing = sendMessage $ ModifySmartSpacing not
|
||||||
|
|
||||||
shrinkRect :: Int -> Rectangle -> Rectangle
|
-- | Increment the borders of 'windowBorder' using 'borderIncrementBy', which
|
||||||
shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (fi $ max 1 $ fi w-2*p) (fi $ max 1 $ fi h-2*p)
|
-- preserves border ratios during clamping.
|
||||||
|
incWindowSpacing :: Integer -> X ()
|
||||||
|
incWindowSpacing = sendMessage . ModifyWindowSpacing . borderIncrementBy
|
||||||
|
|
||||||
-- | Surrounds all windows with blank space, except when the window is the only
|
-- | Increment the borders of 'screenBorder' using 'borderIncrementBy'.
|
||||||
-- visible window on the current workspace.
|
incScreenSpacing :: Integer -> X ()
|
||||||
smartSpacing :: Int -> l a -> ModifiedLayout SmartSpacing l a
|
incScreenSpacing = sendMessage . ModifyScreenSpacing . borderIncrementBy
|
||||||
smartSpacing p = ModifiedLayout (SmartSpacing p)
|
|
||||||
|
|
||||||
data SmartSpacing a = SmartSpacing Int deriving (Show, Read)
|
-- | Inverse of 'incWindowSpacing', equivalent to applying 'negate'.
|
||||||
|
decWindowSpacing :: Integer -> X ()
|
||||||
|
decWindowSpacing = incWindowSpacing . negate
|
||||||
|
|
||||||
instance LayoutModifier SmartSpacing a where
|
-- | Inverse of 'incScreenSpacing'.
|
||||||
|
decScreenSpacing :: Integer -> X ()
|
||||||
|
decScreenSpacing = incScreenSpacing . negate
|
||||||
|
|
||||||
pureModifier _ _ _ [x] = ([x], Nothing)
|
-- | Change the border spacing by the provided amount, adjusted so that at
|
||||||
pureModifier (SmartSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
|
-- least one border field is @>=0@.
|
||||||
|
borderIncrementBy :: Integer -> Border -> Border
|
||||||
|
borderIncrementBy i (Border t b r l) =
|
||||||
|
let bl = [t,b,r,l]
|
||||||
|
o = maximum bl
|
||||||
|
o' = max i $ negate o
|
||||||
|
[t',b',r',l'] = map (+o') bl
|
||||||
|
in Border t' b' r' l'
|
||||||
|
|
||||||
pureMess (SmartSpacing px) m
|
-- | Interface to 'XMonad.Util.Rectangle.withBorder'.
|
||||||
| Just (ModifySpacing f) <- fromMessage m = Just $ SmartSpacing $ max 0 $ f px
|
withBorder' :: Border -> Integer -> Rectangle -> Rectangle
|
||||||
| otherwise = Nothing
|
withBorder' (Border t b r l) = R.withBorder t b r l
|
||||||
|
|
||||||
modifierDescription (SmartSpacing p) = "SmartSpacing " ++ show p
|
-- | Clamp borders to within @[0,Infinity]@.
|
||||||
|
borderClampGTZero :: Border -> Border
|
||||||
-- | Surrounds all windows with blank space, and adds the same amount of spacing
|
borderClampGTZero (Border t b r l) =
|
||||||
-- around the edge of the screen, except when the window is the only visible
|
let bl = [t,b,r,l]
|
||||||
-- window on the current workspace.
|
[t',b',r',l'] = map (max 0) bl
|
||||||
smartSpacingWithEdge :: Int -> l a -> ModifiedLayout SmartSpacingWithEdge l a
|
in Border t' b' r' l'
|
||||||
smartSpacingWithEdge p = ModifiedLayout (SmartSpacingWithEdge p)
|
|
||||||
|
|
||||||
data SmartSpacingWithEdge a = SmartSpacingWithEdge Int deriving (Show, Read)
|
|
||||||
|
|
||||||
instance LayoutModifier SmartSpacingWithEdge a where
|
|
||||||
|
|
||||||
pureModifier _ _ _ [x] = ([x], Nothing)
|
|
||||||
pureModifier (SmartSpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
|
|
||||||
|
|
||||||
modifyLayout (SmartSpacingWithEdge p) w r
|
|
||||||
| maybe False (\s -> null (up s) && null (down s)) (stack w) = runLayout w r
|
|
||||||
| otherwise = runLayout w (shrinkRect p r)
|
|
||||||
|
|
||||||
pureMess (SmartSpacingWithEdge px) m
|
|
||||||
| Just (ModifySpacing f) <- fromMessage m = Just $ SmartSpacingWithEdge $ max 0 $ f px
|
|
||||||
| otherwise = Nothing
|
|
||||||
|
|
||||||
modifierDescription (SmartSpacingWithEdge p) = "SmartSpacingWithEdge " ++ show p
|
|
||||||
|
Loading…
x
Reference in New Issue
Block a user