X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=ghc%2FInteractiveUI.hs;h=e0498317dd17d0f9129c412e922d1d2511c6d9e7;hp=7d9eaca38b9ab42e38858c4786b293847509f630;hb=4aa564abca9eb7aa75b6b77bd19c0c1e8fd828a4;hpb=03bb97e0a29fe3f414c17e6b4074f2c9e8e8012e

diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 7d9eaca..e049831 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -123,11 +123,11 @@ builtin_commands = [
   ("check",     keepGoing' checkModule,         completeHomeModule),
   ("continue",  keepGoing continueCmd,          noCompletion),
   ("cmd",       keepGoing cmdCmd,               completeExpression),
-  ("ctags",     keepGoing createCTagsFileCmd,   completeFilename),
+  ("ctags",     keepGoing createCTagsWithLineNumbersCmd, completeFilename),
+  ("ctags!",    keepGoing createCTagsWithRegExesCmd, completeFilename),
   ("def",       keepGoing (defineMacro False),  completeExpression),
   ("def!",      keepGoing (defineMacro True),   completeExpression),
   ("delete",    keepGoing deleteCmd,            noCompletion),
-  ("e",         keepGoing editFile,             completeFilename),
   ("edit",      keepGoing editFile,             completeFilename),
   ("etags",     keepGoing createETagsFileCmd,   completeFilename),
   ("force",     keepGoing forceCmd,             completeExpression),
@@ -203,7 +203,8 @@ helpText =
  "                               (!: more details; *: all top-level names)\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
  "   :cmd <expr>                 run the commands returned by <expr>::IO String\n" ++
- "   :ctags [<file>]             create tags file for Vi (default: \"tags\")\n" ++
+ "   :ctags[!] [<file>]          create tags file for Vi (default: \"tags\")\n" ++
+ "                               (!: use regex instead of line number)\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
  "   :edit <file>                edit file\n" ++
  "   :edit                       edit last module\n" ++
@@ -398,7 +399,6 @@ runGHCi paths maybe_exprs = do
            -- can we assume this will always be the case?
            -- This would be a good place for runFileInputT.
            Right hdl -> runInputTWithPrefs defaultPrefs defaultSettings $ do
-                            setLogAction
                             runCommands $ fileLoop hdl
      where
       getDirectory f = case takeDirectory f of "" -> "."; d -> d
@@ -438,6 +438,8 @@ runGHCi paths maybe_exprs = do
             -- just evaluate the expression we were given
             enqueueCommands exprs
             let handle e = do st <- getGHCiState
+                              -- flush the interpreter's stdout/stderr on exit (#3890)
+                              flushInterpBuffers
                                    -- Jump through some hoops to get the
                                    -- current progname in the exception text:
                                    -- <progname>: <exception>
@@ -445,7 +447,6 @@ runGHCi paths maybe_exprs = do
                                    -- this used to be topHandlerFastExit, see #2228
                                  $ topHandler e
             runInputTWithPrefs defaultPrefs defaultSettings $ do
-                setLogAction
                 runCommands' handle (return Nothing)
 
   -- and finally, exit
@@ -457,9 +458,7 @@ runGHCiInput f = do
                         (return Nothing)
     let settings = setComplete ghciCompleteWord
                     $ defaultSettings {historyFile = histFile}
-    runInputT settings $ do
-        setLogAction
-        f
+    runInputT settings f
 
 nextInputLine :: Bool -> Bool -> InputT GHCi (Maybe String)
 nextInputLine show_prompt is_tty
@@ -753,9 +752,12 @@ lookupCommand str = do
            Nothing -> BadCommand
 
 lookupCommand' :: String -> IO (Maybe Command)
-lookupCommand' str = do
+lookupCommand' ":" = return Nothing
+lookupCommand' str' = do
   macros <- readIORef macros_ref
-  let cmds = builtin_commands ++ macros
+  let{ (str, cmds) = case str' of
+      ':' : rest -> (rest, builtin_commands)
+      _ -> (str', macros ++ builtin_commands) }
   -- look for exact match first, then the first prefix match
   return $ case [ c | c <- cmds, str == cmdName c ] of
            c:_ -> Just c
@@ -934,6 +936,8 @@ chooseEditFile =
         fromTarget _ = Nothing -- when would we get a module target?
 
 defineMacro :: Bool{-overwrite-} -> String -> GHCi ()
+defineMacro _ (':':_) =
+  io $ putStrLn "macro name cannot start with a colon"
 defineMacro overwrite s = do
   let (macro_name, definition) = break isSpace s
   macros <- io (readIORef macros_ref)
@@ -1143,13 +1147,13 @@ typeOfExpr str
        ty <- GHC.exprType str
        dflags <- getDynFlags
        let pefas = dopt Opt_PrintExplicitForalls dflags
-       printForUser' $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
+       printForUser $ sep [text str, nest 2 (dcolon <+> pprTypeForUser pefas ty)]
 
 kindOfType :: String -> InputT GHCi ()
 kindOfType str 
   = handleSourceError (\e -> GHC.printExceptionAndWarnings e) $ do
        ty <- GHC.typeKind str
-       printForUser' $ text str <+> dcolon <+> ppr ty
+       printForUser $ text str <+> dcolon <+> ppr ty
 
 quit :: String -> InputT GHCi Bool
 quit _ = return True
@@ -1627,9 +1631,13 @@ ghciCompleteWord line@(left,_) = case firstWord of
             Nothing -> return completeFilename
 
 completeCmd = wrapCompleter " " $ \w -> do
-  cmds <- liftIO $ readIORef macros_ref
-  return (filter (w `isPrefixOf`) (map (':':) 
-             (map cmdName (builtin_commands ++ cmds))))
+  macros <- liftIO $ readIORef macros_ref
+  let macro_names = map (':':) . map cmdName $ macros
+  let command_names = map (':':) . map cmdName $ builtin_commands
+  let{ candidates = case w of
+      ':' : ':' : _ -> map (':':) command_names
+      _ -> nub $ macro_names ++ command_names }
+  return $ filter (w `isPrefixOf`) candidates
 
 completeMacro = wrapIdentCompleter $ \w -> do
   cmds <- liftIO $ readIORef macros_ref
@@ -2067,7 +2075,7 @@ listCmd "" = do
    mb_span <- lift getCurrentBreakSpan
    case mb_span of
       Nothing ->
-          printForUser' $ text "Not stopped at a breakpoint; nothing to list"
+          printForUser $ text "Not stopped at a breakpoint; nothing to list"
       Just span
        | GHC.isGoodSrcSpan span -> listAround span True
        | otherwise ->
@@ -2079,7 +2087,7 @@ listCmd "" = do
                                       [] -> text "rerunning with :trace,"
                                       _ -> empty
                             doWhat = traceIt <+> text ":back then :list"
-                        printForUser' (text "Unable to list source for" <+>
+                        printForUser (text "Unable to list source for" <+>
                                       ppr span
                                    $$ text "Try" <+> doWhat)
 listCmd str = list2 (words str)
@@ -2110,7 +2118,7 @@ list2 [arg] = do
                   noCanDo name $ text "can't find its location: " <>
                                  ppr loc
     where
-        noCanDo n why = printForUser' $
+        noCanDo n why = printForUser $
             text "cannot list source code for " <> ppr n <> text ": " <> why
 list2  _other = 
         outputStrLn "syntax:  :list [<line> | <module> <line> | <identifier>]"
@@ -2158,9 +2166,9 @@ listAround span do_highlight = do
   where
         file  = GHC.srcSpanFile span
         line1 = GHC.srcSpanStartLine span
-        col1  = GHC.srcSpanStartCol span
+        col1  = GHC.srcSpanStartCol span - 1
         line2 = GHC.srcSpanEndLine span
-        col2  = GHC.srcSpanEndCol span
+        col2  = GHC.srcSpanEndCol span - 1
 
         pad_before | line1 == 1 = 0
                    | otherwise  = 1