ENH don't mess with signal handlers during setup
This commit is contained in:
parent
761653265d
commit
b058d1245e
|
|
@ -34,7 +34,6 @@ import Xmobar.Plugins.IntelBacklight
|
|||
import Xmobar.Plugins.Screensaver
|
||||
import Xmobar.Plugins.VPN
|
||||
|
||||
import System.Posix.Signals
|
||||
import XMonad.Core hiding (config)
|
||||
import XMonad.Internal.Command.Desktop
|
||||
import XMonad.Internal.Command.Power
|
||||
|
|
@ -65,9 +64,6 @@ run = do
|
|||
db <- connectDBus
|
||||
c <- withCache $ evalConfig db
|
||||
disconnectDBus db
|
||||
-- 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
|
||||
hFlush stdout
|
||||
xmobar c
|
||||
|
|
@ -422,16 +418,16 @@ dateCmd = CmdSpec
|
|||
|
||||
vpnPresent :: IO (Maybe Msg)
|
||||
vpnPresent =
|
||||
go <$> tryIOError (readCreateProcessWithExitCode' (proc' "nmcli" args) "")
|
||||
go <$> tryIOError (readCreateProcessWithExitCode (proc "nmcli" args) "")
|
||||
where
|
||||
args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
|
||||
go (Right (ExitSuccess, out, _)) = if "vpn" `elem` T.lines out then Nothing
|
||||
go (Right (ExitSuccess, out, _)) = if "vpn" `elem` lines out then Nothing
|
||||
else Just $ Msg LevelError "vpn not found"
|
||||
go (Right (ExitFailure c, _, err)) = Just $ Msg LevelError
|
||||
$ T.concat ["vpn search exited with code "
|
||||
, T.pack $ show c
|
||||
, ": "
|
||||
, err]
|
||||
, T.pack err]
|
||||
go (Left e) = Just $ Msg LevelError $ T.pack $ show e
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -82,11 +82,24 @@ parse _ = usage
|
|||
|
||||
run :: IO ()
|
||||
run = do
|
||||
-- These first two commands are only significant when xmonad is restarted.
|
||||
-- The 'launch' function below this will turn off buffering (so flushes are
|
||||
-- required to see stdout) and will also install xmonad's silly signal
|
||||
-- handlers (which set the handlers for sigCHLD and sigPIPE to SIG_IGN).
|
||||
-- Ignoring sigCHLD is particularly bad since most of my setup entails
|
||||
-- spawning processes and waiting for their exit code, which totally breaks
|
||||
-- when sigCHLD is ignored (since children are killed immediately without
|
||||
-- the parent invoking 'wait'). Since the 'launch' function is called last
|
||||
-- here, everything before should be fine except for the case where xmonad
|
||||
-- is restarted, which uses 'exec' and thus should cause the buffering and
|
||||
-- signal handlers to carry over to the top.
|
||||
uninstallSignalHandlers
|
||||
hSetBuffering stdout LineBuffering
|
||||
db <- connectDBusX
|
||||
conf <- withCache $ evalConf db
|
||||
ds <- getCreateDirectories
|
||||
-- IDK why this is necessary; nothing prior to this will print if missing
|
||||
hFlush stdout
|
||||
-- hFlush stdout
|
||||
launch conf ds
|
||||
|
||||
getCreateDirectories :: IO Directories
|
||||
|
|
@ -138,38 +151,37 @@ evalConf db@DBusState { dbSysClient = cl } = do
|
|||
-- start DBus interfaces first since many features after this test these
|
||||
-- interfaces as dependencies
|
||||
io $ putStrLn "hi"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
let fs = features cl
|
||||
tt <- evalAlways $ fsTabbedTheme fs
|
||||
io $ putStrLn "tabbed theme started"
|
||||
io $ hFlush stdout
|
||||
-- uninstallSignalHandlers
|
||||
-- io $ hFlush stdout
|
||||
-- io $ print =<< readCreateProcessWithExitCode (proc "echo" ["hi"]) ""
|
||||
startDBusInterfaces fs
|
||||
io $ putStrLn "dbus started"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
(xmobarHandle, ts) <- startChildDaemons fs
|
||||
io $ putStrLn "child daemons started"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
startRemovableMon fs
|
||||
io $ putStrLn "removemon started"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
startPowerMon fs
|
||||
io $ putStrLn "powermon started"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
dws <- startDynWorkspaces fs
|
||||
io $ putStrLn "dyn workspace started"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
-- fb <- evalAlways $ fsFontBuilder features
|
||||
kbs <- filterExternal <$> evalExternal (fsKeys fs ts db)
|
||||
io $ putStrLn "keys started"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
sk <- evalAlways $ fsShowKeys fs
|
||||
io $ putStrLn "showkeys started"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
ha <- evalAlways $ fsACPIHandler fs
|
||||
io $ putStrLn "acpi handler started"
|
||||
io $ hFlush stdout
|
||||
-- io $ hFlush stdout
|
||||
return $ ewmh
|
||||
$ addKeymap dws sk kbs
|
||||
$ docks
|
||||
|
|
@ -180,7 +192,7 @@ evalConf db@DBusState { dbSysClient = cl } = do
|
|||
, handleEventHook = myEventHook ha
|
||||
, startupHook = myStartupHook
|
||||
, workspaces = myWorkspaces
|
||||
, logHook = myLoghook xmobarHandle
|
||||
, logHook = maybe logViewports myLoghook xmobarHandle
|
||||
, clickJustFocuses = False
|
||||
, focusFollowsMouse = False
|
||||
, normalBorderColor = T.unpack XT.bordersColor
|
||||
|
|
@ -191,9 +203,15 @@ evalConf db@DBusState { dbSysClient = cl } = do
|
|||
startDBusInterfaces fs = mapM_ (\f -> executeSometimes $ f $ dbSesClient db)
|
||||
$ fsDBusExporters fs
|
||||
startChildDaemons fs = do
|
||||
(h, p) <- io $ spawnPipe "xmobar"
|
||||
-- (h, p) <- io $ spawnPipe "xmobar"
|
||||
(h, _, _, p) <- io $ createProcess $ (shell "xmobar") { std_in = CreatePipe }
|
||||
io $ case h of
|
||||
Just h' -> hSetBuffering h' LineBuffering
|
||||
Nothing -> return ()
|
||||
--installSignalHandlers
|
||||
ps <- catMaybes <$> mapM executeSometimes (fsDaemons fs)
|
||||
return (h, ThreadState (p:ps) [h])
|
||||
-- uninstallSignalHandlers
|
||||
return (h, ThreadState (p:ps) $ maybeToList h)
|
||||
startRemovableMon fs = void $ executeSometimes $ fsRemovableMon fs
|
||||
$ dbSysClient db
|
||||
startPowerMon fs = void $ async $ void $ executeSometimes $ fsPowerMon fs
|
||||
|
|
|
|||
|
|
@ -681,7 +681,7 @@ testSysDependency (AccessiblePath p r w) = permMsg <$> getPermissionsSafe p
|
|||
|
||||
shellTest :: T.Text -> T.Text -> IO (Maybe Msg)
|
||||
shellTest cmd msg = do
|
||||
(rc, _, _) <- readCreateProcessWithExitCode' (shell $ T.unpack cmd) ""
|
||||
(rc, _, _) <- readCreateProcessWithExitCode (shell $ T.unpack cmd) ""
|
||||
return $ case rc of
|
||||
ExitSuccess -> Nothing
|
||||
_ -> Just $ Msg LevelError msg
|
||||
|
|
|
|||
|
|
@ -257,7 +257,8 @@ runNetAppDaemon cl = Sometimes "network applet" xpfVPN
|
|||
where
|
||||
tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
|
||||
app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
|
||||
cmd _ = snd <$> spawnPipe "nm-applet"
|
||||
-- cmd _ = snd <$> spawnPipe "nm-applet"
|
||||
cmd _ = spawnProcess "nm-applet" []
|
||||
|
||||
runToggleBluetooth :: Maybe SysClient -> SometimesX
|
||||
runToggleBluetooth cl = Sometimes "bluetooth toggle" xpfBluetooth
|
||||
|
|
|
|||
|
|
@ -42,10 +42,10 @@ import qualified RIO.Text as T
|
|||
import System.Directory
|
||||
import System.Exit
|
||||
import System.IO.Error
|
||||
import System.Process (ProcessHandle)
|
||||
import System.Process (ProcessHandle, spawnProcess)
|
||||
|
||||
import XMonad.Core
|
||||
import XMonad.Internal.Process (spawnPipeArgs)
|
||||
-- import XMonad.Internal.Process (spawnPipeArgs)
|
||||
import XMonad.Internal.Shell
|
||||
import qualified XMonad.Internal.Theme as XT
|
||||
import XMonad.Prompt
|
||||
|
|
@ -96,7 +96,8 @@ runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
|
|||
where
|
||||
tree = And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock")
|
||||
$ Only_ $ IOSometimes_ runScreenLock
|
||||
cmd = snd <$> spawnPipeArgs "xss-lock" ["--ignore-sleep", "screenlock"]
|
||||
-- cmd = snd <$> spawnPipeArgs "xss-lock" ["--ignore-sleep", "screenlock"]
|
||||
cmd = spawnProcess "xss-lock" ["--ignore-sleep", "screenlock"]
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Confirmation prompts
|
||||
|
|
|
|||
Loading…
Reference in New Issue