Lin to tables.

Lin to tables.
New unicode flag.

6 files changed, 32 insertions, 11 deletions

diff --git a/src/GF/API.hs b/src/GF/API.hs
index dfaf3bd27..29474585f 100644
--- a/src/GF/API.hs
+++ b/src/GF/API.hs
@@ -178,6 +178,8 @@ optLinearizeTree opts0 gr t = case getOptVal opts transferFun of
 
   lin mk
     | oElem showRecord opts = liftM prt . linearizeNoMark g c
+    | oElem tableLin opts   = liftM (unlines . map untok . prLinTable) . 
+                                allLinTables g c
     | otherwise             = return . untok . linTree2string mk g c
   g = grammar gr
   c = cncId gr
@@ -288,9 +290,10 @@ optTransfer opts g = case getOptVal opts transferFun of
 optTokenizer :: Options -> GFGrammar -> String -> String
 optTokenizer opts gr = show . customOrDefault opts useTokenizer customTokenizer gr
 
--- performs UTF8 if the language name is not *U.gf ; should be by gr option ---
-optEncodeUTF8 :: Language -> GFGrammar -> String -> String
-optEncodeUTF8 lang gr = case reverse (prLanguage lang) of
-  'U':_ -> id
+-- performs UTF8 if the language does not have flag coding=utf8; replaces name*U
+
+optEncodeUTF8 :: GFGrammar -> String -> String
+optEncodeUTF8 gr = case getOptVal (stateOptions gr) uniCoding of
+  Just "utf8" -> id
   _ -> encodeUTF8
 
diff --git a/src/GF/Infra/Option.hs b/src/GF/Infra/Option.hs
index 100ded735..e28d18fcd 100644
--- a/src/GF/Infra/Option.hs
+++ b/src/GF/Infra/Option.hs
@@ -191,6 +191,7 @@ typeDisplay    = aOpt "types"
 noDepTypes     = aOpt "nodeptypes"
 extractGr      = aOpt "extract"
 pathList       = aOpt "path"
+uniCoding      = aOpt "coding"
 
 markLin        = aOpt "mark"
 markOptXML     = oArg "xml"
diff --git a/src/GF/Shell/Commands.hs b/src/GF/Shell/Commands.hs
index 42a4f013c..8be8b576e 100644
--- a/src/GF/Shell/Commands.hs
+++ b/src/GF/Shell/Commands.hs
@@ -426,7 +426,7 @@ displaySStateJavaX env state = unlines $ tagXML "gfedit" $ concat [
   opts   = addOptions (optsSState state)   -- state opts override 
               (addOption (markLin mark) (globalOptions env))
   lin (n,gr) = (n, map uni $ linearizeState noWrap opts gr zipper) where
-                  uni = optEncodeUTF8 n gr . mkUnicode
+                  uni = optEncodeUTF8 gr . mkUnicode
   exp    = prprTree $ loc2tree zipper
   zipper = stateSState state
   linAll = map lin lgrs
diff --git a/src/GF/Source/PrintGF.hs b/src/GF/Source/PrintGF.hs
index e4238ceff..aa5909e33 100644
--- a/src/GF/Source/PrintGF.hs
+++ b/src/GF/Source/PrintGF.hs
@@ -17,10 +17,11 @@ render :: [String] -> String
 render = rend 0 where
   rend i ss = case ss of
 
-    --H these three are hand-written
+    --H these four are hand-written
     "{0"     :ts -> cons "{"  $ rend (i+1) ts
     t :"}0"  :ts -> cons t    $ space "}"  $ rend (i-1) ts
     t : "."  :ts -> cons t    $ cons "."  $ rend i ts
+    "\\"     :ts -> cons "\\"  $ rend i ts
 
     "["      :ts -> cons "["  $ rend i ts
     "("      :ts -> cons "("  $ rend i ts
diff --git a/src/GF/UseGrammar/Linear.hs b/src/GF/UseGrammar/Linear.hs
index c439d62b2..e60f8da79 100644
--- a/src/GF/UseGrammar/Linear.hs
+++ b/src/GF/UseGrammar/Linear.hs
@@ -111,7 +111,7 @@ strs2strings = map unlex
 
 -- this is just unwords; use an unlexer from Text to postprocess
 unlex :: [Str] -> String
-unlex = performBinds . concat . map sstr . take 1 ----
+unlex = concat . map sstr . take 1 ----
 
 -- finally, a top-level function to get a string from an expression
 linTree2string :: Marker -> CanonGrammar -> Ident -> A.Tree -> String
@@ -132,6 +132,25 @@ allLinsOfTree gr a e = err (singleton . str) id $ do
   ts <- rec2strTables r'
   return $ concat $ sTables2strs $ strTables2sTables ts
 
+-- the value is a list of structures arranged as records of tables of terms
+allLinsAsRec :: CanonGrammar -> Ident -> A.Tree -> Err [[(Label,[([Patt],Term)])]]
+allLinsAsRec gr c t = linearizeNoMark gr c t >>= allLinValues
+
+-- the value is a list of structures arranged as records of tables of strings
+-- only taking into account string fields
+allLinTables :: CanonGrammar ->Ident ->A.Tree -> Err [[(Label,[([Patt],[String])])]]
+allLinTables gr c t = do
+  r' <- allLinsAsRec gr c t
+  mapM (mapM getS) r'
+ where 
+   getS (lab,pss) = liftM (curry id lab) $ mapM gets pss
+   gets (ps,t) = liftM (curry id ps . concat . map str2strings) $ strsFromTerm t
+
+prLinTable :: [[(Label,[([Patt],[String])])]] -> [String]
+prLinTable = concatMap prOne . concat where
+  prOne (lab,pss) = prt lab : map pr pss ----
+  pr (ps,ss) = unwords (map prt_ ps) +++ ":" +++ unwords ss
+
 {-
 -- the value is a list of strs
 allLinStrings :: CanonGrammar -> Tree -> [Str]
@@ -145,9 +164,6 @@ allLinsAsStrs gr ft = do
   lpts <- allLinearizations gr ft
   return $ concat $ mapM (mapPairsM (mapPairsM strsFromTerm)) lpts
 
--- the value is a list of terms of type Str, not forgetting their arguments
-allLinearizations :: CanonGrammar -> Tree -> Err [[(Label,[([Patt],Term)])]]
-allLinearizations gr ft = linearizeTree gr ft >>= allLinValues
 
 -- to a list of strings
 linearizeToStrings :: CanonGrammar -> ([Int] ->Term -> Term) -> Tree -> Err [String]
diff --git a/src/Today.hs b/src/Today.hs
index ebaac4647..1ed560bc7 100644
--- a/src/Today.hs
+++ b/src/Today.hs
@@ -1 +1 @@
-module Today where today = "Mon Nov 10 11:51:43 CET 2003"
+module Today where today = "Mon Nov 10 16:45:46 CET 2003"