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

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')