diff options
| -rw-r--r-- | src/tools/Htmls.hs | 102 | ||||
| -rw-r--r-- | src/tools/gf-tools.cabal | 4 |
2 files changed, 0 insertions, 106 deletions
diff --git a/src/tools/Htmls.hs b/src/tools/Htmls.hs deleted file mode 100644 index e4b7d4ccd..000000000 --- a/src/tools/Htmls.hs +++ /dev/null @@ -1,102 +0,0 @@ ----------------------------------------------------------------------- --- | --- Maintainer : AR --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/16 17:07:18 $ --- > CVS $Author: aarne $ --- > CVS $Revision: 1.11 $ --- --- 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. --- Added table of contents generation in file 00, 16/4/2005 ------------------------------------------------------------------------------ - -module Main (main) where - -import System.Environment(getArgs) -import Data.Char - -main :: IO () -main = do - file:_ <- getArgs - htmls file - -htmls :: FilePath -> IO () -htmls file = do - s <- readFile file - let ss = allPages file s - lg = length ss - putStrLn $ show lg ++ " slides" - mapM_ (uncurry writeFile . mkFile file lg) ss - -allPages :: FilePath -> String -> [(Int,String)] -allPages file s = addIndex $ zip [1..] $ map unlines $ chop lss where - chop ls = case span isNoSep ls of - (s,_:ss) -> s : chop ss - _ -> [ls] - isNoSep = (/= separator) - addIndex = ((0,mkIndex file lss) :) - lss = lines s - -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-1 then "" else (" <a href=\"" ++ file' ++ "\">Next</a>")) ++ - (if n == 1 then "" else (" <a href=\"" ++ file_ ++ "\">Previous</a>")) ++ - (" <a href=\"" ++ file0 ++ "\">Contents</a>") ++ - (" <a href=\"" ++ file ++ "\">Fulltext</a>") ++ - (" <a href=\"" ++ file1 ++ "\">First</a>") ++ - (" <a href=\"" ++ file2 ++ "\">Last</a>") - where - file_ = fileName file (n - 1) - file' = fileName file (n + 1) - file0 = fileName file 0 - file1 = fileName file 1 - file2 = fileName file (mx - 1) - -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-1) ++ "</p>" - -mkIndex file = unlines . mkInd 1 where - mkInd n ss = case ss of - s : rest | (s==separator) -> mkInd (n+1) rest - s : rest -> case getHeading s of - Just (i,t) -> mkLine n i t : mkInd n rest - _ -> mkInd n rest - _ -> [] - getHeading s = case dropWhile isSpace s of - '<':h:i:_:t | isDigit i -> return (i,take (length t - 5) t) -- drop final </hi> - _ -> Nothing - mkLine _ '1' t = t ++ " : Table of Contents<p>" -- heading of whole document - mkLine n i t = stars i ++ link n t ++ "<br>" - stars i = case i of - '3' -> "<li> " - '4' -> "<li>* " - _ -> "" - link n t = "<a href=\"" ++ fileName file n ++ "\">" ++ t ++ "</a>" diff --git a/src/tools/gf-tools.cabal b/src/tools/gf-tools.cabal index 1f89f3a85..f8a9a1cde 100644 --- a/src/tools/gf-tools.cabal +++ b/src/tools/gf-tools.cabal @@ -6,7 +6,3 @@ cabal-version: >= 1.8 Executable gfdoc main-is: GFDoc.hs build-depends: base, directory>=1.2, time>=1.5, process - -Executable htmls - main-is: Htmls.hs - build-depends: base
\ No newline at end of file |