diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 4f9aa5f..97140e8 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -21,6 +21,7 @@ import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Extras import RIO (async) +import RIO.Process import qualified RIO.Text as T import System.Directory @@ -29,7 +30,10 @@ import System.IO hiding ( hPutStrLn ) import System.IO.Error -import System.Process +import System.Process hiding + ( createPipe + , proc + ) import XMonad import XMonad.Actions.CopyWindow @@ -53,7 +57,7 @@ import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Control import XMonad.Internal.DBus.Removable import XMonad.Internal.DBus.Screensaver -import XMonad.Internal.Process +import XMonad.Internal.Process (killHandle) import XMonad.Internal.Shell import qualified XMonad.Internal.Theme as XT import XMonad.Layout.MultiToggle @@ -152,7 +156,7 @@ evalConf db@DBusState { dbSysClient = cl } = do let fs = features cl tt <- evalAlways $ fsTabbedTheme fs startDBusInterfaces fs - (xmobarHandle, ts) <- startChildDaemons fs + ts <- startChildDaemons fs startRemovableMon fs startPowerMon fs dws <- startDynWorkspaces fs @@ -170,7 +174,7 @@ evalConf db@DBusState { dbSysClient = cl } = do , handleEventHook = myEventHook ha , startupHook = myStartupHook , workspaces = myWorkspaces - , logHook = maybe logViewports myLoghook xmobarHandle + , logHook = maybe logViewports myLoghook $ tsXmobar ts , clickJustFocuses = False , focusFollowsMouse = False , normalBorderColor = T.unpack XT.bordersColor @@ -181,12 +185,14 @@ evalConf db@DBusState { dbSysClient = cl } = do startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db) $ fsDBusExporters fs startChildDaemons fs = do - (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe } - io $ case h of - Just h' -> hSetBuffering h' LineBuffering - Nothing -> return () + p <- proc "xmobar" [] (startProcess . setStdin createPipe) + -- (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe } + io $ hSetBuffering (getStdin p) LineBuffering + -- io $ case h of + -- Just h' -> hSetBuffering h' LineBuffering + -- Nothing -> return () ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs) - return (h, ThreadState (p:ps) $ maybeToList h) + return $ ThreadState ps $ Just p startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs $ dbSysClient db startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs @@ -215,7 +221,7 @@ allFeatures db = do let others = [runRemovableMon $ dbSysClient db, runPowermon] return (dbus ++ others, Left runScreenLock:bfs, allDWs') where - ts = ThreadState { tsChildPIDs = [], tsChildHandles = [] } + ts = ThreadState { tsChildPIDs = [], tsXmobar = Nothing } usage :: IO () usage = putStrLn $ intercalate "\n" @@ -227,8 +233,8 @@ usage = putStrLn $ intercalate "\n" -- | Concurrency configuration data ThreadState = ThreadState - { tsChildPIDs :: [ProcessHandle] - , tsChildHandles :: [Handle] + { tsChildPIDs :: [ProcessHandle] + , tsXmobar :: Maybe (Process Handle () ()) } -- TODO shouldn't this be run by a signal handler? @@ -395,7 +401,7 @@ runHide = sendMessage $ Toggle HIDE -- | Loghook configuration -- -myLoghook :: Handle -> X () +myLoghook :: Process Handle () () -> X () myLoghook h = do logXinerama h logViewports @@ -452,9 +458,9 @@ whenChanged v action = do -- screen. The "<>" is the workspace that currently has focus. N is the number -- of windows on the current workspace. -logXinerama :: Handle -> X () -logXinerama h = withWindowSet $ \ws -> io - $ hPutStrLn h +logXinerama :: Process Handle () () -> X () +logXinerama p = withWindowSet $ \ws -> io + $ hPutStrLn (getStdin p) $ T.unwords $ filter (not . T.null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws] where