It's better not to lock in native code...

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
 

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
+withDisplay (Display dispvar) f = do
-  Graphics.X11.Xlib.lockDisplay disp
+  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

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
 
     

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
+withDisplayX (Widget.Display dispvar) f = do
-  liftIO $ lockDisplay disp
+  disp <- liftIO $ takeMVar dispvar
   a <- f disp
-  liftIO $ unlockDisplay disp
+  liftIO $ putMVar dispvar disp
   return a
 
 defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
@@ -76,7 +76,6 @@ defaultXConfig = XConfig { phiXScreenInfo = getScreenInfo
 
 runPhi :: XConfig -> Panel.PanelConfig -> [Widget.Widget] -> IO ()
 runPhi xconfig config widgets = do
-  initThreads
   phi <- initPhi
   disp <- openDisplay []
   
@@ -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