diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Xmobar/System/Utils.hs | 23 | ||||
| -rw-r--r-- | src/Xmobar/X11/Loop.hs | 19 | 
2 files changed, 28 insertions, 14 deletions
| diff --git a/src/Xmobar/System/Utils.hs b/src/Xmobar/System/Utils.hs index 24c655e..379dec3 100644 --- a/src/Xmobar/System/Utils.hs +++ b/src/Xmobar/System/Utils.hs @@ -3,7 +3,7 @@  ------------------------------------------------------------------------------  -- |  -- Module: Utils --- Copyright: (c) 2010, 2018, 2020 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2010, 2018, 2020, 2022 Jose Antonio Ortega Ruiz  -- License: BSD3-style (see LICENSE)  --  -- Maintainer: Jose A Ortega Ruiz <jao@gnu.org> @@ -21,10 +21,19 @@ module Xmobar.System.Utils    ( expandHome    , changeLoop    , safeIndex +  , forkThread    ) where  import Control.Monad  import Control.Concurrent.STM +import Control.Exception (handle, SomeException(..)) + +#ifdef THREADED_RUNTIME +import Control.Concurrent (forkOS) +#else +import Control.Concurrent (forkIO) +#endif +  import qualified Data.List.NonEmpty as NE  import Data.Maybe (fromMaybe) @@ -35,6 +44,18 @@ expandHome :: FilePath -> IO FilePath  expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME")  expandHome p = return p +forkThread :: String -> IO () -> IO () +forkThread name action = do +#ifdef THREADED_RUNTIME +    _ <- forkOS (handle (onError name) action) +#else +    _ <- forkIO (handle (onError name) action) +#endif +    return () +  where +    onError thing (SomeException e) = +      void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e) +  changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO ()  changeLoop s f = atomically s >>= go   where diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs index c74ae57..e957acd 100644 --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -28,7 +28,7 @@ import Control.Arrow ((&&&))  import Control.Monad.Reader  import Control.Concurrent  import Control.Concurrent.STM -import Control.Exception (handle, SomeException(..)) +  import Data.Bits  import Data.Map hiding (foldr, map, filter)  import qualified Data.Map as Map @@ -56,7 +56,7 @@ import Xmobar.X11.Text  import Xmobar.X11.Draw  import Xmobar.X11.Bitmap as Bitmap  import Xmobar.X11.Types -import Xmobar.System.Utils (safeIndex) +import Xmobar.System.Utils (safeIndex, forkThread)  import Xmobar.Run.Loop (loop) @@ -81,23 +81,16 @@ x11Loop conf = do    let ic = Map.empty        to = textOffset conf        ts = textOffsets conf ++ replicate (length fl) (-1) +#ifdef XFT +  xftInitFtLibrary +#endif    (r,w) <- createWin d fs conf    loop conf (startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf))  startLoop :: XConf -> TMVar SignalType -> TVar [String] -> IO ()  startLoop xcfg@(XConf _ _ w _ _ _ _) sig tv = do -#ifdef XFT -    xftInitFtLibrary -#endif -#ifdef THREADED_RUNTIME -    _ <- forkOS (handle (handler "X event handler") (handleXEvent w sig)) -#else -    _ <- forkIO (handle (handler "X event handler") (handleXEvent w sig)) -#endif +    forkThread "X event handler" (handleXEvent w sig)      eventLoop xcfg [] sig tv -  where -    handler thing (SomeException e) = -      void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)  -- | Translates X11 events received by w to signals handled by eventLoop  handleXEvent :: Window -> TMVar SignalType -> IO () | 
