diff options
| -rw-r--r-- | Config.hs | 2 | ||||
| -rw-r--r-- | Config.hs-boot | 2 | ||||
| -rw-r--r-- | Main.hs | 45 | ||||
| -rw-r--r-- | Operations.hs | 85 | ||||
| -rw-r--r-- | StackSet.hs | 30 |
5 files changed, 128 insertions, 36 deletions
@@ -115,6 +115,8 @@ 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 + -- 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 , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- @@ Deincrement the number of windows in the master area diff --git a/Config.hs-boot b/Config.hs-boot index 2d66ae1..681160a 100644 --- a/Config.hs-boot +++ b/Config.hs-boot @@ -1,3 +1,5 @@ module Config where import Graphics.X11.Xlib.Types (Dimension) +import Graphics.X11.Xlib (KeyMask) borderWidth :: Dimension +modMask :: KeyMask @@ -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) +import Operations (manage, unmanage, focus, setFocusX, full, isClient, rescreen, makeFloating, swapMaster) -- -- The main entry point @@ -111,6 +111,41 @@ grabKeys dpy rootw = do where grab kc m = grabKey dpy kc m rootw True grabModeAsync grabModeAsync +cleanMask :: KeyMask -> KeyMask +cleanMask = (complement (numlockMask .|. lockMask) .&.) + +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 + maskEvent d (buttonReleaseMask .|. pointerMotionMask) p + et <- get_EventType p + when (et == motionNotify) $ get_MotionEvent p >>= f >> again + + io $ ungrabPointer d currentTime + +mouseMoveWindow :: Window -> X () +mouseMoveWindow w = withDisplay $ \d -> do + io $ raiseWindow d w + 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 + +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)) + mouseDrag $ \(_, _, _, ex, ey, _, _, _, _, _) -> + resizeWindow d w (fromIntegral (max 1 (ex - fromIntegral (wa_x wa)))) (fromIntegral (max 1 (ey - fromIntegral (wa_y wa)))) + + makeFloating w + -- --------------------------------------------------------------------- -- | Event handler. Map X events onto calls into Operations.hs, which -- modify our internal model of the window manager state. @@ -128,7 +163,7 @@ handle :: Event -> X () handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) | t == keyPress = withDisplay $ \dpy -> do s <- io $ keycodeToKeysym dpy code 0 - whenJust (M.lookup (complement (numlockMask .|. lockMask) .&. m,s) keys) id + whenJust (M.lookup (cleanMask m,s) keys) id -- manage a new window handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do @@ -146,7 +181,11 @@ handle e@(MappingNotifyEvent {ev_window = w}) = do when (ev_request e == mappingKeyboard) $ withDisplay $ io . flip grabKeys w -- click on an unfocused window, makes it focused on this workspace -handle (ButtonEvent {ev_window = w, ev_event_type = t}) | t == buttonPress = focus w +handle (ButtonEvent {ev_window = w, ev_event_type = t, ev_state = m, ev_button = b }) + | t == buttonPress && cleanMask m == modMask && b == button1 = mouseMoveWindow w + | t == buttonPress && cleanMask m == modMask && b == button2 = focus w >> swapMaster + | t == buttonPress && cleanMask m == modMask && b == button3 = mouseResizeWindow w + | t == buttonPress = focus w -- entered a normal window, makes this focused. handle e@(CrossingEvent {ev_window = w, ev_event_type = t}) diff --git a/Operations.hs b/Operations.hs index 2d0eac5..ce6e01f 100644 --- a/Operations.hs +++ b/Operations.hs @@ -15,11 +15,12 @@ module Operations where import XMonad import qualified StackSet as W -import {-# SOURCE #-} Config (borderWidth) +import {-# SOURCE #-} Config (borderWidth, modMask) import Data.Maybe -import Data.List (genericIndex, intersectBy) +import Data.List (genericIndex, intersectBy, partition, delete) import Data.Bits ((.|.)) +import Data.Ratio import qualified Data.Map as M -- import System.Mem (performGC) @@ -38,17 +39,29 @@ import Graphics.X11.Xlib.Extras -- Bring it into focus. If the window is already managed, nothing happens. -- manage :: Window -> X () -manage w = do - withDisplay $ \d -> io $ do - selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask - mapWindow d w - setWindowBorderWidth d w borderWidth - windows $ W.insertUp w +manage w = withDisplay $ \d -> do + io $ selectInput d w $ structureNotifyMask .|. enterWindowMask .|. propertyChangeMask + io $ mapWindow d w + 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 + -- lose the default sizing. + isTransient <- isJust `liftM` (io $ getTransientForHint d w) + if isTransient + then do + modify $ \s -> s { windowset = W.insertUp w (windowset s) } + makeFloating w + else windows $ W.insertUp w -- | unmanage. A window no longer exists, remove it from the window -- list, on whatever workspace it is. +-- +-- FIXME: clearFloating should be taken care of in W.delete, but if we do it +-- there, floating status is lost when moving windows between workspaces, +-- because W.shift calls W.delete. unmanage :: Window -> X () -unmanage = windows . W.delete +unmanage w = windows $ W.clearFloating w . W.delete w -- | focus. focus window up or down. or swap various windows. focusUp, focusDown, swapUp, swapDown, swapMaster :: X () @@ -141,6 +154,7 @@ 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) (Rectangle sx sy sw sh) = genericIndex xinesc (W.screen w) (gt,gb,gl,gr) = genericIndex gaps (W.screen w) @@ -148,11 +162,19 @@ refresh = do rs <- doLayout l (Rectangle (sx + fromIntegral gl) (sy + fromIntegral gt) (sw - fromIntegral (gl + gr)) - (sh - fromIntegral (gt + gb))) (W.index this) + (sh - fromIntegral (gt + gb))) tiled mapM_ (\(win,rect) -> io (tileWindow d win rect)) rs - -- and raise the focused window if there is one. - whenJust (W.peek this) $ io . raiseWindow d + -- move/resize the floating windows + (`mapM_` float) $ \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))) + + -- 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) + + io $ restackWindows d (float ++ tiled') setTopFocus clearEnterEvents @@ -198,15 +220,13 @@ rescreen = do -- --------------------------------------------------------------------- -buttonsToGrab :: [Button] -buttonsToGrab = [button1, button2, button3] - -- | setButtonGrab. Tell whether or not to intercept clicks on a given window setButtonGrab :: Bool -> Window -> X () -setButtonGrab grab w = withDisplay $ \d -> io $ (`mapM_` buttonsToGrab) $ \b -> - if grab then grabButton d b anyModifier w False (buttonPressMask .|. buttonReleaseMask) - grabModeAsync grabModeSync none none - else ungrabButton d b anyModifier w +setButtonGrab grab w = withDisplay $ \d -> io $ do + when (not grab) $ ungrabButton d anyButton anyModifier w + grabButton d anyButton mask w False (buttonPressMask .|. buttonReleaseMask) + grabModeAsync grabModeSync none none + where mask = if grab then anyModifier else modMask -- --------------------------------------------------------------------- -- Setting keyboard focus @@ -239,10 +259,11 @@ setFocusX w = withWorkspace $ \ws -> do setButtonGrab True otherw io $ setWindowBorder dpy otherw (color_pixel nbc) - io $ do setInputFocus dpy w revertToPointerRoot 0 - -- raiseWindow dpy w - setButtonGrab False w - io $ setWindowBorder dpy w (color_pixel fbc) + whenX (not `liftM` isRoot w) $ do + io $ do setInputFocus dpy w revertToPointerRoot 0 + -- raiseWindow dpy w + setButtonGrab False w + io $ setWindowBorder dpy w (color_pixel fbc) -- --------------------------------------------------------------------- -- Managing layout @@ -360,3 +381,21 @@ withFocused f = withWorkspace $ \w -> whenJust (W.peek w) f -- | True if window is under management by us isClient :: Window -> X Bool isClient w = withWorkspace $ return . W.member w + +-- | Make a floating window tiled +clearFloating :: Window -> X () +clearFloating = windows . W.clearFloating + +-- | Make a tiled window floating +makeFloating :: Window -> X () +makeFloating 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 diff --git a/StackSet.hs b/StackSet.hs index cae577c..810fa60 100644 --- a/StackSet.hs +++ b/StackSet.hs @@ -75,15 +75,15 @@ -- 'delete'. -- module StackSet ( - StackSet(..), Workspace(..), Screen(..), Stack(..), + StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..), new, view, lookupWorkspace, peek, index, focusUp, focusDown, focusWindow, member, findIndex, insertUp, delete, shift, - swapMaster, swapUp, swapDown, modify -- needed by users + swapMaster, swapUp, swapDown, modify, makeFloating, clearFloating -- needed by users ) where import Data.Maybe (listToMaybe) import qualified Data.List as L (delete,find,genericSplitAt) - +import qualified Data.Map as M (Map,insert,delete,empty) -- API changes from xmonad 0.1: -- StackSet constructor arguments changed. StackSet workspace window screen @@ -112,10 +112,11 @@ import qualified Data.List as L (delete,find,genericSplitAt) -- Xinerama screens, and those workspaces not visible anywhere. -- data StackSet i a sid = - StackSet { size :: !i -- number of workspaces - , current :: !(Screen i a sid) -- currently focused workspace - , visible :: [Screen i a sid] -- non-focused workspaces, visible in xinerama - , hidden :: [Workspace i a] -- workspaces not visible anywhere + StackSet { size :: !i -- number of workspaces + , current :: !(Screen i a sid) -- currently focused workspace + , visible :: [Screen i a sid] -- non-focused workspaces, visible in xinerama + , hidden :: [Workspace i a] -- workspaces not visible anywhere + , floating :: M.Map a RationalRect -- floating windows } deriving (Show, Read, Eq) -- Visible workspaces, and their Xinerama screens. @@ -128,6 +129,9 @@ data Screen i a sid = Screen { workspace :: !(Workspace i a), screen :: !sid } data Workspace i a = Workspace { tag :: !i, stack :: Stack a } deriving (Show, Read, Eq) +data RationalRect = RationalRect Rational Rational Rational Rational + deriving (Show, Read, Eq) + -- -- A stack is a cursor onto a (possibly empty) window list. -- The data structure tracks focus by construction, and @@ -167,7 +171,7 @@ abort x = error $ "xmonad: StackSet: " ++ x -- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0. -- new :: (Integral i, Integral s) => i -> s -> StackSet i a s -new n m | n > 0 && m > 0 = StackSet n cur visi unseen +new n m | n > 0 && m > 0 = StackSet n cur visi unseen M.empty | otherwise = abort "non-positive arguments to StackSet.new" where (seen,unseen) = L.genericSplitAt m $ Workspace 0 Empty : [ Workspace i Empty | i <- [1 ..n-1]] @@ -351,7 +355,7 @@ insertUp a s = if member a s then s else insert -- * deleting the master window resets it to the newly focused window -- * otherwise, delete doesn't affect the master. -- -delete :: (Integral i, Eq a, Eq s) => a -> StackSet i a s -> StackSet i a s +delete :: (Integral i, Ord a, Eq s) => a -> StackSet i a s -> StackSet i a s delete w s | Just w == peek s = remove s -- common case. | otherwise = maybe s (removeWindow.tag.workspace.current $ s) (findIndex w s) where @@ -367,6 +371,12 @@ 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) } + +clearFloating :: Ord a => a -> StackSet i a s -> StackSet i a s +clearFloating w s = s { floating = M.delete w (floating s) } + ------------------------------------------------------------------------ -- Setting the master window @@ -390,7 +400,7 @@ swapMaster = modify Empty $ \c -> case c of -- The actual focused workspace doesn't change. If there is -- no -- element on the current stack, the original stackSet is returned. -- -shift :: (Eq a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s +shift :: (Ord a, Eq s, Integral i) => i -> StackSet i a s -> StackSet i a s shift n s = if and [n >= 0,n < size s,n /= tag (workspace (current s))] then maybe s go (peek s) else s where go w = foldr ($) s [view (tag (workspace (current s))),insertUp w,view n,delete w] |