[haddock @ 2004-08-02 16:25:53 by krasimir]

Add root node to the table of contents. All modules in tree are not children of
the root

3 files changed, 19 insertions, 9 deletions

diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs
index 6a41f738..d4dc07e8 100644
--- a/src/HaddockHH.hs
+++ b/src/HaddockHH.hs
@@ -17,8 +17,8 @@ import HaddockUtil
 import HaddockTypes
 
 
-ppHHContents :: FilePath -> Maybe String -> [ModuleTree] -> IO ()
-ppHHContents odir maybe_package tree = do
+ppHHContents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
+ppHHContents odir doctitle maybe_package tree = do
   let contentsHHFile = package++".hhc"
 
       html =
@@ -40,9 +40,17 @@ ppHHContents odir maybe_package tree = do
 		text "<PARAM name=\"FrameName\" value=\"main\">" $$
 		text "</OBJECT>" $$
 		text "<UL>" $+$
-		nest 4 (fn [] ts) $+$
+		nest 4 (text "<LI>" <> nest 4
+		                (text "<OBJECT type=\"text/sitemap\">" $$
+		                 nest 4 (text "<PARAM name=\"Name\" value=\""<>text doctitle<>text "\">" $$
+		                         text "<PARAM name=\"Local\" value=\"index.html\">") $$
+		                 text "</OBJECT>") $+$
+		        text "</LI>" $$
+		        text "<UL>" $+$
+		        nest 4 (fn [] ts) $+$
+		        text "</UL>") $+$
 		text "</UL>"
-  	
+
 	fn :: [String] -> [ModuleTree] -> Doc
 	fn ss [x]    = ppNode ss x
 	fn ss (x:xs) = ppNode ss x $$ fn ss xs
diff --git a/src/HaddockHH2.hs b/src/HaddockHH2.hs
index ce4d488e..915f211d 100644
--- a/src/HaddockHH2.hs
+++ b/src/HaddockHH2.hs
@@ -17,8 +17,8 @@ import HaddockModuleTree
 import HaddockUtil
 import HaddockTypes
 
-ppHH2Contents :: FilePath -> Maybe String -> [ModuleTree] -> IO ()
-ppHH2Contents odir maybe_package tree = do
+ppHH2Contents :: FilePath -> String -> Maybe String -> [ModuleTree] -> IO ()
+ppHH2Contents odir doctitle maybe_package tree = do
   let 	
 	contentsHH2File = package++".HxT"
 
@@ -26,7 +26,9 @@ ppHH2Contents odir maybe_package tree = do
 		text "<?xml version=\"1.0\"?>" $$

 		text "<!DOCTYPE HelpTOC SYSTEM \"ms-help://hx/resources/HelpTOC.DTD\">" $$
 		text "<HelpTOC DTDVersion=\"1.0\">" $$
-		nest 4 (ppModuleTree [] tree) $$
+		nest 4 (text "<HelpTOCNode Title=\""<>text doctitle<>text"\" Url=\"index.html\">" $$

+		        nest 4 (ppModuleTree [] tree) $+$

+		        text "</HelpTOCNode>") $$

 		text "</HelpTOC>"
   writeFile (odir ++ pathSeparator:contentsHH2File) (render doc)
   where
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 466fd413..1d9f3c5e 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -234,8 +234,8 @@ ppHtmlContents odir doctitle maybe_package maybe_html_help_format maybe_index_ur
   -- Generate contents page for Html Help if requested
   case maybe_html_help_format of
     Nothing        -> return ()
-    Just "mshelp"  -> ppHHContents  odir maybe_package tree
-    Just "mshelp2" -> ppHH2Contents odir maybe_package tree
+    Just "mshelp"  -> ppHHContents  odir doctitle maybe_package tree
+    Just "mshelp2" -> ppHH2Contents odir doctitle maybe_package tree
     Just "devhelp" -> return ()
     Just format    -> fail ("The "++format++" format is not implemented")