diff --git a/lib/resource-1.4/Make.hs b/lib/resource-1.4/Make.hs index 725000d3f..4bbab08cc 100644 --- a/lib/resource-1.4/Make.hs +++ b/lib/resource-1.4/Make.hs @@ -19,21 +19,21 @@ import System langsCoding = [ (("arabic", "Ara"),""), - (("bulgarian","Bul"),"from_cp1251,to_utf8"), - (("catalan", "Cat"),"to_utf8"), - (("danish", "Dan"),"to_utf8"), + (("bulgarian","Bul"),""), + (("catalan", "Cat"),""), + (("danish", "Dan"),""), (("english", "Eng"),""), - (("finnish", "Fin"),"to_utf8"), - (("french", "Fre"),"to_utf8"), - (("hindi", "Hin"),"to_devanagari,to_utf8"), - (("german", "Ger"),"to_utf8"), + (("finnish", "Fin"),""), + (("french", "Fre"),""), + (("hindi", "Hin"),"to_devanagari"), + (("german", "Ger"),""), (("interlingua","Ina"),""), - (("italian", "Ita"),"to_utf8"), - (("norwegian","Nor"),"to_utf8"), + (("italian", "Ita"),""), + (("norwegian","Nor"),""), (("russian", "Rus"),""), - (("spanish", "Spa"),"to_utf8"), - (("swedish", "Swe"),"to_utf8"), - (("thai", "Tha"),"to_thai,to_utf8") + (("spanish", "Spa"),""), + (("swedish", "Swe"),""), + (("thai", "Tha"),"to_thai") ] langs = map fst langsCoding diff --git a/lib/resource-1.4/bulgarian/AdjectiveBul.gf b/lib/resource-1.4/bulgarian/AdjectiveBul.gf index 2fecd1155..dfdf19763 100644 --- a/lib/resource-1.4/bulgarian/AdjectiveBul.gf +++ b/lib/resource-1.4/bulgarian/AdjectiveBul.gf @@ -1,4 +1,6 @@ concrete AdjectiveBul of Adjective = CatBul ** open ResBul, Prelude in { + flags coding=cp1251 ; + lin PositA a = { s = \\aform => a.s ! aform ; diff --git a/lib/resource-1.4/bulgarian/AdverbBul.gf b/lib/resource-1.4/bulgarian/AdverbBul.gf index 7210ea056..f886575aa 100644 --- a/lib/resource-1.4/bulgarian/AdverbBul.gf +++ b/lib/resource-1.4/bulgarian/AdverbBul.gf @@ -1,4 +1,6 @@ concrete AdverbBul of Adverb = CatBul ** open ResBul, Prelude in { + flags coding=cp1251 ; + lin PositAdvAdj a = {s = a.adv} ; ComparAdvAdj cadv a np = { diff --git a/lib/resource-1.4/bulgarian/Bulgarian.gf b/lib/resource-1.4/bulgarian/Bulgarian.gf index 7fa27a6dd..596cbfc82 100644 --- a/lib/resource-1.4/bulgarian/Bulgarian.gf +++ b/lib/resource-1.4/bulgarian/Bulgarian.gf @@ -3,4 +3,6 @@ concrete Bulgarian of BulgarianAbs = LangBul, ExtraBul - ** {} ; + ** { + flags coding=cp1251 ; +} ; diff --git a/lib/resource-1.4/bulgarian/BulgarianAbs.gf b/lib/resource-1.4/bulgarian/BulgarianAbs.gf index c14c7b0d6..83f17ad72 100644 --- a/lib/resource-1.4/bulgarian/BulgarianAbs.gf +++ b/lib/resource-1.4/bulgarian/BulgarianAbs.gf @@ -3,4 +3,6 @@ abstract BulgarianAbs = Lang, ExtraBulAbs - ** {} ; + ** { + flags coding=cp1251 ; +} ; diff --git a/lib/resource-1.4/bulgarian/CatBul.gf b/lib/resource-1.4/bulgarian/CatBul.gf index 1587aa535..257c4c0f2 100644 --- a/lib/resource-1.4/bulgarian/CatBul.gf +++ b/lib/resource-1.4/bulgarian/CatBul.gf @@ -1,4 +1,6 @@ -concrete CatBul of Cat = open ResBul, Prelude, (R = ParamX) in { +concrete CatBul of Cat = open ResBul, Prelude, (R = ParamX) in { + flags coding=cp1251 ; + flags optimize=all_subs ; diff --git a/lib/resource-1.4/bulgarian/ConjunctionBul.gf b/lib/resource-1.4/bulgarian/ConjunctionBul.gf index 8669e8dfd..23664cd1f 100644 --- a/lib/resource-1.4/bulgarian/ConjunctionBul.gf +++ b/lib/resource-1.4/bulgarian/ConjunctionBul.gf @@ -1,5 +1,7 @@ concrete ConjunctionBul of Conjunction = CatBul ** open ResBul, Coordination, Prelude in { + flags coding=cp1251 ; + flags optimize=all_subs ; diff --git a/lib/resource-1.4/bulgarian/ExtraBul.gf b/lib/resource-1.4/bulgarian/ExtraBul.gf index ebf4b9601..1e15a19de 100644 --- a/lib/resource-1.4/bulgarian/ExtraBul.gf +++ b/lib/resource-1.4/bulgarian/ExtraBul.gf @@ -1,5 +1,7 @@ concrete ExtraBul of ExtraBulAbs = CatBul ** open ResBul, Coordination, Prelude in { + flags coding=cp1251 ; + lin PossIndefPron p = { diff --git a/lib/resource-1.4/bulgarian/ExtraBulAbs.gf b/lib/resource-1.4/bulgarian/ExtraBulAbs.gf index 8e6fdeec4..fe57f33b1 100644 --- a/lib/resource-1.4/bulgarian/ExtraBulAbs.gf +++ b/lib/resource-1.4/bulgarian/ExtraBulAbs.gf @@ -1,4 +1,6 @@ abstract ExtraBulAbs = Extra ** { + flags coding=cp1251 ; + fun -- Feminine variants of pronouns (those in $Structural$ are diff --git a/lib/resource-1.4/bulgarian/GrammarBul.gf b/lib/resource-1.4/bulgarian/GrammarBul.gf index 7fb8791be..21e437b74 100644 --- a/lib/resource-1.4/bulgarian/GrammarBul.gf +++ b/lib/resource-1.4/bulgarian/GrammarBul.gf @@ -15,6 +15,8 @@ concrete GrammarBul of Grammar = StructuralBul, IdiomBul ** { + flags coding=cp1251 ; + flags startcat = Phr ; unlexer = text ; lexer = text ; diff --git a/lib/resource-1.4/bulgarian/IdiomBul.gf b/lib/resource-1.4/bulgarian/IdiomBul.gf index b99106810..40536ad2e 100644 --- a/lib/resource-1.4/bulgarian/IdiomBul.gf +++ b/lib/resource-1.4/bulgarian/IdiomBul.gf @@ -1,4 +1,6 @@ concrete IdiomBul of Idiom = CatBul ** open Prelude, ParadigmsBul, ResBul in { + flags coding=cp1251 ; + flags optimize=all_subs ; lin diff --git a/lib/resource-1.4/bulgarian/LangBul.gf b/lib/resource-1.4/bulgarian/LangBul.gf index 7dca04dee..dcfaacdc1 100644 --- a/lib/resource-1.4/bulgarian/LangBul.gf +++ b/lib/resource-1.4/bulgarian/LangBul.gf @@ -4,6 +4,8 @@ concrete LangBul of Lang = GrammarBul, LexiconBul ** { + flags coding=cp1251 ; + flags startcat = Phr ; unlexer = text ; lexer = text ; erasing = on ; coding = cp1251 ; diff --git a/lib/resource-1.4/bulgarian/LexiconBul.gf b/lib/resource-1.4/bulgarian/LexiconBul.gf index 56846f04a..5fce55c54 100644 --- a/lib/resource-1.4/bulgarian/LexiconBul.gf +++ b/lib/resource-1.4/bulgarian/LexiconBul.gf @@ -2,6 +2,8 @@ concrete LexiconBul of Lexicon = CatBul ** open ParadigmsBul, ResBul, Prelude in { + flags coding=cp1251 ; + flags optimize=values ; diff --git a/lib/resource-1.4/bulgarian/MorphoBul.gf b/lib/resource-1.4/bulgarian/MorphoBul.gf index ed1ad0c18..c8459d0f5 100644 --- a/lib/resource-1.4/bulgarian/MorphoBul.gf +++ b/lib/resource-1.4/bulgarian/MorphoBul.gf @@ -12,7 +12,9 @@ resource MorphoBul = ResBul ** open Predef, Prelude, CatBul - in { + in { + flags coding=cp1251 ; + flags optimize=all ; diff --git a/lib/resource-1.4/bulgarian/MorphoFunsBul.gf b/lib/resource-1.4/bulgarian/MorphoFunsBul.gf index 6483e7fb0..678479d8e 100644 --- a/lib/resource-1.4/bulgarian/MorphoFunsBul.gf +++ b/lib/resource-1.4/bulgarian/MorphoFunsBul.gf @@ -4,7 +4,9 @@ resource MorphoFunsBul = open Prelude, CatBul, MorphoBul - in { + in { + flags coding=cp1251 ; + oper --2 Adverbs diff --git a/lib/resource-1.4/bulgarian/NounBul.gf b/lib/resource-1.4/bulgarian/NounBul.gf index ae8bc4b60..8c939c31d 100644 --- a/lib/resource-1.4/bulgarian/NounBul.gf +++ b/lib/resource-1.4/bulgarian/NounBul.gf @@ -1,4 +1,6 @@ -concrete NounBul of Noun = CatBul ** open ResBul, Prelude in { +concrete NounBul of Noun = CatBul ** open ResBul, Prelude in { + flags coding=cp1251 ; + flags optimize=all_subs ; diff --git a/lib/resource-1.4/bulgarian/NumeralBul.gf b/lib/resource-1.4/bulgarian/NumeralBul.gf index d09573b6c..bf89fbe21 100644 --- a/lib/resource-1.4/bulgarian/NumeralBul.gf +++ b/lib/resource-1.4/bulgarian/NumeralBul.gf @@ -1,4 +1,6 @@ concrete NumeralBul of Numeral = CatBul ** open Prelude, ResBul in { + flags coding=cp1251 ; + lincat Digit = {s : DForm => CardOrd => Str} ; diff --git a/lib/resource-1.4/bulgarian/ParadigmsBul.gf b/lib/resource-1.4/bulgarian/ParadigmsBul.gf index 731386d3e..a22cc6fe9 100644 --- a/lib/resource-1.4/bulgarian/ParadigmsBul.gf +++ b/lib/resource-1.4/bulgarian/ParadigmsBul.gf @@ -3,7 +3,9 @@ resource ParadigmsBul = MorphoFunsBul ** open Prelude, MorphoBul, CatBul - in { + in { + flags coding=cp1251 ; + oper mkN001 : Str -> N ; mkN001 base = let v0 = base diff --git a/lib/resource-1.4/bulgarian/PhraseBul.gf b/lib/resource-1.4/bulgarian/PhraseBul.gf index fb2ab25fe..0d3524832 100644 --- a/lib/resource-1.4/bulgarian/PhraseBul.gf +++ b/lib/resource-1.4/bulgarian/PhraseBul.gf @@ -1,4 +1,6 @@ concrete PhraseBul of Phrase = CatBul ** open Prelude, ResBul in { + flags coding=cp1251 ; + lin PhrUtt pconj utt voc = {s = pconj.s ++ utt.s ++ voc.s} ; diff --git a/lib/resource-1.4/bulgarian/QuestionBul.gf b/lib/resource-1.4/bulgarian/QuestionBul.gf index cadd1a2b2..1032e6b44 100644 --- a/lib/resource-1.4/bulgarian/QuestionBul.gf +++ b/lib/resource-1.4/bulgarian/QuestionBul.gf @@ -1,4 +1,6 @@ concrete QuestionBul of Question = CatBul ** open ResBul, Prelude in { + flags coding=cp1251 ; + flags optimize=all_subs ; diff --git a/lib/resource-1.4/bulgarian/RelativeBul.gf b/lib/resource-1.4/bulgarian/RelativeBul.gf index 4bdcd7faa..fefd03032 100644 --- a/lib/resource-1.4/bulgarian/RelativeBul.gf +++ b/lib/resource-1.4/bulgarian/RelativeBul.gf @@ -1,4 +1,6 @@ concrete RelativeBul of Relative = CatBul ** open ResBul in { + flags coding=cp1251 ; + flags optimize=all_subs ; diff --git a/lib/resource-1.4/bulgarian/ResBul.gf b/lib/resource-1.4/bulgarian/ResBul.gf index c49613678..795b9a746 100644 --- a/lib/resource-1.4/bulgarian/ResBul.gf +++ b/lib/resource-1.4/bulgarian/ResBul.gf @@ -8,6 +8,8 @@ -- patterns needed for $Lex$. resource ResBul = ParamX ** open Prelude in { + flags coding=cp1251 ; + flags optimize=all ; diff --git a/lib/resource-1.4/bulgarian/SentenceBul.gf b/lib/resource-1.4/bulgarian/SentenceBul.gf index 6a3a20873..36bbb7cf5 100644 --- a/lib/resource-1.4/bulgarian/SentenceBul.gf +++ b/lib/resource-1.4/bulgarian/SentenceBul.gf @@ -1,4 +1,6 @@ concrete SentenceBul of Sentence = CatBul ** open Prelude, ResBul in { + flags coding=cp1251 ; + flags optimize=all_subs ; diff --git a/lib/resource-1.4/bulgarian/StructuralBul.gf b/lib/resource-1.4/bulgarian/StructuralBul.gf index c8e92365f..a3b8ec75c 100644 --- a/lib/resource-1.4/bulgarian/StructuralBul.gf +++ b/lib/resource-1.4/bulgarian/StructuralBul.gf @@ -1,5 +1,7 @@ concrete StructuralBul of Structural = CatBul ** open MorphoBul, ParadigmsBul, Prelude in { + flags coding=cp1251 ; + flags optimize=all ; diff --git a/lib/resource-1.4/bulgarian/TextBul.gf b/lib/resource-1.4/bulgarian/TextBul.gf index f3aa46909..21e624b8e 100644 --- a/lib/resource-1.4/bulgarian/TextBul.gf +++ b/lib/resource-1.4/bulgarian/TextBul.gf @@ -1,4 +1,6 @@ concrete TextBul of Text = CatBul ** { + flags coding=cp1251 ; + -- This will work for almost all languages except Spanish. diff --git a/lib/resource-1.4/bulgarian/VerbBul.gf b/lib/resource-1.4/bulgarian/VerbBul.gf index 3ad248a08..59d29deb2 100644 --- a/lib/resource-1.4/bulgarian/VerbBul.gf +++ b/lib/resource-1.4/bulgarian/VerbBul.gf @@ -1,4 +1,6 @@ concrete VerbBul of Verb = CatBul ** open Prelude, ResBul, ParadigmsBul in { + flags coding=cp1251 ; + flags optimize=all_subs ; diff --git a/lib/resource-1.4/demo/DemoRus.gf b/lib/resource-1.4/demo/DemoRus.gf index 3de795f38..83da10ca5 100644 --- a/lib/resource-1.4/demo/DemoRus.gf +++ b/lib/resource-1.4/demo/DemoRus.gf @@ -18,6 +18,6 @@ concrete DemoRus of Demo = LexiconRus ** { -flags startcat = Phr ; unlexer = text ; lexer = text ; +flags startcat = Phr ; unlexer = text ; lexer = text ; coding = utf8 ; } ; diff --git a/lib/resource-1.4/mathematical/SymbolGer.gf b/lib/resource-1.4/mathematical/SymbolGer.gf index 1240e2df1..38516d74a 100644 --- a/lib/resource-1.4/mathematical/SymbolGer.gf +++ b/lib/resource-1.4/mathematical/SymbolGer.gf @@ -4,7 +4,7 @@ lin SymbPN i = {s = \\c => i.s ; g = Neutr} ; --- c IntPN i = {s = \\c => i.s ; g = Neutr} ; --- c FloatPN i = {s = \\c => i.s ; g = Neutr} ; --- c - NumPN i = {s = \\c => i.s ; g = Neutr} ; --- c + NumPN i = {s = i.s ! Neutr ; g = Neutr} ; --- c CNIntNP cn i = { s = \\c => cn.s ! Weak ! Sg ! Nom ++ i.s ; @@ -17,14 +17,14 @@ lin isPron = False } ; CNNumNP cn i = { - s = \\c => artDef ! (GSg cn.g) ! c ++ cn.s ! Weak ! Sg ! Nom ++ i.s ; + s = \\c => artDef ! (GSg cn.g) ! c ++ cn.s ! Weak ! Sg ! Nom ++ i.s ! Neutr ! c ; a = agrP3 Sg ; isPron = False } ; SymbS sy = {s = \\_ => sy.s} ; - SymbNum n = {s = n.s ; n = Pl ; isNum = True} ; + SymbNum n = {s = \\_,_ => n.s ; n = Pl ; isNum = True} ; SymbOrd n = {s = \\_ => n.s ++ "."} ; diff --git a/lib/resource-1.4/russian/ExtraRus.gf b/lib/resource-1.4/russian/ExtraRus.gf index 5dff1e86a..d592b6e64 100644 --- a/lib/resource-1.4/russian/ExtraRus.gf +++ b/lib/resource-1.4/russian/ExtraRus.gf @@ -1,3 +1,3 @@ concrete ExtraRus of ExtraRusAbs = CatRus ** { - +flags coding=utf8 ; } diff --git a/lib/resource-1.4/russian/GrammarRus.gf b/lib/resource-1.4/russian/GrammarRus.gf index 31b505a3a..052d5204c 100644 --- a/lib/resource-1.4/russian/GrammarRus.gf +++ b/lib/resource-1.4/russian/GrammarRus.gf @@ -14,4 +14,4 @@ concrete GrammarRus of Grammar = TextX, StructuralRus, IdiomRus - ** { flags startcat = Phr ; unlexer = text ; lexer = text ;} ; + ** { flags startcat = Phr ; unlexer = text ; lexer = text ; coding=utf8 ;} ; diff --git a/lib/resource-1.4/russian/IrregRus.gf b/lib/resource-1.4/russian/IrregRus.gf index e4ebb7327..37e109b68 100644 --- a/lib/resource-1.4/russian/IrregRus.gf +++ b/lib/resource-1.4/russian/IrregRus.gf @@ -3,7 +3,7 @@ -- concrete IrregRus of IrregRusAbs = CatRus ** open ParadigmsRus in { -- ---flags optimize=values ; +flags optimize=values ; coding=utf8 ; -- -- lin -- awake_V = irregV "awake" "awoke" "awoken" ; diff --git a/lib/resource-1.4/russian/NounRus.gf b/lib/resource-1.4/russian/NounRus.gf index 7f4beb58c..683f54d07 100644 --- a/lib/resource-1.4/russian/NounRus.gf +++ b/lib/resource-1.4/russian/NounRus.gf @@ -2,7 +2,7 @@ concrete NounRus of Noun = CatRus ** open ResRus, Prelude, MorphoRus in { - flags optimize=all_subs ; + flags optimize=all_subs ; coding=utf8 ; lin DetCN kazhduj okhotnik = { diff --git a/lib/resource-1.4/russian/PhraseRus.gf b/lib/resource-1.4/russian/PhraseRus.gf index a3629b3e3..7a13e3c32 100644 --- a/lib/resource-1.4/russian/PhraseRus.gf +++ b/lib/resource-1.4/russian/PhraseRus.gf @@ -2,6 +2,7 @@ concrete PhraseRus of Phrase = CatRus ** open Prelude, ResRus in { + flags coding=utf8 ; lin PhrUtt pconj utt voc = {s = pconj.s ++ utt.s ++ voc.s} ; diff --git a/lib/resource-1.4/russian/QuestionRus.gf b/lib/resource-1.4/russian/QuestionRus.gf index 46a33f4b8..28a9dfccd 100644 --- a/lib/resource-1.4/russian/QuestionRus.gf +++ b/lib/resource-1.4/russian/QuestionRus.gf @@ -2,7 +2,7 @@ concrete QuestionRus of Question = CatRus ** open ResRus, Prelude in { - flags optimize=all_subs ; + flags optimize=all_subs ; coding=utf8 ; lin diff --git a/lib/resource-1.4/russian/Russian.gf b/lib/resource-1.4/russian/Russian.gf index 8aa2679ec..b128c45d0 100644 --- a/lib/resource-1.4/russian/Russian.gf +++ b/lib/resource-1.4/russian/Russian.gf @@ -3,4 +3,4 @@ concrete Russian of RussianAbs = LangRus, ExtraRus - ** {} ; + ** {flags coding=utf8 ;} ; diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index 96e7c57f4..e161c623f 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -62,10 +62,10 @@ emptyCommandInfo = CommandInfo { lookCommand :: String -> Map.Map String CommandInfo -> Maybe CommandInfo lookCommand = Map.lookup -commandHelpAll :: PGF -> [Option] -> String -commandHelpAll pgf opts = unlines +commandHelpAll :: (String -> String) -> PGF -> [Option] -> String +commandHelpAll enc pgf opts = unlines [commandHelp (isOpt "full" opts) (co,info) - | (co,info) <- Map.assocs (allCommands pgf)] + | (co,info) <- Map.assocs (allCommands enc pgf)] commandHelp :: Bool -> (String,CommandInfo) -> String commandHelp full (co,info) = unlines $ [ @@ -81,8 +81,8 @@ commandHelp full (co,info) = unlines $ [ ] else [] -- this list must no more be kept sorted by the command name -allCommands :: PGF -> Map.Map String CommandInfo -allCommands pgf = Map.fromList [ +allCommands :: (String -> String) -> PGF -> Map.Map String CommandInfo +allCommands enc pgf = Map.fromList [ ("cc", emptyCommandInfo { longname = "compute_concrete", syntax = "cc (-all | -table | -unqual)? TERM", @@ -145,7 +145,8 @@ allCommands pgf = Map.fromList [ syntax = "gr [-cat=CAT] [-number=INT]", examples = [ "gr -- one tree in the startcat of the current grammar", - "gr -cat=NP -number=16 -- 16 trees in the category NP" + "gr -cat=NP -number=16 -- 16 trees in the category NP", + "gr -lang=LangHin,LangTha -cat=Cl -- Cl, both in LangHin and LangTha" ], explanation = unlines [ "Generates a list of random trees, by default one tree." @@ -154,7 +155,7 @@ allCommands pgf = Map.fromList [ ], flags = [ ("cat","generation category"), - ("lang","excludes functions that have no linearization in this language"), + ("lang","uses only functions that have linearizations in all these languages"), ("number","number of trees generated") ], exec = \opts _ -> do @@ -196,10 +197,10 @@ allCommands pgf = Map.fromList [ ], exec = \opts ts -> return ([], case ts of [t] -> let co = showTree t in - case lookCommand co (allCommands pgf) of ---- new map ??!! + case lookCommand co (allCommands enc pgf) of ---- new map ??!! Just info -> commandHelp True (co,info) _ -> "command not found" - _ -> commandHelpAll pgf opts) + _ -> commandHelpAll enc pgf opts) }), ("i", emptyCommandInfo { longname = "import", @@ -400,6 +401,15 @@ allCommands pgf = Map.fromList [ ("number","the maximum number of questions") ] }), + ("se", emptyCommandInfo { + longname = "set_encoding", + synopsis = "set the encoding used in current terminal", + syntax = "se ID", + examples = [ + "se cp1251 -- set encoding to cp1521", + "se utf8 -- set encoding to utf8 (default)" + ] + }), ("sp", emptyCommandInfo { longname = "system_pipe", synopsis = "send argument to a system command", @@ -407,7 +417,7 @@ allCommands pgf = Map.fromList [ exec = \opts arg -> do let tmpi = "_tmpi" --- let tmpo = "_tmpo" - writeFile tmpi $ toString arg + writeFile tmpi $ enc $ toString arg let syst = optComm opts ++ " " ++ tmpi system $ syst ++ " <" ++ tmpi ++ " >" ++ tmpo s <- readFile tmpo @@ -451,7 +461,7 @@ allCommands pgf = Map.fromList [ let file s = "_grph." ++ s let view = optViewGraph opts ++ " " let format = optViewFormat opts - writeFile (file "dot") grph + writeFile (file "dot") (enc grph) system $ "dot -T" ++ format ++ " " ++ file "dot" ++ " > " ++ file format ++ " ; " ++ view ++ file format return void @@ -475,8 +485,8 @@ allCommands pgf = Map.fromList [ exec = \opts arg -> do let file = valIdOpts "file" "_gftmp" opts if isOpt "append" opts - then appendFile file (toString arg) - else writeFile file (toString arg) + then appendFile file (enc (toString arg)) + else writeFile file (enc (toString arg)) return void, options = [ ("append","append to file, instead of overwriting it") @@ -526,7 +536,8 @@ allCommands pgf = Map.fromList [ in cod : filter (/=cod) (map prOpt opts) _ -> map prOpt opts - optRestricted opts = restrictPGF (hasLin pgf (mkCId (optLang opts))) pgf + optRestricted opts = + restrictPGF (\f -> and [hasLin pgf (mkCId la) f | la <- optLangs opts]) pgf optLangs opts = case valIdOpts "lang" "" opts of "" -> languages pgf diff --git a/src/GF/Command/Interpreter.hs b/src/GF/Command/Interpreter.hs index e1a06a205..2762875ec 100644 --- a/src/GF/Command/Interpreter.hs +++ b/src/GF/Command/Interpreter.hs @@ -17,6 +17,7 @@ import GF.System.Signal import GF.Infra.UseIO import GF.Data.ErrM ---- +import GF.Text.UTF8 import qualified Data.Map as Map @@ -27,25 +28,25 @@ data CommandEnv = CommandEnv { expmacros :: Map.Map String Tree } -mkCommandEnv :: PGF -> CommandEnv -mkCommandEnv pgf = CommandEnv pgf (allCommands pgf) Map.empty Map.empty +mkCommandEnv :: (String -> String) -> PGF -> CommandEnv +mkCommandEnv enc pgf = CommandEnv pgf (allCommands enc pgf) Map.empty Map.empty emptyCommandEnv :: CommandEnv -emptyCommandEnv = mkCommandEnv emptyPGF +emptyCommandEnv = mkCommandEnv encodeUTF8 emptyPGF -interpretCommandLine :: CommandEnv -> String -> IO () -interpretCommandLine env line = +interpretCommandLine :: (String -> String) -> CommandEnv -> String -> IO () +interpretCommandLine enc env line = case readCommandLine line of Just [] -> return () - Just pipes -> do res <- runInterruptibly (mapM_ (interpretPipe env) pipes) + Just pipes -> do res <- runInterruptibly (mapM_ (interpretPipe enc env) pipes) case res of - Left ex -> putStrLnFlush (show ex) + Left ex -> putStrLnFlush $ enc (show ex) Right x -> return x Nothing -> putStrLnFlush "command not parsed" -interpretPipe env cs = do +interpretPipe enc env cs = do v@(_,s) <- intercs ([],"") cs - putStrLnFlush s + putStrLnFlush $ enc s return v where intercs treess [] = return treess @@ -55,12 +56,12 @@ interpretPipe env cs = do interc es comm@(Command co _ arg) = case co of '%':f -> case Map.lookup f (commandmacros env) of Just css -> do - mapM_ (interpretPipe env) (appLine (getCommandArg env arg es) css) + mapM_ (interpretPipe enc env) (appLine (getCommandArg env arg es) css) return ([],[]) ---- return ? _ -> do putStrLn $ "command macro " ++ co ++ " not interpreted" return ([],[]) - _ -> interpret env es comm + _ -> interpret enc env es comm appLine es = map (map (appCommand es)) -- macro definition applications: replace ?i by (exps !! i) @@ -75,12 +76,12 @@ appCommand xs c@(Command i os arg) = case arg of Abs x b -> Abs x (app b) -- return the trees to be sent in pipe, and the output possibly printed -interpret :: CommandEnv -> [Tree] -> Command -> IO CommandOutput -interpret env trees0 comm = case lookCommand co comms of +interpret :: (String -> String) -> CommandEnv -> [Tree] -> Command -> IO CommandOutput +interpret enc env trees0 comm = case lookCommand co comms of Just info -> do checkOpts info tss@(_,s) <- exec info opts trees - optTrace s + optTrace $ enc s return tss _ -> do putStrLn $ "command " ++ co ++ " not interpreted" diff --git a/src/GF/Compile.hs b/src/GF/Compile.hs index eb491cc78..69ada9e1a 100644 --- a/src/GF/Compile.hs +++ b/src/GF/Compile.hs @@ -14,6 +14,9 @@ import GF.Compile.ReadFiles import GF.Compile.Update import GF.Compile.Refresh +import GF.Compile.Coding +import GF.Text.UTF8 ---- + import GF.Grammar.Grammar import GF.Grammar.Lookup import GF.Grammar.PrGrammar @@ -133,7 +136,8 @@ compileOne opts env@(_,srcgr,_) file = do -- for compiled gf, read the file and update environment -- also undo common subexp optimization, to enable normal computations ".gfo" -> do - sm0 <- putPointE Normal opts ("+ reading" +++ file) $ getSourceModule opts file + sm00 <- putPointE Normal opts ("+ reading" +++ file) $ getSourceModule opts file + let sm0 = codeSourceModule decodeUTF8 sm00 -- always UTF8 in gfo let sm1 = unsubexpModule sm0 sm <- {- putPointE Normal opts "creating indirections" $ -} ioeErr $ extendModule mos sm1 @@ -148,8 +152,9 @@ compileOne opts env@(_,srcgr,_) file = do then compileOne opts env $ gfo else do - sm0 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ + sm00 <- putpOpt ("- parsing" +++ file) ("- compiling" +++ file ++ "... ") $ getSourceModule opts file + let sm0 = decodeStringsInModule sm00 (k',sm) <- compileSourceModule opts env sm0 let sm1 = if isConcr sm then shareModule sm else sm -- cannot expand Str cm <- putPointE Verbose opts " generating code... " $ generateModuleCode opts gfo sm1 @@ -201,7 +206,7 @@ compileSourceModule opts env@(k,gr,_) mo@(i,mi) = do generateModuleCode :: Options -> FilePath -> SourceModule -> IOE SourceModule generateModuleCode opts file minfo = do let minfo1 = subexpModule minfo - out = prGrammar (MGrammar [minfo1]) + out = prGrammar (MGrammar [codeSourceModule encodeUTF8 minfo1]) putPointE Normal opts (" wrote file" +++ file) $ ioeIO $ writeFile file $ out return minfo1 diff --git a/src/GF/Compile/Export.hs b/src/GF/Compile/Export.hs index 23b8198f8..21ecb3d15 100644 --- a/src/GF/Compile/Export.hs +++ b/src/GF/Compile/Export.hs @@ -58,5 +58,5 @@ outputConcr pgf = case cncnames pgf of cnc:_ -> cnc printPGF :: PGF -> String -printPGF = ---- encodeUTF8 . -- out by AR26/6/2008: the PGF may already be UTF8 +printPGF = -- encodeUTF8 . -- fromPGF does UTF8 encoding printTree . fromPGF diff --git a/src/GF/Compile/GrammarToGFCC.hs b/src/GF/Compile/GrammarToGFCC.hs index e13c8edf2..2b4156bec 100644 --- a/src/GF/Compile/GrammarToGFCC.hs +++ b/src/GF/Compile/GrammarToGFCC.hs @@ -97,8 +97,10 @@ canon2gfcc opts pars cgr@(M.MGrammar ((a,M.ModMod abm):cms)) = js = tree2list (M.jments mo) flags = Map.fromList [(mkCId f,x) | (f,x) <- moduleOptionsGFO (M.flags mo)] opers = Map.fromAscList [] -- opers will be created as optimization - utf = if moduleFlag optEncoding (moduleOptions (M.flags mo)) == UTF_8 - then D.convertStringsInTerm decodeUTF8 else id + utf = id -- trace (show lang0 +++ show flags) $ + -- if moduleFlag optEncoding (moduleOptions (M.flags mo)) == UTF_8 + -- then id else id + ---- then (trace "decode" D.convertStringsInTerm decodeUTF8) else id umkTerm = utf . mkTerm lins = Map.fromAscList [(i2i f, umkTerm tr) | (f,CncFun _ (Yes tr) _) <- js] diff --git a/src/GFI.hs b/src/GFI.hs index 8bcc7df14..75ffa22d8 100644 --- a/src/GFI.hs +++ b/src/GFI.hs @@ -11,6 +11,8 @@ import GF.Infra.UseIO import GF.Infra.Option import GF.System.Readline +import GF.Text.UTF8 ---- + import PGF import PGF.Data import PGF.Macros @@ -23,8 +25,8 @@ import qualified Text.ParserCombinators.ReadP as RP import System.Cmd import System.CPUTime import Control.Exception - import Data.Version + import Paths_gf mainGFI :: Options -> [FilePath] -> IO () @@ -39,13 +41,15 @@ loop opts gfenv0 = do let env = commandenv gfenv0 let sgr = sourcegrammar gfenv0 setCompletionFunction (Just (wordCompletion (commandenv gfenv0))) - s <- fetchCommand (prompt env) - let gfenv = gfenv0 {history = s : history gfenv0} + s0 <- fetchCommand (prompt env) + let gfenv = gfenv0 {history = s0 : history gfenv0} let loopNewCPU gfenv' = do cpu' <- getCPUTime putStrLnFlush (show ((cpu' - cputime gfenv') `div` 1000000000) ++ " msec") loop opts $ gfenv' {cputime = cpu'} let + enc = encode gfenv + s = decode gfenv s0 pwords = case words s of w:ws -> getCommandOp w :ws ws -> ws @@ -60,8 +64,8 @@ loop opts gfenv0 = do ('-':w):ws2 -> (pTermPrintStyle w, ws2) _ -> (TermPrintDefault, ws) case pTerm (unwords term) >>= checkTerm sgr >>= computeTerm sgr of ---- pipe! - Ok x -> putStrLn (showTerm style x) - Bad s -> putStrLn s + Ok x -> putStrLn $ enc (showTerm style x) + Bad s -> putStrLn $ enc s loopNewCPU gfenv "i":args -> do gfenv' <- case parseOptions args of @@ -93,12 +97,14 @@ loop opts gfenv0 = do } _ -> putStrLn "value definition not parsed" >> loopNewCPU gfenv - "ph":_ -> mapM_ putStrLn (reverse (history gfenv0)) >> loopNewCPU gfenv + "ph":_ -> mapM_ (putStrLn . enc) (reverse (history gfenv0)) >> loopNewCPU gfenv + "se":c -> loopNewCPU $ gfenv {coding = s} + "q":_ -> putStrLn "See you." >> return gfenv -- ordinary commands, working on CommandEnv _ -> do - interpretCommandLine env s + interpretCommandLine enc env s loopNewCPU gfenv importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv @@ -111,7 +117,7 @@ importInEnv gfenv opts files pgf0 = multigrammar (commandenv gfenv) pgf1 <- importGrammar pgf0 opts' files putStrLnFlush $ unwords $ "\nLanguages:" : languages pgf1 - return $ gfenv { commandenv = mkCommandEnv pgf1 } + return $ gfenv { commandenv = mkCommandEnv (encode gfenv) pgf1 } welcome = unlines [ " ", @@ -139,11 +145,21 @@ data GFEnv = GFEnv { sourcegrammar :: Grammar, -- gfo grammar -retain commandenv :: CommandEnv, history :: [String], - cputime :: Integer + cputime :: Integer, + coding :: String } emptyGFEnv :: GFEnv -emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] 0 +emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv encodeUTF8 emptyPGF) [] 0 "utf8" + +encode env = case coding env of + "utf8" -> encodeUTF8 + _ -> id + +decode env = case coding env of + "utf8" -> decodeUTF8 + _ -> id + wordCompletion cmdEnv line prefix p =