twin/xmonad
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad.git synced 2025-05-19 08:30:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

clean up mouse code a bit

Browse Source
This commit is contained in:
Don Stewart 2007-05-31 08:53:08 +00:00
parent 3cb64d7461
commit 777cf28bdf
4 changed files with 73 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
Config.hs
View File

@ -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

28
Main.hs
View File

@ -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

73
Operations.hs
View File

@ -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
-- | Make a floating window tiled
clearFloating :: Window -> X ()
clearFloating = windows . W.clearFloating
------------------------------------------------------------------------
-- | Floating layer support
-- | Make a tiled window floating
makeFloating :: Window -> X ()
makeFloating w = withDisplay $ \d -> do
-- | Make a floating window tiled
sink :: Window -> X ()
sink = windows . W.sink
-- | 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

13
StackSet.hs
View File

@ -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