From 8c595555ce9d1f1d2bfce4bf0ff441d75b79b1c0 Mon Sep 17 00:00:00 2001 From: Andrea Rossato Date: Mon, 18 Feb 2008 11:57:26 +0100 Subject: Refactor MouseResize, remove isDecoration and introduce isInStack, isVisible, isInvisible This patch includes several changes, which are strictly related and cannot be recorded separately: - remove Decoraion.isDecoartion and introduce Decoration.isInStack (with the related change to LayoutHints) - in Decoration introduce useful utilities: isVisible, isInvisible, isWithin and lookFor' - MouseResize: - invisible inputOnly windows will not be created; - fix a bug in the read instance which caused a failure in the state deserialization. darcs-hash:20080218105726-32816-9d42d4fdff75fad3258aec92d059e5155f0e64bc.gz --- XMonad/Actions/MouseResize.hs | 57 ++++++++++++++++++++++++++----------------- XMonad/Layout/Decoration.hs | 27 +++++++++++++++++--- XMonad/Layout/LayoutHints.hs | 19 ++++++++------- 3 files changed, 69 insertions(+), 34 deletions(-) diff --git a/XMonad/Actions/MouseResize.hs b/XMonad/Actions/MouseResize.hs index 063ac0b..a0efb0d 100644 --- a/XMonad/Actions/MouseResize.hs +++ b/XMonad/Actions/MouseResize.hs @@ -24,6 +24,7 @@ module XMonad.Actions.MouseResize ) where import Control.Monad +import Data.Maybe import XMonad import XMonad.Layout.Decoration @@ -59,28 +60,35 @@ import XMonad.Util.XUtils mouseResize :: l a -> ModifiedLayout MouseResize l a mouseResize = ModifiedLayout (MR []) -data MouseResize a = MR [((a,Rectangle),a)] -instance Show (MouseResize a) where show _ = [] -instance Read (MouseResize a) where readsPrec _ _ = [] +data MouseResize a = MR [((a,Rectangle),Maybe a)] +instance Show (MouseResize a) where show _ = "" +instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)] instance LayoutModifier MouseResize Window where - redoLayout (MR st) _ _ wrs - | [] <- st = do nst <- filterM (liftM not . isDecoration . fst) wrs >>= initState - return (wrs, Just $ MR nst) - | otherwise = do nst <- filterM (liftM not . isDecoration . fst) wrs >>= processState - return (wrs, Just $ MR nst) + redoLayout (MR st) _ s wrs + | [] <- st = initState >>= \nst -> return (wrs, Just $ MR nst) + | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst) where - initState ws = mapM createInputWindow ws - processState ws = deleteWindows (map snd st) >> mapM createInputWindow ws + wrs' = wrs_to_state [] . filter (isInStack s . fst) $ wrs + initState = mapM createInputWindow wrs' + processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs' + + inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10 + + wrs_to_state rs ((w,r):xs) + | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs + | otherwise = ((w,r),Nothing) : wrs_to_state (r: rs) xs + where ir = inputRectangle r + wrs_to_state _ [] = [] handleMess (MR s) m | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing | Just Hide <- fromMessage m = releaseResources >> return (Just $ MR []) | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR []) - where releaseResources = deleteWindows (map snd s) + where releaseResources = mapM_ (deleteInputWin . snd) s handleMess _ _ = return Nothing -handleResize :: [((Window,Rectangle),Window)] -> Event -> X () +handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X () handleResize st ButtonEvent { ev_window = ew, ev_event_type = et } | et == buttonPress , Just (w,Rectangle wx wy _ _) <- getWin ew st = do @@ -92,20 +100,25 @@ handleResize st ButtonEvent { ev_window = ew, ev_event_type = et } sendMessage (SetGeometry rect)) (return ()) where - getWin w (((win,r),w'):xs) - | w == w' = Just (win,r) + getWin w (((win,r),tw):xs) + | Just w' <- tw + , w == w' = Just (win,r) | otherwise = getWin w xs getWin _ [] = Nothing handleResize _ _ = return () -createInputWindow :: (Window,Rectangle) -> X ((Window,Rectangle),Window) -createInputWindow (w,r@(Rectangle x y wh ht)) = do - d <- asks display - let rect = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10 - tw <- mkInputWindow d rect - io $ selectInput d tw (exposureMask .|. buttonPressMask) - showWindow tw - return ((w,r),tw) +createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window) +createInputWindow ((w,r),mr) = do + case mr of + Just tr -> withDisplay $ \d -> do + tw <- mkInputWindow d tr + io $ selectInput d tw (exposureMask .|. buttonPressMask) + showWindow tw + return ((w,r), Just tw) + Nothing -> return ((w,r), Nothing) + +deleteInputWin :: Maybe Window -> X () +deleteInputWin = maybe (return ()) deleteWindow mkInputWindow :: Display -> Rectangle -> X Window mkInputWindow d (Rectangle x y w h) = do diff --git a/XMonad/Layout/Decoration.hs b/XMonad/Layout/Decoration.hs index c5b78ae..e18a6d1 100644 --- a/XMonad/Layout/Decoration.hs +++ b/XMonad/Layout/Decoration.hs @@ -27,7 +27,8 @@ module XMonad.Layout.Decoration , shrinkText, CustomShrink ( CustomShrink ) , Shrinker (..), DefaultShrinker , module XMonad.Layout.LayoutModifier - , isDecoration, fi, lookFor + , isInStack, isVisible, isInvisible, isWithin + , lookFor, lookFor', fi ) where import Control.Monad (when) @@ -224,6 +225,11 @@ lookFor w ((wr,(dw,dr)):dwrs) | w == dw = Just (wr,(dw,dr)) | otherwise = lookFor w dwrs lookFor _ [] = Nothing +lookFor' :: Window -> [(OrigWin,DecoWin)] -> Maybe (OrigWin,DecoWin) +lookFor' w (((w',r),dwr):dwrs) | w == w' = Just ((w,r),dwr) + | otherwise = lookFor' w dwrs +lookFor' _ [] = Nothing + getDWs :: [(OrigWin,DecoWin)] -> [Window] getDWs = map (fst . snd) @@ -271,8 +277,23 @@ updateDeco sh t fs ((w,_),(dw,Just (Rectangle _ _ wh ht))) = do paintAndWrite dw fs wh ht 1 bc borderc tc bc AlignCenter name updateDeco _ _ _ (_,(w,Nothing)) = hideWindow w -isDecoration :: Window -> X Bool -isDecoration w = withDisplay (io . flip getWindowAttributes w) >>= return . wa_override_redirect +isInStack :: Eq a => W.Stack a -> a -> Bool +isInStack s = flip elem (W.integrate s) + +isVisible :: Rectangle -> [Rectangle] -> Bool +isVisible r = and . foldr f [] + where f x xs = if r `isWithin` x then False : xs else True : xs + +isInvisible :: Rectangle -> [Rectangle] -> Bool +isInvisible r = not . isVisible r + +isWithin :: Rectangle -> Rectangle -> Bool +isWithin (Rectangle x y w h) (Rectangle rx ry rw rh) + | x >= rx, x <= rx + fi rw + , y >= ry, y <= ry + fi rh + , x + fi w <= rx + fi rw + , y + fi h <= ry + fi rh = True + | otherwise = False shrinkWhile :: (String -> [String]) -> (String -> X Bool) -> String -> X String shrinkWhile sh p x = sw $ sh x diff --git a/XMonad/Layout/LayoutHints.hs b/XMonad/Layout/LayoutHints.hs index f8df071..6442934 100644 --- a/XMonad/Layout/LayoutHints.hs +++ b/XMonad/Layout/LayoutHints.hs @@ -13,15 +13,17 @@ -- Make layouts respect size hints. ----------------------------------------------------------------------------- -module XMonad.Layout.LayoutHints ( - -- * usage - -- $usage - layoutHints, - LayoutHints) where +module XMonad.Layout.LayoutHints + ( -- * usage + -- $usage + layoutHints + , LayoutHints + ) where import XMonad hiding ( trace ) import XMonad.Layout.LayoutModifier -import XMonad.Layout.Decoration ( isDecoration ) +import XMonad.Layout.Decoration ( isInStack ) + -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- @@ -49,14 +51,13 @@ data LayoutHints a = LayoutHints deriving (Read, Show) instance LayoutModifier LayoutHints Window where modifierDescription _ = "Hinted" - redoLayout _ _ _ xs = do + redoLayout _ _ s xs = do bW <- asks (borderWidth . config) xs' <- mapM (applyHint bW) xs return (xs', Nothing) where applyHint bW (w,r@(Rectangle a b c d)) = withDisplay $ \disp -> do - isd <- isDecoration w sh <- io $ getWMNormalHints disp w let (c',d') = adjBorders 1 bW . applySizeHints sh . adjBorders bW (-1) $ (c,d) - return (w, if isd then r else Rectangle a b c' d') + return (w, if isInStack s w then r else Rectangle a b c' d') -- cgit v1.2.3