1
0
forked from GitHub/gf-core

Hew version of GFDoc.

This commit is contained in:
aarne
2003-11-21 13:57:49 +00:00
parent 259eb4c866
commit 6d99debdff
2 changed files with 91 additions and 7 deletions

View File

@@ -5,6 +5,7 @@ import System
import Char import Char
-- produce a HTML document from a list of GF grammar files. AR 6/10/2002 -- produce a HTML document from a list of GF grammar files. AR 6/10/2002
-- Added --! (NewPage) and --* (Item) 21/11/2003
-- to read files and write a file -- to read files and write a file
@@ -13,9 +14,10 @@ main = do
xx <- getArgs xx <- getArgs
let let
(typ,format,name) = case xx of (typ,format,name) = case xx of
"+latex" : x: [] -> (True,doc2latex,x) "+latex" : x: [] -> (0,doc2latex,x)
x:[] -> (False,doc2html,x) "+htmls" : x: [] -> (2,doc2html,x)
_ -> (True,doc2html, "unknown.txt") --- x:[] -> (1,doc2html,x)
_ -> (1,doc2html, "unknown.txt") ---
if null xx if null xx
then do then do
putStrLn welcome putStrLn welcome
@@ -24,6 +26,11 @@ main = do
ss <- readFile name ss <- readFile name
let outfile = fileFormat typ name let outfile = fileFormat typ name
writeFile outfile $ format $ pDoc $ ss writeFile outfile $ format $ pDoc $ ss
if typ == 2
then do
system $ "htmls " ++ (fileFormat typ name)
return ()
else return ()
welcome = unlines [ welcome = unlines [
"", "",
@@ -33,21 +40,25 @@ welcome = unlines [
help = unlines $ [ help = unlines $ [
"", "",
"Usage: gfdoc (+latex) file", "Usage: gfdoc (+latex|+htmls) file",
"", "",
"The program operates with lines in GF code, treating them into LaTeX", "The program operates with lines in GF code, treating them into LaTeX",
"(flag +latex) or to HTML (by default). The output is written in a file", "(flag +latex), to a set of HTML documents (flag +htmls), or to one",
"HTML file (by default). The output is written in a file",
"whose name is formed from the input file name by replacing its suffix", "whose name is formed from the input file name by replacing its suffix",
"with html or tex.", "with html or tex; in case of set of HTML files, the names are prefixed",
"by 01-, 02-, etc, and each file has navigation links.",
"", "",
"The translation is line by line", "The translation is line by line",
"depending as follows on how the line begins", "depending as follows on how the line begins",
"", "",
" --[Int] heading of level Int", " --[Int] heading of level Int",
" -- new paragraph", " -- new paragraph",
" --! new page (in HTML, recognized by the htmls program)",
" --. end of document", " --. end of document",
--- " --- ignore this comment line in document", --- " --- ignore this comment line in document",
--- " {---} ignore this code line in document", --- " {---} ignore this code line in document",
" --*[Text] Text paragraph starting with a bullet",
" --[Text] Text belongs to text paragraph", " --[Text] Text belongs to text paragraph",
" [Text] Text belongs to code paragraph", " [Text] Text belongs to code paragraph",
"", "",
@@ -59,7 +70,7 @@ help = unlines $ [
" $[Text]$ example code (courier)" " $[Text]$ example code (courier)"
] ]
fileFormat isLatex x = body ++ if isLatex then "tex" else "html" where fileFormat typ x = body ++ if (typ==0) then "tex" else "html" where
body = reverse $ dropWhile (/='.') $ reverse x body = reverse $ dropWhile (/='.') $ reverse x
-- the document datatype -- the document datatype
@@ -72,7 +83,9 @@ data Paragraph =
Text [TextItem] -- text line starting with -- Text [TextItem] -- text line starting with --
| List [[TextItem]] -- | List [[TextItem]] --
| Code String -- other text line | Code String -- other text line
| Item [TextItem] -- bulleted item: line prefixed by --*
| New -- new paragraph: line consisting of -- | New -- new paragraph: line consisting of --
| NewPage -- new parage: line consisting of --!
| Heading Int [TextItem] -- text line starting with --n where n = 1,2,3,4 | Heading Int [TextItem] -- text line starting with --n where n = 1,2,3,4
data TextItem = data TextItem =
@@ -100,7 +113,9 @@ pDoc s = case lines s of
_ -> unlines code : grp rest where (code,rest) = span (not . isComment) ss _ -> unlines code : grp rest where (code,rest) = span (not . isComment) ss
pPara s = case s of pPara s = case s of
'-':'-':d:text | isDigit d -> Heading (read [d]) (pItems text) '-':'-':d:text | isDigit d -> Heading (read [d]) (pItems text)
'-':'-':'!':[] -> NewPage
'-':'-':[] -> New '-':'-':[] -> New
'-':'-':'*':text -> Item (pItems (dropWhile isSpace text))
'-':'-':text -> Text (pItems (dropWhile isSpace text)) '-':'-':text -> Text (pItems (dropWhile isSpace text))
_ -> Code s _ -> Code s
pItems s = case s of pItems s = case s of
@@ -139,9 +154,11 @@ doc2html (Doc title paras) = unlines $
para2html :: Paragraph -> String para2html :: Paragraph -> String
para2html p = case p of para2html p = case p of
Text its -> concat (map item2html its) Text its -> concat (map item2html its)
Item its -> mkTagXML "li" ++ concat (map item2html its)
Code s -> unlines $ tagXML "pre" $ map (indent 2) $ Code s -> unlines $ tagXML "pre" $ map (indent 2) $
remEmptyLines $ lines $ spec s remEmptyLines $ lines $ spec s
New -> mkTagXML "p" New -> mkTagXML "p"
NewPage -> mkTagXML "p" ++ "\n" ++ mkTagXML "!-- NEW --"
Heading i its -> concat $ tagXML ('h':show i) [concat (map item2html its)] Heading i its -> concat $ tagXML ('h':show i) [concat (map item2html its)]
item2html :: TextItem -> String item2html :: TextItem -> String
@@ -177,9 +194,11 @@ doc2latex (Doc title paras) = unlines $
para2latex :: Paragraph -> String para2latex :: Paragraph -> String
para2latex p = case p of para2latex p = case p of
Text its -> concat (map item2latex its) Text its -> concat (map item2latex its)
Item its -> "$\\bullet$" ++ concat (map item2latex its)
Code s -> unlines $ envLatex "verbatim" $ map (indent 2) $ Code s -> unlines $ envLatex "verbatim" $ map (indent 2) $
remEmptyLines $ lines $ s remEmptyLines $ lines $ s
New -> "\n" New -> "\n"
NewPage -> "\\newpage"
Heading i its -> headingLatex i (concat (map item2latex its)) Heading i its -> headingLatex i (concat (map item2latex its))
item2latex :: TextItem -> String item2latex :: TextItem -> String

65
src/tools/Htmls.hs Normal file
View File

@@ -0,0 +1,65 @@
module Main where
import System
-- chop an HTML file into separate files, each linked to the next and previous.
-- the names of the files are n-file, with n = 01,02,...
-- the chopping is performed at each separator, here defined as "<!-- NEW -->"
-- AR 7/1/2002 for the Vinnova meeting in Linköping.
main :: IO ()
main = do
file:_ <- getArgs
htmls file
htmls :: FilePath -> IO ()
htmls file = do
s <- readFile file
let ss = allPages s
mapM (uncurry writeFile) (map (mkFile file (length ss)) ss)
return ()
allPages :: String -> [(Int,String)]
allPages = zip [1..] . map unlines . chop . lines where
chop ls = case span isNoSep ls of
(s,_:ss) -> s : chop ss
_ -> [ls]
isNoSep = (/= separator)
mkFile :: FilePath -> Int -> (Int,String) -> (FilePath,String)
mkFile base mx (number,content) =
(fileName base number,
unlines [
begHTML,
"<font size=1>",
pageNum mx number,
link base mx number,
"</font>",
"<p>",
content,
endHTML
]
)
begHTML, endHTML, separator :: String
begHTML = "<html><body bgcolor=\"#FFFFFF\" text=\"#000000\">"
endHTML = "</body></html>"
separator = "<!-- NEW -->"
link :: FilePath -> Int -> Int -> String
link file mx n =
(if n >= mx then "" else (" <a href=\"" ++ file' ++ "\">Next</a>")) ++
(if n == 1 then "" else (" <a href=\"" ++ file_ ++ "\">Previous</a>")) ++
(" <a href=\"" ++ file1 ++ "\">First</a>") ++
(" <a href=\"" ++ file2 ++ "\">Last</a>")
where
file_ = fileName file (n - 1)
file' = fileName file (n + 1)
file1 = fileName file 1
file2 = fileName file mx
fileName :: FilePath -> Int -> FilePath
fileName file n = (if n < 10 then ('0':) else id) $ show n ++ "-" ++ file
pageNum mx num = "<p align=right>" ++ show num ++"/" ++ show mx ++ "</p>"