New patches: [first shot at a floating layer Jason Creighton **20070531044733 This is a first attempting at a floating layer: mod-button1: move window mod-button2: swapMaster mod-button3: resize window mod-t: make floating window tiled again Moving or resizing a window automatically makes it floating. Known issues: Hard to manage stacking order. You can promote a window to move it to the top, (which you can do with mod-button2) but it should be easier than that. Moving a window by dragging it to a different Xinerama screen does not move it to that workspace. Code is ugly. ] { hunk ./Config.hs 117 + + , ((modMask, xK_t ), withFocused clearFloating) -- @@ Make floating window tiled hunk ./Config.hs-boot 3 +import Graphics.X11.Xlib (KeyMask) hunk ./Config.hs-boot 5 +modMask :: KeyMask hunk ./Main.hs 29 -import Operations (manage, unmanage, focus, setFocusX, full, isClient, rescreen) +import Operations (manage, unmanage, focus, setFocusX, full, isClient, rescreen, makeFloating, swapMaster) hunk ./Main.hs 114 +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 + hunk ./Main.hs 166 - whenJust (M.lookup (complement (numlockMask .|. lockMask) .&. m,s) keys) id + whenJust (M.lookup (cleanMask m,s) keys) id hunk ./Main.hs 184 -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 hunk ./Operations.hs 18 -import {-# SOURCE #-} Config (borderWidth) +import {-# SOURCE #-} Config (borderWidth, modMask) hunk ./Operations.hs 21 -import Data.List (genericIndex, intersectBy) +import Data.List (genericIndex, intersectBy, partition, delete) hunk ./Operations.hs 23 +import Data.Ratio hunk ./Operations.hs 42 -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 hunk ./Operations.hs 59 +-- +-- 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. hunk ./Operations.hs 64 -unmanage = windows . W.delete +unmanage w = windows $ W.clearFloating w . W.delete w hunk ./Operations.hs 157 + (float, tiled) = partition (flip M.member (W.floating ws)) (W.index this) hunk ./Operations.hs 165 - (sh - fromIntegral (gt + gb))) (W.index this) + (sh - fromIntegral (gt + gb))) tiled hunk ./Operations.hs 168 - -- 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') hunk ./Operations.hs 223 -buttonsToGrab :: [Button] -buttonsToGrab = [button1, button2, button3] - hunk ./Operations.hs 225 -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 hunk ./Operations.hs 262 - 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) hunk ./Operations.hs 385 +-- | 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 + hunk ./StackSet.hs 78 - StackSet(..), Workspace(..), Screen(..), Stack(..), + StackSet(..), Workspace(..), Screen(..), Stack(..), RationalRect(..), hunk ./StackSet.hs 81 - swapMaster, swapUp, swapDown, modify -- needed by users + swapMaster, swapUp, swapDown, modify, makeFloating, clearFloating -- needed by users hunk ./StackSet.hs 86 - +import qualified Data.Map as M (Map,insert,delete,empty) hunk ./StackSet.hs 115 - 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 hunk ./StackSet.hs 132 +data RationalRect = RationalRect Rational Rational Rational Rational + deriving (Show, Read, Eq) + hunk ./StackSet.hs 174 -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 hunk ./StackSet.hs 358 -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 hunk ./StackSet.hs 374 +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) } + hunk ./StackSet.hs 403 -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 } Context: [TAG 0.2 Spencer Janssen **20070531010004] Patch bundle hash: 6e64c8babb064ba1e51345afc69d2c7a623013bc