auxiliaries for making the synopsis with multilingual examples

lib/doc/Makefile

@@ -14,3 +14,20 @@ abstract:
 	gfdoc -txthtml ../src/abstract/*.gf
 	mv ../src/abstract/*.html abstract
 
+exx-script:
+	runghc MkExx.hs <api-examples.txt >api-examples.gfs
+exx: exx-script
+	gf -retain -s ../alltenses/TryBul.gfo <api-examples.gfs >api-examples-Bul.txt
+	gf -retain -s ../alltenses/TryCat.gfo <api-examples.gfs >api-examples-Cat.txt
+	gf -retain -s ../alltenses/TryDan.gfo <api-examples.gfs >api-examples-Dan.txt
+	gf -retain -s ../alltenses/TryDut.gfo <api-examples.gfs >api-examples-Dut.txt
+	gf -retain -s ../alltenses/TryEng.gfo <api-examples.gfs >api-examples-Eng.txt
+	gf -retain -s ../alltenses/TryFin.gfo <api-examples.gfs >api-examples-Fin.txt
+	gf -retain -s ../alltenses/TryFre.gfo <api-examples.gfs >api-examples-Fre.txt
+	gf -retain -s ../alltenses/TryGer.gfo <api-examples.gfs >api-examples-Ger.txt
+	gf -retain -s ../alltenses/TryIta.gfo <api-examples.gfs >api-examples-Ita.txt
+	gf -retain -s ../alltenses/TryNor.gfo <api-examples.gfs >api-examples-Nor.txt
+	gf -retain -s ../alltenses/TryPol.gfo <api-examples.gfs >api-examples-Pol.txt
+	gf -retain -s ../alltenses/TryRon.gfo <api-examples.gfs >api-examples-Ron.txt
+	gf -retain -s ../alltenses/TrySpa.gfo <api-examples.gfs >api-examples-Spa.txt
+	gf -retain -s ../alltenses/TrySwe.gfo <api-examples.gfs >api-examples-Swe.txt

lib/doc/MkExx.hs

@@ -1,9 +1,9 @@
 -- make a script for computing examples
 -- usage: runghc MkExx.hs <koe.txt >koe.gfs
 -- then:  gf -retain -s ../alltenses/TryRon.gfo <koe.gfs
+-- called automatically by 'make exx'
 
-
+main = interact (unlines . concatMap mkScript . takeWhile (/="--.") . lines)
-main = interact (unlines . concatMap mkScript . lines)
 
 mkScript l = case l of
   ' ':_ -> 
@@ -12,7 +12,8 @@ mkScript l = case l of
   '-':_ -> []
   _ -> [
      add $ psq l,
-     add $ "cc -one " ++ l
+     add $ "cc -one " ++ l,
+     add $ psq "*"
      ]
 
 add = ('\n':)

lib/doc/MkExxTable.hs

@@ -0,0 +1,79 @@
+module MkExxTable (getApiExx, ApiExx, prApiEx) where
+
+import System
+import qualified Data.Map as M
+import Data.Char
+
+main = do
+  xx <- getArgs 
+  aexx <- getApiExx xx
+  return () -- putStrLn $ prApiExx aexx
+
+getApiExx :: [FilePath] -> IO ApiExx
+getApiExx xx = do
+  s  <- readFile (head xx)
+  let aet = getApiExxTrees $ dropInit $ lines s 
+  aeos <- mapM readApiExxOne xx
+  let aexx = mkApiExx $ ("API",aet) : aeos
+  putStrLn $ prApiExx aexx
+  return aexx
+
+readApiExxOne file = do
+  s <- readFile file
+  let lang = reverse (take 3 (drop 4 (reverse file))) -- api-exx-*Eng*.txt
+  let api = getApiExxOne (dropInit $ lines s)
+  putStrLn $ unlines $ prApiEx api
+  return (lang,api)
+
+-- map function -> language -> example
+type ApiExx = M.Map String (M.Map String String)
+
+-- map function -> example
+type ApiExxOne = M.Map String String
+
+-- get a map function -> example
+getApiExxOne :: [String] -> ApiExxOne
+getApiExxOne = M.fromList . pairs . map cleanUp
+ where
+   pairs ss = case ss of
+     f:_:e:rest -> (f,e) : pairs (drop 1 (dropWhile (notElem '*') rest))
+     _ -> []
+
+-- get the map function -> tree
+getApiExxTrees :: [String] -> ApiExxOne
+getApiExxTrees = M.fromList . pairs . map cleanUp
+ where
+   pairs ss = case ss of
+     f:e:_:rest -> (f,e) : pairs (drop 1 (dropWhile (notElem '*') rest))
+     _ -> []
+
+-- remove leading prompts and spaces
+cleanUp = dropWhile (\c -> not (isAlpha c || c == '*'))
+
+-- drop GF welcome
+dropInit = dropWhile ((/=">") . take 1)
+
+mkApiExx :: [(String,ApiExxOne)] -> ApiExx
+mkApiExx ltes = 
+  M.fromList [(t, 
+      M.fromList [(l,maybe "NONE" id (M.lookup t te)) | (l,te) <- ltes]) 
+    | t <- M.keys firstL]
+  where
+    firstL = snd (head ltes)
+
+prApiExx :: ApiExx -> String
+prApiExx aexx = unlines 
+  [unlines (t:prApiEx lexx) | (t,lexx) <- M.toList aexx]
+
+prApiEx :: M.Map String String -> [String]
+prApiEx apexx = case M.toList apexx of
+  (a,e):lexx -> (a ++ ": ``" ++ unwords (words e) ++ "``"):
+                [l ++ ": //" ++ doBind e ++ "//" | (l,e) <- lexx]
+
+doBind = unwords . bind . words
+
+bind ws = case ws of
+         w : "&+" : u : ws2 -> bind ((w ++ u) : ws2)
+         "&+":ws2           -> bind ws2
+         w : ws2            -> w : bind ws2
+         _ -> ws

lib/doc/MkSynopsis.hs

@@ -1,7 +1,10 @@
+import MkExxTable
 import System
 import Char
 import List
 import qualified Data.ByteString.Char8 as BS
+import qualified Data.Map as M
+import Debug.Trace ----
 
 type Cats = [(String,String,String)]
 type Rules = [(String,String,String)]
@@ -9,6 +12,9 @@ type Rules = [(String,String,String)]
 -- the file generated
 synopsis = "synopsis.txt"
 
+apiExxFiles = ["api-examples-" ++ lang ++ ".txt" | lang <- words 
+  "Bul Cat Dan Dut Eng Fin Fre Ger Ita Nor Pol Ron Spa Swe"]
+
 main = do
   xx <- getArgs
   let isLatex = case xx of
@@ -18,8 +24,17 @@ main = do
   cs2 <- getCats catAPI
   let cs = sortCats (cs1 ++ cs2)
   writeFile synopsis "GF Resource Grammar Library: Synopsis"
-  append "B. Bringert and A. Ranta"
+  append "B. Bringert, T. Hallgren, and A. Ranta"
   space
+  append "%!Encoding:utf-8"
+  append "%!style(html): ./revealpopup.css"
+  space
+  append "%!postproc(html): '#divreveal'  '<div class=reveal>'"
+  append "%!postproc(html): '#divpopup'  '<div class=popup>'"
+  append "%!postproc(html): '#ediv'  '</div>'"
+  append "%!postproc(html): '#UL'  '<ul>'"
+  append "%!postproc(html): '#EUL'  '</ul>'"
+  append "%!postproc(html): '#LI'  '<li>'"
   append "%!postproc(html): '(SRC=\"categories.png\")'  '\\1 USEMAP=\"#categories\"'"  
   append "%!postproc(html): '#LParadigms'  '<a name=\"RParadigms\"></a>'"
   append "%!postproc(tex): '#LParadigms' ''"
@@ -42,13 +57,14 @@ main = do
   space
   link "Source 2:" structuralAPI
   space
-  rs <- getRules syntaxAPI
+  apiExx <- getApiExx apiExxFiles
+  rs <- getRules apiExx syntaxAPI
 ---  putStrLn $ unlines ["p -cat=" ++ last (words t) ++ 
 ---               " \"" ++ e ++ "\"" | (_,t,e) <- rs, not (null e)] ----
-  rs2 <- getRules structuralAPI
+  rs2 <- getRules apiExx structuralAPI
   let rss = rs ++ rs2
-  mapM_ putStrLn [f ++ " " ++ e | (f,_,e) <- rss]
+---  mapM_ putStrLn [f ++ " " ++ e | (f,_,e) <- rss]
-  delimit $ mkSplitTables True isLatex cs rss 
+  delimit $ mkSplitTables True isLatex apiExx cs rss 
   space
 --  title "Structural Words"
 --  space
@@ -66,8 +82,12 @@ main = do
   space
   include "synopsis-example.txt"
   space
+  title "Table of Contents"
+  space
+  append "%%toc"
+  space
   let format = if isLatex then "tex" else "html"
-  system $ "txt2tags -t" ++ format ++ " --toc " ++ synopsis
+  system $ "txt2tags -t" ++ format ++ " " ++ " --toc " ++ synopsis
   if isLatex then (system $ "pdflatex synopsis.tex") >> return () else return ()
 
 addToolTips :: Cats -> [String]
@@ -89,14 +109,14 @@ getCats file = do
          (expl,ex) = span (/="e.g.") exp
        _ -> getrs rs ss2
 
-rulesTable :: Bool -> Bool -> Cats -> FilePath -> IO [String]
+rulesTable :: ApiExx ->  Bool -> Bool -> Cats -> FilePath -> IO [String]
-rulesTable hasEx isLatex cs file = do
+rulesTable aexx hasEx isLatex cs file = do
-  rs <- getRules file
+  rs <- getRules aexx file
-  return $ mkTable hasEx isLatex cs rs
+  return $ mkTable hasEx isLatex aexx cs rs
 
 
-getRules :: FilePath -> IO Rules
+getRules :: ApiExx -> FilePath -> IO Rules
-getRules file = do
+getRules aexx file = do
   ss <- readFileC file >>= return . filter (not . hiddenLine) . lines
   return $ getrs [] ss
  where
@@ -127,7 +147,7 @@ putParadigms isLatex cs (lang,file) = do
   space
   link "source" file
   space
-  rs <- rulesTable False isLatex cs file
+  rs <- rulesTable M.empty False isLatex cs file
   space
   delimit rs
   space
@@ -139,32 +159,60 @@ inChunks i f = concat . intersperse ["\n\n"] . map f . chunks i where
 
 -- Makes one table per result category.
 -- Adds a subsection header for each table.
-mkSplitTables :: Bool -> Bool -> Cats -> Rules -> [String]
+mkSplitTables :: Bool -> Bool -> ApiExx -> Cats -> Rules -> [String]
-mkSplitTables hasEx isLatex cs = concatMap t . addLexicalCats cs . sortRules
+mkSplitTables hasEx isLatex aexx cs = concatMap t . addLexicalCats cs . sortRules
   where t (c, xs) = [subtitle c expl] ++ tableOrLink
          where 
            expl = case [e | (n,e,_) <- cs, n == c] of
                         []  -> ""
                         e:_ -> e
-           tableOrLink = if null xs then parad else mkTable hasEx isLatex cs xs
+           tableOrLink = if null xs then parad else mkTable hasEx isLatex aexx cs xs
            parad = [
              "Lexical category, constructors given in",
              "[lexical paradigms #RParadigms]."
              ]
 
-mkTable :: Bool -> Bool -> Cats -> Rules -> [String]
+mkTable :: Bool -> Bool -> ApiExx -> Cats -> Rules -> [String]
-mkTable hasEx isLatex cs = inChunks chsize (\rs -> header : map (unwords . row) rs)
+mkTable hasEx isLatex aexx cs = inChunks chsize (\rs -> header : map (unwords . row) rs)
  where
   chsize = if isLatex then 40 else 1000
   header = if hasEx then "|| Function  | Type  | Example  ||" 
                     else "|| Function  | Type  ||"
-  row (name,typ,ex) 
+  row (name,typ,ex) =
-         = if hasEx then ["|", name', "|", typ', "|", ex', "|"]
+         let ntyp = mkIdent (name ++ " : " ++ typ) in
-                    else ["|", name', "|", typ', "|"]
+         if hasEx then ["|", name', "|", typ', "|", ex' ntyp, "|"]
+                  else ["|", name', "|", typ', "|"]
    where 
      name' = ttf name
      typ' = showTyp cs typ
-     ex' = if null ex then itf (takeWhile (/='_') name) else itf ex
+     ex' typ = if null ex then itf (takeWhile (/='_') name) else 
+           case M.lookup typ aexx of
+             Just es -> mkExample es ex
+             _ -> trace typ $ itf ex
+
+-- make an example with hover-popup translations
+mkExample es ex = unwords [
+  "#divreveal",
+  itf ex,
+  "#divpopup",
+  "#UL",
+  unwords ["#LI" ++ e | e <- prApiEx es],
+  "#EUL",
+  "#ediv",
+  "#ediv"
+  ]
+
+-- makes mkUtt : QS -> Utt to mkUtt-QS-Utt
+mkIdent :: String -> String
+mkIdent = concatMap unspec where
+  unspec c = case c of
+    ' ' -> ""
+    '>' -> ""
+    '(' -> ""
+    ')' -> ""
+    ':' -> "-"
+    _   -> [c]
+
 
 mkCatTable :: Bool -> Cats -> [String]
 mkCatTable isLatex cs = inChunks chsize (\rs -> header ++ map mk1 rs) cs

lib/doc/revealpopup.css

@@ -0,0 +1,26 @@
+/* Popup boxes will have a light yellow background and a black border */
+div.popup {
+  display: none;
+  background: #ffc;
+  border: 1px solid black;
+}
+
+div.expand { display: none }
+
+div.reveal:hover div.popup {
+  display: block;
+  position: absolute;
+  margin-left: 3em;
+}
+.popup dl { margin: 5px; }
+
+tr:hover div.expand {
+  display: block;
+}
+
+/* Just some optional color and border styles: */
+body { background: #eee; }
+table { border-collapse: collapse; }
+td, th { padding: 5px; }
+th { background: #9df; }
+td { background: white }