Look at both command-line and grammar startcat falgs in pg commands.

6 files changed, 22 insertions, 17 deletions

diff --git a/src/GF/Speech/GrammarToVoiceXML.hs b/src/GF/Speech/GrammarToVoiceXML.hs
index 1e3916953..f61e75f24 100644
--- a/src/GF/Speech/GrammarToVoiceXML.hs
+++ b/src/GF/Speech/GrammarToVoiceXML.hs
@@ -21,10 +21,9 @@ import GF.Data.XML
 import Data.List (isPrefixOf, find, intersperse)
 
 -- | the main function
-grammar2vxml :: GFC.CanonGrammar -> String
-grammar2vxml gr = showsXMLDoc (skel2vxml name startcat gr') ""
+grammar2vxml :: String -> GFC.CanonGrammar -> String
+grammar2vxml startcat gr = showsXMLDoc (skel2vxml name startcat gr') ""
     where (name, gr') = vSkeleton gr
-          startcat = "Order" -- FIXME
 
 type VIdent = String
 
@@ -109,7 +108,7 @@ cat2form :: String -> VIdent -> [(VIdent, [VIdent])] -> XML
 cat2form gr cat fs = 
     form cat [var "value" (Just "'?'"), formDebug cat,
               block [if_ "value != '?'" [assign cat "value"]],
-              field cat [] [promptString ("quest_"++cat), 
+              field cat [] [promptString (catQuestion cat), 
                             grammar (gr++"#"++cat),
                             nomatch [Data "I didn't understand you.", reprompt],
                             help [Data ("help_"++cat)],
@@ -120,6 +119,10 @@ cat2form gr cat fs =
   where subDone = [assign cat "sub.value", return_ [cat]]
         feedback = []
 
+catQuestion :: VIdent -> String
+catQuestion cat = questFun
+  where questFun = "quest_"++cat
+
 fun2form :: String -> VIdent -> [VIdent] -> XML
 fun2form gr fun args = 
     form fun ([var "value" Nothing] ++ [formDebug fun]
diff --git a/src/GF/Speech/PrGSL.hs b/src/GF/Speech/PrGSL.hs
index 5fdb28e8e..ffcd00509 100644
--- a/src/GF/Speech/PrGSL.hs
+++ b/src/GF/Speech/PrGSL.hs
@@ -31,9 +31,10 @@ import GF.Probabilistic.Probabilistic (Probs)
 import Data.Char (toUpper,toLower)
 
 gslPrinter :: Ident -- ^ Grammar name
+           -> String    -- ^ Start category
 	   -> Options -> Maybe Probs -> CGrammar -> String
-gslPrinter name opts probs cfg = prGSL srg ""
-    where srg = topDownFilter $ makeSimpleSRG name opts probs $ rmPunctCFG cfg
+gslPrinter name start opts probs cfg = prGSL srg ""
+    where srg = topDownFilter $ makeSimpleSRG name start opts probs $ rmPunctCFG cfg
 
 prGSL :: SRG -> ShowS
 prGSL (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
diff --git a/src/GF/Speech/PrJSGF.hs b/src/GF/Speech/PrJSGF.hs
index 56f5eda1b..2a4c4fd51 100644
--- a/src/GF/Speech/PrJSGF.hs
+++ b/src/GF/Speech/PrJSGF.hs
@@ -30,9 +30,10 @@ import GF.Probabilistic.Probabilistic (Probs)
 import GF.Speech.SRG
 
 jsgfPrinter :: Ident -- ^ Grammar name
-	   -> Options -> Maybe Probs -> CGrammar -> String
-jsgfPrinter name opts probs cfg = prJSGF srg ""
-    where srg = makeSimpleSRG name opts probs cfg
+            -> String    -- ^ Start category
+	    -> Options -> Maybe Probs -> CGrammar -> String
+jsgfPrinter name start opts probs cfg = prJSGF srg ""
+    where srg = makeSimpleSRG name start opts probs cfg
 
 prJSGF :: SRG -> ShowS
 prJSGF (SRG{grammarName=name,startCat=start,origStartCat=origStart,rules=rs})
diff --git a/src/GF/Speech/PrSRGS.hs b/src/GF/Speech/PrSRGS.hs
index 8e358e51f..dae6f35f6 100644
--- a/src/GF/Speech/PrSRGS.hs
+++ b/src/GF/Speech/PrSRGS.hs
@@ -36,12 +36,13 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 
 srgsXmlPrinter :: Ident -- ^ Grammar name
+               -> String    -- ^ Start category
 	       -> Options 
                -> Bool  -- ^ Whether to include semantic interpretation 
 	       -> Maybe Probs
 	       -> CGrammar -> String
-srgsXmlPrinter name opts sisr probs cfg = prSrgsXml sisr srg ""
-    where srg = makeSRG name opts probs cfg
+srgsXmlPrinter name start opts sisr probs cfg = prSrgsXml sisr srg ""
+    where srg = makeSRG name start opts probs cfg
 
 prSrgsXml :: Bool -> SRG -> ShowS
 prSrgsXml sisr (SRG{grammarName=name,startCat=start,
diff --git a/src/GF/Speech/SRG.hs b/src/GF/Speech/SRG.hs
index 03204d888..2dd41cfaf 100644
--- a/src/GF/Speech/SRG.hs
+++ b/src/GF/Speech/SRG.hs
@@ -69,6 +69,7 @@ type CatNames = Map String String
 --   FIXME: the probabilities, names and profiles in the returned 
 --   grammar may be meaningless.
 makeSimpleSRG :: Ident     -- ^ Grammar name
+              -> String    -- ^ Start category
 	      -> Options   -- ^ Grammar options
 	      -> Maybe Probs -- ^ Probabilities
 	      -> CGrammar -- ^ A context-free grammar
@@ -79,6 +80,7 @@ makeSimpleSRG
 -- | Create a SRG preserving the names, profiles and probabilities of the 
 --   input grammar. The returned grammar may be left-recursive.
 makeSRG :: Ident     -- ^ Grammar name
+        -> String    -- ^ Start category
 	-> Options   -- ^ Grammar options
 	-> Maybe Probs -- ^ Probabilities
 	-> CGrammar -- ^ A context-free grammar
@@ -88,11 +90,12 @@ makeSRG = makeSRG_ removeEmptyCats
 makeSRG_ :: (CFRules -> CFRules) -- ^ Transformations to apply to the
                                  --   CFG before converting to SRG
          -> Ident     -- ^ Grammar name
+         -> String    -- ^ Start category
 	 -> Options   -- ^ Grammar options
 	 -> Maybe Probs -- ^ Probabilities
 	 -> CGrammar -- ^ A context-free grammar
 	 -> SRG
-makeSRG_ f i opts probs gr 
+makeSRG_ f i origStart opts probs gr 
     = SRG { grammarName = name,
 	    startCat = lookupFM_ names origStart,
 	    origStartCat = origStart,
@@ -100,7 +103,6 @@ makeSRG_ f i opts probs gr
 	    rules = rs }
     where 
     name = prIdent i
-    origStart = getStartCat opts
     l = fromMaybe "en_UK" (getOptVal opts speechLanguage)
     gr' = f (cfgToCFRules gr)
     (cats,cfgRules) = unzip gr'
diff --git a/src/GF/Speech/TransformCFG.hs b/src/GF/Speech/TransformCFG.hs
index b1ddcbde2..27435ed89 100644
--- a/src/GF/Speech/TransformCFG.hs
+++ b/src/GF/Speech/TransformCFG.hs
@@ -19,7 +19,7 @@
 -- FIXME: lots of this stuff is used by CFGToFiniteState, thus
 -- the missing explicit expot list.
 module GF.Speech.TransformCFG {- (CFRule_, CFRules, 
-			       cfgToCFRules, getStartCat,
+			       cfgToCFRules,
 			       removeLeftRecursion,
 			       removeEmptyCats, removeIdenticalRules) -} where
 
@@ -56,9 +56,6 @@ cfgToCFRules cfg = groupProds [CFRule (catToString c) (map symb r) n | CFRule c
 	  -- symb (Tok t) = Tok t
 	  catToString = prt
 
-getStartCat :: Options -> String
-getStartCat opts = fromMaybe "S" (getOptVal opts gStartCat) ++ "{}.s"
-
 -- | Group productions by their lhs categories
 groupProds :: [CFRule_] -> CFRules
 groupProds = Map.toList . Map.fromListWith (++) . map (\r -> (lhsCat r,[r]))