diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 2a4a8b631..eda61255f 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -17,7 +17,7 @@ import PGF.Data ---- import PGF.Morphology import PGF.VisualizeTree import GF.Compile.Export -import GF.Infra.Option (noOptions, readOutputFormat) +import GF.Infra.Option (noOptions, readOutputFormat, Encoding(..)) import GF.Infra.UseIO import GF.Data.ErrM ---- import PGF.Expr (readTree) @@ -66,7 +66,7 @@ emptyCommandInfo = CommandInfo { lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo lookCommand = Map.lookup -commandHelpAll :: String -> PGFEnv -> [Option] -> String +commandHelpAll :: Encoding -> PGFEnv -> [Option] -> String commandHelpAll cod pgf opts = unlines [commandHelp (isOpt "full" opts) (co,info) | (co,info) <- Map.assocs (allCommands cod pgf)] @@ -88,7 +88,7 @@ commandHelp full (co,info) = unlines $ [ type PGFEnv = (PGF, Map.Map Language Morpho) -- this list must no more be kept sorted by the command name -allCommands :: String -> PGFEnv -> Map.Map String CommandInfo +allCommands :: Encoding -> PGFEnv -> Map.Map String CommandInfo allCommands cod env@(pgf, mos) = Map.fromList [ ("!", emptyCommandInfo { synopsis = "system command: escape to system shell", @@ -704,12 +704,12 @@ stringOpOptions = [ treeOpOptions pgf = [(op,expl) | (op,(expl,_)) <- allTreeOps pgf] -translationQuiz :: String -> PGF -> Language -> Language -> Type -> IO () +translationQuiz :: Encoding -> PGF -> Language -> Language -> Type -> IO () translationQuiz cod pgf ig og typ = do tts <- translationList pgf ig og typ infinity mkQuiz cod "Welcome to GF Translation Quiz." tts -morphologyQuiz :: String -> PGF -> Language -> Type -> IO () +morphologyQuiz :: Encoding -> PGF -> Language -> Type -> IO () morphologyQuiz cod pgf ig typ = do tts <- morphologyList pgf ig typ infinity mkQuiz cod "Welcome to GF Morphology Quiz." tts diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs index 7e9ebb653..7c962b375 100644 --- a/src/GF/Command/Interpreter.hs +++ b/src/GF/Command/Interpreter.hs @@ -16,6 +16,7 @@ import PGF.Macros import PGF.Morphology import GF.System.Signal import GF.Infra.UseIO +import GF.Infra.Option import GF.Data.ErrM ---- @@ -29,13 +30,13 @@ data CommandEnv = CommandEnv { expmacros :: Map.Map String Tree } -mkCommandEnv :: String -> PGF -> CommandEnv +mkCommandEnv :: Encoding -> PGF -> CommandEnv mkCommandEnv enc pgf = let mos = Map.fromList [(la,buildMorpho pgf la) | la <- languages pgf] in CommandEnv pgf mos (allCommands enc (pgf, mos)) Map.empty Map.empty emptyCommandEnv :: CommandEnv -emptyCommandEnv = mkCommandEnv "utf8" emptyPGF +emptyCommandEnv = mkCommandEnv UTF_8 emptyPGF interpretCommandLine :: (String -> String) -> CommandEnv -> String -> IO () interpretCommandLine enc env line = diff --git a/src/GF/Compile/Coding.hs b/src/GF/Compile/Coding.hs index 511ceddef..0891c4546 100644 --- a/src/GF/Compile/Coding.hs +++ b/src/GF/Compile/Coding.hs @@ -2,8 +2,7 @@ module GF.Compile.Coding where import GF.Grammar.Grammar import GF.Grammar.Macros -import GF.Text.UTF8 -import GF.Text.CP1251 +import GF.Text.Coding import GF.Infra.Modules import GF.Infra.Option import GF.Data.Operations @@ -11,14 +10,10 @@ import GF.Data.Operations import Data.Char encodeStringsInModule :: SourceModule -> SourceModule -encodeStringsInModule = codeSourceModule encodeUTF8 +encodeStringsInModule = codeSourceModule (encodeUnicode UTF_8) decodeStringsInModule :: SourceModule -> SourceModule -decodeStringsInModule mo = - case flag optEncoding (flagsModule mo) of - UTF_8 -> codeSourceModule decodeUTF8 mo - CP_1251 -> codeSourceModule decodeCP1251 mo - _ -> mo +decodeStringsInModule mo = codeSourceModule (decodeUnicode (flag optEncoding (flagsModule mo))) mo codeSourceModule :: (String -> String) -> SourceModule -> SourceModule codeSourceModule co (id,mo) = (id,replaceJudgements mo (mapTree codj (jments mo))) diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs index e02130ff3..a26237f3f 100644 --- a/src/GF/Infra/Option.hs +++ b/src/GF/Infra/Option.hs @@ -17,7 +17,7 @@ module GF.Infra.Option helpMessage, -- * Checking specific options flag, cfgTransform, haskellOption, readOutputFormat, - isLexicalCat, + isLexicalCat, encodings, -- * Setting specific options setOptimization, setCFGTransform, -- * Convenience methods for checking options @@ -77,7 +77,7 @@ data Verbosity = Quiet | Normal | Verbose | Debug data Phase = Preproc | Convert | Compile | Link deriving (Show,Eq,Ord) -data Encoding = UTF_8 | ISO_8859_1 | CP_1251 +data Encoding = UTF_8 | ISO_8859_1 | CP_1250 | CP_1251 | CP_1252 deriving (Eq,Ord) data OutputFormat = FmtPGFPretty @@ -483,7 +483,9 @@ haskellOptionNames = encodings :: [(String,Encoding)] encodings = [("utf8", UTF_8), + ("cp1250", CP_1250), ("cp1251", CP_1251), + ("cp1252", CP_1252), ("latin1", ISO_8859_1) ] diff --git a/src/GF/Quiz.hs b/src/GF/Quiz.hs index bfdd9a54a..43b037b87 100644 --- a/src/GF/Quiz.hs +++ b/src/GF/Quiz.hs @@ -23,6 +23,7 @@ import PGF.ShowLinearize import GF.Data.Operations import GF.Infra.UseIO +import GF.Infra.Option import GF.Text.Coding import System.Random @@ -33,7 +34,7 @@ import Data.List (nub) -- generic quiz function -mkQuiz :: String -> String -> [(String,[String])] -> IO () +mkQuiz :: Encoding -> String -> [(String,[String])] -> IO () mkQuiz cod msg tts = do let qas = [ (q, mkAnswer cod as) | (q,as) <- tts] teachDialogue qas msg @@ -58,7 +59,7 @@ morphologyList pgf ig typ number = do (pws,i) <- zip ss forms, let (par,ws) = pws !! i] -- | compare answer to the list of right answers, increase score and give feedback -mkAnswer :: String -> [String] -> String -> (Integer, String) +mkAnswer :: Encoding -> [String] -> String -> (Integer, String) mkAnswer cod as s = if (elem (norm s) as) then (1,"Yes.") diff --git a/src/GF/Text/Coding.hs b/src/GF/Text/Coding.hs index 2860b79d2..e3cd7b0ea 100644 --- a/src/GF/Text/Coding.hs +++ b/src/GF/Text/Coding.hs @@ -1,20 +1,21 @@ module GF.Text.Coding where +import GF.Infra.Option import GF.Text.UTF8 import GF.Text.CP1250 import GF.Text.CP1251 import GF.Text.CP1252 encodeUnicode e = case e of - "utf8" -> encodeUTF8 - "cp1250" -> encodeCP1250 - "cp1251" -> encodeCP1251 - "cp1252" -> encodeCP1252 - _ -> id + UTF_8 -> encodeUTF8 + CP_1250 -> encodeCP1250 + CP_1251 -> encodeCP1251 + CP_1252 -> encodeCP1252 + _ -> id decodeUnicode e = case e of - "utf8" -> decodeUTF8 - "cp1250" -> decodeCP1250 - "cp1251" -> decodeCP1251 - "cp1252" -> decodeCP1252 - _ -> id + UTF_8 -> decodeUTF8 + CP_1250 -> decodeCP1250 + CP_1251 -> decodeCP1251 + CP_1252 -> decodeCP1252 + _ -> id diff --git a/src/GFI.hs b/src/GFI.hs index 748fcfe55..e5926f5e9 100644 --- a/src/GFI.hs +++ b/src/GFI.hs @@ -21,6 +21,7 @@ import PGF.Macros import PGF.Expr (readTree) import Data.Char +import Data.Maybe import Data.List(isPrefixOf) import qualified Data.Map as Map import qualified Text.ParserCombinators.ReadP as RP @@ -140,15 +141,19 @@ loop opts gfenv0 = do "ph":_ -> mapM_ (putStrLn . enc) (reverse (history gfenv0)) >> loopNewCPU gfenv - "se":c:_ -> do + "se":c:_ -> + case lookup c encodings of + Just cod -> do #ifdef mingw32_HOST_OS - case c of - 'c':'p':c -> case reads c of - [(cp,"")] -> setConsoleCP cp >> setConsoleOutputCP cp - _ -> return () - _ -> return () + case c of + 'c':'p':c -> case reads c of + [(cp,"")] -> setConsoleCP cp >> setConsoleOutputCP cp + _ -> return () + _ -> return () #endif - loopNewCPU $ gfenv {coding = c} + loopNewCPU $ gfenv {coding = cod} + Nothing -> do putStrLn "unknown encoding" + loopNewCPU gfenv -- ordinary commands, working on CommandEnv _ -> do @@ -208,16 +213,16 @@ data GFEnv = GFEnv { commandenv :: CommandEnv, history :: [String], cputime :: Integer, - coding :: String + coding :: Encoding } emptyGFEnv :: IO GFEnv emptyGFEnv = do #ifdef mingw32_HOST_OS codepage <- getACP - let coding = "cp"++show codepage + let coding = fromMaybe UTF_8 (lookup ("cp"++show codepage) encodings) #else - let coding = "utf8" + let coding = UTF_8 #endif return $ GFEnv emptyGrammar (mkCommandEnv coding emptyPGF) [] 0 coding