From 579552b29b396943c3a2c97456c37c8005729ce1 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Fri, 7 Oct 2011 05:31:23 +0200
Subject: Send X message batched

---
 lib/Phi/X11.hs | 23 ++++++++++++++++++++---
 1 file changed, 20 insertions(+), 3 deletions(-)

(limited to 'lib/Phi/X11.hs')

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
-- 
cgit v1.2.3