From 840f96c76b4ce93c5e6d555c4a2cc816b3cd590c Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Wed, 1 Apr 2020 12:57:39 -0400 Subject: [PATCH] REF add documentation --- app/Main.hs | 86 +++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 73 insertions(+), 13 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 68539b2..b5448e4 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,23 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +-------------------------------------------------------------------------------- +-- | Xcape MANager (XMan) - a wrapper for managing Xcape +-- +-- Xcape is a program to map keyrease events to keysyms, and is very useful +-- for making custom keymaps. However, it is not alwasys desirable to have this +-- running all the time; for example, VirtualBox will blend the XKB keymap with +-- that if the Guest OS, so Xcape may end up producing an extra keypress. The +-- solution is to turn off Xcape when certain windows are in focus. +-- +-- The process for doing this using Xlib: +-- 1) Listen for PropertyNotify events from the root window +-- 2) Of those events, filter those where the _NET_ACTIVE_WINDOW atom has changed +-- 3) Using the value of _NET_ACTIVE_WINDOW, get the title of the active window +-- 4) If active window matches a certain criteria, turn off Xcape (vice versa) +-- +-- The matching criteria in (4) are POSIX regular expressions. + module Main where import Control.Monad (forM_, forever, void, when) @@ -30,7 +47,15 @@ import System.Process type WindowTitle = String --- I wonder where this idea came from... +-------------------------------------------------------------------------------- +-- | Central State+Reader+IO Monad (I wonder where this idea came from...) +-- +-- The Reader portion holds some of the key data structures from +-- X that we care about as well as the regular expression patterns to match and +-- the keys to pass the Xcape command. +-- +-- The State portion holds the Xcape process handle (so we can kill it later) +-- and the current window title. newtype XMan a = XMan (ReaderT XMConf (StateT XMState IO) a) deriving (Functor, Monad, MonadIO, MonadState XMState, MonadReader XMConf) @@ -52,25 +77,26 @@ data XMConf = XMConf , xcapeKeys :: String } -io :: MonadIO m => IO a -> m a -io = liftIO - -runXMan :: XMConf -> XMState -> XMan a -> IO (a, XMState) -runXMan c s (XMan a) = runStateT (runReaderT a c) s +main :: IO () +main = getArgs >>= parse +-- | Given a list of arguments, either start the program or print the usage parse :: [String] -> IO () parse [_] = usage parse (x:rs) = initXMan x rs parse _ = usage +-- | Print the usage and exit usage :: IO () +-- TODO produce relevant exit codes here usage = putStrLn "xman XCAPE_KEYS REGEXP [[REGEXP]...]" -main :: IO () -main = getArgs >>= parse - +-- | Given a string of keys for xcape and a list of regular expressions to match +-- the window titles we care about, initialize the XMan monad and run the main +-- event loop. initXMan :: String -> [String] -> IO () initXMan x r = do + -- ignore SIGCHLD so we don't produce zombie processes void $ installHandler sigCHLD Ignore Nothing dpy <- openDisplay "" root <- rootWindow dpy $ defaultScreen dpy @@ -85,14 +111,24 @@ initXMan x r = do , xcapeKeys = x } st = XMState { currentTitle = Nothing, xcapeProcess = Nothing } + -- listen only for PropertyNotify events on the root window allocaSetWindowAttributes $ \a -> do set_event_mask a propertyChangeMask changeWindowAttributes dpy root cWEventMask a void $ allocaXEvent $ \e -> runXMan cf st $ do - updateXCape + updateXCape -- set the initial state before entering main loop forever $ handle =<< io (nextEvent dpy e >> getEvent e) +-- | Lift an IO monad into the XMan context +io :: MonadIO m => IO a -> m a +io = liftIO + +-- | Given an initial state and configuration, run the XMan monad +runXMan :: XMConf -> XMState -> XMan a -> IO (a, XMState) +runXMan c s (XMan a) = runStateT (runReaderT a c) s + +-- | Update the xcape status given the state of XMan updateXCape :: XMan () updateXCape = do dpy <- asks display @@ -103,21 +139,28 @@ updateXCape = do Just [aw] -> getTitle aw >>= updateTitle >> startOrKillXCape _ -> return () +-- | Given an event, call a handler. In this case the only thing we care about +-- are PropertyNotify events where the atom is _NET_ACTIVE_WINDOW, which will +-- initiated the xcape update logic. handle :: Event -> XMan () handle PropertyEvent { ev_atom = a } = do atom <- asks netActiveWindow when (a == atom) updateXCape handle _ = return () +-- | Get the title of a window given a window ID +-- The window title could be in two atoms. This will try _NET_WM_NAME first +-- before trying WM_NAME (legacy) getTitle :: CLong -> XMan (Maybe WindowTitle) getTitle winID = do nwn <- asks netWMName - -- try getting _NET_WM_NAME first before trying legacy WM_NAME doMaybe [nwn, wM_NAME] $ getTitle' winID where doMaybe (x:xs) f = f x >>= (\r -> if isJust r then return r else doMaybe xs f) doMaybe [] _ = return Nothing +-- | Get the title of a window given a window ID and an atom that may contain +-- the title getTitle' :: CLong -> Atom -> XMan (Maybe WindowTitle) getTitle' winID atom = do dpy <- asks display @@ -125,6 +168,11 @@ getTitle' winID atom = do $ fromIntegral winID return $ fmap (fmap castCCharToChar) title' +-- | Given an IO action (which is assumed to call an XLib function that may +-- throw an error), attach an error handler before performing the action and +-- remove it after it completes. The error handler will ignore BadWindow errors +-- (which in this case are assumed to be benign since the _NET_ACTIVE_WINDOW +-- atom may refer to a non-existent window) permitBadWindow :: IO a -> IO a permitBadWindow action = do handler <- mkXErrorHandler $ \_ e -> @@ -134,24 +182,27 @@ permitBadWindow action = do void $ _xSetErrorHandler original return res where - -- totally ignore BadWindow errors -- TODO also ignore badvalue errors? handleError ErrorEvent { ev_error_code = t } | fromIntegral t == badWindow = return () - -- anything not a BadWindow is an unexpected error handleError _ = print "actual error" +-- | Given a window title that may exist, update the window title in XMan's +-- state updateTitle :: Maybe WindowTitle -> XMan () updateTitle newTitle = modify (\s -> s { currentTitle = newTitle } ) +-- | Start or stop xcape given the state in XMan startOrKillXCape :: XMan () startOrKillXCape = do + -- TODO this is redundant title <- gets currentTitle case title of Just t -> asks regexps >>= \r -> if any (t =~) r then stopXCape else startXCape Nothing -> startXCape +-- | Start Xcape if it is not already running startXCape :: XMan () startXCape = do pID <- gets xcapeProcess @@ -161,6 +212,7 @@ startXCape = do modify $ \s -> s { xcapeProcess = Just h } io $ print "started xcape" +-- | Stop Xcape if it is running stopXCape :: XMan () stopXCape = do pID <- gets xcapeProcess @@ -169,10 +221,18 @@ stopXCape = do modify $ \s -> s { xcapeProcess = Nothing } io $ print "stopped xcape" +-- | Given the keys argument for xcape, run xcape with the keys argument and +-- return the process handle. Run xcape in debug mode (this will make it run as +-- a foreground process, otherwise it will fork unnecessarily) and pipe the +-- output and error streams to the null device. +-- NOTE: use the process module here rather than the unix module. The latter +-- has the 'forkProcess' function which may fail if multiple instances of xcape +-- are started and killed in quick succession (Resource unavailable error). runXcape :: String -> IO ProcessHandle runXcape keys = do dn <- fmap UseHandle $ fdToHandle =<< openFd "/dev/null" ReadOnly Nothing defaultFileFlags + -- TODO pass more arguments here? this hardcodes the timeout let cp = proc "xcape" $ ["-d", "-t", "500", "-e"] ++ [keys] (_, _, _, h) <- createProcess $ cp { std_err = dn, std_out = dn } return h