From c6e57070ab4ca1fdaddf816208aef24f38aecaba Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Fri, 15 Jul 2011 02:51:50 +0200
Subject: It's better not to lock in native code...

---
 lib/Phi/Phi.hs             |  4 ++++
 lib/Phi/Widget.hs          | 13 +++++++------
 lib/Phi/Widgets/Taskbar.hs |  3 ---
 lib/Phi/X11.hs             | 11 +++++------
 4 files changed, 16 insertions(+), 15 deletions(-)

(limited to 'lib/Phi')

diff --git a/lib/Phi/Phi.hs b/lib/Phi/Phi.hs
index 1fef39b..b517de6 100644
--- a/lib/Phi/Phi.hs
+++ b/lib/Phi/Phi.hs
@@ -5,6 +5,7 @@ module Phi.Phi ( Phi
                , DefaultMessage(..)
                , fromMessage
                , initPhi
+               , dupPhi
                , sendMessage
                , receiveMessage
                ) where
@@ -26,6 +27,9 @@ fromMessage (Message m) = cast m
 initPhi :: IO Phi
 initPhi = liftM Phi newChan
 
+dupPhi :: Phi -> IO Phi
+dupPhi (Phi chan) = liftM Phi $ dupChan chan
+
 sendMessage :: (Typeable a, Show a) => Phi -> a -> IO ()
 sendMessage (Phi chan) = writeChan chan . Message
 
diff --git a/lib/Phi/Widget.hs b/lib/Phi/Widget.hs
index e0d051b..9534c8c 100644
--- a/lib/Phi/Widget.hs
+++ b/lib/Phi/Widget.hs
@@ -12,24 +12,24 @@ module Phi.Widget ( Display(..)
                   , handleMessageWidgets
                   ) where
 
+import Control.Concurrent.MVar
 import Control.Monad
 
 import Data.Traversable
 
 import qualified Graphics.X11.Xlib
-
 import Graphics.Rendering.Cairo
 
 import Phi.Phi
 
 
-newtype Display = Display Graphics.X11.Xlib.Display
+newtype Display = Display (MVar Graphics.X11.Xlib.Display)
 
 withDisplay :: Display -> (Graphics.X11.Xlib.Display -> IO a) -> IO a
-withDisplay (Display disp) f = do
-  Graphics.X11.Xlib.lockDisplay disp
+withDisplay (Display dispvar) f = do
+  disp <- takeMVar dispvar
   a <- f disp
-  Graphics.X11.Xlib.unlockDisplay disp
+  putMVar dispvar disp
   return a
 
 
@@ -65,7 +65,8 @@ deriving instance Show WidgetState
 
 createWidgetState :: Phi -> Display -> Widget -> IO WidgetState
 createWidgetState phi disp (Widget w) = do
-  priv <- initWidget w phi disp
+  phi' <- dupPhi phi
+  priv <- initWidget w phi' disp
   return WidgetState { stateWidget = w
                      , stateX = 0
                      , stateY = 0
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index 1b86ffd..a32c5d2 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -38,9 +38,6 @@ instance WidgetClass Taskbar where
   type WidgetData Taskbar = TaskbarState
   
   initWidget (Taskbar _) phi dispvar = do
-    --withMVar dispvar $ \disp ->
-      
-    --  return ()
     return TaskbarState
 
     
diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs
index 56293ef..4332352 100644
--- a/lib/Phi/X11.hs
+++ b/lib/Phi/X11.hs
@@ -64,10 +64,10 @@ runPhiX :: PhiConfig -> PhiState -> PhiX a -> IO (a, PhiState)
 runPhiX config st (PhiX a) = runPhiReader config $ runStateT a st
 
 withDisplayX :: Widget.Display -> (Display -> PhiX a) -> PhiX a
-withDisplayX (Widget.Display disp) f = do
-  liftIO $ lockDisplay disp
+withDisplayX (Widget.Display dispvar) f = do
+  disp <- liftIO $ takeMVar dispvar
   a <- f disp
-  liftIO $ unlockDisplay disp
+  liftIO $ putMVar dispvar disp
   return a
 
 defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
@@ -76,10 +76,9 @@ defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
 
 runPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO ()
 runPhi xconfig config widgets = do
-  initThreads
   phi <- initPhi
   disp <- openDisplay []
-
+  
   atoms <- initAtoms disp
   selectInput disp (defaultRootWindow disp) $ propertyChangeMask.|.structureNotifyMask
   
@@ -89,7 +88,7 @@ runPhi xconfig config widgets = do
     
     screens <- liftIO $ phiXScreenInfo xconfig disp
     
-    let dispvar = Widget.Display disp
+    dispvar <- liftM Widget.Display $ liftIO $ newMVar disp
     widgetStates <- liftIO $ mapM (Widget.createWidgetState phi dispvar) widgets
     
     withDisplayX dispvar $ \disp -> do
-- 
cgit v1.2.3