ENH make app puke if xcape isn't installed (good idea, right?)
This commit is contained in:
parent
399f3ebe23
commit
1b9fa101fa
58
app/Main.hs
58
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,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
|
||||||
|
|
|
@ -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