-----------------------------------------------------------------------------
-- |
-- Module : XMonadContrib.ShellPrompt
-- Copyright : (C) 2007 Andrea Rossato
-- License : BSD3
--
-- Maintainer : andrea.rossato@unibz.it
-- Stability : unstable
-- Portability : unportable
--
-- A shell prompt for XMonad
--
-----------------------------------------------------------------------------
module XMonadContrib.ShellPrompt (
-- * Usage
-- $usage
shellPrompt
, getShellCompl
, split
, prompt
, safePrompt
, runInXTerm
) where
import System.Environment (getEnv)
import Control.Monad (Monad((>>=), return), Functor(..), filterM, forM)
import Data.List ((++), concat, filter, map, lines, elem, span, tail, last,
isPrefixOf)
import Data.Set (toList, fromList)
import System.Directory (Permissions(executable), getPermissions,
getDirectoryContents, doesDirectoryExist, doesFileExist)
import System.IO (IO, FilePath)
import XMonadContrib.Run (runProcessWithInput, safeSpawn, unsafeSpawn)
import XMonad (X, io, spawn)
import XMonadContrib.XPrompt (XPrompt(..), XPConfig, mkXPrompt)
-- $usage
--
-- 1. In Config.hs add:
--
-- > import XMonadContrib.XPrompt
-- > import XMonadContrib.ShellPrompt
--
-- 2. In your keybindings add something like:
--
-- > , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig)
--
-- %import XMonadContrib.XPrompt
-- %import XMonadContrib.ShellPrompt
-- %keybind , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig)
data Shell = Shell
instance XPrompt Shell where
showXPrompt Shell = "Run: "
shellPrompt :: XPConfig -> X ()
shellPrompt c = do
cmds <- io $ getCommands
mkXPrompt Shell c (getShellCompl cmds) spawn
{- | See safe and unsafeSpawn. prompt is an alias for safePrompt; safePrompt and unsafePrompt work on the same principles,
but will use XPrompt to interactively query the user for input; the appearance is set by passing an XPConfig as the
second argument. The first argument is the program to be run with the interactive input.
You would use these like this:
> , ((modMask, xK_b ), safePrompt "firefox" greenXPConfig)
> , ((modMask .|. shiftMask, xK_c ), prompt ("xterm" ++ " -e") greenXPConfig)
Note that you want to use safePrompt for Firefox input, as Firefox wants URLs, and unsafePrompt for the XTerm example
because this allows you to easily start a terminal executing an arbitrary command, like 'top'. -}
prompt, unsafePrompt, safePrompt :: FilePath -> XPConfig -> X ()
prompt = unsafePrompt
safePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run
where run = safeSpawn c
unsafePrompt c config = mkXPrompt Shell config (getShellCompl [c]) run
where run a = unsafeSpawn $ c ++ " " ++ a
-- This may be better done as a specialization of 'prompt'
runInXTerm :: String -> X ()
runInXTerm com = do
c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm")
spawn ("exec " ++ c ++ " -e " ++ com)
getShellCompl :: [String] -> String -> IO [String]
getShellCompl cmds s | s == "" || last s == ' ' = return []
| otherwise = do
f <- fmap lines $ runProcessWithInput "/bin/bash" [] ("compgen -A file " ++ s ++ "\n")
return . map escape . uniqSort $ f ++ commandCompletionFunction cmds s
uniqSort :: Ord a => [a] -> [a]
uniqSort = toList . fromList
commandCompletionFunction :: [String] -> String -> [String]
commandCompletionFunction cmds str | '/' `elem` str = []
| otherwise = filter (isPrefixOf str) cmds
getCommands :: IO [String]
getCommands = do
p <- getEnv "PATH" `catch` const (return [])
let ds = split ':' p
fp d f = d ++ "/" ++ f
es <- forM ds $ \d -> do
exists <- doesDirectoryExist d
if exists
then getDirectoryContents d >>= filterM (isExecutable . fp d)
else return []
return . uniqSort . concat $ es
isExecutable :: FilePath ->IO Bool
isExecutable f = do
fe <- doesFileExist f
if fe
then fmap executable $ getPermissions f
else return False
split :: Eq a => a -> [a] -> [[a]]
split _ [] = []
split e l =
f : split e (rest ls)
where
(f,ls) = span (/=e) l
rest s | s == [] = []
| otherwise = tail s
escape :: String -> String
escape [] = ""
escape (' ':xs) = "\\ " ++ escape xs
escape (x:xs)
| isSpecialChar x = '\\' : x : escape xs
| otherwise = x : escape xs
isSpecialChar :: Char -> Bool
isSpecialChar = flip elem "\\@\"'#?$*()[]{};"
