Merge pull request #754 from Quoteme/master

made borderresize take a parameter
This commit is contained in:
Tony Zorman
2022-09-10 16:30:15 +02:00
committed by GitHub
2 changed files with 43 additions and 29 deletions

View File

@@ -5,6 +5,12 @@
### Breaking Changes ### Breaking Changes
### New Modules ### New Modules
### Bug Fixes and Minor Changes ### Bug Fixes and Minor Changes
* `XMonad.Layout.BorderResize`
- Added `borderResizeNear` as a variant of `borderResize` that can
control how many pixels near a border resizing still works.
### Other changes ### Other changes
## 0.17.1 (September 3, 2022) ## 0.17.1 (September 3, 2022)

View File

@@ -24,6 +24,7 @@ module XMonad.Layout.BorderResize
( -- * Usage ( -- * Usage
-- $usage -- $usage
borderResize borderResize
, borderResizeNear
, BorderResize (..) , BorderResize (..)
, RectWithBorders, BorderInfo, , RectWithBorders, BorderInfo,
) where ) where
@@ -58,27 +59,34 @@ data BorderInfo = BI { bWin :: Window,
type RectWithBorders = (Rectangle, [BorderInfo]) type RectWithBorders = (Rectangle, [BorderInfo])
newtype BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read) data BorderResize a = BR
{ brBorderSize :: !Dimension
brBorderSize :: Dimension -- ^ Still resize when this number of pixels around the border.
brBorderSize = 2 , brWrsLastTime :: !(M.Map Window RectWithBorders)
}
deriving (Show, Read)
borderResize :: l a -> ModifiedLayout BorderResize l a borderResize :: l a -> ModifiedLayout BorderResize l a
borderResize = ModifiedLayout (BR M.empty) borderResize = borderResizeNear 2
-- | Like 'borderResize', but takes the number of pixels near the border
-- up to which dragging still resizes a window.
borderResizeNear :: Dimension -> l a -> ModifiedLayout BorderResize l a
borderResizeNear borderSize = ModifiedLayout (BR borderSize M.empty)
instance LayoutModifier BorderResize Window where instance LayoutModifier BorderResize Window where
redoLayout _ _ Nothing wrs = return (wrs, Nothing) redoLayout _ _ Nothing wrs = return (wrs, Nothing)
redoLayout (BR wrsLastTime) _ _ wrs = do redoLayout (BR borderSize wrsLastTime) _ _ wrs = do
let correctOrder = map fst wrs let correctOrder = map fst wrs
wrsCurrent = M.fromList wrs wrsCurrent = M.fromList wrs
wrsGone = M.difference wrsLastTime wrsCurrent wrsGone = M.difference wrsLastTime wrsCurrent
wrsAppeared = M.difference wrsCurrent wrsLastTime wrsAppeared = M.difference wrsCurrent wrsLastTime
wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent wrsStillThere = M.intersectionWith testIfUnchanged wrsLastTime wrsCurrent
handleGone wrsGone handleGone wrsGone
wrsCreated <- handleAppeared wrsAppeared wrsCreated <- handleAppeared borderSize wrsAppeared
let wrsChanged = handleStillThere wrsStillThere let wrsChanged = handleStillThere borderSize wrsStillThere
wrsThisTime = M.union wrsChanged wrsCreated wrsThisTime = M.union wrsChanged wrsCreated
return (compileWrs wrsThisTime correctOrder, Just $ BR wrsThisTime) return (compileWrs wrsThisTime correctOrder, Just $ BR borderSize wrsThisTime)
-- What we return is the original wrs with the new border -- What we return is the original wrs with the new border
-- windows inserted at the correct positions - this way, the core -- windows inserted at the correct positions - this way, the core
-- will restack the borders correctly. -- will restack the borders correctly.
@@ -91,11 +99,11 @@ instance LayoutModifier BorderResize Window where
then (Nothing, entry) then (Nothing, entry)
else (Just rCurrent, entry) else (Just rCurrent, entry)
handleMess (BR wrsLastTime) m handleMess (BR borderSize wrsLastTime) m
| Just e <- fromMessage m :: Maybe Event = | Just e <- fromMessage m :: Maybe Event =
handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing handleResize (createBorderLookupTable wrsLastTime) e >> return Nothing
| Just _ <- fromMessage m :: Maybe LayoutMessages = | Just _ <- fromMessage m :: Maybe LayoutMessages =
handleGone wrsLastTime >> return (Just $ BR M.empty) handleGone wrsLastTime >> return (Just $ BR borderSize M.empty)
handleMess _ _ = return Nothing handleMess _ _ = return Nothing
compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)] compileWrs :: M.Map Window RectWithBorders -> [Window] -> [(Window, Rectangle)]
@@ -112,26 +120,26 @@ handleGone wrsGone = mapM_ deleteWindow borderWins
where where
borderWins = map bWin . concatMap snd . M.elems $ wrsGone borderWins = map bWin . concatMap snd . M.elems $ wrsGone
handleAppeared :: M.Map Window Rectangle -> X (M.Map Window RectWithBorders) handleAppeared :: Dimension -> M.Map Window Rectangle -> X (M.Map Window RectWithBorders)
handleAppeared wrsAppeared = do handleAppeared borderSize wrsAppeared = do
let wrs = M.toList wrsAppeared let wrs = M.toList wrsAppeared
wrsCreated <- mapM handleSingleAppeared wrs wrsCreated <- mapM (handleSingleAppeared borderSize) wrs
return $ M.fromList wrsCreated return $ M.fromList wrsCreated
handleSingleAppeared :: (Window, Rectangle) -> X (Window, RectWithBorders) handleSingleAppeared :: Dimension ->(Window, Rectangle) -> X (Window, RectWithBorders)
handleSingleAppeared (w, r) = do handleSingleAppeared borderSize (w, r) = do
let borderBlueprints = prepareBorders r let borderBlueprints = prepareBorders borderSize r
borderInfos <- mapM createBorder borderBlueprints borderInfos <- mapM createBorder borderBlueprints
return (w, (r, borderInfos)) return (w, (r, borderInfos))
handleStillThere :: M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders handleStillThere :: Dimension -> M.Map Window (Maybe Rectangle, RectWithBorders) -> M.Map Window RectWithBorders
handleStillThere = M.map handleSingleStillThere handleStillThere borderSize = M.map (handleSingleStillThere borderSize)
handleSingleStillThere :: (Maybe Rectangle, RectWithBorders) -> RectWithBorders handleSingleStillThere :: Dimension -> (Maybe Rectangle, RectWithBorders) -> RectWithBorders
handleSingleStillThere (Nothing, entry) = entry handleSingleStillThere _ (Nothing, entry) = entry
handleSingleStillThere (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos) handleSingleStillThere borderSize (Just rCurrent, (_, borderInfos)) = (rCurrent, updatedBorderInfos)
where where
changedBorderBlueprints = prepareBorders rCurrent changedBorderBlueprints = prepareBorders borderSize rCurrent
updatedBorderInfos = zipWith (curry updateBorderInfo) borderInfos changedBorderBlueprints updatedBorderInfos = zipWith (curry updateBorderInfo) borderInfos changedBorderBlueprints
-- assuming that the four borders are always in the same order -- assuming that the four borders are always in the same order
@@ -144,12 +152,12 @@ createBorderLookupTable wrsLastTime = concatMap processSingleEntry (M.toList wrs
processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))] processSingleEntry :: (Window, RectWithBorders) -> [(Window, (BorderType, Window, Rectangle))]
processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r)) processSingleEntry (w, (r, borderInfos)) = for borderInfos $ \bi -> (bWin bi, (bType bi, w, r))
prepareBorders :: Rectangle -> [BorderBlueprint] prepareBorders :: Dimension -> Rectangle -> [BorderBlueprint]
prepareBorders (Rectangle x y wh ht) = prepareBorders borderSize (Rectangle x y wh ht) =
[(Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht, xC_right_side , RightSideBorder), [(Rectangle (x + fi wh - fi borderSize) y borderSize ht, xC_right_side , RightSideBorder),
(Rectangle x y brBorderSize ht , xC_left_side , LeftSideBorder), (Rectangle x y borderSize ht , xC_left_side , LeftSideBorder),
(Rectangle x y wh brBorderSize , xC_top_side , TopSideBorder), (Rectangle x y wh borderSize , xC_top_side , TopSideBorder),
(Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize, xC_bottom_side, BottomSideBorder) (Rectangle x (y + fi ht - fi borderSize) wh borderSize, xC_bottom_side, BottomSideBorder)
] ]
handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X () handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X ()