summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--XMonad/Core.hs35
-rw-r--r--XMonad/Main.hsc15
-rw-r--r--XMonad/Operations.hs9
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 ()
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 04:30:56 +0100