summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-07-15 02:51:50 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-07-15 02:51:50 +0200
commitc6e57070ab4ca1fdaddf816208aef24f38aecaba (patch)
tree778196ebcd31bbfd5c57c9acdfcfcd205a798920 /lib
parent7da8a9114eecc750a93087d0ec985641ca2a3165 (diff)
downloadphi-c6e57070ab4ca1fdaddf816208aef24f38aecaba.tar
phi-c6e57070ab4ca1fdaddf816208aef24f38aecaba.zip
It's better not to lock in native code...
Diffstat (limited to 'lib')
-rw-r--r--lib/Phi/Phi.hs4
-rw-r--r--lib/Phi/Widget.hs13
-rw-r--r--lib/Phi/Widgets/Taskbar.hs3
-rw-r--r--lib/Phi/X11.hs11
4 files changed, 16 insertions, 15 deletions
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