1
0
forked from GitHub/gf-core

option cc -list added

This commit is contained in:
aarne
2010-12-14 17:42:42 +00:00
parent 1f1a0d7ada
commit 22e50ae31c
3 changed files with 10 additions and 6 deletions

View File

@@ -216,6 +216,7 @@ allCommands env@(pgf, mos) = Map.fromList [
],
options = [
("all","pick all strings (forms and variants) from records and tables"),
("list","all strings, comma-separated on one line"),
("one","pick the first strings, if there is any, from records and tables"),
("table","show all strings labelled by parameters"),
("unqual","hide qualifying module names")

View File

@@ -9,12 +9,13 @@ import Text.PrettyPrint
import Data.List (intersperse)
showTerm :: SourceGrammar -> TermPrintStyle -> TermPrintQual -> Term -> String
showTerm gr style q t = render $
case style of
TermPrintTable -> vcat [p <+> s | (p,s) <- ppTermTabular gr q t]
TermPrintAll -> vcat [ s | (p,s) <- ppTermTabular gr q t]
TermPrintOne -> vcat [ s | (p,s) <- take 1 (ppTermTabular gr q t)]
TermPrintDefault -> ppTerm q 0 t
showTerm gr sty q t = case sty of
TermPrintTable -> render $ vcat [p <+> s | (p,s) <- ppTermTabular gr q t]
TermPrintAll -> render $ vcat [ s | (p,s) <- ppTermTabular gr q t]
TermPrintList -> renderStyle (style{mode = OneLineMode}) $
vcat (punctuate comma [s | (p,s) <- ppTermTabular gr q t])
TermPrintOne -> render $ vcat [ s | (p,s) <- take 1 (ppTermTabular gr q t)]
TermPrintDefault -> render $ ppTerm q 0 t
ppTermTabular :: SourceGrammar -> TermPrintQual -> Term -> [(Doc,Doc)]
ppTermTabular gr q = pr where
@@ -38,5 +39,6 @@ ppTermTabular gr q = pr where
data TermPrintStyle
= TermPrintTable
| TermPrintAll
| TermPrintList
| TermPrintOne
| TermPrintDefault

View File

@@ -111,6 +111,7 @@ loop opts gfenv0 = do
let
pOpts style q ("-table" :ws) = pOpts TermPrintTable q ws
pOpts style q ("-all" :ws) = pOpts TermPrintAll q ws
pOpts style q ("-list" :ws) = pOpts TermPrintList q ws
pOpts style q ("-one" :ws) = pOpts TermPrintOne q ws
pOpts style q ("-default":ws) = pOpts TermPrintDefault q ws
pOpts style q ("-unqual" :ws) = pOpts style Unqualified ws