ENH make app puke if xcape isn't installed (good idea, right?)

This commit is contained in:
Nathan Dwarshuis 2022-07-21 23:36:18 -04:00
parent 399f3ebe23
commit 1b9fa101fa
2 changed files with 36 additions and 23 deletions

View File

@ -42,6 +42,7 @@ import Graphics.X11.Xlib.Types
import Text.Regex.TDFA import Text.Regex.TDFA
import System.Directory
import System.Environment import System.Environment
import System.Posix.IO import System.Posix.IO
import System.Posix.Signals import System.Posix.Signals
@ -96,12 +97,15 @@ parse ("-t":t:b:rs) = initXMan rs $ mkXcapeProcess (Just t) b
parse (b:rs) = initXMan rs $ mkXcapeProcess Nothing b parse (b:rs) = initXMan rs $ mkXcapeProcess Nothing b
parse _ = usage parse _ = usage
xcapeExe :: String
xcapeExe = "xcape"
-- | Given a timeout and bindings for xcape, return a process record. This will -- | Given a timeout and bindings for xcape, return a process record. This will
-- run xcape in debug mode (which will make it run as a foreground process, -- run xcape in debug mode (which will make it run as a foreground process,
-- otherwise it will fork unnecessarily). -- otherwise it will fork unnecessarily).
mkXcapeProcess :: Timeout -> Bindings -> CreateProcess mkXcapeProcess :: Timeout -> Bindings -> CreateProcess
mkXcapeProcess (Just t) b = proc "xcape" $ ["-t", t, "-d", "-e"] ++ [b] mkXcapeProcess (Just t) b = proc xcapeExe $ ["-t", t, "-d", "-e"] ++ [b]
mkXcapeProcess Nothing b = proc "xcape" $ ["-d", "-e"] ++ [b] mkXcapeProcess Nothing b = proc xcapeExe $ ["-d", "-e"] ++ [b]
-- | Print the usage and exit -- | Print the usage and exit
usage :: IO () usage :: IO ()
@ -111,27 +115,35 @@ usage = putStrLn "xman [-t TIMEOUT] BINDINGS REGEXP [[REGEXP] ...]"
-- titles we care about, initialize the XMan monad and run the main event loop -- titles we care about, initialize the XMan monad and run the main event loop
initXMan :: Patterns -> CreateProcess -> IO () initXMan :: Patterns -> CreateProcess -> IO ()
initXMan rs cp = do initXMan rs cp = do
-- ignore SIGCHLD so we don't produce zombie processes r <- checkXcape
void $ installHandler sigCHLD Ignore Nothing if r then initX else putStrLn "could not find xcape binary"
dpy <- openDisplay "" where
root <- rootWindow dpy $ defaultScreen dpy initX = do
naw <- internAtom dpy "_NET_ACTIVE_WINDOW" False -- ignore SIGCHLD so we don't produce zombie processes
let cf = XMConf void $ installHandler sigCHLD Ignore Nothing
{ display = dpy dpy <- openDisplay ""
, theRoot = root root <- rootWindow dpy $ defaultScreen dpy
, netActiveWindow = naw naw <- internAtom dpy "_NET_ACTIVE_WINDOW" False
, regexps = rs let cf = XMConf
, xcapeProcess = cp { display = dpy
} , theRoot = root
st = XMState { xcapeHandle = Nothing } , netActiveWindow = naw
-- listen only for PropertyNotify events on the root window , regexps = rs
allocaSetWindowAttributes $ \a -> do , xcapeProcess = cp
set_event_mask a propertyChangeMask }
changeWindowAttributes dpy root cWEventMask a st = XMState { xcapeHandle = Nothing }
void $ allocaXEvent $ \e -> -- listen only for PropertyNotify events on the root window
runXMan cf st $ do allocaSetWindowAttributes $ \a -> do
updateXCape -- set the initial state before entering main loop set_event_mask a propertyChangeMask
forever $ handle =<< io (nextEvent dpy e >> getEvent e) changeWindowAttributes dpy root cWEventMask a
void $ allocaXEvent $ \e ->
runXMan cf st $ do
updateXCape -- set the initial state before entering main loop
forever $ handle =<< io (nextEvent dpy e >> getEvent e)
checkXcape :: IO Bool
checkXcape = isJust <$> findExecutable xcapeExe
-- | Lift an IO monad into the XMan context -- | Lift an IO monad into the XMan context

View File

@ -33,5 +33,6 @@ executable xman
, unix >= 2.7.2.2 , unix >= 2.7.2.2
, regex-tdfa >= 1.2.3.2 , regex-tdfa >= 1.2.3.2
, process >= 1.6.5.0 , process >= 1.6.5.0
, directory >= 1.3.3.0
default-language: Haskell2010 default-language: Haskell2010