ENH don't use killall to kill child processes

This commit is contained in:
Nathan Dwarshuis 2020-03-15 01:49:39 -04:00
parent bb9e6ad056
commit 6f95dc0673
2 changed files with 60 additions and 20 deletions

View File

@ -18,6 +18,8 @@ executable xmonad
, xmonad-contrib >= 0.13 , xmonad-contrib >= 0.13
, xmonad-extras >= 0.15.2 , xmonad-extras >= 0.15.2
, X11 >= 1.9.1 , X11 >= 1.9.1
, unix >= 2.7.2.2
, process >= 1.6.5.0
, my-xmonad , my-xmonad
hs-source-dirs: bin hs-source-dirs: bin
default-language: Haskell2010 default-language: Haskell2010

View File

@ -6,10 +6,7 @@ module Main (main) where
import ACPI import ACPI
import SendXMsg import SendXMsg
import Control.Monad (forM_, void, when) import Control.Monad (mapM_, forM_, void, when)
import System.Exit
import System.IO
import Data.List (sortBy, sortOn) import Data.List (sortBy, sortOn)
import Data.Maybe (fromMaybe, isJust) import Data.Maybe (fromMaybe, isJust)
@ -19,6 +16,20 @@ import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import Graphics.X11.Types import Graphics.X11.Types
import Control.Exception
import System.Exit
import System.IO
import System.Process (waitForProcess)
import System.Process.Internals
( ProcessHandle__(ClosedHandle, OpenHandle)
, withProcessHandle
, mkProcessHandle)
import System.Posix.IO
import System.Posix.Process
import System.Posix.Signals
import System.Posix.Types
import Text.Read (readMaybe) import Text.Read (readMaybe)
import XMonad import XMonad
@ -56,11 +67,11 @@ import XMonad.Util.Run
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
main = do main = do
h <- spawnPipe "xmobar" (barPID, h) <- spawnPipe' "xmobar"
spawn "powermon" pwrPID <- spawnPID "powermon"
xmonad launch
$ ewmh $ ewmh
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) myKeys $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [pwrPID, barPID])
$ def { terminal = myTerm $ def { terminal = myTerm
, modMask = myModMask , modMask = myModMask
, layoutHook = myLayouts , layoutHook = myLayouts
@ -73,6 +84,18 @@ main = do
, focusFollowsMouse = False , focusFollowsMouse = False
} }
spawnPipe' :: MonadIO m => String -> m (ProcessID, Handle)
spawnPipe' x = io $ do
(rd, wr) <- createPipe
setFdOption wr CloseOnExec True
h <- fdToHandle wr
hSetBuffering h LineBuffering
p <- xfork $ do
_ <- dupTo rd stdInput
executeFile "/bin/sh" False ["-c", x] Nothing
closeFd rd
return (p, h)
myTopBarTheme = def myTopBarTheme = def
{ fontName = myFont { fontName = myFont
, inactiveBorderColor = "#999999" , inactiveBorderColor = "#999999"
@ -334,8 +357,8 @@ spawnCmdOwnWS cmd args ws = spawn
$ formatCmd cmd args $ formatCmd cmd args
#!&& formatCmd "xit-event" [magicStringWS, ws] #!&& formatCmd "xit-event" [magicStringWS, ws]
spawnKill :: [String] -> X () -- spawnKill :: [String] -> X ()
spawnKill cmds = spawn $ formatCmd "killall" cmds -- spawnKill = mapM_ (spawn . ("killall " ++))
myTerm :: String myTerm :: String
myTerm = "urxvt" myTerm = "urxvt"
@ -388,7 +411,7 @@ runBrowser = spawn "brave"
runEditor :: X () runEditor :: X ()
runEditor = spawnCmd "emacsclient" runEditor = spawnCmd "emacsclient"
["-c", "-e", "(select-frame-set-input-focus (selected-frame))\""] ["-c", "-e", "\"(select-frame-set-input-focus (selected-frame))\""]
runFileManager :: X () runFileManager :: X ()
runFileManager = spawn "pcmanfm" runFileManager = spawn "pcmanfm"
@ -405,14 +428,29 @@ runVBox = spawnCmdOwnWS "vbox-start win8raw" [] myVMWorkspace
runGimp :: X () runGimp :: X ()
runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace runGimp = spawnCmdOwnWS "gimp" [] myGimpWorkspace
runCleanup :: X () runCleanup :: [ProcessID] -> X ()
runCleanup = spawnKill ["xmobar", "powermon"] runCleanup ps = io $ mapM_ killPID ps
killPID :: ProcessID -> IO ()
killPID pID = do
h <- mkProcessHandle pID False
-- this may fail of the PID does not exist
_ <- try $ sendSIGTERM h :: IO (Either IOException ())
-- this may fail if the process exits instantly and the handle
-- is destroyed by the time we get to this line (I think?)
_ <- try $ waitForProcess h :: IO (Either IOException ExitCode)
return ()
where
sendSIGTERM h = withProcessHandle h $ \case
OpenHandle _ -> signalProcess sigTERM pID
ClosedHandle _ -> return ()
_ -> return () -- this should never happen
runRestart :: X () runRestart :: X ()
runRestart = spawnCmd "xmonad" ["--restart"] runRestart = restart "xmonad" True
runRecompile :: X () -- runRecompile :: X ()
runRecompile = spawnCmd "xmonad" ["--recompile"] -- runRecompile = void $ recompile True -- spawnCmd "xmonad" ["--recompile"]
myMultimediaCtl :: String myMultimediaCtl :: String
myMultimediaCtl = "playerctl" myMultimediaCtl = "playerctl"
@ -490,8 +528,8 @@ mkNamedSubmap c sectionName bindings =
-- NOTE: the following bindings are used by dunst: -- NOTE: the following bindings are used by dunst:
-- "M-~", "M-<esc>", "M-S-<esc>", "M-S-." -- "M-~", "M-<esc>", "M-S-<esc>", "M-S-."
myKeys :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] myKeys :: [ProcessID] -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)]
myKeys c = myKeys hs c =
mkNamedSubmap c "Window Layouts" mkNamedSubmap c "Window Layouts"
[ ("M-j", addName "focus down" $ windows W.focusDown) [ ("M-j", addName "focus down" $ windows W.focusDown)
, ("M-k", addName "focus up" $ windows W.focusUp) , ("M-k", addName "focus up" $ windows W.focusUp)
@ -571,8 +609,8 @@ myKeys c =
, ("M-M1-.", addName "backlight max" runMinBacklight) , ("M-M1-.", addName "backlight max" runMinBacklight)
, ("M-M1-=", addName "enable screensaver" enableDPMS) , ("M-M1-=", addName "enable screensaver" enableDPMS)
, ("M-M1--", addName "disable screensaver" disableDPMS) , ("M-M1--", addName "disable screensaver" disableDPMS)
, ("M-<F2>", addName "restart xmonad" $ runCleanup >> runRestart) , ("M-<F2>", addName "restart xmonad" $ runCleanup hs >> runRestart)
, ("M-S-<F2>", addName "recompile xmonad" $ runCleanup >> runRecompile) -- , ("M-S-<F2>", addName "recompile xmonad" $ runCleanup hs)
, ("M-<End>", addName "power menu" myPowerPrompt) , ("M-<End>", addName "power menu" myPowerPrompt)
, ("M-<Home>", addName "quit xmonad" myQuitPrompt) , ("M-<Home>", addName "quit xmonad" myQuitPrompt)
] ]