----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.SpawnOn -- Description : Modify a window spawned by a command. -- Copyright : (c) Spencer Janssen -- License : BSD -- -- Maintainer : Spencer Janssen <spencerjanssen@gmail.com> -- Stability : unstable -- Portability : unportable -- -- Provides a way to modify a window spawned by a command(e.g shift it to the workspace -- it was launched on) by using the _NET_WM_PID property that most windows set on creation. -- Hence this module won't work on applications that don't set this property. -- ----------------------------------------------------------------------------- module XMonad.Actions.SpawnOn ( -- * Usage -- $usage Spawner, manageSpawn, manageSpawnWithGC, spawnHere, spawnOn, spawnAndDo, shellPromptHere, shellPromptOn ) where import Control.Exception (tryJust) import System.IO.Error (isDoesNotExistError) import System.IO.Unsafe (unsafePerformIO) import System.Posix.Types (ProcessID) import Text.Printf (printf) import XMonad import XMonad.Prelude import qualified XMonad.StackSet as W import XMonad.Hooks.ManageHelpers import XMonad.Prompt import XMonad.Prompt.Shell import qualified XMonad.Util.ExtensibleState as XS -- $usage -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@: -- -- > import XMonad.Actions.SpawnOn -- -- > main = do -- > xmonad def { -- > ... -- > manageHook = manageSpawn <+> manageHook def -- > ... -- > } -- -- To ensure that application appears on a workspace it was launched at, add keybindings like: -- -- > , ((mod1Mask,xK_o), spawnHere "urxvt") -- > , ((mod1Mask,xK_s), shellPromptHere def) -- -- The module can also be used to apply other manage hooks to the window of -- the spawned application(e.g. float or resize it). -- -- For detailed instructions on editing your key bindings, see -- "XMonad.Doc.Extending#Editing_key_bindings". newtype Spawner = Spawner {Spawner -> [(ProcessID, ManageHook)] pidsRef :: [(ProcessID, ManageHook)]} instance ExtensionClass Spawner where initialValue :: Spawner initialValue = [(ProcessID, ManageHook)] -> Spawner Spawner [] getPPIDOf :: ProcessID -> Maybe ProcessID getPPIDOf :: ProcessID -> Maybe ProcessID getPPIDOf ProcessID thisPid = case IO (Either () String) -> Either () String forall a. IO a -> a unsafePerformIO (IO (Either () String) -> Either () String) -> (Integer -> IO (Either () String)) -> Integer -> Either () String forall b c a. (b -> c) -> (a -> b) -> a -> c . (IOError -> Maybe ()) -> IO String -> IO (Either () String) forall e b a. Exception e => (e -> Maybe b) -> IO a -> IO (Either b a) tryJust (Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard (Bool -> Maybe ()) -> (IOError -> Bool) -> IOError -> Maybe () forall b c a. (b -> c) -> (a -> b) -> a -> c . IOError -> Bool isDoesNotExistError) (IO String -> IO (Either () String)) -> (Integer -> IO String) -> Integer -> IO (Either () String) forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> IO String readFile (String -> IO String) -> (Integer -> String) -> Integer -> IO String forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Integer -> String forall r. PrintfType r => String -> r printf String "/proc/%d/stat" (Integer -> Either () String) -> Integer -> Either () String forall a b. (a -> b) -> a -> b $ ProcessID -> Integer forall a. Integral a => a -> Integer toInteger ProcessID thisPid of Left () _ -> Maybe ProcessID forall a. Maybe a Nothing Right String contents -> case String -> [String] lines String contents of [] -> Maybe ProcessID forall a. Maybe a Nothing String first : [String] _ -> case String -> [String] words String first of String _ : String _ : String _ : String ppid : [String] _ -> ProcessID -> Maybe ProcessID forall a. a -> Maybe a Just (ProcessID -> Maybe ProcessID) -> ProcessID -> Maybe ProcessID forall a b. (a -> b) -> a -> b $ Int -> ProcessID forall a b. (Integral a, Num b) => a -> b fromIntegral (String -> Int forall a. Read a => String -> a read String ppid :: Int) [String] _ -> Maybe ProcessID forall a. Maybe a Nothing getPPIDChain :: ProcessID -> [ProcessID] getPPIDChain :: ProcessID -> [ProcessID] getPPIDChain ProcessID thisPid = ProcessID -> [ProcessID] -> [ProcessID] ppid_chain ProcessID thisPid [] where ppid_chain :: ProcessID -> [ProcessID] -> [ProcessID] ppid_chain ProcessID pid' [ProcessID] acc = if ProcessID pid' ProcessID -> ProcessID -> Bool forall a. Eq a => a -> a -> Bool == ProcessID 0 then [ProcessID] acc else case ProcessID -> Maybe ProcessID getPPIDOf ProcessID pid' of Maybe ProcessID Nothing -> [ProcessID] acc Just ProcessID ppid -> ProcessID -> [ProcessID] -> [ProcessID] ppid_chain ProcessID ppid (ProcessID ppid ProcessID -> [ProcessID] -> [ProcessID] forall a. a -> [a] -> [a] : [ProcessID] acc) -- | Get the current Spawner or create one if it doesn't exist. modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)] f = (Spawner -> Spawner) -> X () forall a (m :: * -> *). (ExtensionClass a, XLike m) => (a -> a) -> m () XS.modify ([(ProcessID, ManageHook)] -> Spawner Spawner ([(ProcessID, ManageHook)] -> Spawner) -> (Spawner -> [(ProcessID, ManageHook)]) -> Spawner -> Spawner forall b c a. (b -> c) -> (a -> b) -> a -> c . [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)] f ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> (Spawner -> [(ProcessID, ManageHook)]) -> Spawner -> [(ProcessID, ManageHook)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Spawner -> [(ProcessID, ManageHook)] pidsRef) -- | Provides a manage hook to react on process spawned with -- 'spawnOn', 'spawnHere' etc. manageSpawn :: ManageHook manageSpawn :: ManageHook manageSpawn = ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -> ManageHook manageSpawnWithGC ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)] forall (m :: * -> *) a. Monad m => a -> m a return ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -> ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> [(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)] forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)] forall a. Int -> [a] -> [a] take Int 20) manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@ -> ManageHook manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)]) -> ManageHook manageSpawnWithGC [(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)] garbageCollect = do Spawner [(ProcessID, ManageHook)] pids <- X Spawner -> Query Spawner forall a. X a -> Query a liftX X Spawner forall a (m :: * -> *). (ExtensionClass a, XLike m) => m a XS.get Maybe ProcessID mp <- Query (Maybe ProcessID) pid let ppid_chain :: [ProcessID] ppid_chain = case Maybe ProcessID mp of Just ProcessID winpid -> ProcessID winpid ProcessID -> [ProcessID] -> [ProcessID] forall a. a -> [a] -> [a] : ProcessID -> [ProcessID] getPPIDChain ProcessID winpid Maybe ProcessID Nothing -> [] known_window_handlers :: [ManageHook] known_window_handlers = [ ManageHook mpid | ProcessID ppid <- [ProcessID] ppid_chain , Just ManageHook mpid <- [ProcessID -> [(ProcessID, ManageHook)] -> Maybe ManageHook forall a b. Eq a => a -> [(a, b)] -> Maybe b lookup ProcessID ppid [(ProcessID, ManageHook)] pids] ] case [ManageHook] known_window_handlers of [] -> ManageHook forall m. Monoid m => m idHook (ManageHook mh:[ManageHook] _) -> do Maybe ProcessID -> (ProcessID -> Query ()) -> Query () forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m () whenJust Maybe ProcessID mp ((ProcessID -> Query ()) -> Query ()) -> (ProcessID -> Query ()) -> Query () forall a b. (a -> b) -> a -> b $ \ProcessID p -> X () -> Query () forall a. X a -> Query a liftX (X () -> Query ()) -> X () -> Query () forall a b. (a -> b) -> a -> b $ do [(ProcessID, ManageHook)] ps <- (Spawner -> [(ProcessID, ManageHook)]) -> X [(ProcessID, ManageHook)] forall a (m :: * -> *) b. (ExtensionClass a, XLike m) => (a -> b) -> m b XS.gets Spawner -> [(ProcessID, ManageHook)] pidsRef Spawner -> X () forall a (m :: * -> *). (ExtensionClass a, XLike m) => a -> m () XS.put (Spawner -> X ()) -> ([(ProcessID, ManageHook)] -> Spawner) -> [(ProcessID, ManageHook)] -> X () forall b c a. (b -> c) -> (a -> b) -> a -> c . [(ProcessID, ManageHook)] -> Spawner Spawner ([(ProcessID, ManageHook)] -> X ()) -> X [(ProcessID, ManageHook)] -> X () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< [(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)] garbageCollect (((ProcessID, ManageHook) -> Bool) -> [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)] forall a. (a -> Bool) -> [a] -> [a] filter ((ProcessID -> ProcessID -> Bool forall a. Eq a => a -> a -> Bool /= ProcessID p) (ProcessID -> Bool) -> ((ProcessID, ManageHook) -> ProcessID) -> (ProcessID, ManageHook) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (ProcessID, ManageHook) -> ProcessID forall a b. (a, b) -> a fst) [(ProcessID, ManageHook)] ps) ManageHook mh mkPrompt :: (String -> X ()) -> XPConfig -> X () mkPrompt :: (String -> X ()) -> XPConfig -> X () mkPrompt String -> X () cb XPConfig c = do [String] cmds <- IO [String] -> X [String] forall (m :: * -> *) a. MonadIO m => IO a -> m a io IO [String] getCommands Shell -> XPConfig -> ComplFunction -> (String -> X ()) -> X () forall p. XPrompt p => p -> XPConfig -> ComplFunction -> (String -> X ()) -> X () mkXPrompt Shell Shell XPConfig c ([String] -> Predicate -> ComplFunction getShellCompl [String] cmds (Predicate -> ComplFunction) -> Predicate -> ComplFunction forall a b. (a -> b) -> a -> b $ XPConfig -> Predicate searchPredicate XPConfig c) String -> X () cb -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on current workspace. shellPromptHere :: XPConfig -> X () shellPromptHere :: XPConfig -> X () shellPromptHere = (String -> X ()) -> XPConfig -> X () mkPrompt String -> X () spawnHere -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches -- application on given workspace. shellPromptOn :: WorkspaceId -> XPConfig -> X () shellPromptOn :: String -> XPConfig -> X () shellPromptOn String ws = (String -> X ()) -> XPConfig -> X () mkPrompt (String -> String -> X () spawnOn String ws) -- | Replacement for 'spawn' which launches -- application on current workspace. spawnHere :: String -> X () spawnHere :: String -> X () spawnHere String cmd = (WindowSet -> X ()) -> X () forall a. (WindowSet -> X a) -> X a withWindowSet ((WindowSet -> X ()) -> X ()) -> (WindowSet -> X ()) -> X () forall a b. (a -> b) -> a -> b $ \WindowSet ws -> String -> String -> X () spawnOn (WindowSet -> String forall i l a s sd. StackSet i l a s sd -> i W.currentTag WindowSet ws) String cmd -- | Replacement for 'spawn' which launches -- application on given workspace. spawnOn :: WorkspaceId -> String -> X () spawnOn :: String -> String -> X () spawnOn String ws = ManageHook -> String -> X () spawnAndDo (String -> ManageHook doShift String ws) -- | Spawn an application and apply the manage hook when it opens. spawnAndDo :: ManageHook -> String -> X () spawnAndDo :: ManageHook -> String -> X () spawnAndDo ManageHook mh String cmd = do ProcessID p <- String -> X ProcessID forall (m :: * -> *). MonadIO m => String -> m ProcessID spawnPID (String -> X ProcessID) -> String -> X ProcessID forall a b. (a -> b) -> a -> b $ String -> String mangle String cmd ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X () modifySpawner ((ProcessID p,ManageHook mh) (ProcessID, ManageHook) -> [(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)] forall a. a -> [a] -> [a] :) where -- TODO this is silly, search for a better solution mangle :: String -> String mangle String xs | (Char -> Bool) -> String -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (Char -> String -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` String metaChars) String xs Bool -> Bool -> Bool || String "exec" Predicate forall a. Eq a => [a] -> [a] -> Bool `isInfixOf` String xs = String xs | Bool otherwise = String "exec " String -> String -> String forall a. [a] -> [a] -> [a] ++ String xs metaChars :: String metaChars = String "&|;"