diff options
| -rw-r--r-- | XMonad/Core.hs | 5 | ||||
| -rw-r--r-- | XMonad/Main.hsc | 36 | ||||
| -rw-r--r-- | XMonad/Operations.hs | 27 |
3 files changed, 58 insertions, 10 deletions
diff --git a/XMonad/Core.hs b/XMonad/Core.hs index 0ebb3fa..4171060 100644 --- a/XMonad/Core.hs +++ b/XMonad/Core.hs @@ -61,7 +61,8 @@ import qualified Data.Map as M data WindowState = WindowState { wsMapped :: !Bool , wsWaitingUnmap :: !Int -- ^ the number of expected UnmapEvents - } deriving (Eq) + , wsFrame :: !Window + } deriving (Show, Eq) -- | XState, the (mutable) window manager state. @@ -218,7 +219,7 @@ getAtom :: String -> X Atom getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False emptyWindowState :: WindowState -emptyWindowState = WindowState False 0 +emptyWindowState = WindowState False 0 0 getWindowState :: Window -> X WindowState getWindowState w = gets $ M.findWithDefault emptyWindowState w . windowState diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc index 19f988f..b5a2bf2 100644 --- a/XMonad/Main.hsc +++ b/XMonad/Main.hsc @@ -32,6 +32,7 @@ import System.Environment (getArgs) import Graphics.X11.Xlib hiding (refreshKeyboardMapping) import Graphics.X11.Xlib.Extras +import Graphics.X11.Xlib.Types (Visual(..)) import XMonad.Core import qualified XMonad.Config as Default @@ -197,12 +198,16 @@ handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do wa <- io $ getWindowAttributes dpy w -- ignore override windows -- need to ignore mapping requests by managed windows not on the current workspace managed <- isClient w - when (not (wa_override_redirect wa) && not managed) $ do manage w + when (not (wa_override_redirect wa) && not managed) $ do + reparent w + manage w -- window destroyed, unmanage it -- window gone, unmanage it -handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ do - unmanage w +handle (DestroyWindowEvent {ev_window = w}) = do + whenX (isClient w) $ + unmanage w + unparent w modify (\s -> s { windowState = M.delete w (windowState s)}) -- We track expected unmap events in waitingUnmap. We ignore this event unless @@ -304,6 +309,31 @@ handle e@ClientMessageEvent { ev_message_type = mt } = do handle e = broadcastMessage e -- trace (eventName e) -- ignoring +reparent :: Window -> X () +reparent w = withDisplay $ \dpy -> do + rootw <- asks theRoot + p <- asks normalBorder + noFrame <- getsWindowState ((==0) . wsFrame) w + when noFrame $ do + trace $ "reparent: " ++ show w + frame <- io $ allocaSetWindowAttributes $ \swa -> do + set_background_pixel swa p + set_border_pixel swa p + set_override_redirect swa True + createWindow dpy rootw (-1) (-1) 1 1 0 copyFromParent inputOutput (Visual nullPtr) (cWBackPixel.|.cWBorderPixel.|.cWOverrideRedirect) swa + io $ do + mapWindow dpy frame + reparentWindow dpy w frame 0 0 + modifyWindowState (\ws -> ws { wsFrame = frame }) w + +unparent :: Window -> X () +unparent w = withDisplay $ \dpy -> do + trace $ "unparent: " ++ show w + frame <- getsWindowState wsFrame w + when (frame /= 0) $ do + io $ destroyWindow dpy frame + modifyWindowState (\ws -> ws { wsFrame = 0 }) w + -- --------------------------------------------------------------------- -- IO stuff. Doesn't require any X state -- Most of these things run only on startup (bar grabkeys) diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs index 6bb2dae..a88ce06 100644 --- a/XMonad/Operations.hs +++ b/XMonad/Operations.hs @@ -159,8 +159,11 @@ setWMState w v = withDisplay $ \dpy -> do hide :: Window -> X () hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do cMask <- asks $ clientMask . config + frame <- getsWindowState wsFrame w io $ do selectInput d w (cMask .&. complement structureNotifyMask) - unmapWindow d w + selectInput d frame (cMask .&. complement structureNotifyMask) + unmapWindow d frame + selectInput d frame cMask selectInput d w cMask setWMState w iconicState -- this part is key: we increment the waitingUnmap counter to distinguish @@ -174,7 +177,21 @@ reveal :: Window -> X () reveal w = withDisplay $ \d -> do setWMState w normalState io $ mapWindow d w - whenX (isClient w) $ modifyWindowState (\ws -> ws { wsMapped = True }) w + whenX (isClient w) $ do + frame <- getsWindowState wsFrame w + io $ do + mapWindow d frame + (_, x, y, width, height, _, _) <- getGeometry d frame + moveResizeWindow d w 0 0 width height + -- send absolute ConfigureNotify + allocaXEvent $ \event -> do + setEventType event configureNotify + setConfigureEvent event w w (fi x) (fi y) (fi width) (fi height) 0 0 False + sendEvent d w False structureNotifyMask event + modifyWindowState (\ws -> ws { wsMapped = True }) w + where + fi :: (Integral a, Num b) => a -> b + fi = fromIntegral -- | Set some properties when we initially gain control of a window setInitialProperties :: Window -> X () @@ -204,12 +221,12 @@ clearEvents mask = withDisplay $ \d -> io $ do -- rectangle, including its border. tileWindow :: Window -> Rectangle -> X () tileWindow w r = withDisplay $ \d -> do - bw <- (fromIntegral . wa_border_width) <$> io (getWindowAttributes d w) + let bw = 0 -- give all windows at least 1x1 pixels let least x | x <= bw*2 = 1 | otherwise = x - bw*2 - io $ moveResizeWindow d w (rect_x r) (rect_y r) - (least $ rect_width r) (least $ rect_height r) + frame <- getsWindowState wsFrame w + io $ moveResizeWindow d frame (rect_x r) (rect_y r) (least $ rect_width r) (least $ rect_height r) -- --------------------------------------------------------------------- |