diff --git a/gf.cabal b/gf.cabal index 7b2a49c89..dd06e2e51 100644 --- a/gf.cabal +++ b/gf.cabal @@ -54,7 +54,6 @@ library random, pretty, mtl ---ghc-options: -O2 hs-source-dirs: src/compiler src/runtime/haskell extensions: exposed-modules: @@ -127,7 +126,6 @@ executable gf ghc-prof-options: -auto-all ---ghc-options: -O2 if impl(ghc>=7.0) ghc-options: -rtsopts hs-source-dirs: src/compiler src/runtime/haskell @@ -148,6 +146,8 @@ executable gf GF.Infra.Option GF.Infra.UseIO GF.Infra.CheckM + GF.System.Signal + GF.System.Console GF.Command.Commands GF.Command.Interpreter GF.Command.Abstract diff --git a/src/compiler/GF.hs b/src/compiler/GF.hs index 40ce7fed3..04748b85b 100644 --- a/src/compiler/GF.hs +++ b/src/compiler/GF.hs @@ -1,4 +1,3 @@ -{-# OPTIONS -cpp #-} module Main where import GFC @@ -14,22 +13,11 @@ import System.Directory import System.Environment (getArgs) import System.Exit import System.IO -#ifdef mingw32_HOST_OS -import System.Win32.Console -import System.Win32.NLS -#endif +import GF.System.Console (setConsoleEncoding) main :: IO () main = do -#ifdef mingw32_HOST_OS - codepage <- getACP - setConsoleCP codepage - setConsoleOutputCP codepage - enc <- mkTextEncoding ("CP"++show codepage) - hSetEncoding stdin enc - hSetEncoding stdout enc - hSetEncoding stderr enc -#endif + setConsoleEncoding args <- getArgs case parseOptions args of Ok (opts,files) -> do curr_dir <- getCurrentDirectory diff --git a/src/compiler/GF/System/Console.hs b/src/compiler/GF/System/Console.hs new file mode 100644 index 000000000..ea901d55d --- /dev/null +++ b/src/compiler/GF/System/Console.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE CPP #-} +module GF.System.Console(setConsoleEncoding,changeConsoleEncoding) where +import System.IO +#ifdef mingw32_HOST_OS +import System.Win32.Console +import System.Win32.NLS +#endif + +setConsoleEncoding = +#ifdef mingw32_HOST_OS + do codepage <- getACP + setCP codepage + setEncoding ("CP"++show codepage) +#endif + return () :: IO () + +changeConsoleEncoding code = + do +#ifdef mingw32_HOST_OS + maybe (return ()) setCP (readCP code) +#endif + setEncoding code + +setEncoding code = + do enc <- mkTextEncoding code + hSetEncoding stdin enc + hSetEncoding stdout enc + hSetEncoding stderr enc + +#ifdef mingw32_HOST_OS +setCP codepage = + do setConsoleCP codepage + setConsoleOutputCP codepage + +readCP code = + case code of + 'C':'P':c -> case reads c of + [(cp,"")] -> Just cp + _ -> Nothing + "UTF-8" -> Just 65001 + _ -> Nothing +#endif diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs index 136f52972..9c62d1fd0 100644 --- a/src/compiler/GFI.hs +++ b/src/compiler/GFI.hs @@ -50,10 +50,7 @@ import qualified GF.System.Signal as IO(runInterruptibly) #ifdef SERVER_MODE import GFServer(server) #endif -#ifdef mingw32_HOST_OS -import System.Win32.Console -import System.Win32.NLS -#endif +import GF.System.Console(changeConsoleEncoding) import GF.Infra.BuildInfo(buildInfo) import Data.Version(showVersion) @@ -315,21 +312,7 @@ execute1 opts gfenv0 s0 = set_encoding [c] = do let cod = renameEncoding c - restricted $ do -#ifdef mingw32_HOST_OS - case cod of - 'C':'P':c -> case reads c of - [(cp,"")] -> do setConsoleCP cp - setConsoleOutputCP cp - _ -> return () - "UTF-8" -> do setConsoleCP 65001 - setConsoleOutputCP 65001 - _ -> return () -#endif - enc <- mkTextEncoding cod - hSetEncoding stdin enc - hSetEncoding stdout enc - hSetEncoding stderr enc + restricted $ changeConsoleEncoding cod continue gfenv set_encoding _ = putStrLn "se command not parsed" >> continue gfenv