ENH use rio proc for xmobar startup

This commit is contained in:
Nathan Dwarshuis 2022-12-27 22:09:23 -05:00
parent 6526f5e309
commit 780c600d47
1 changed files with 22 additions and 16 deletions

View File

@ -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