diff options
| -rw-r--r-- | src/GF/Command/Abstract.hs | 6 | ||||
| -rw-r--r-- | src/GF/Command/Commands.hs | 22 | ||||
| -rw-r--r-- | src/GF/Text/Lexing.hs | 2 |
3 files changed, 24 insertions, 6 deletions
diff --git a/src/GF/Command/Abstract.hs b/src/GF/Command/Abstract.hs index cf82e96c6..dff404194 100644 --- a/src/GF/Command/Abstract.hs +++ b/src/GF/Command/Abstract.hs @@ -56,6 +56,12 @@ isOpt o opts = elem o [x | OOpt x <- opts] isFlag :: String -> [Option] -> Bool isFlag o opts = elem o [x | OFlag x _ <- opts] +optsAndFlags :: [Option] -> ([Option],[Option]) +optsAndFlags = foldr add ([],[]) where + add o (os,fs) = case o of + OOpt _ -> (o:os,fs) + OFlag _ _ -> (os,o:fs) + prOpt :: Option -> String prOpt o = case o of OOpt i -> i diff --git a/src/GF/Command/Commands.hs b/src/GF/Command/Commands.hs index e6ee4a80c..2e0cdb991 100644 --- a/src/GF/Command/Commands.hs +++ b/src/GF/Command/Commands.hs @@ -416,10 +416,15 @@ allCommands cod env@(pgf, mos) = Map.fromList [ "l (EAdd 3 4) | ps -code -- linearize code-like output", "ps -lexer=code | p -cat=Exp -- parse code-like input", "gr -cat=QCl | l | ps -bind -- linearization output from LangFin", - "ps -to_devanagari \"A-p\" -- show Devanagari in UTF8 terminal" + "ps -to_devanagari \"A-p\" -- show Devanagari in UTF8 terminal" ], - exec = \opts -> return . fromString . stringOps (map prOpt opts) . toString, - options = stringOpOptions + exec = \opts -> + let (os,fs) = optsAndFlags opts in + return . fromString . stringOps (envFlag fs) (map prOpt os) . toString, + options = stringOpOptions, + flags = [ + ("env","apply in this environment only") + ] }), ("pt", emptyCommandInfo { longname = "put_tree", @@ -603,7 +608,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [ (prCId (abstractName pgf) ++ ": " ++ showTree t) : [prCId lang ++ ": " ++ linear opts lang t | lang <- optLangs opts] - unlex opts lang = stringOps (getUnlex opts lang ++ map prOpt opts) + unlex opts lang = stringOps Nothing (getUnlex opts lang ++ map prOpt opts) ---- getUnlex opts lang = case words (valStrOpts "unlexer" "" opts) of lexs -> case lookup lang @@ -616,7 +621,7 @@ allCommands cod env@(pgf, mos) = Map.fromList [ -- - If lang has flag coding=utf8, -to_utf8 is ignored. -- - If lang has coding=other, and -to_utf8 is in opts, from_other is applied first. -- THIS DOES NOT WORK UNFORTUNATELY - can't use the grammar flag properly - unlexx opts lang = {- trace (unwords optsC) $ -} stringOps optsC where + unlexx opts lang = {- trace (unwords optsC) $ -} stringOps Nothing optsC where ---- optsC = case lookFlag pgf lang "coding" of Just "utf8" -> filter (/="to_utf8") $ map prOpt opts Just other | isOpt "to_utf8" opts -> @@ -666,8 +671,13 @@ allCommands cod env@(pgf, mos) = Map.fromList [ morpho la = maybe Map.empty id $ Map.lookup la mos -- ps -f -g s returns g (f s) - stringOps opts s = foldr app s (reverse opts) where + stringOps menv opts s = foldr (menvop . app) s (reverse opts) where app f = maybe id id (stringOp f) + menvop op = maybe op (\ (b,e) -> opInEnv b e op) menv + + envFlag fs = case valStrOpts "env" "global" fs of + "quotes" -> Just ("\"","\"") + _ -> Nothing treeOps opts s = foldr app s (reverse opts) where app f = maybe id id (treeOp pgf f) diff --git a/src/GF/Text/Lexing.hs b/src/GF/Text/Lexing.hs index 302a1db51..3300d311e 100644 --- a/src/GF/Text/Lexing.hs +++ b/src/GF/Text/Lexing.hs @@ -29,6 +29,8 @@ stringOp name = case name of "from_cp1251" -> Just decodeCP1251 _ -> transliterate name +-- perform op in environments beg--end, t.ex. between "--" +--- suboptimal implementation opInEnv :: String -> String -> (String -> String) -> (String -> String) opInEnv beg end op = concat . altern False . chop (lbeg, beg) [] where chop mk@(lg, mark) s0 s = |