summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--XMonad/Core.hs5
-rw-r--r--XMonad/Main.hsc36
-rw-r--r--XMonad/Operations.hs27
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)
-- ---------------------------------------------------------------------