diff --git a/XMonad/Layout/BorderResize.hs b/XMonad/Layout/BorderResize.hs --- a/XMonad/Layout/BorderResize.hs +++ b/XMonad/Layout/BorderResize.hs @@ -20,7 +20,7 @@ import XMonad.Layout.Decoration import XMonad.Layout.WindowArranger import XMonad.Util.XUtils -import Control.Monad(when) +import Control.Monad(when,forM) data BorderInfo = RightSideBorder Window Rectangle | LeftSideBorder Window Rectangle @@ -52,12 +52,25 @@ instance LayoutModifier BorderResize Window where redoLayout _ _ Nothing wrs = return (wrs, Nothing) redoLayout (BR borders) _ _ wrs = - let preparedBorders = concat $ map prepareBorders wrs - visibleBorders = selectVisible [] preparedBorders + let preparedBorders = for wrs $ \wr -> (wr, prepareBorders wr) in do mapM_ deleteBorder borders - newBorders <- mapM createBorder visibleBorders - return (wrs, Just $ BR newBorders) + newBorders <- forM preparedBorders $ \(wr, (b1, b2, b3, b4)) -> do + (b1WR, b1BWW) <- createBorder b1 + (b2WR, b2BWW) <- createBorder b2 + (b3WR, b3BWW) <- createBorder b3 + (b4WR, b4BWW) <- createBorder b4 + return ([b1WR, b2WR, b3WR, b4WR, wr], + [b1BWW, b2BWW, b3BWW, b4BWW]) + let wrs' = concat $ map fst newBorders + newBordersSerialized = concat $ map snd newBorders + return (wrs', Just $ BR newBordersSerialized) + -- What we return is the original wrs with the new border + -- windows inserted at the correct positions - this way, the core + -- will restack the borders correctly. + -- We also return information about our borders, so that we + -- can handle events that they receive and destroy them when + -- they are no longer needed. handleMess (BR borders) m | Just e <- fromMessage m :: Maybe Event = handleResize borders e >> return Nothing @@ -66,59 +79,51 @@ where releaseResources = mapM_ deleteBorder borders handleMess _ _ = return Nothing -prepareBorders :: (Window, Rectangle) -> [BorderWithRect] +prepareBorders :: (Window, Rectangle) -> (BorderWithRect, BorderWithRect, BorderWithRect, BorderWithRect) prepareBorders (w, r@(Rectangle x y wh ht)) = - [(r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide , RightSideBorder w r), + ((r, (Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht) , brCursorRightSide , RightSideBorder w r), (r, (Rectangle (x - brBorderOffset) y brBorderSize ht) , brCursorLeftSide , LeftSideBorder w r), (r, (Rectangle x (y - brBorderOffset) wh brBorderSize) , brCursorTopSide , TopSideBorder w r), (r, (Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize) , brCursorBottomSide , BottomSideBorder w r) - ] - -selectVisible :: [Rectangle] -> [BorderWithRect] -> [BorderWithRect] -selectVisible _ [] = [] -selectVisible rs (border@(hostRect, borderRect, _, _) : borders) - | borderRect `isVisible` otherRs = border : selectVisible (hostRect : borderRect : rs) borders - | otherwise = selectVisible (hostRect : rs) borders - where - otherRs = filter (/= hostRect) rs + ) handleResize :: [BorderWithWin] -> Event -> X () handleResize borders ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress = do case (lookup ew borders) of Just (RightSideBorder hostWin (Rectangle hx hy _ hht)) -> do - focus hostWin mouseDrag (\x _ -> do let nwh = max 1 $ fi (x - hx) rect = Rectangle hx hy nwh hht - when (x - hx > 0) $ sendMessage (SetGeometry rect)) (return ()) + focus hostWin + when (x - hx > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) Just (LeftSideBorder hostWin (Rectangle hx hy hwh hht)) -> do - focus hostWin mouseDrag (\x _ -> do let nx = max 0 $ min (hx + fi hwh) $ x nwh = max 1 $ hwh + fi (hx - x) rect = Rectangle nx hy nwh hht - when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (return ()) + focus hostWin + when (x < hx + fi hwh) $ sendMessage (SetGeometry rect)) (focus hostWin) Just (TopSideBorder hostWin (Rectangle hx hy hwh hht)) -> do - focus hostWin mouseDrag (\_ y -> do let ny = max 0 $ min (hy + fi hht) $ y nht = max 1 $ hht + fi (hy - y) rect = Rectangle hx ny hwh nht - when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (return ()) + focus hostWin + when (y < hy + fi hht) $ sendMessage (SetGeometry rect)) (focus hostWin) Just (BottomSideBorder hostWin (Rectangle hx hy hwh _)) -> do - focus hostWin mouseDrag (\_ y -> do let nht = max 1 $ fi (y - hy) rect = Rectangle hx hy hwh nht - when (y - hy > 0) $ sendMessage (SetGeometry rect)) (return ()) + focus hostWin + when (y - hy > 0) $ sendMessage (SetGeometry rect)) (focus hostWin) Nothing -> return () handleResize _ _ = return () -createBorder :: BorderWithRect -> X (BorderWithWin) +createBorder :: BorderWithRect -> X (((Window, Rectangle), BorderWithWin)) createBorder (_, borderRect, borderCursor, borderInfo) = do borderWin <- createInputWindow borderCursor borderRect - return (borderWin, borderInfo) + return ((borderWin, borderRect), (borderWin, borderInfo)) deleteBorder :: BorderWithWin -> X () deleteBorder (borderWin, _) = deleteWindow borderWin @@ -143,3 +148,6 @@ \attributes -> do set_override_redirect attributes True createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes + +for :: [a] -> (a -> b) -> [b] +for = flip map diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -166,7 +166,8 @@ decorationWhileDraggingHook _ ex ey (mainw, r) x y = handleDraggingInProgress ex ey (mainw, r) x y decorationAfterDraggingHook :: ds a -> (Window, Rectangle) -> Window -> X () - decorationAfterDraggingHook ds (mainw, r) decoWin = handleScreenCrossing mainw decoWin + decorationAfterDraggingHook ds (mainw, r) decoWin = focus mainw + >> handleScreenCrossing mainw decoWin >>= decorationAfterDraggingHookAddon ds (mainw, r) decorationAfterDraggingHookAddon :: ds a -> (Window, Rectangle) -> Bool -> X () @@ -321,13 +322,13 @@ fi distFromRight <= minimizeButtonOffset + buttonSize) then MinimizeButton else Dragging - focus mainw case action of - WindowMenu -> windowMenu - CloseButton -> kill - MinimizeButton -> sendMessage (MinimizeWin mainw) - MaximizeButton -> sendMessage (maximizeRestore mainw) - Dragging -> mouseDrag (decorationWhileDraggingHook ds ex ey (mainw, r)) + WindowMenu -> focus mainw >> windowMenu + CloseButton -> focus mainw >> kill + MinimizeButton -> focus mainw >> sendMessage (MinimizeWin mainw) + MaximizeButton -> focus mainw >> sendMessage (maximizeRestore mainw) + Dragging -> mouseDrag (\x y -> focus mainw + >> decorationWhileDraggingHook ds ex ey (mainw, r) x y) (decorationAfterDraggingHook ds (mainw, r) ew) handleMouseFocusDrag _ _ _ = return () diff --git a/xmonad-contrib-bluetilebranch.cabal b/xmonad-contrib-bluetilebranch.cabal --- a/xmonad-contrib-bluetilebranch.cabal +++ b/xmonad-contrib-bluetilebranch.cabal @@ -1,5 +1,5 @@ name: xmonad-contrib-bluetilebranch -version: 0.8.1 +version: 0.8.1.2 homepage: http://xmonad.org/ synopsis: Third party extensions for xmonad description: This is a modified version of xmonad-contrib used by Bluetile.