1 files changed, 105 insertions, 0 deletions

diff --git a/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs
new file mode 100644
index 00000000..c268f87d
--- /dev/null
+++ b/accounts/gkleen@sif/xmonad/lib/XMonad/Prompt/MyShell.hs
@@ -0,0 +1,105 @@
+module XMonad.Prompt.MyShell
+       ( Shell (..)
+       , shellPrompt
+       , prompt
+       , safePrompt
+       , unsafePrompt
+       , getCommands
+       , getShellCompl
+       , split
+       ) where
+
+import Codec.Binary.UTF8.String (encodeString)
+import Control.Exception as E
+import Control.Monad (forM)
+import Data.List (isPrefixOf)
+import System.Directory (doesDirectoryExist, getDirectoryContents)
+import System.Environment (getEnv)
+import System.Posix.Files (getFileStatus, isDirectory)
+
+import XMonad hiding (config)
+import XMonad.Prompt
+import XMonad.Util.Run
+
+econst :: Monad m => a -> IOException -> m a
+econst = const . return
+
+data Shell = Shell String
+
+instance XPrompt Shell where
+    showXPrompt (Shell q)     = q
+    completionToCommand _ = escape
+
+shellPrompt :: String -> XPConfig -> X ()
+shellPrompt q c = do
+    cmds <- io getCommands
+    mkXPrompt (Shell q) c (getShellCompl cmds) spawn
+
+{- $spawns
+    See safe and unsafeSpawn in "XMonad.Util.Run".
+    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:
+
+    >     , ((modm,               xK_b), safePrompt "firefox" greenXPConfig)
+    >     , ((modm .|. 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 :: String -> FilePath -> XPConfig -> X ()
+prompt = unsafePrompt
+safePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run
+    where run = safeSpawn c . return
+unsafePrompt q c config = mkXPrompt (Shell q) config (getShellCompl [c]) run
+    where run a = unsafeSpawn $ c ++ " " ++ a
+
+getShellCompl :: [String] -> String -> IO [String]
+getShellCompl cmds s | s == "" || last s == ' ' = return []
+                     | otherwise                = do
+    f     <- fmap lines $ runProcessWithInput "bash" [] ("compgen -A file -- "
+                                                        ++ s ++ "\n")
+    files <- case f of
+               [x] -> do fs <- getFileStatus (encodeString x)
+                         if isDirectory fs then return [x ++ "/"]
+                                           else return [x]
+               _   -> return f
+    return . uniqSort $ files ++ commandCompletionFunction cmds s
+
+commandCompletionFunction :: [String] -> String -> [String]
+commandCompletionFunction cmds str | '/' `elem` str = []
+                                   | otherwise      = filter (isPrefixOf str) cmds
+
+getCommands :: IO [String]
+getCommands = do
+    p  <- getEnv "PATH" `E.catch` econst []
+    let ds = filter (/= "") $ split ':' p
+    es <- forM ds $ \d -> do
+        exists <- doesDirectoryExist d
+        if exists
+            then getDirectoryContents d
+            else return []
+    return . uniqSort . filter ((/= '.') . head) . concat $ es
+
+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 (x:xs)
+    | isSpecialChar x = '\\' : x : escape xs
+    | otherwise       = x : escape xs
+
+isSpecialChar :: Char -> Bool
+isSpecialChar =  flip elem " &\\@\"'#?$*()[]{};"