diff options
| -rw-r--r-- | Config.hs | 6 | ||||
| -rw-r--r-- | Main.hs | 28 | ||||
| -rw-r--r-- | Operations.hs | 71 | ||||
| -rw-r--r-- | StackSet.hs | 13 |
4 files changed, 72 insertions, 46 deletions
@@ -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 ] ++ @@ -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 |