ghciWelcomeMsg = "GHCi, version " ++ cProjectVersion ++
": http://www.haskell.org/ghc/ :? for help"
-type Command = (String, String -> GHCi Bool, Bool, String -> IO [String])
-
cmdName :: Command -> String
cmdName (n,_,_,_) = n
builtin_commands :: [Command]
builtin_commands = [
-- Hugs users are accustomed to :e, so make sure it doesn't overlap
- ("?", keepGoing help, False, completeNone),
- ("add", keepGoingPaths addModule, False, completeFilename),
- ("abandon", keepGoing abandonCmd, False, completeNone),
- ("break", keepGoing breakCmd, False, completeIdentifier),
- ("back", keepGoing backCmd, False, completeNone),
- ("browse", keepGoing (browseCmd False), False, completeModule),
- ("browse!", keepGoing (browseCmd True), False, completeModule),
- ("cd", keepGoing changeDirectory, False, completeFilename),
- ("check", keepGoing checkModule, False, completeHomeModule),
- ("continue", keepGoing continueCmd, False, completeNone),
- ("cmd", keepGoing cmdCmd, False, completeIdentifier),
- ("ctags", keepGoing createCTagsFileCmd, False, completeFilename),
- ("def", keepGoing (defineMacro False), False, completeIdentifier),
- ("def!", keepGoing (defineMacro True), False, completeIdentifier),
- ("delete", keepGoing deleteCmd, False, completeNone),
- ("e", keepGoing editFile, False, completeFilename),
- ("edit", keepGoing editFile, False, completeFilename),
- ("etags", keepGoing createETagsFileCmd, False, completeFilename),
- ("force", keepGoing forceCmd, False, completeIdentifier),
- ("forward", keepGoing forwardCmd, False, completeNone),
- ("help", keepGoing help, False, completeNone),
- ("history", keepGoing historyCmd, False, completeNone),
- ("info", keepGoing info, False, completeIdentifier),
- ("kind", keepGoing kindOfType, False, completeIdentifier),
- ("load", keepGoingPaths loadModule_, False, completeHomeModuleOrFile),
- ("list", keepGoing listCmd, False, completeNone),
- ("module", keepGoing setContext, False, completeModule),
- ("main", keepGoing runMain, False, completeIdentifier),
- ("print", keepGoing printCmd, False, completeIdentifier),
- ("quit", quit, False, completeNone),
- ("reload", keepGoing reloadModule, False, completeNone),
- ("set", keepGoing setCmd, True, completeSetOptions),
- ("show", keepGoing showCmd, False, completeNone),
- ("sprint", keepGoing sprintCmd, False, completeIdentifier),
- ("step", keepGoing stepCmd, False, completeIdentifier),
- ("steplocal", keepGoing stepLocalCmd, False, completeIdentifier),
- ("stepmodule",keepGoing stepModuleCmd, False, completeIdentifier),
- ("type", keepGoing typeOfExpr, False, completeIdentifier),
- ("trace", keepGoing traceCmd, False, completeIdentifier),
- ("undef", keepGoing undefineMacro, False, completeMacro),
- ("unset", keepGoing unsetOptions, True, completeSetOptions)
+ ("?", keepGoing help, Nothing, completeNone),
+ ("add", keepGoingPaths addModule, Just filenameWordBreakChars, completeFilename),
+ ("abandon", keepGoing abandonCmd, Nothing, completeNone),
+ ("break", keepGoing breakCmd, Nothing, completeIdentifier),
+ ("back", keepGoing backCmd, Nothing, completeNone),
+ ("browse", keepGoing (browseCmd False), Nothing, completeModule),
+ ("browse!", keepGoing (browseCmd True), Nothing, completeModule),
+ ("cd", keepGoing changeDirectory, Just filenameWordBreakChars, completeFilename),
+ ("check", keepGoing checkModule, Nothing, completeHomeModule),
+ ("continue", keepGoing continueCmd, Nothing, completeNone),
+ ("cmd", keepGoing cmdCmd, Nothing, completeIdentifier),
+ ("ctags", keepGoing createCTagsFileCmd, Just filenameWordBreakChars, completeFilename),
+ ("def", keepGoing (defineMacro False), Nothing, completeIdentifier),
+ ("def!", keepGoing (defineMacro True), Nothing, completeIdentifier),
+ ("delete", keepGoing deleteCmd, Nothing, completeNone),
+ ("e", keepGoing editFile, Just filenameWordBreakChars, completeFilename),
+ ("edit", keepGoing editFile, Just filenameWordBreakChars, completeFilename),
+ ("etags", keepGoing createETagsFileCmd, Just filenameWordBreakChars, completeFilename),
+ ("force", keepGoing forceCmd, Nothing, completeIdentifier),
+ ("forward", keepGoing forwardCmd, Nothing, completeNone),
+ ("help", keepGoing help, Nothing, completeNone),
+ ("history", keepGoing historyCmd, Nothing, completeNone),
+ ("info", keepGoing info, Nothing, completeIdentifier),
+ ("kind", keepGoing kindOfType, Nothing, completeIdentifier),
+ ("load", keepGoingPaths loadModule_, Just filenameWordBreakChars, completeHomeModuleOrFile),
+ ("list", keepGoing listCmd, Nothing, completeNone),
+ ("module", keepGoing setContext, Nothing, completeModule),
+ ("main", keepGoing runMain, Nothing, completeIdentifier),
+ ("print", keepGoing printCmd, Nothing, completeIdentifier),
+ ("quit", quit, Nothing, completeNone),
+ ("reload", keepGoing reloadModule, Nothing, completeNone),
+ ("set", keepGoing setCmd, Just flagWordBreakChars, completeSetOptions),
+ ("show", keepGoing showCmd, Nothing, completeNone),
+ ("sprint", keepGoing sprintCmd, Nothing, completeIdentifier),
+ ("step", keepGoing stepCmd, Nothing, completeIdentifier),
+ ("steplocal", keepGoing stepLocalCmd, Nothing, completeIdentifier),
+ ("stepmodule",keepGoing stepModuleCmd, Nothing, completeIdentifier),
+ ("type", keepGoing typeOfExpr, Nothing, completeIdentifier),
+ ("trace", keepGoing traceCmd, Nothing, completeIdentifier),
+ ("undef", keepGoing undefineMacro, Nothing, completeMacro),
+ ("unset", keepGoing unsetOptions, Just flagWordBreakChars, completeSetOptions)
]
+
+-- We initialize readline (in the interactiveUI function) to use
+-- word_break_chars as the default set of completion word break characters.
+-- This can be overridden for a particular command (for example, filename
+-- expansion shouldn't consider '/' to be a word break) by setting the third
+-- entry in the Command tuple above.
+--
+-- NOTE: in order for us to override the default correctly, any custom entry
+-- must be a SUBSET of word_break_chars.
+word_break_chars, flagWordBreakChars, filenameWordBreakChars :: String
+word_break_chars = let symbols = "!#$%&*+/<=>?@\\^|-~"
+ specials = "(),;[]`{}"
+ spaces = " \t\n"
+ in spaces ++ specials ++ symbols
+flagWordBreakChars = " \t\n"
+filenameWordBreakChars = " \t\n\\`@$><=;|&{(" -- bash defaults
+
+
keepGoing :: (String -> GHCi ()) -> (String -> GHCi Bool)
keepGoing a str = a str >> return False
" Commands available from the prompt:\n" ++
"\n" ++
" <statement> evaluate/run <statement>\n" ++
+ " : repeat last command\n" ++
" :{\\n ..lines.. \\n:}\\n multiline command\n" ++
" :add <filename> ... add module(s) to the current target set\n" ++
" :browse[!] [[*]<mod>] display the names defined by module <mod>\n" ++
Readline.setAttemptedCompletionFunction (Just completeWord)
--Readline.parseAndBind "set show-all-if-ambiguous 1"
- let symbols = "!#$%&*+/<=>?@\\^|-~"
- specials = "(),;[]`{}"
- spaces = " \t\n"
- word_break_chars = spaces ++ specials ++ symbols
-
Readline.setBasicWordBreakCharacters word_break_chars
Readline.setCompleterWordBreakCharacters word_break_chars
#endif
break_ctr = 0,
breaks = [],
tickarrays = emptyModuleEnv,
+ last_command = Nothing,
cmdqueue = [],
remembered_ctx = Nothing
}
Just thing -> printTyThing thing
-
+data MaybeCommand = GotCommand Command | BadCommand | NoLastCommand
specialCommand :: String -> GHCi Bool
specialCommand ('!':str) = shellEscape (dropWhile isSpace str)
specialCommand str = do
let (cmd,rest) = break isSpace str
- maybe_cmd <- io (lookupCommand cmd)
+ maybe_cmd <- lookupCommand cmd
case maybe_cmd of
- Nothing -> io (hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
- ++ shortHelpText) >> return False)
- Just (_,f,_,_) -> f (dropWhile isSpace rest)
-
-lookupCommand :: String -> IO (Maybe Command)
+ GotCommand (_,f,_,_) -> f (dropWhile isSpace rest)
+ BadCommand ->
+ do io $ hPutStr stdout ("unknown command ':" ++ cmd ++ "'\n"
+ ++ shortHelpText)
+ return False
+ NoLastCommand ->
+ do io $ hPutStr stdout ("there is no last command to perform\n"
+ ++ shortHelpText)
+ return False
+
+lookupCommand :: String -> GHCi (MaybeCommand)
+lookupCommand "" = do
+ st <- getGHCiState
+ case last_command st of
+ Just c -> return $ GotCommand c
+ Nothing -> return NoLastCommand
lookupCommand str = do
+ mc <- io $ lookupCommand' str
+ st <- getGHCiState
+ setGHCiState st{ last_command = mc }
+ return $ case mc of
+ Just c -> GotCommand c
+ Nothing -> BadCommand
+
+lookupCommand' :: String -> IO (Maybe Command)
+lookupCommand' str = do
macros <- readIORef macros_ref
let cmds = builtin_commands ++ macros
-- look for exact match first, then the first prefix match
- case [ c | c <- cmds, str == cmdName c ] of
- c:_ -> return (Just c)
- [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
- [] -> return Nothing
- c:_ -> return (Just c)
-
+ return $ case [ c | c <- cmds, str == cmdName c ] of
+ c:_ -> Just c
+ [] -> case [ c | c@(s,_,_,_) <- cmds, str `isPrefixOf` s ] of
+ [] -> Nothing
+ c:_ -> Just c
getCurrentBreakSpan :: GHCi (Maybe SrcSpan)
getCurrentBreakSpan = do
afterLoad ok session False prev_context
changeDirectory :: String -> GHCi ()
+changeDirectory "" = do
+ -- :cd on its own changes to the user's home directory
+ either_dir <- io (IO.try getHomeDirectory)
+ case either_dir of
+ Left _e -> return ()
+ Right dir -> changeDirectory dir
changeDirectory dir = do
session <- getSession
graph <- io (GHC.getModuleGraph session)
case maybe_hv of
Nothing -> return ()
Just hv -> io (writeIORef macros_ref --
- (filtered ++ [(macro_name, runMacro hv, False, completeNone)]))
+ (filtered ++ [(macro_name, runMacro hv, Nothing, completeNone)]))
runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
runMacro fun s = do
':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
_other
| ((':':c) : _) <- line_words -> do
- maybe_cmd <- lookupCommand c
- let (n,w') = selectWord (words' 0 line)
- case maybe_cmd of
- Nothing -> return Nothing
- Just (_,_,False,complete) -> wrapCompleter complete w
- Just (_,_,True,complete) -> let complete' w = do rets <- complete w
- return (map (drop n) rets)
- in wrapCompleter complete' w'
+ completionVars <- lookupCompletionVars c
+ case completionVars of
+ (Nothing,complete) -> wrapCompleter complete w
+ (Just breakChars,complete)
+ -> let (n,w') = selectWord
+ (words' (`elem` breakChars) 0 line)
+ complete' w = do rets <- complete w
+ return (map (drop n) rets)
+ in wrapCompleter complete' w'
| ("import" : _) <- line_words ->
wrapCompleter completeModule w
| otherwise -> do
--printf "complete %s, start = %d, end = %d\n" w start end
wrapCompleter completeIdentifier w
- where words' _ [] = []
- words' n str = let (w,r) = break isSpace str
- (s,r') = span isSpace r
- in (n,w):words' (n+length w+length s) r'
+ where words' _ _ [] = []
+ words' isBreak n str = let (w,r) = break isBreak str
+ (s,r') = span isBreak r
+ in (n,w):words' isBreak (n+length w+length s) r'
-- In a Haskell expression we want to parse 'a-b' as three words
-- where a compiler flag (ie. -fno-monomorphism-restriction) should
-- only be a single word.
selectWord ((offset,x):xs)
| offset+length x >= start = (start-offset,take (end-offset) x)
| otherwise = selectWord xs
+
+ lookupCompletionVars ('!':_) = return (Just filenameWordBreakChars,
+ completeFilename)
+ lookupCompletionVars c = do
+ maybe_cmd <- lookupCommand' c
+ case maybe_cmd of
+ Just (_,_,ws,f) -> return (ws,f)
+ Nothing -> return (Just filenameWordBreakChars,
+ completeFilename)
+
completeCmd :: String -> IO [String]
completeCmd w = do
(r:_) -> do
let hist = GHC.resumeHistory r
(took,rest) = splitAt num hist
- spans <- mapM (io . GHC.getHistorySpan s) took
- let nums = map (printf "-%-3d:") [(1::Int)..]
- let names = map GHC.historyEnclosingDecl took
- printForUser (vcat(zipWith3
- (\x y z -> x <+> y <+> z)
- (map text nums)
- (map (bold . ppr) names)
- (map (parens . ppr) spans)))
- io $ putStrLn $ if null rest then "<end of history>" else "..."
+ case hist of
+ [] -> io $ putStrLn $
+ "Empty history. Perhaps you forgot to use :trace?"
+ _ -> do
+ spans <- mapM (io . GHC.getHistorySpan s) took
+ let nums = map (printf "-%-3d:") [(1::Int)..]
+ names = map GHC.historyEnclosingDecl took
+ printForUser (vcat(zipWith3
+ (\x y z -> x <+> y <+> z)
+ (map text nums)
+ (map (bold . ppr) names)
+ (map (parens . ppr) spans)))
+ io $ putStrLn $ if null rest then "<end of history>" else "..."
bold :: SDoc -> SDoc
bold c | do_bold = text start_bold <> c <> text end_bold
projects / ghc-hetmet.git / blobdiff