From 373fae3f1d7a521eca06930acdbd35cbc6fba7f4 Mon Sep 17 00:00:00 2001 From: Matthias Schiffer Date: Mon, 9 Sep 2013 18:24:31 +0200 Subject: Add WindowState record --- XMonad/Core.hs | 35 +++++++++++++++++++++++++++++------ XMonad/Main.hsc | 15 +++++---------- XMonad/Operations.hs | 9 ++++----- 3 files changed, 38 insertions(+), 21 deletions(-) diff --git a/XMonad/Core.hs b/XMonad/Core.hs index 958cd68..0ebb3fa 100644 --- a/XMonad/Core.hs +++ b/XMonad/Core.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, +{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving, PatternGuards, MultiParamTypeClasses, TypeSynonymInstances, CPP, DeriveDataTypeable #-} ----------------------------------------------------------------------------- @@ -17,14 +17,14 @@ ----------------------------------------------------------------------------- module XMonad.Core ( - X, WindowSet, WindowSpace, WorkspaceId, + X, WindowSet, WindowSpace, WorkspaceId, WindowState(..), ScreenId(..), ScreenDetail(..), XState(..), XConf(..), XConfig(..), LayoutClass(..), Layout(..), readsLayout, Typeable, Message, SomeMessage(..), fromMessage, LayoutMessages(..), StateExtension(..), ExtensionClass(..), runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, - withDisplay, withWindowSet, isRoot, runOnWorkspaces, + withDisplay, withWindowSet, isRoot, runOnWorkspaces, getWindowState, getsWindowState, setWindowState, modifyWindowState, getAtom, spawn, spawnPID, xfork, getXMonadDir, recompile, trace, whenJust, whenX, atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery ) where @@ -56,13 +56,18 @@ import Data.Maybe (isJust,fromMaybe) import Data.Monoid import qualified Data.Map as M -import qualified Data.Set as S + + +data WindowState = WindowState + { wsMapped :: !Bool + , wsWaitingUnmap :: !Int -- ^ the number of expected UnmapEvents + } deriving (Eq) + -- | XState, the (mutable) window manager state. data XState = XState { windowset :: !WindowSet -- ^ workspace list - , mapped :: !(S.Set Window) -- ^ the Set of mapped windows - , waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents + , windowState :: !(M.Map Window WindowState) -- ^ the extended window state , dragging :: !(Maybe (Position -> Position -> X (), X ())) , numberlockMask :: !KeyMask -- ^ The numlock modifier , extensibleState :: !(M.Map String (Either String StateExtension)) @@ -212,6 +217,24 @@ isRoot w = (w==) <$> asks theRoot getAtom :: String -> X Atom getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False +emptyWindowState :: WindowState +emptyWindowState = WindowState False 0 + +getWindowState :: Window -> X WindowState +getWindowState w = gets $ M.findWithDefault emptyWindowState w . windowState + +getsWindowState :: (WindowState -> a) -> Window -> X a +getsWindowState f w = f <$> getWindowState w + +setWindowState :: Window -> WindowState -> X () +setWindowState w ws = modify $ \s -> s { windowState = f (windowState s) } + where + f | ws == emptyWindowState = M.delete w + | otherwise = M.insert w ws + +modifyWindowState :: (WindowState -> WindowState) -> Window -> X () +modifyWindowState f w = getWindowState w >>= return . f >>= setWindowState w + -- | Common non-predefined atoms atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom atom_WM_PROTOCOLS = getAtom "WM_PROTOCOLS" diff --git a/XMonad/Main.hsc b/XMonad/Main.hsc index 653ec9d..19f988f 100644 --- a/XMonad/Main.hsc +++ b/XMonad/Main.hsc @@ -20,7 +20,6 @@ import Data.Bits import Data.List ((\\)) import Data.Function import qualified Data.Map as M -import qualified Data.Set as S import Control.Monad.Reader import Control.Monad.State import Data.Maybe (fromMaybe) @@ -124,9 +123,8 @@ xmonad initxmc = do st = XState { windowset = initialWinset - , numberlockMask = 0 - , mapped = S.empty - , waitingUnmap = M.empty + , numberlockMask = 0 + , windowState = M.empty , dragging = Nothing , extensibleState = extState } @@ -205,18 +203,15 @@ handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do -- window gone, unmanage it handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ do unmanage w - modify (\s -> s { mapped = S.delete w (mapped s) - , waitingUnmap = M.delete w (waitingUnmap s)}) + modify (\s -> s { windowState = M.delete w (windowState s)}) -- We track expected unmap events in waitingUnmap. We ignore this event unless -- it is synthetic or we are not expecting an unmap notification from a window. handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do - e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) + e <- getsWindowState wsWaitingUnmap w if (synthetic || e == 0) then unmanage w - else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) }) - where mpred 1 = Nothing - mpred n = Just $ pred n + else modifyWindowState (\ws -> ws { wsWaitingUnmap = (wsWaitingUnmap ws) - 1 }) w -- set keyboard mapping handle e@(MappingNotifyEvent {}) = do diff --git a/XMonad/Operations.hs b/XMonad/Operations.hs index 4a3e3fc..79feba1 100644 --- a/XMonad/Operations.hs +++ b/XMonad/Operations.hs @@ -27,7 +27,6 @@ import Data.List (nub, (\\), find) import Data.Bits ((.|.), (.&.), complement, testBit) import Data.Ratio import qualified Data.Map as M -import qualified Data.Set as S import Control.Applicative import Control.Monad.Reader @@ -158,7 +157,7 @@ setWMState w v = withDisplay $ \dpy -> do -- | hide. Hide a window by unmapping it, and setting Iconified. hide :: Window -> X () -hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do +hide w = whenX (getsWindowState wsMapped w) $ withDisplay $ \d -> do cMask <- asks $ clientMask . config io $ do selectInput d w (cMask .&. complement structureNotifyMask) unmapWindow d w @@ -166,8 +165,8 @@ hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do setWMState w iconicState -- this part is key: we increment the waitingUnmap counter to distinguish -- between client and xmonad initiated unmaps. - modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s) - , mapped = S.delete w (mapped s) }) + modifyWindowState (\ws -> ws { wsMapped = False + , wsWaitingUnmap = (wsWaitingUnmap ws) + 1 }) w -- | reveal. Show a window by mapping it and setting Normal -- this is harmless if the window was already visible @@ -175,7 +174,7 @@ reveal :: Window -> X () reveal w = withDisplay $ \d -> do setWMState w normalState io $ mapWindow d w - whenX (isClient w) $ modify (\s -> s { mapped = S.insert w (mapped s) }) + whenX (isClient w) $ modifyWindowState (\ws -> ws { wsMapped = True }) w -- | Set some properties when we initially gain control of a window setInitialProperties :: Window -> X () -- cgit v1.2.3