FIX waitforprocess bug in xmobar
This commit is contained in:
parent
a796cedcf6
commit
64d4771029
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue