From a1737a36132b2867a1c795c5c5bb32cb130b74c0 Mon Sep 17 00:00:00 2001 From: Stefan O'Rear Date: Mon, 4 Jun 2007 06:23:43 +0200 Subject: Set WM_STATE, iconify invisible windows (+9 loc) Note that this breaks compatibility with certain programs described as "obsolete" in the ICCCM (1994). See the command above the UnmapEvent handler for details. darcs-hash:20070604042343-e3110-4766eafca2875091189159f6a1df29eac3c21387.gz --- Main.hs | 15 +++++++++++++-- Operations.hs | 34 +++++++++++++++++++++++----------- XMonad.hs | 6 ++++-- 3 files changed, 40 insertions(+), 15 deletions(-) diff --git a/Main.hs b/Main.hs index 1575fa5..38ac301 100644 --- a/Main.hs +++ b/Main.hs @@ -144,12 +144,23 @@ handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code}) -- manage a new window handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do wa <- io $ getWindowAttributes dpy w -- ignore override windows - when (not (wa_override_redirect wa)) $ manage w + -- 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 -- window destroyed, unmanage it -- window gone, unmanage it handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ unmanage w -handle (UnmapEvent {ev_window = w}) = whenX (isClient w) $ unmanage w + +-- We only handle synthetic unmap events, because real events are confusable +-- with the events produced by 'hide'. ICCCM says that all clients should send +-- synthetic unmap events immediately after unmapping, and later describes +-- clients that do not follow the rule as "obsolete". For now, we make the +-- simplifying assumption that nobody uses clients that were already obsolete +-- in 1994. Note that many alternative methods for resolving the hide/withdraw +-- ambiguity are racy. + +handle (UnmapEvent {ev_window = w, ev_send_event = True}) = whenX (isClient w) $ unmanage w -- set keyboard mapping handle e@(MappingNotifyEvent {ev_window = w}) = do diff --git a/Operations.hs b/Operations.hs index ab99946..79ccbcc 100644 --- a/Operations.hs +++ b/Operations.hs @@ -61,7 +61,7 @@ manage w = withDisplay $ \d -> do -- there, floating status is lost when moving windows between workspaces, -- because W.shift calls W.delete. unmanage :: Window -> X () -unmanage w = windows $ W.sink w . W.delete w +unmanage w = setWMState w 0{-withdrawn-} >> windows (W.sink w . W.delete w) -- | focus. focus window up or down. or swap various windows. focusUp, focusDown, swapUp, swapDown, swapMaster :: X () @@ -133,11 +133,20 @@ windows f = do where integrate W.Empty = [] integrate (W.Node x l r) = x : l ++ r --- | hide. Hide a window by moving it off screen. +-- | setWMState. set the WM_STATE property +setWMState :: Window -> Int -> X () +setWMState w v = withDisplay $ \dpy -> do + a <- atom_WM_STATE + io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none] + +-- | hide. Hide a window by unmapping it. +-- +-- If you call this on a window that is marked as visible, very bad things will +-- happen (currently unmanaging, but don't count on it). hide :: Window -> X () hide w = withDisplay $ \d -> do - (sw,sh) <- gets dimensions - io $ moveWindow d w sw sh + io $ unmapWindow d w + setWMState w 3 --iconic -- | refresh. Render the currently visible workspaces, as determined by -- the StackSet. Also, set focus to the focused window. @@ -164,14 +173,14 @@ refresh = do rs <- doLayout l (Rectangle (sx + fromIntegral gl) (sy + fromIntegral gt) (sw - fromIntegral (gl + gr)) (sh - fromIntegral (gt + gb))) tiled - mapM_ (\(win,rect) -> io (tileWindow d win rect)) rs + mapM_ (\(win,rect) -> tileWindow win rect) rs -- now the floating windows: -- move/resize the floating windows, if there are any (`mapM_` flt) $ \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 + tileWindow fw $ Rectangle (px + floor (toRational pw*rx)) (py + floor (toRational ph*ry)) (floor (toRational pw*rw)) (floor (toRational ph*rh)) @@ -209,11 +218,14 @@ clearEnterEvents = withDisplay $ \d -> io $ do -- | tileWindow. Moves and resizes w such that it fits inside the given -- rectangle, including its border. -tileWindow :: Display -> Window -> Rectangle -> IO () -tileWindow d w r = do - bw <- (fromIntegral . wa_border_width) `liftM` getWindowAttributes d w - moveResizeWindow d w (rect_x r) (rect_y r) - (rect_width r - bw*2) (rect_height r - bw*2) +tileWindow :: Window -> Rectangle -> X () +tileWindow w r = withDisplay $ \d -> do + bw <- (fromIntegral . wa_border_width) `liftM` io (getWindowAttributes d w) + io $ moveResizeWindow d w (rect_x r) (rect_y r) + (rect_width r - bw*2) (rect_height r - bw*2) + -- this is harmless if the window was already visible + setWMState w 1 --normal + io $ mapWindow d w -- --------------------------------------------------------------------- diff --git a/XMonad.hs b/XMonad.hs index d6fc83f..7fafa7c 100644 --- a/XMonad.hs +++ b/XMonad.hs @@ -18,7 +18,8 @@ module XMonad ( X, WindowSet, WorkspaceId(..), ScreenId(..), XState(..), XConf(..), Layout(..), Typeable, Message, SomeMessage(..), fromMessage, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, - runX, io, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX + runX, io, withDisplay, withWindowSet, isRoot, spawn, restart, trace, whenJust, whenX, + atom_WM_STATE ) where import StackSet (StackSet) @@ -95,9 +96,10 @@ getAtom :: String -> X Atom getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False -- | Common non-predefined atoms -atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW :: X Atom +atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE :: X Atom atom_WM_PROTOCOLS = getAtom "WM_PROTOCOLS" atom_WM_DELETE_WINDOW = getAtom "WM_DELETE_WINDOW" +atom_WM_STATE = getAtom "WM_STATE" ------------------------------------------------------------------------ -- Layout handling -- cgit v1.2.3