aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorsimonmar <unknown>2005-02-28 16:22:08 +0000
committersimonmar <unknown>2005-02-28 16:22:08 +0000
commita95fd63f4dad4eaf5fc256209fe1d5daf23e8e16 (patch)
tree3c69a52f35496be57db401e9bd8c3890cbe628b0 /src
parent9c3afd02e92a25a9e700efa6b32d6d72ccc395ba (diff)
[haddock @ 2005-02-28 16:22:08 by simonmar]
Attempt to fix the layout of the package names in the contents. Having tried just about everything, the only thing I can get to work reliably is to make the package names line up on a fixed offset from the left margin. This obviously isn't ideal, so anyone else that would like to have a go at improving it is welcome. One option is to remove the +/- buttons from the contents list and go back to a plain table. The contents page now uses CSS for layout rather than tables. It seems that most browsers have different interpretations of CSS layout, so only the simplest things lead to consistent results.
Diffstat (limited to 'src')
-rw-r--r--src/HaddockHtml.hs39
1 files changed, 20 insertions, 19 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index b02caf5b..9b0f29fd 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -257,35 +257,36 @@ ppPrologue title (Just doc) =
ppModuleTree :: String -> [ModuleTree] -> HtmlTable
ppModuleTree _ ts =
tda [theclass "section1"] << toHtml "Modules" </>
- pad_td Nothing << vanillaTable << htmlTable
+ pad_td Nothing << fst (genTable empty 0 ts)
where
- genTable htmlTable id [] = (htmlTable,id)
- genTable htmlTable id (x:xs) = genTable (htmlTable </> u) id' xs
+ genTable html id [] = (html,id)
+ genTable html id (x:xs) = genTable (html +++ u) id' xs
where
(u,id') = mkNode [] x id
- (htmlTable,_) = genTable emptyTable 0 ts
-
-mkNode :: [String] -> ModuleTree -> Int -> (HtmlTable,Int)
+mkNode :: [String] -> ModuleTree -> Int -> (Html,Int)
mkNode ss (Node s leaf pkg short ts) id = htmlNode
where
htmlNode = case ts of
- [] -> ( pad_td (Just 1.25) << htmlModule <-> shortDescr <-> htmlPkg,id)
- _ -> ((pad_td Nothing<< (collapsebutton id_s +++ htmlModule) <-> shortDescr <-> htmlPkg) </>
- (pad_td (Just 2) << sub_tree), id')
+ [] -> (node << (htmlModule +++ shortDescr +++ htmlPkg), id)
+ _ -> (cnode << (collapsebutton id_s +++ htmlModule +++ shortDescr
+ +++ htmlPkg +++ sub_tree), id')
+
+ node = thediv ! [theclass "node"]
+ cnode = thediv ! [theclass "cnode"]
- shortDescr :: HtmlTable
+ shortDescr :: Html
shortDescr = case short of
- Nothing -> td empty
- Just doc -> tda [theclass "rdoc"] (docToHtml doc)
+ Nothing -> empty
+ Just doc -> thespan ! [theclass "rdoc"] << (docToHtml doc)
htmlModule
| leaf = ppHsModule mdl
| otherwise = toHtml s
htmlPkg = case pkg of
- Nothing -> tda [width "1"] << empty
- Just p -> td << toHtml p
+ Nothing -> empty
+ Just p -> thespan ! [theclass "pkg"] << toHtml p
mdl = foldr (++) "" (s' : map ('.':) ss')
(s':ss') = reverse (s:ss)
@@ -293,13 +294,13 @@ mkNode ss (Node s leaf pkg short ts) id = htmlNode
id_s = "n:" ++ show id
- (sub_tree,id') = genSubTree emptyTable (id+1) ts
+ (sub_tree,id') = genSubTree empty (id+1) ts
- genSubTree :: HtmlTable -> Int -> [ModuleTree] -> (Html,Int)
- genSubTree htmlTable id [] = (sub_tree,id)
+ genSubTree :: Html -> Int -> [ModuleTree] -> (Html,Int)
+ genSubTree html id [] = (sub_tree,id)
where
- sub_tree = collapsed vanillaTable id_s htmlTable
- genSubTree htmlTable id (x:xs) = genSubTree (htmlTable </> u) id' xs
+ sub_tree = collapsed thediv id_s html
+ genSubTree html id (x:xs) = genSubTree (html +++ u) id' xs
where
(u,id') = mkNode (s:ss) x id