ENH use rio proc for xmobar startup
This commit is contained in:
parent
6526f5e309
commit
780c600d47
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue