ENH make app puke if xcape isn't installed (good idea, right?)
This commit is contained in:
parent
399f3ebe23
commit
1b9fa101fa
16
app/Main.hs
16
app/Main.hs
|
@ -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,6 +115,10 @@ 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
|
||||||
|
r <- checkXcape
|
||||||
|
if r then initX else putStrLn "could not find xcape binary"
|
||||||
|
where
|
||||||
|
initX = do
|
||||||
-- ignore SIGCHLD so we don't produce zombie processes
|
-- ignore SIGCHLD so we don't produce zombie processes
|
||||||
void $ installHandler sigCHLD Ignore Nothing
|
void $ installHandler sigCHLD Ignore Nothing
|
||||||
dpy <- openDisplay ""
|
dpy <- openDisplay ""
|
||||||
|
@ -133,6 +141,10 @@ initXMan rs cp = do
|
||||||
updateXCape -- set the initial state before entering main loop
|
updateXCape -- set the initial state before entering main loop
|
||||||
forever $ handle =<< io (nextEvent dpy e >> getEvent e)
|
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
|
||||||
io :: MonadIO m => IO a -> m a
|
io :: MonadIO m => IO a -> m a
|
||||||
|
|
|
@ -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
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue