X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=e385f6bb4659552ffe37033dfba6879a4e52897b;hb=8690b84f0bbcae6351d1a664d96db9bc60b81b0f;hp=b1baecd69a32b5a1d28f2829d5e389ccd70b30b5;hpb=66579ff945831c5fc9a17c58c722ff01f2268d76;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index b1baecd..e385f6b 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -85,7 +85,6 @@ import System.Directory
 import System.IO
 import System.IO.Error as IO
 import Data.Char
-import Data.Dynamic
 import Data.Array
 import Control.Monad as Monad
 import Text.Printf
@@ -294,7 +293,7 @@ findEditor = do
 
 interactiveUI :: [(FilePath, Maybe Phase)] -> Maybe [String]
               -> Ghc ()
-interactiveUI srcs maybe_exprs = do
+interactiveUI srcs maybe_exprs = withTerminalReset $ do
    -- HACK! If we happen to get into an infinite loop (eg the user
    -- types 'let x=x in x' at the prompt), then the thread will block
    -- on a blackhole, and become unreachable during GC.  The GC will
@@ -383,6 +382,22 @@ withGhcAppData right left = do
       Right dir -> right dir
       _ -> left
 
+-- libedit doesn't always restore the terminal settings correctly (as of at 
+-- least 07/12/2008); see trac #2691.  Work around this by manually resetting
+-- the terminal outselves.
+withTerminalReset :: Ghc () -> Ghc ()
+#ifdef mingw32_HOST_OS
+withTerminalReset = id
+#else
+withTerminalReset f = do
+    isTTY <- liftIO $ hIsTerminalDevice stdout
+    if not isTTY
+        then f
+        else do
+            oldAttrs <- liftIO $ getTerminalAttributes stdOutput
+            f
+            liftIO $ setTerminalAttributes stdOutput oldAttrs Immediately
+#endif
 
 runGHCi :: [(FilePath, Maybe Phase)] -> Maybe [String] -> GHCi ()
 runGHCi paths maybe_exprs = do
@@ -667,7 +682,7 @@ runCommands' eh getCmd = do
   where
     printErrorAndKeepGoing err = do
         GHC.printExceptionAndWarnings err
-        return True
+        return False
 
     noSpace q = q >>= maybe (return Nothing)
                             (\c->case removeSpaces c of 
@@ -1740,7 +1755,8 @@ completeHomeModule w = do
 
 completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)
-    where options = "args":"prog":allFlags
+    where options = "args":"prog":flagList
+          flagList = map head $ group $ sort allFlags
 
 completeFilename w = do
     ws <- Readline.filenameCompletionFunction w
@@ -1820,28 +1836,15 @@ handler exception = do
   ghciHandle handler (showException exception >> return False)
 
 showException :: SomeException -> GHCi ()
-#if __GLASGOW_HASKELL__ < 609
-showException (DynException dyn) =
-  case fromDynamic dyn of
-    Nothing               -> io (putStrLn ("*** Exception: (unknown)"))
-    Just Interrupted      -> io (putStrLn "Interrupted.")
-    Just (CmdLineError s) -> io (putStrLn s)	 -- omit the location for CmdLineError
-    Just ph@PhaseFailed{} -> io (putStrLn (showGhcException ph "")) -- ditto
-    Just other_ghc_ex     -> io (print other_ghc_ex)
-
-showException other_exception
-  = io (putStrLn ("*** Exception: " ++ show other_exception))
-#else
-showException (SomeException e) =
-  io $ case cast e of
+showException se =
+  io $ case fromException se of
        Just Interrupted         -> putStrLn "Interrupted."
        -- omit the location for CmdLineError:
        Just (CmdLineError s)    -> putStrLn s
        -- ditto:
        Just ph@(PhaseFailed {}) -> putStrLn (showGhcException ph "")
        Just other_ghc_ex        -> print other_ghc_ex
-       Nothing                  -> putStrLn ("*** Exception: " ++ show e)
-#endif
+       Nothing                  -> putStrLn ("*** Exception: " ++ show se)
 
 -----------------------------------------------------------------------------
 -- recursive exception handlers