general refactor, and call xerrorhandler to ignore certain undetectable issues

Main.hs

@@ -23,7 +23,6 @@ import System.Exit
 import Graphics.X11.Xlib
 import Graphics.X11.Xlib.Extras
 
-import Numeric
 import Control.Monad.State
 
 import XMonad
@@ -59,19 +58,26 @@ keys = M.fromList $
 -- 
 main :: IO ()
 main = do
-    dpy <- openDisplay ""
+    dpy   <- openDisplay ""
     let dflt = defaultScreen dpy
-        st   = XState
+    rootw  <- rootWindow dpy dflt
+    wmdelt <- internAtom dpy "WM_DELETE_WINDOW" False
+    wmprot <- internAtom dpy "WM_PROTOCOLS"     False
+
+    let st = XState
             { display      = dpy
-            , screenWidth  = displayWidth  dpy dflt
+            , screen       = dflt
-            , screenHeight = displayHeight dpy dflt
+            , theRoot      = rootw
+            , wmdelete     = wmdelt
+            , wmprotocols  = wmprot
+            , dimensions   = (displayWidth  dpy dflt, displayHeight dpy dflt)
             , workspace    = W.empty workspaces
             }
 
-    -- setup initial X environment
+    xSetErrorHandler -- in C, I'm too lazy to write the binding
-    rootw <- rootWindow dpy dflt
-    sync dpy False
 
+    -- setup initial X environment
+    sync dpy False
     selectInput dpy rootw $  substructureRedirectMask
                          .|. substructureNotifyMask
                          .|. enterWindowMask
@@ -79,16 +85,13 @@ main = do
     grabKeys dpy rootw
     sync dpy False
 
-    ws   <- scan dpy rootw
+    ws <- scan dpy rootw
     allocaXEvent $ \e ->
         runX st $ do
             mapM_ manage ws
             forever $ handle =<< xevent dpy e
       where
-        xevent d e = do ev <- io (nextEvent d e >> getEvent e)
+        xevent d e = io (nextEvent d e >> getEvent e)
-                        trace ("GOT: " ++ eventName ev)
-                        return ev
-
         forever a = a >> forever a
 
 -- ---------------------------------------------------------------------
@@ -156,30 +159,17 @@ handle (KeyEvent {event_type = t, state = m, keycode = code})
         s   <- io $ keycodeToKeysym dpy code 0
         maybe (return ()) id (M.lookup (m,s) keys)
 
---
--- there's a race here, we might enter a window (e.g. on firefox
--- exiting), just as firefox destroys the window anyway. Setting focus
--- here will just trigger an error
---
 handle e@(CrossingEvent {event_type = t})
     | t == enterNotify  && mode e == notifyNormal && detail e /= notifyInferior
     = withDisplay $ \d -> do
         let w = window e
         ws <- gets workspace
-        -- note: we get enter events for what appear to be subwindows of
-        -- ones under managment. we need to ignore those. hence we check either for
-        -- root, or for ismember.
-        trace $ "Got enter notify message for: " ++ show w
         if W.member w ws
-            then do trace $ "It's one of ours, set input focus"
+            then io $ setInputFocus d w revertToPointerRoot 0 -- it is ours, manage it
-                    -- it might have already disappeared (firefox close event)
+            else do rootw <- gets theRoot
-                    io $ setInputFocus d w revertToPointerRoot 0 -- it is ours, manage it
-            else do let dflt = defaultScreen d
-                    rootw <- io $ rootWindow d dflt -- should be in state
                     when (w == rootw) $ do
-                       let w' = maybe rootw id (W.peek ws) -- focus to the top of the stack
+                       let new_w = maybe rootw id (W.peek ws) -- focus to the top of the stack
-                       trace $ "It's not one of ours, set focus to: " ++ show w'
+                       io $ setInputFocus d new_w revertToPointerRoot 0
-                       io $ setInputFocus d w' revertToPointerRoot 0
         io $ sync d False
 
 handle e@(CrossingEvent {event_type = t})
@@ -210,7 +200,7 @@ handle e@(ConfigureRequestEvent {}) = do
 
     io $ sync dpy False
 
-handle e = trace ("IGNORING: " ++ eventName e) -- ignoring
+handle e = trace (eventName e) -- ignoring
 
 -- ---------------------------------------------------------------------
 -- Managing windows
@@ -220,23 +210,10 @@ handle e = trace ("IGNORING: " ++ eventName e) -- ignoring
 refresh :: X ()
 refresh = do
     ws <- gets workspace
-    whenJust (W.peek ws) $ \w ->
+    whenJust (W.peek ws) $ \w -> withDisplay $ \d -> do
-        withDisplay $ \d -> do
+        (sw,sh) <- gets dimensions
-            sw <- gets screenWidth
+        io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen
-            sh <- gets screenHeight
+                raiseWindow d w
-            io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen
-                    raiseWindow d w
-
--- | hide. Hide a list of windows by moving them offscreen.
-hide :: Window -> X ()
-hide w = withDisplay $ \d -> do
-    sw <- gets screenWidth
-    sh <- gets screenHeight
-    io $! moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh)
-
--- | reveal. Expose a list of windows, moving them on screen
-reveal :: Window -> X ()
-reveal w = withDisplay $ \d -> io $! moveWindow d w 0 0
 
 -- | windows. Modify the current window list with a pure function, and refresh
 windows :: (WorkSpace -> WorkSpace) -> X ()
@@ -246,6 +223,16 @@ windows f = do
     ws <- gets workspace
     trace (show ws) -- log state changes to stderr
 
+-- | hide. Hide a list of windows by moving them offscreen.
+hide :: Window -> X ()
+hide w = withDisplay $ \d -> do
+    (sw,sh) <- gets dimensions
+    io $! moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh)
+
+-- | reveal. Expose a list of windows, moving them on screen
+reveal :: Window -> X ()
+reveal w = withDisplay $ \d -> io $! moveWindow d w 0 0
+
 -- ---------------------------------------------------------------------
 -- Window operations
 
@@ -266,27 +253,21 @@ manage w = do
 -- list, on whatever workspace it is.
 unmanage :: Window -> X ()
 unmanage w = do
-    trace $ "Asked to unmanage: " ++ show w
-    -- 
-    -- quitting firefox will ask us to unmange one of its subwindows
-    -- then there'll be an EnterNotify event for the main window, which
-    -- will already have disappeared. leading to bad XsetFocus errors
-    --
     ws <- gets workspace
-    when (W.member w ws) $ withDisplay $ \d ->
+    when (W.member w ws) $ withDisplay $ \d -> withServerX d $ do
-      withServerX d $ do -- be sure to set focus on unmanaging
+        -- xseterrorhandler(dummy)
         modify $ \s -> s { workspace = W.delete w (workspace s) }
-        ws' <- gets workspace
+        new_ws <- gets workspace
-        case W.peek ws' of
+        case W.peek new_ws of
-            Just w' -> io $ setInputFocus d w' revertToPointerRoot 0
+            Just new -> io $ setInputFocus d new revertToPointerRoot 0
-            Nothing -> do
+            Nothing  -> do
-                let dflt = defaultScreen d
+                rootw <- gets theRoot
-                rootw <- io $ rootWindow d dflt
                 io $ setInputFocus d rootw revertToPointerRoot 0
 
         io (sync d False)
+        -- xseterrorhandler(error)
 
--- Grab the X server (lock it) from the X monad
+-- | Grab the X server (lock it) from the X monad
 withServerX :: Display -> X () -> X ()
 withServerX dpy f = do
     io $ grabServer dpy
@@ -303,13 +284,13 @@ kill :: X ()
 kill = withDisplay $ \d -> do
     ws <- gets workspace
     whenJust (W.peek ws) $ \w -> do
-        protocols   <- io $ getWMProtocols d w
+        protocols <- io $ getWMProtocols d w
-        wmdelete    <- io $ internAtom d "WM_DELETE_WINDOW" False -- stick in X state
+        wmdelt    <- gets wmdelete
-        wmprotocols <- io $ internAtom d "WM_PROTOCOLS"     False
+        wmprot    <- gets wmprotocols
-        if wmdelete `elem` protocols
+        if wmdelt `elem` protocols
             then io $ allocaXEvent $ \ev -> do
                     setEventType ev clientMessage
-                    setClientMessageEvent ev w wmprotocols 32 wmdelete 0
+                    setClientMessageEvent ev w wmprot 32 wmdelt 0
                     sendEvent d w False noEventMask ev
             else io (killClient d w) >> return ()
 

XMonad.hs

@@ -23,14 +23,17 @@ import StackSet (StackSet)
 import Control.Monad.State
 import System.IO
 import System.Process (runCommand)
-import Graphics.X11.Xlib (Display,Window)
+import Graphics.X11.Xlib
 
 -- | XState, the window manager state.
 -- Just the display, width, height and a window list
 data XState = XState
     { display       :: Display
-    , screenWidth   :: {-# UNPACK #-} !Int
+    , screen        :: {-# UNPACK #-} !ScreenNumber
-    , screenHeight  :: {-# UNPACK #-} !Int
+    , theRoot       :: {-# UNPACK #-} !Window
+    , wmdelete      :: {-# UNPACK #-} !Atom
+    , wmprotocols   :: {-# UNPACK #-} !Atom
+    , dimensions    :: {-# UNPACK #-} !(Int,Int)
     , workspace     :: {-# UNPACK #-} !WorkSpace      -- ^ workspace list
     }