Send X message batched

1 files changed, 20 insertions, 3 deletions

diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index 9c213e0..e08c990 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -179,7 +179,7 @@ runPhi xconfig config widget = do
     forever $ do
       available <- messageAvailable phi
       repaint <- gets phiRepaint
-      when (not available && repaint) $ liftIO $ threadDelay 20000
+      when (not available && repaint) $ liftIO $ threadDelay 30000
       
       available <- messageAvailable phi
       when (not available && repaint) $ do
@@ -296,9 +296,26 @@ handleConfigureNotifyEvent MkConfigureNotifyEvent { window_ConfigureNotifyEvent
       sendMessage phi $ UpdateScreens $ map (panelScreenArea &&& panelWindow) panels'
       sendMessage phi Repaint
 
+
+maybeReceiveEvents' :: Connection -> IO [XEvent]
+maybeReceiveEvents' conn = do
+  yield
+  mevent <- pollForEvent conn
+  case mevent of
+    Just event ->
+      liftM2 (:) (return . XEvent $ event) (maybeReceiveEvents' conn)
+    Nothing ->
+      return []
+      
+
+receiveEvents' :: Connection -> IO [XEvent]
+receiveEvents' conn = do
+  liftM2 (:) (liftM XEvent $ waitForEvent conn) (maybeReceiveEvents' conn)
+
+
 receiveEvents :: Phi -> Connection -> IO ()
-receiveEvents phi conn = do
-  forever $ waitForEvent conn >>= sendMessage phi . XEvent
+receiveEvents phi conn =
+  forever $ receiveEvents' conn >>= sendMessages phi
 
 updatePanels :: (Widget w s c X11) => PhiX w s c ()
 updatePanels = do