FIX waitforprocess bug in xmobar

This commit is contained in:
Nathan Dwarshuis 2022-07-02 18:22:26 -04:00
parent a796cedcf6
commit 64d4771029
2 changed files with 14 additions and 4 deletions

View File

@ -22,9 +22,9 @@ import System.Directory
import System.Exit import System.Exit
import System.IO import System.IO
import System.IO.Error import System.IO.Error
import System.Process -- import System.Process
( readProcessWithExitCode -- ( readProcessWithExitCode
) -- )
import Xmobar.Plugins.Bluetooth import Xmobar.Plugins.Bluetooth
import Xmobar.Plugins.ClevoKeyboard import Xmobar.Plugins.ClevoKeyboard
@ -33,6 +33,7 @@ import Xmobar.Plugins.IntelBacklight
import Xmobar.Plugins.Screensaver import Xmobar.Plugins.Screensaver
import Xmobar.Plugins.VPN import Xmobar.Plugins.VPN
import System.Posix.Signals
import XMonad.Core import XMonad.Core
( cfgDir ( cfgDir
, getDirectories , getDirectories
@ -43,6 +44,10 @@ import XMonad.Internal.DBus.Brightness.ClevoKeyboard
import XMonad.Internal.DBus.Brightness.IntelBacklight import XMonad.Internal.DBus.Brightness.IntelBacklight
import XMonad.Internal.DBus.Screensaver (ssSignalDep) import XMonad.Internal.DBus.Screensaver (ssSignalDep)
import XMonad.Internal.Dependency import XMonad.Internal.Dependency
import XMonad.Internal.Process
( proc'
, readCreateProcessWithExitCode'
)
import XMonad.Internal.Shell import XMonad.Internal.Shell
import qualified XMonad.Internal.Theme as T import qualified XMonad.Internal.Theme as T
import Xmobar import Xmobar
@ -55,6 +60,9 @@ main = do
ff <- evalFonts ff <- evalFonts
cs <- getAllCommands =<< rightPlugins sysClient sesClient cs <- getAllCommands =<< rightPlugins sysClient sesClient
d <- cfgDir <$> getDirectories d <- cfgDir <$> getDirectories
-- this is needed to prevent waitForProcess error when forking in plugins (eg
-- alsacmd)
_ <- installHandler sigCHLD Default Nothing
-- this is needed to see any printed messages -- this is needed to see any printed messages
hFlush stdout hFlush stdout
mapM_ (maybe skip disconnect) [sysClient, sesClient] mapM_ (maybe skip disconnect) [sysClient, sesClient]
@ -255,7 +263,8 @@ readInterface n f = IORead n go
return $ Right $ PostPass x $ fmap ("ignoring extra interface: "++) xs return $ Right $ PostPass x $ fmap ("ignoring extra interface: "++) xs
vpnPresent :: IO (Maybe String) vpnPresent :: IO (Maybe String)
vpnPresent = go <$> tryIOError (readProcessWithExitCode "nmcli" args "") vpnPresent =
go <$> tryIOError (readCreateProcessWithExitCode' (proc' "nmcli" args) "")
where where
args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"] args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
go (Right (ExitSuccess, out, _)) = if "vpn" `elem` lines out then Nothing go (Right (ExitSuccess, out, _)) = if "vpn" `elem` lines out then Nothing

View File

@ -79,5 +79,6 @@ executable xmobar
, filepath >= 1.4.2.1 , filepath >= 1.4.2.1
, xmonad-contrib >= 0.13 , xmonad-contrib >= 0.13
, directory >= 1.3.3.0 , directory >= 1.3.3.0
, unix >= 2.7.2.2
default-language: Haskell2010 default-language: Haskell2010
ghc-options: -Wall -Werror -Wpartial-fields -fno-warn-missing-signatures -threaded ghc-options: -Wall -Werror -Wpartial-fields -fno-warn-missing-signatures -threaded