X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=b147bbd2807ce2021052f255a8d6257740523420;hb=a91bf796d200a3b950ea30ea7a9f04ee497f39ae;hp=d45bddc97b2aac15dce6dfc27f542b3df9855c42;hpb=0fa697bca153468bf073aad1fe02d5b4055059f2;p=ghc-hetmet.git

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index d45bddc..b147bbd 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -67,6 +67,7 @@ import System.Posix
 #endif
 #else
 import GHC.ConsoleHandler ( flushConsole )
+import System.Win32	  ( setConsoleCP, setConsoleOutputCP )
 #endif
 
 #ifdef USE_READLINE
@@ -240,8 +241,9 @@ jumpFunction session@(Session ref) (I# idsPtr) hValues location b
              new_ic = ictxt { ic_rn_local_env = new_rn_env, 
 		  	      ic_type_env     = new_type_env }
          writeIORef ref (hsc_env { hsc_IC = new_ic })
+         is_tty <- hIsTerminalDevice stdin
          withExtendedLinkEnv (zip names hValues) $
-           startGHCi (runGHCi [] Nothing)
+           startGHCi (interactiveLoop is_tty True)
                      GHCiState{ progname = "<interactive>",
                                 args = [],
                                 prompt = location++"> ",
@@ -373,6 +375,9 @@ runGHCi paths maybe_expr = do
    		      | otherwise -> io (ioError err)
    	     Right () -> return ()
 #endif
+	    -- initialise the console if necessary
+	    io setUpConsole
+
 	    -- enter the interactive loop
 	    interactiveLoop is_tty show_prompt
 	Just expr -> do
@@ -460,13 +465,13 @@ fileLoop hdl show_prompt = do
 	    l  -> do quit <- runCommand l
                      if quit then return () else fileLoop hdl show_prompt
 
-stringLoop :: [String] -> GHCi ()
-stringLoop [] = return ()
+stringLoop :: [String] -> GHCi Bool{-True: we quit-}
+stringLoop [] = return False
 stringLoop (s:ss) = do
    case removeSpaces s of
 	"" -> stringLoop ss
 	l  -> do quit <- runCommand l
-                 if quit then return () else stringLoop ss
+                 if quit then return True else stringLoop ss
 
 mkPrompt toplevs exports prompt
   = showSDoc $ f prompt
@@ -749,9 +754,9 @@ defineMacro s = do
   case maybe_hv of
      Nothing -> return ()
      Just hv -> io (writeIORef commands --
-		    (cmds ++ [(macro_name, keepGoing (runMacro hv), False, completeNone)]))
+		    (cmds ++ [(macro_name, runMacro hv, False, completeNone)]))
 
-runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi ()
+runMacro :: GHC.HValue{-String -> IO String-} -> String -> GHCi Bool
 runMacro fun s = do
   str <- io ((unsafeCoerce# fun :: String -> IO String) s)
   stringLoop (lines str)
@@ -1528,7 +1533,7 @@ revertCAFs = do
 foreign import ccall "revertCAFs" rts_revertCAFs  :: IO ()  
 	-- Make it "safe", just in case
 
--- -----------------------------------------------------------------------------
+-- ----------------------------------------------------------------------------
 -- Utils
 
 expandPath :: String -> GHCi String
@@ -1539,3 +1544,27 @@ expandPath path =
 	return (tilde ++ '/':d)
    other -> 
 	return other
+
+-- ----------------------------------------------------------------------------
+-- Windows console setup
+
+setUpConsole :: IO ()
+setUpConsole = do
+#ifdef mingw32_HOST_OS
+	-- On Windows we need to set a known code page, otherwise the characters
+  	-- we read from the console will be be in some strange encoding, and
+	-- similarly for characters we write to the console.
+	--
+	-- At the moment, GHCi pretends all input is Latin-1.  In the
+	-- future we should support UTF-8, but for now we set the code pages
+	-- to Latin-1.
+	--
+	-- It seems you have to set the font in the console window to
+	-- a Unicode font in order for output to work properly,
+	-- otherwise non-ASCII characters are mapped wrongly.  sigh.
+	-- (see MSDN for SetConsoleOutputCP()).
+	--
+	setConsoleCP 28591       -- ISO Latin-1
+	setConsoleOutputCP 28591 -- ISO Latin-1
+#endif
+	return ()