Implement simple reparenting

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