ENH clean up xmobar properly
This commit is contained in:
parent
780c600d47
commit
59c483785a
|
@ -20,7 +20,10 @@ import Graphics.X11.Types
|
||||||
import Graphics.X11.Xlib.Atom
|
import Graphics.X11.Xlib.Atom
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
|
|
||||||
import RIO (async)
|
import RIO
|
||||||
|
( async
|
||||||
|
, handleIO
|
||||||
|
)
|
||||||
import RIO.Process
|
import RIO.Process
|
||||||
import qualified RIO.Text as T
|
import qualified RIO.Text as T
|
||||||
|
|
||||||
|
@ -186,11 +189,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
|
||||||
$ fsDBusExporters fs
|
$ fsDBusExporters fs
|
||||||
startChildDaemons fs = do
|
startChildDaemons fs = do
|
||||||
p <- proc "xmobar" [] (startProcess . setStdin createPipe)
|
p <- proc "xmobar" [] (startProcess . setStdin createPipe)
|
||||||
-- (h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
|
|
||||||
io $ hSetBuffering (getStdin p) LineBuffering
|
io $ hSetBuffering (getStdin p) LineBuffering
|
||||||
-- io $ case h of
|
|
||||||
-- Just h' -> hSetBuffering h' LineBuffering
|
|
||||||
-- Nothing -> return ()
|
|
||||||
ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
|
ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
|
||||||
return $ ThreadState ps $ Just p
|
return $ ThreadState ps $ Just p
|
||||||
startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
|
startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
|
||||||
|
@ -240,8 +239,11 @@ data ThreadState = ThreadState
|
||||||
-- TODO shouldn't this be run by a signal handler?
|
-- TODO shouldn't this be run by a signal handler?
|
||||||
runCleanup :: ThreadState -> DBusState -> X ()
|
runCleanup :: ThreadState -> DBusState -> X ()
|
||||||
runCleanup ts db = io $ do
|
runCleanup ts db = io $ do
|
||||||
|
mapM_ stopNoWait $ tsXmobar ts
|
||||||
mapM_ killHandle $ tsChildPIDs ts
|
mapM_ killHandle $ tsChildPIDs ts
|
||||||
disconnectDBusX db
|
disconnectDBusX db
|
||||||
|
where
|
||||||
|
stopNoWait p = handleIO (\_ -> return ()) $ stopProcess p
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Startuphook configuration
|
-- | Startuphook configuration
|
||||||
|
|
|
@ -133,6 +133,7 @@ import System.Directory
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.IO.Error
|
import System.IO.Error
|
||||||
import System.Posix.Files
|
import System.Posix.Files
|
||||||
|
import System.Process.Typed (nullStream)
|
||||||
|
|
||||||
import XMonad.Core (X, io)
|
import XMonad.Core (X, io)
|
||||||
import XMonad.Internal.IO
|
import XMonad.Internal.IO
|
||||||
|
@ -685,7 +686,7 @@ testSysDependency (AccessiblePath p r w) = io $ permMsg <$> getPermissionsSafe p
|
||||||
|
|
||||||
shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg)
|
shellTest :: FilePath -> [T.Text] -> T.Text -> FIO (Maybe Msg)
|
||||||
shellTest cmd args msg = do
|
shellTest cmd args msg = do
|
||||||
rc <- proc cmd (T.unpack <$> args) runProcess
|
rc <- proc cmd (T.unpack <$> args) (runProcess . setStdout nullStream)
|
||||||
return $ case rc of
|
return $ case rc of
|
||||||
ExitSuccess -> Nothing
|
ExitSuccess -> Nothing
|
||||||
_ -> Just $ Msg LevelError msg
|
_ -> Just $ Msg LevelError msg
|
||||||
|
|
|
@ -41,6 +41,7 @@ dependencies:
|
||||||
- xml >= 1.3.14
|
- xml >= 1.3.14
|
||||||
- lifted-base >= 0.2.3.12
|
- lifted-base >= 0.2.3.12
|
||||||
- utf8-string >= 1.0.2
|
- utf8-string >= 1.0.2
|
||||||
|
- typed-process >= 0.2.8.0
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: lib/
|
source-dirs: lib/
|
||||||
|
|
Loading…
Reference in New Issue