diff --git a/CHANGES.md b/CHANGES.md index 027deec2..c5d33eb2 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -87,6 +87,11 @@ This module implements modal keybindings for xmonad. + * `XMonad.Layout.SideBorderDecoration` + + This module allows for having a configurable border position around + windows; i.e., it can move the border to either cardinal direction. + ### Bug Fixes and Minor Changes * `XMonad.Prompt.OrgMode` diff --git a/XMonad/Layout/SideBorderDecoration.hs b/XMonad/Layout/SideBorderDecoration.hs new file mode 100644 index 00000000..e423a4f1 --- /dev/null +++ b/XMonad/Layout/SideBorderDecoration.hs @@ -0,0 +1,193 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE NamedFieldPuns #-} +-------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.SideBorderDecoration +-- Description : Configure the border position around windows. +-- Copyright : (c) 2018 L. S. Leary +-- 2022 Tony Zorman +-- License : BSD3 +-- Maintainer : Tony Zorman +-- +-- This module allows for having a configurable border position around +-- windows; i.e., it can move the border to any cardinal direction. +-- +-------------------------------------------------------------------- +module XMonad.Layout.SideBorderDecoration ( + -- * Usage + -- $usage + sideBorder, + + -- * Border configuration + SideBorderConfig (..), + def, + + -- * Re-exports + Direction2D (..), + + -- * Lower-level hooks + sideBorderLayout, +) where + +import qualified XMonad.StackSet as W + +import XMonad +import XMonad.Layout.Decoration +import XMonad.StackSet (Stack) +import XMonad.Util.Types + +{- $usage + +To use this module, first import it into your configuration file: + +> import XMonad.Layout.SideBorderDecoration + +You can now add the 'sideBorder' combinator to your configuration: + +> main :: IO () +> main = xmonad +> $ … +> $ sideBorder mySideBorderConfig +> $ def { … } +> where +> mySideBorderConfig :: SideBorderConfig +> mySideBorderConfig = def +> { sbSide = D +> , sbActiveColor = "#ff0000" +> , sbInactiveColor = "#ffaaaa" +> , sbSize = 5 +> } + +or, alternatively, + +> main :: IO () +> main = xmonad +> $ … +> $ sideBorder def{ sbSide = D, sbActiveColor = "#ff000", … } +> $ def { … } + +See 'SideBorderConfig' for the different size and colour options. + +The following is a fully-functional, minimal configuration example: + +> import XMonad +> import XMonad.Layout.SideBorderDecoration +> +> main :: IO () +> main = xmonad $ sideBorder def $ def + +This would result in the following border being displayed: + +<> + +-} + +----------------------------------------------------------------------- +-- Configuration + +-- | Configuring how the border looks like. +data SideBorderConfig = SideBorderConfig + { sbSide :: !Direction2D -- ^ Which side to have the border on. + , sbActiveColor :: !String -- ^ Active border colour. + , sbInactiveColor :: !String -- ^ Inactive border colour. + , sbSize :: !Dimension + -- ^ Size of the border. This will be the height if 'sbSide' is 'U' + -- or 'D' and the width if it is 'L' or 'R'. + } + +instance Default SideBorderConfig where + def :: SideBorderConfig + def = SideBorderConfig + { sbSide = D + , sbActiveColor = "#ff0000" + , sbInactiveColor = "#ffaaaa" + , sbSize = 5 + } + +----------------------------------------------------------------------- +-- User-facing + +-- | Move the default XMonad border to any of the four cardinal +-- directions. +-- +-- Note that this function should only be applied once to your +-- configuration and should /not/ be combined with 'sideBorderLayout'. +sideBorder :: SideBorderConfig -> XConfig l -> XConfig (SideBorder l) +sideBorder sbc cfg = + cfg{ layoutHook = sideBorderLayout sbc (layoutHook cfg) + , borderWidth = 0 + } + +-- | Layout hook to only enable the side border for some layouts. For +-- example: +-- +-- > myLayout = Full ||| sideBorderLayout def tall ||| somethingElse +-- +-- Note that, unlike 'sideBorder', this does /not/ disable the normal +-- border in XMonad, you will have to do this yourself. Remove this +-- function from your layout hook and use 'sideBorder' if you want a +-- side border in every layout (do not use the two functions together). +sideBorderLayout :: Eq a => SideBorderConfig -> l a -> SideBorder l a +sideBorderLayout SideBorderConfig{ sbSide, sbActiveColor, sbInactiveColor, sbSize } = + decoration BorderShrinker theme (SideBorderDecoration sbSide) + where + theme :: Theme + theme = deco + { activeColor = sbActiveColor + , inactiveColor = sbInactiveColor + } + where + deco | sbSide `elem` [U, D] = def{ decoHeight = sbSize } + | otherwise = def{ decoWidth = sbSize } + +----------------------------------------------------------------------- +-- Decoration + +newtype SideBorderDecoration a = SideBorderDecoration Direction2D + deriving (Show, Read) + +type SideBorder = ModifiedLayout (Decoration SideBorderDecoration BorderShrinker) + +instance Eq a => DecorationStyle SideBorderDecoration a where + shrink :: SideBorderDecoration a -> Rectangle -> Rectangle -> Rectangle + shrink dec (Rectangle _ _ dw dh) (Rectangle x y w h) = case dec of + SideBorderDecoration U -> Rectangle x (y + fi dh) w (h - dh) + SideBorderDecoration R -> Rectangle x y (w - dw) h + SideBorderDecoration D -> Rectangle x y w (h - dh) + SideBorderDecoration L -> Rectangle (x + fi dw) y (w - dw) h + + pureDecoration + :: SideBorderDecoration a + -> Dimension -> Dimension + -> Rectangle + -> Stack a + -> [(a, Rectangle)] + -> (a, Rectangle) + -> Maybe Rectangle + pureDecoration dec dw dh _ st _ (win, Rectangle x y w h) + | win `elem` W.integrate st && dw < w && dh < h = Just $ case dec of + SideBorderDecoration U -> Rectangle x y w dh + SideBorderDecoration R -> Rectangle (x + fi (w - dw)) y dw h + SideBorderDecoration D -> Rectangle x (y + fi (h - dh)) w dh + SideBorderDecoration L -> Rectangle x y dw h + | otherwise = Nothing + +----------------------------------------------------------------------- +-- Shrinker + +-- | Kill all text. +data BorderShrinker = BorderShrinker + +instance Show BorderShrinker where + show :: BorderShrinker -> String + show _ = "" + +instance Read BorderShrinker where + readsPrec :: Int -> ReadS BorderShrinker + readsPrec _ s = [(BorderShrinker, s)] + +instance Shrinker BorderShrinker where + shrinkIt :: BorderShrinker -> String -> [String] + shrinkIt _ _ = [""] diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index fa0e3ac7..d87d2be2 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -296,6 +296,7 @@ library XMonad.Layout.ResizeScreen XMonad.Layout.Roledex XMonad.Layout.ShowWName + XMonad.Layout.SideBorderDecoration XMonad.Layout.SimpleDecoration XMonad.Layout.SimpleFloat XMonad.Layout.Simplest