From 5fd087d0f00b652d29de064b4d119e48f44976b0 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Wed, 1 Apr 2020 15:59:26 -0400 Subject: [PATCH] ENH use app name instead of window title for matching --- app/Main.hs | 91 +++++++++++++++++++++-------------------------------- 1 file changed, 35 insertions(+), 56 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 09bd906..70fb1ae 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,5 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -------------------------------------------------------------------------------- -- | Xcape MANager (XMan) - a wrapper for managing xcape @@ -24,9 +23,6 @@ -- will not be updated or restarted. Furthermore, it is outside the scope of -- this program to bind multiple xcape mappings with multiple keymaps --- TODO actually match the command associated with the window? Might be simpler --- and more reliable since the title can be changed on the fly - module Main where import Control.Monad (forM_, forever, void, when) @@ -36,9 +32,6 @@ import Control.Monad.State import Data.List (any) import Data.Maybe (isJust) -import Foreign.C.String (castCCharToChar) -import Foreign.C.Types (CLong) - import Graphics.X11.Types import Graphics.X11.Xlib.Atom import Graphics.X11.Xlib.Display @@ -54,14 +47,12 @@ import System.Posix.IO import System.Posix.Signals import System.Process -type WindowTitle = String - -------------------------------------------------------------------------------- -- | 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. +-- about as well as the regular expression patterns to match the app names we +-- care about and and the bindings to pass to the xcape command. -- -- The State portion holds the xcape process handle (so we can kill it later) newtype XMan a = XMan (ReaderT XMConf (StateT XMState IO) a) deriving @@ -77,11 +68,19 @@ data XMConf = XMConf { display :: Display , theRoot :: Window , netActiveWindow :: Atom - , netWMName :: Atom - , regexps :: [String] - , xcapeKeys :: String + , regexps :: Patterns + , xcapeKeys :: Bindings } +-- | regular expression patterns +type Patterns = [String] + +-- | bindings for xcape +type Bindings = String + +-- | window app name +type AppName = String + -------------------------------------------------------------------------------- main :: IO () @@ -95,25 +94,21 @@ parse _ = usage -- | Print the usage and exit usage :: IO () --- TODO produce relevant exit codes here -usage = putStrLn "xman XCAPE_KEYS REGEXP [[REGEXP]...]" +usage = putStrLn "xman BINDINGS REGEXP [[REGEXP]...]" --- | 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 () +-- | Given xcape bindings and regular expression patterns to match the window +-- titles we care about, initialize the XMan monad and run the main event loop +initXMan :: Bindings -> Patterns -> 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 naw <- internAtom dpy "_NET_ACTIVE_WINDOW" False - nwn <- internAtom dpy "_NET_WM_NAME" False let cf = XMConf { display = dpy , theRoot = root , netActiveWindow = naw - , netWMName = nwn , regexps = r , xcapeKeys = x } @@ -143,7 +138,7 @@ updateXCape = do root <- asks theRoot prop <- io $ getWindowProperty32 dpy atom root case prop of - Just [aw] -> getTitle aw >>= startOrKillXCape + Just [aw] -> getAppName (fromIntegral aw) >>= startOrKillXCape _ -> return () -- | Given an event, call a handler. In this case the only thing we care about @@ -155,25 +150,9 @@ handle PropertyEvent { ev_atom = a } = do 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 - 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 - title' <- io $ permitBadWindow $ getWindowProperty8 dpy atom - $ fromIntegral winID - return $ fmap (fmap castCCharToChar) title' +-- | Given a window, return its app name +getAppName :: Window -> XMan AppName +getAppName w = asks display >>= io . fmap resName . flip getClassHint w -- | 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 @@ -194,12 +173,12 @@ permitBadWindow action = do | fromIntegral t == badWindow = return () handleError _ = print "actual error" --- | Given a window title that may exist, start or stop xcape given -startOrKillXCape :: Maybe WindowTitle -> XMan () -startOrKillXCape = \case - Just title -> asks regexps >>= \rs -> - if any (title =~) rs then stopXCape else startXCape - Nothing -> startXCape +-- | Given an app name, start or stop xcape if it matches any of the supplied +-- regular expressions in XMan +startOrKillXCape :: AppName -> XMan () +startOrKillXCape name = do + rs <- asks regexps + if any (name =~) rs then stopXCape else startXCape -- | Start xcape if it is not already running startXCape :: XMan () @@ -220,14 +199,14 @@ 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 +-- | Given xcape bindings, run xcape with the bindings 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 :: Bindings -> IO ProcessHandle runXcape keys = do dn <- fmap UseHandle $ fdToHandle =<< openFd "/dev/null" ReadOnly Nothing defaultFileFlags