clean up mouse code a bit

darcs-hash:20070531085308-9c5c1-73ed940708aa9a369b0345c0d2b2a4708a231e67

4 files changed, 72 insertions, 46 deletions

diff --git a/Config.hs b/Config.hs
index 57750e0..25d56ee 100644
--- a/Config.hs
+++ b/Config.hs
@@ -74,7 +74,7 @@ numlockMask = mod2Mask
 -- Border colors for unfocused and focused windows, respectively.
 normalBorderColor, focusedBorderColor :: String
 normalBorderColor  = "#dddddd"
-focusedBorderColor = "#ff0000"
+focusedBorderColor = "#5fbf77"
 
 -- Width of the window border in pixels
 borderWidth :: Dimension
@@ -115,7 +115,7 @@ keys = M.fromList $
     , ((modMask,               xK_h     ), sendMessage Shrink) -- @@ Shrink the master area
     , ((modMask,               xK_l     ), sendMessage Expand) -- @@ Expand the master area
 
-    , ((modMask,               xK_t     ), withFocused clearFloating) -- @@ Make floating window tiled
+    , ((modMask,               xK_t     ), withFocused sink) -- @@ Push window back into tiling
 
     -- increase or decrease number of windows in the master area
     , ((modMask              , xK_comma ), sendMessage (IncMasterN 1)) -- @@ Increment the number of windows in the master area
@@ -125,7 +125,7 @@ keys = M.fromList $
     , ((modMask              , xK_b     ), modifyGap (\i n -> let x = (defaultGaps ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- @@ Toggle the status bar gap
 
     -- quit, or restart
-    , ((modMask .|. shiftMask, xK_q                     ), io (exitWith ExitSuccess)) -- @@ Quit xmonad
+    , ((modMask .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- @@ Quit xmonad
     , ((modMask              , xK_q     ), restart Nothing True) -- @@ Restart xmonad
 
     ] ++
diff --git a/Main.hs b/Main.hs
index b0a75e9..95b2aa3 100644
--- a/Main.hs
+++ b/Main.hs
@@ -26,7 +26,7 @@ import Graphics.X11.Xinerama    (getScreenInfo)
 import XMonad
 import Config
 import StackSet (new)
-import Operations   (manage, unmanage, focus, setFocusX, full, isClient, rescreen, makeFloating, swapMaster)
+import Operations
 
 --
 -- The main entry point
@@ -114,16 +114,19 @@ grabKeys dpy rootw = do
 cleanMask :: KeyMask -> KeyMask
 cleanMask = (complement (numlockMask .|. lockMask) .&.)
 
+------------------------------------------------------------------------
+-- mouse handling
+
+-- | Accumulate mouse motion events
 mouseDrag :: (XMotionEvent -> IO ()) -> X ()
 mouseDrag f = do
     XConf { theRoot = root, display = d } <- ask
-    io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask) grabModeAsync grabModeAsync none none currentTime
-
-    io $ allocaXEvent $ \p -> fix $ \again -> do
+    io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
+            grabModeAsync grabModeAsync none none currentTime
+    io $ allocaXEvent $ \p -> fix $ \again -> do -- event loop
         maskEvent d (buttonReleaseMask .|. pointerMotionMask) p
         et <- get_EventType p
         when (et == motionNotify) $ get_MotionEvent p >>= f >> again
-
     io $ ungrabPointer d currentTime
 
 mouseMoveWindow :: Window -> X ()
@@ -132,19 +135,20 @@ mouseMoveWindow w = withDisplay $ \d -> do
     wa <- io $ getWindowAttributes d w
     (_, _, _, ox, oy, _, _, _) <- io $ queryPointer d w
     mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) ->
-        moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
-
-    makeFloating w
+        moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
+                       (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
+    float w
 
 mouseResizeWindow :: Window -> X ()
 mouseResizeWindow w = withDisplay $ \d -> do
     io $ raiseWindow d w
     wa <- io $ getWindowAttributes d w
-    io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
+    io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa))
+                                      (fromIntegral (wa_height wa))
     mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) ->
-        resizeWindow d w (fromIntegral (max 1 (ex - fromIntegral (wa_x wa)))) (fromIntegral (max 1 (ey - fromIntegral (wa_y wa))))
-
-    makeFloating w
+        resizeWindow d w (fromIntegral (max 1 (ex - fromIntegral (wa_x wa))))
+                         (fromIntegral (max 1 (ey - fromIntegral (wa_y wa))))
+    float w
 
 -- ---------------------------------------------------------------------
 -- | Event handler. Map X events onto calls into Operations.hs, which
diff --git a/Operations.hs b/Operations.hs
index ce6e01f..9bdd962 100644
--- a/Operations.hs
+++ b/Operations.hs
@@ -45,13 +45,13 @@ manage w = withDisplay $ \d -> do
     io $ setWindowBorderWidth d w borderWidth
 
     -- FIXME: This is pretty awkward. We can't can't let "refresh" happen
-    -- before the call to makeFloating, because that will resize the window and
+    -- before the call to float, because that will resize the window and
     -- lose the default sizing.
-    isTransient <- isJust `liftM` (io $ getTransientForHint d w)
+
+    isTransient <- isJust `liftM` io (getTransientForHint d w)
     if isTransient
-        then do
-            modify $ \s -> s { windowset = W.insertUp w (windowset s) }
-            makeFloating w
+        then do modify $ \s -> s { windowset = W.insertUp w (windowset s) }
+                float w -- ^^ now go the refresh.
         else windows $ W.insertUp w
 
 -- | unmanage. A window no longer exists, remove it from the window
@@ -61,7 +61,7 @@ manage w = withDisplay $ \d -> do
 -- there, floating status is lost when moving windows between workspaces,
 -- because W.shift calls W.delete.
 unmanage :: Window -> X ()
-unmanage w = windows $ W.clearFloating w . W.delete w
+unmanage w = windows $ W.sink w . W.delete w
 
 -- | focus. focus window up or down. or swap various windows.
 focusUp, focusDown, swapUp, swapDown, swapMaster :: X ()
@@ -154,10 +154,11 @@ refresh = do
         let n      = W.tag (W.workspace w)
             this   = W.view n ws
             Just l = fmap fst $ M.lookup n fls
-            (float, tiled) = partition (flip M.member (W.floating ws)) (W.index this)
+            (flt, tiled) = partition (flip M.member (W.floating ws)) (W.index this)
             (Rectangle sx sy sw sh) = genericIndex xinesc (W.screen w)
             (gt,gb,gl,gr)           = genericIndex gaps   (W.screen w)
 
+        -- just the tiled windows:
         -- now tile the windows on this workspace, modified by the gap
         rs <- doLayout l (Rectangle (sx + fromIntegral gl)
                                     (sy + fromIntegral gt)
@@ -165,16 +166,24 @@ refresh = do
                                     (sh - fromIntegral (gt + gb))) tiled
         mapM_ (\(win,rect) -> io (tileWindow d win rect)) rs
 
-        -- move/resize the floating windows
-        (`mapM_` float) $ \fw -> whenJust (M.lookup fw (W.floating ws)) $ \(W.RationalRect rx ry rw rh) -> do
+        -- now the floating windows:
+        -- move/resize the floating windows, if there are any
+        (`mapM_` flt) $ \fw -> whenJust (M.lookup fw (W.floating ws)) $
+          \(W.RationalRect rx ry rw rh) -> do
             let Rectangle px py pw ph = genericIndex xinesc (W.screen w)
-            io $ tileWindow d fw (Rectangle (px + floor (toRational pw*rx)) (py + floor (toRational ph*ry)) (floor (toRational pw*rw)) (floor (toRational ph*rh)))
+            io $ tileWindow d fw (Rectangle (px + floor (toRational pw*rx))
+                                            (py + floor (toRational ph*ry))
+                                            (floor (toRational pw*rw))
+                                            (floor (toRational ph*rh)))
 
-        -- urgh. This is required because the fullscreen layout assumes that
-        -- the focused window will be raised.
-        let tiled' = maybe tiled (\x -> if x `elem` tiled then x : delete x tiled else tiled) (W.peek this)
+        -- TODO seems fishy?
+        -- Urgh. This is required because the fullscreen layout assumes that
+        -- the focused window will be raised. Hmm. This is a reordering.
+        let tiled' = case W.peek this of
+                        Just x | x `elem` tiled -> x : delete x tiled
+                        _ -> tiled
 
-        io $ restackWindows d (float ++ tiled')
+        io $ restackWindows d (flt ++ tiled')
 
     setTopFocus
     clearEnterEvents
@@ -382,20 +391,30 @@ withFocused f = withWorkspace $ \w -> whenJust (W.peek w) f
 isClient :: Window -> X Bool
 isClient w = withWorkspace $ return . W.member w
 
+------------------------------------------------------------------------
+-- | Floating layer support
+
 -- | Make a floating window tiled
-clearFloating :: Window -> X ()
-clearFloating = windows . W.clearFloating
+sink :: Window -> X ()
+sink = windows . W.sink
 
--- | Make a tiled window floating
-makeFloating :: Window -> X ()
-makeFloating w = withDisplay $ \d -> do
+-- | Make a tiled window floating, using its suggested rectangle
+float :: Window -> X ()
+float w = withDisplay $ \d -> do
     xinesc <- gets xineScreens
     sc     <- (genericIndex xinesc . W.screen . W.current) `liftM` gets windowset
     wa     <- io $ getWindowAttributes d w
-    let bw = fI . wa_border_width $ wa
-    windows $ W.makeFloating w
-        (W.RationalRect ((fI (wa_x wa) - fI (rect_x sc)) % fI (rect_width sc))
-                        ((fI (wa_y wa) - fI (rect_y sc)) % fI (rect_height sc))
-                        (fI (wa_width  wa + bw*2) % fI (rect_width sc))
-                        (fI (wa_height wa + bw*2) % fI (rect_height sc)))
-  where fI x = fromIntegral x
+    let bw = fi . wa_border_width $ wa
+    windows $ W.float w
+        (W.RationalRect ((fi (wa_x wa) - fi (rect_x sc)) % fi (rect_width sc))
+                        ((fi (wa_y wa) - fi (rect_y sc)) % fi (rect_height sc))
+                        (fi (wa_width  wa + bw*2) % fi (rect_width sc))
+                        (fi (wa_height wa + bw*2) % fi (rect_height sc)))
+  where fi x = fromIntegral x
+
+-- | Toggle floating bit
+--
+-- TODO not useful unless we remember the original size
+--
+-- toggleFloating :: Window -> X ()
+-- toggleFloating w = gets windowset >>= \ws -> if M.member w (W.floating ws) then sink w else float w
diff --git a/StackSet.hs b/StackSet.hs
index 810fa60..7374da3 100644
--- a/StackSet.hs
+++ b/StackSet.hs
@@ -78,7 +78,7 @@ module StackSet (
         StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..),
         new, view, lookupWorkspace, peek, index, focusUp, focusDown,
         focusWindow, member, findIndex, insertUp, delete, shift,
-        swapMaster, swapUp, swapDown, modify, makeFloating, clearFloating -- needed by users
+        swapMaster, swapUp, swapDown, modify, float, sink -- needed by users
     ) where
 
 import Data.Maybe   (listToMaybe)
@@ -371,11 +371,14 @@ delete w s | Just w == peek s = remove s -- common case.
         Node _ []     []     -> Empty
       else c { up = w `L.delete` up c, down = w `L.delete` down c }
 
-makeFloating :: Ord a => a -> RationalRect -> StackSet i a s -> StackSet i a s
-makeFloating w r s = s { floating = M.insert w r (floating s) }
+-- | Given a window, and its preferred rectangle, set it as floating
+-- A floating window should already be managed by the StackSet.
+float :: Ord a => a -> RationalRect -> StackSet i a s -> StackSet i a s
+float w r s = s { floating = M.insert w r (floating s) }
 
-clearFloating :: Ord a => a -> StackSet i a s -> StackSet i a s
-clearFloating w s = s { floating = M.delete w (floating s) }
+-- | Clear the floating status of a window
+sink :: Ord a => a -> StackSet i a s -> StackSet i a s
+sink w s = s { floating = M.delete w (floating s) }
 
 ------------------------------------------------------------------------
 -- Setting the master window