Added -startcat flag to the pg command.

6 files changed, 78 insertions, 82 deletions

diff --git a/src/GF/API.hs b/src/GF/API.hs
index 768fa7d6b..950fed731 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -216,7 +216,7 @@ speechInput opt s = recognizeSpeech name language cfg cat number
   name = cncId s
   cfg = stateCFG s -- FIXME: use lang flag to select grammar
   language = fromMaybe "en_UK" (getOptVal opts speechLanguage)
-  cat = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s"
+  cat = prCFCat (firstCatOpts opts s) ++ "{}.s"
   number = optIntOrN opts flagNumber 1
 
 optLinearizeTreeVal :: Options -> GFGrammar -> Tree -> String
@@ -327,7 +327,9 @@ prMultiGrammar opts = M.showMGrammar (oElem optimizeCanon opts)
 -- access to customizable commands
 
 optPrintGrammar :: Options -> StateGrammar -> String
-optPrintGrammar opts = customOrDefault opts grammarPrinter customGrammarPrinter
+optPrintGrammar opts = pg opts
+    where
+    pg = customOrDefault opts grammarPrinter customGrammarPrinter
 
 optPrintMultiGrammar :: Options -> CanonGrammar -> String
 optPrintMultiGrammar opts = encodeId . pmg opts . encode
diff --git a/src/GF/Shell/HelpFile.hs b/src/GF/Shell/HelpFile.hs
index 57692b493..8d7b72c08 100644
--- a/src/GF/Shell/HelpFile.hs
+++ b/src/GF/Shell/HelpFile.hs
@@ -133,6 +133,8 @@ txtHelpFile =
   "\n  flags: " ++
   "\n      -printer" ++
   "\n      -lang" ++
+  "\n      -startcat  -- The start category of the generated grammar." ++
+  "\n                    Only supported by some grammar printers." ++
   "\n  examples:" ++
   "\n      pg -printer=cf  -- show the context-free skeleton" ++
   "\n" ++
diff --git a/src/GF/Shell/ShellCommands.hs b/src/GF/Shell/ShellCommands.hs
index b93335416..2740101a7 100644
--- a/src/GF/Shell/ShellCommands.hs
+++ b/src/GF/Shell/ShellCommands.hs
@@ -212,7 +212,7 @@ optionsOfCommand co = case co of
   CSystemCommand _ -> none
   CGrep _ -> opts "v"
 
-  CPrintGrammar -> both "utf8" "printer lang"
+  CPrintGrammar -> both "utf8" "printer lang startcat"
   CPrintMultiGrammar -> both "utf8 utf8id" "printer"
   CPrintSourceGrammar -> both "utf8" "printer"
 
diff --git a/src/GF/System/ATKSpeechInput.hs b/src/GF/System/ATKSpeechInput.hs
index 2b46915f5..2e9e5c0a1 100644
--- a/src/GF/System/ATKSpeechInput.hs
+++ b/src/GF/System/ATKSpeechInput.hs
@@ -110,7 +110,6 @@ recognizeSpeech :: Ident -- ^ Grammar name
                 -> IO [String]
 recognizeSpeech name language cfg start number = 
     do
-    -- FIXME: use cat
     let slf = slfPrinter name start cfg
         n = prIdent name
         hmmName = "hmm_" ++ language
@@ -119,10 +118,10 @@ recognizeSpeech name language cfg start number =
         recName = "rec_" ++ language ++ "_" ++ n
     writeFile "debug.net" slf
     initATK language
-    hPutStrLn stderr "Loading grammar..."
+    hPutStrLn stderr $ "Loading grammar " ++ n ++ " ..."
     loadGrammarString slfName slf
     createRecognizer recName hmmName dictName slfName
-    hPutStrLn stderr "Listening..."
+    hPutStrLn stderr $ "Listening in category " ++ start ++ "..."
     s <- replicateM number (recognize recName)
     return s
 
diff --git a/src/GF/UseGrammar/Custom.hs b/src/GF/UseGrammar/Custom.hs
index efaa1abeb..69d6d7df1 100644
--- a/src/GF/UseGrammar/Custom.hs
+++ b/src/GF/UseGrammar/Custom.hs
@@ -141,7 +141,7 @@ import GF.Text.ExtraDiacritics (mkExtraDiacritics)
 customGrammarParser :: CustomData (FilePath -> IOE C.CanonGrammar) 
 
 -- | grammarPrinter, \"-printer=x\"
-customGrammarPrinter :: CustomData (StateGrammar -> String)             
+customGrammarPrinter :: CustomData (Options -> StateGrammar -> String)             
 
 -- | multiGrammarPrinter, \"-printer=x\"
 customMultiGrammarPrinter :: CustomData (Options -> CanonGrammar -> String)    
@@ -238,67 +238,58 @@ customGrammarParser =
 customGrammarPrinter = 
   customData "Grammar printers, selected by option -printer=x" $
   [
-   (strCI "gfc",     prCanon . stateGrammarST) -- DEFAULT
-  ,(strCI "gf",      err id prGrammar . canon2sourceGrammar . stateGrammarST)
-  ,(strCI "cf",      prCF . stateCF)
-  ,(strCI "old",     printGrammarOld . stateGrammarST)
-  ,(strCI "srg",     prSRG . stateCF)
-  ,(strCI "gsl",     \s -> let opts = stateOptions s
-                               name = cncId s
-                            in gslPrinter name opts Nothing $ stateCFG s)
-  ,(strCI "jsgf",    \s -> let opts = stateOptions s
-                               name = cncId s
-                            in jsgfPrinter name opts Nothing $ stateCFG s)
-  ,(strCI "srgs_xml", \s -> let opts = stateOptions s
-                                name = cncId s
-                             in srgsXmlPrinter name opts False Nothing $ stateCFG s)
-  ,(strCI "srgs_xml_prob", \s -> let opts = stateOptions s
-                                     name = cncId s
-                                     probs = stateProbs s
-                             in srgsXmlPrinter name opts False (Just probs) $ stateCFG s)
-  ,(strCI "srgs_xml_ms_sem", \s -> let opts = stateOptions s
-                                       name = cncId s
-                                   in srgsXmlPrinter name opts True Nothing $ stateCFG s)
-  ,(strCI "vxml",    grammar2vxml . stateGrammarST)
-  ,(strCI "slf",     \s -> let opts = stateOptions s
-                               start = getStartCat opts
-                               name = cncId s
-                            in slfPrinter name start $ stateCFG s)
-  ,(strCI "slf_graphviz", \s -> let opts = stateOptions s
-                                    start = getStartCat opts
+   (strCI "gfc",     \_ -> prCanon . stateGrammarST) -- DEFAULT
+  ,(strCI "gf",      \_ -> err id prGrammar . canon2sourceGrammar . stateGrammarST)
+  ,(strCI "cf",      \_ -> prCF . stateCF)
+  ,(strCI "old",     \_ -> printGrammarOld . stateGrammarST)
+  ,(strCI "srg",     \_ -> prSRG . stateCF)
+  ,(strCI "gsl",     \opts s -> let name = cncId s
+                                 in gslPrinter name opts Nothing $ stateCFG s)
+  ,(strCI "jsgf",    \opts s -> let name = cncId s
+                                 in jsgfPrinter name opts Nothing $ stateCFG s)
+  ,(strCI "srgs_xml", \opts s -> let name = cncId s
+                                  in srgsXmlPrinter name opts False Nothing $ stateCFG s)
+  ,(strCI "srgs_xml_prob", 
+              \opts s -> let name = cncId s
+                             probs = stateProbs s
+                          in srgsXmlPrinter name opts False (Just probs) $ stateCFG s)
+  ,(strCI "srgs_xml_ms_sem", 
+              \opts s -> let name = cncId s
+                          in srgsXmlPrinter name opts True Nothing $ stateCFG s)
+  ,(strCI "vxml", \_ -> grammar2vxml . stateGrammarST)
+  ,(strCI "slf",  \opts s -> let start = getStartCat opts
+                                 name = cncId s
+                              in slfPrinter name start $ stateCFG s)
+  ,(strCI "slf_graphviz", \opts s -> let start = getStartCat opts
+                                         name = cncId s
+                                      in slfGraphvizPrinter name start $ stateCFG s)
+  ,(strCI "slf_sub", \opts s -> let start = getStartCat opts
                                     name = cncId s
-                                 in slfGraphvizPrinter name start $ stateCFG s)
-  ,(strCI "slf_sub", \s -> let opts = stateOptions s
-                               start = getStartCat opts
-                               name = cncId s
-                            in slfSubPrinter name start $ stateCFG s)
-  ,(strCI "slf_sub_graphviz", \s -> let opts = stateOptions s
-                                        start = getStartCat opts
+                                 in slfSubPrinter name start $ stateCFG s)
+  ,(strCI "slf_sub_graphviz", \opts s -> let start = getStartCat opts
+                                             name = cncId s
+                                          in slfSubGraphvizPrinter name start $ stateCFG s)
+  ,(strCI "fa_graphviz", \opts s -> let start = getStartCat opts
                                         name = cncId s
-                                     in slfSubGraphvizPrinter name start $ stateCFG s)
-  ,(strCI "fa_graphviz", \s -> let opts = stateOptions s
-                                   start = getStartCat opts
-                                   name = cncId s
-                                 in faGraphvizPrinter name start $ stateCFG s)
-  ,(strCI "fa_c", \s -> let opts = stateOptions s
-                            start = getStartCat opts
-                            name = cncId s
-                        in faCPrinter name start $ stateCFG s)
-  ,(strCI "regular", regularPrinter . stateCFG)
-  ,(strCI "plbnf",   prLBNF True)
-  ,(strCI "lbnf",    prLBNF False)
-  ,(strCI "bnf",     prBNF False)
-  ,(strCI "haskell", grammar2haskell . stateGrammarST)
-  ,(strCI "transfer", grammar2transfer . stateGrammarST)
-  ,(strCI "morpho",  prMorpho . stateMorpho)
-  ,(strCI "fullform",prFullForm . stateMorpho)
-  ,(strCI "opts",    prOpts . stateOptions)
-  ,(strCI "words",   unwords . stateGrammarWords)
-  ,(strCI "printnames", C.prPrintnamesGrammar . stateGrammarST)
-  ,(strCI "stat",    prStatistics . stateGrammarST)
-  ,(strCI "probs",   prProbs . stateProbs)
-  ,(strCI "unpar",   prCanon . unparametrizeCanon . stateGrammarST)
-  ,(strCI "subs",    prSubtermStat . stateGrammarST)
+                                     in faGraphvizPrinter name start $ stateCFG s)
+  ,(strCI "fa_c", \opts s -> let start = getStartCat opts
+                                 name = cncId s
+                              in faCPrinter name start $ stateCFG s)
+  ,(strCI "regular", \_ -> regularPrinter . stateCFG)
+  ,(strCI "plbnf",   \_ -> prLBNF True)
+  ,(strCI "lbnf",    \_ -> prLBNF False)
+  ,(strCI "bnf",     \_ -> prBNF False)
+  ,(strCI "haskell", \_ -> grammar2haskell . stateGrammarST)
+  ,(strCI "transfer", \_ -> grammar2transfer . stateGrammarST)
+  ,(strCI "morpho",  \_ -> prMorpho . stateMorpho)
+  ,(strCI "fullform",\_ -> prFullForm . stateMorpho)
+  ,(strCI "opts",    \_ -> prOpts . stateOptions)
+  ,(strCI "words",   \_ -> unwords . stateGrammarWords)
+  ,(strCI "printnames", \_ -> C.prPrintnamesGrammar . stateGrammarST)
+  ,(strCI "stat",    \_ -> prStatistics . stateGrammarST)
+  ,(strCI "probs",   \_ -> prProbs . stateProbs)
+  ,(strCI "unpar",   \_ -> prCanon . unparametrizeCanon . stateGrammarST)
+  ,(strCI "subs",    \_ -> prSubtermStat . stateGrammarST)
 
 {- ----
    (strCI "gf",      prt  . st2grammar . stateGrammarST)  -- DEFAULT
@@ -310,26 +301,26 @@ customGrammarPrinter =
 -- add your own grammar printers here
 
 -- grammar conversions:
-  ,(strCI "mcfg",     Prt.prt . stateMCFG)
-  ,(strCI "cfg",      Prt.prt . stateCFG)
-  ,(strCI "pinfo",    Prt.prt . statePInfo)
-  ,(strCI "abstract", Prt.prtAfter "\n" . Cnv.gfc2abstract . stateGrammarLang)
+  ,(strCI "mcfg",     \_ -> Prt.prt . stateMCFG)
+  ,(strCI "cfg",      \_ -> Prt.prt . stateCFG)
+  ,(strCI "pinfo",    \_ -> Prt.prt . statePInfo)
+  ,(strCI "abstract", \_ -> Prt.prtAfter "\n" . Cnv.gfc2abstract . stateGrammarLang)
 
-  ,(strCI "functiongraph",CnvTypeGraph.prtFunctionGraph . Cnv.gfc2simple noOptions . stateGrammarLang)
-  ,(strCI "typegraph",    CnvTypeGraph.prtTypeGraph . Cnv.gfc2simple noOptions . stateGrammarLang)
+  ,(strCI "functiongraph",\_ -> CnvTypeGraph.prtFunctionGraph . Cnv.gfc2simple noOptions . stateGrammarLang)
+  ,(strCI "typegraph",    \_ -> CnvTypeGraph.prtTypeGraph . Cnv.gfc2simple noOptions . stateGrammarLang)
 
-  ,(strCI "gfc-haskell",  CnvHaskell.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
-  ,(strCI "mcfg-haskell", CnvHaskell.prtMGrammar . stateMCFG)
-  ,(strCI "cfg-haskell",  CnvHaskell.prtCGrammar . stateCFG)
-  ,(strCI "gfc-prolog",   CnvProlog.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
-  ,(strCI "mcfg-prolog",  CnvProlog.prtMGrammar . stateMCFG)
-  ,(strCI "cfg-prolog",   CnvProlog.prtCGrammar . stateCFG)
+  ,(strCI "gfc-haskell",  \_ -> CnvHaskell.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
+  ,(strCI "mcfg-haskell", \_ -> CnvHaskell.prtMGrammar . stateMCFG)
+  ,(strCI "cfg-haskell",  \_ -> CnvHaskell.prtCGrammar . stateCFG)
+  ,(strCI "gfc-prolog",   \_ -> CnvProlog.prtSGrammar . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
+  ,(strCI "mcfg-prolog",  \_ -> CnvProlog.prtMGrammar . stateMCFG)
+  ,(strCI "cfg-prolog",   \_ -> CnvProlog.prtCGrammar . stateCFG)
 
 -- obsolete, or only for testing:
-  ,(strCI "abs-skvatt", Cnv.abstract2skvatt . Cnv.gfc2abstract . stateGrammarLang)
-  ,(strCI "cfg-skvatt", Cnv.cfg2skvatt . stateCFG)
-  ,(strCI "simple",   Prt.prt . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
-  ,(strCI "mcfg-erasing", Prt.prt . fst . snd . uncurry Cnv.convertGFC . stateGrammarLangOpts)
+  ,(strCI "abs-skvatt", \_ -> Cnv.abstract2skvatt . Cnv.gfc2abstract . stateGrammarLang)
+  ,(strCI "cfg-skvatt", \_ -> Cnv.cfg2skvatt . stateCFG)
+  ,(strCI "simple",   \_ -> Prt.prt . uncurry Cnv.gfc2simple . stateGrammarLangOpts)
+  ,(strCI "mcfg-erasing", \_ -> Prt.prt . fst . snd . uncurry Cnv.convertGFC . stateGrammarLangOpts)
 --  ,(strCI "mcfg-old", PrtOld.prt . CnvOld.mcfg . statePInfoOld)
 --  ,(strCI "cfg-old",  PrtOld.prt . CnvOld.cfg . statePInfoOld)
   ] 
diff --git a/src/HelpFile b/src/HelpFile
index 97ce04186..634b0ee45 100644
--- a/src/HelpFile
+++ b/src/HelpFile
@@ -104,6 +104,8 @@ pg, print_grammar: pg
   flags: 
       -printer
       -lang
+      -startcat  -- The start category of the generated grammar.
+                    Only supported by some grammar printers.
   examples:
       pg -printer=cf  -- show the context-free skeleton