aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--html/haddock.css2
-rw-r--r--html/haddock.js11
-rw-r--r--src/HaddockHtml.hs61
-rw-r--r--src/Html.hs8
4 files changed, 64 insertions, 18 deletions
diff --git a/html/haddock.css b/html/haddock.css
index 927d1ecd..b853bf76 100644
--- a/html/haddock.css
+++ b/html/haddock.css
@@ -35,6 +35,8 @@ TD.s15 { height: 15px; }
SPAN.keyword { text-decoration: underline; }
+BUTTON.coll { width : 2em; }
+
/* --------- Documentation elements ---------- */
TD.children {
diff --git a/html/haddock.js b/html/haddock.js
new file mode 100644
index 00000000..4f6a2e44
--- /dev/null
+++ b/html/haddock.js
@@ -0,0 +1,11 @@
+// Haddock JavaScript utilities
+function toggle(button,id) {
+ var n = document.getElementById(id).style;
+ if (n.display == "none") {
+ button.childNodes[0].data = "-";
+ n.display = "inline";
+ } else {
+ button.childNodes[0].data = "+";
+ n.display = "none";
+ }
+}
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 7b909a02..527fe758 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -39,8 +39,9 @@ foo = 42
-- -----------------------------------------------------------------------------
-- Files we need to copy from our $libdir
-cssFile, iconFile :: String
+cssFile, jsFile, iconFile :: String
cssFile = "haddock.css"
+jsFile = "haddock.js"
iconFile = "haskell_icon.gif"
-- -----------------------------------------------------------------------------
@@ -88,13 +89,13 @@ copyHtmlBits odir libdir maybe_css = do
Just f -> f
css_destination = odir ++ pathSeparator:cssFile
- icon_file = libdir ++ pathSeparator:iconFile
- icon_destination = odir ++ pathSeparator:iconFile
+ copyFile f = do
+ s <- readFile (libdir ++ pathSeparator:f)
+ writeFile (odir ++ pathSeparator:f) s
css_contents <- readFile css_file
writeFile css_destination css_contents
- icon_contents <- readFile icon_file
- writeFile icon_destination icon_contents
+ mapM_ copyFile [ iconFile, jsFile ]
contentsHtmlFile, indexHtmlFile :: String
@@ -369,7 +370,8 @@ ppHtmlModule odir doctitle source_url
let html =
header (thetitle (toHtml mdl) +++
thelink ! [href cssFile,
- rel "stylesheet", thetype "text/css"]) +++
+ rel "stylesheet", thetype "text/css"] +++
+ (script ! [src jsFile] $ noHtml)) +++
body << vanillaTable << (
pageHeader mdl iface doctitle source_url
maybe_contents_url maybe_index_url </> s15 </>
@@ -579,13 +581,18 @@ ppHsDataDecl summary instances is_newty
aboves (map ppSideBySideConstr cons)
)
+ inst_id = "i:" ++ hsNameStr nm
+
instances_bit
| null instances = Html.emptyTable
| otherwise
- = inst_hdr </>
- tda [theclass "body"] << spacedTable1 << (
- aboves (map (declBox.ppInstHead) instances)
- )
+ = inst_hdr inst_id </>
+ tda [theclass "body"] <<
+ collapsed inst_id (
+ spacedTable1 << (
+ aboves (map (declBox.ppInstHead) instances)
+ )
+ )
ppHsDataDecl _ _ _ _ d =
error $ "HaddockHtml.ppHsDataDecl: unexpected decl " ++ show d
@@ -753,11 +760,16 @@ ppHsClassDecl summary instances orig_c
]
)
+ inst_id = "i:" ++ hsNameStr nm
instances_bit
- = s8 </> inst_hdr </>
- tda [theclass "body"] << spacedTable1 << (
+ | null instances = Html.emptyTable
+ | otherwise
+ = s8 </> inst_hdr inst_id </>
+ tda [theclass "body"] <<
+ collapsed inst_id (
+ spacedTable1 << (
aboves (map (declBox.ppInstHead) instances)
- )
+ ))
ppHsClassDecl _ _ _ d =
error $ "HaddockHtml.ppHsClassDecl: unexpected decl: " ++ show d
@@ -1074,10 +1086,13 @@ spacedTable1, spacedTable5 :: Html -> Html
spacedTable1 = table ! [theclass "vanilla", cellspacing 1, cellpadding 0]
spacedTable5 = table ! [theclass "vanilla", cellspacing 5, cellpadding 0]
-constr_hdr, meth_hdr, inst_hdr :: HtmlTable
-constr_hdr = tda [ theclass "section4" ] << toHtml "Constructors"
-meth_hdr = tda [ theclass "section4" ] << toHtml "Methods"
-inst_hdr = tda [ theclass "section4" ] << toHtml "Instances"
+constr_hdr, meth_hdr :: HtmlTable
+constr_hdr = tda [ theclass "section4" ] << toHtml "Constructors"
+meth_hdr = tda [ theclass "section4" ] << toHtml "Methods"
+
+inst_hdr :: String -> HtmlTable
+inst_hdr id =
+ tda [ theclass "section4" ] << (collapsebutton id +++ toHtml " Instances")
dcolon, arrow, darrow :: Html
dcolon = toHtml "::"
@@ -1098,3 +1113,15 @@ linkedAnchor ref frag = anchor ! [href hr]
escapeStr :: String -> String
escapeStr = flip escapeString unreserved
+
+--
+-- A section of HTML which is collapsible via a +/- button.
+--
+collapsebutton :: String -> Html
+collapsebutton id =
+ button ! [ theclass "coll", onclick ("toggle(this,'" ++ id ++ "')") ] <<
+ toHtml "+"
+
+collapsed :: String -> Html -> Html
+collapsed id html =
+ thediv ! [identifier id, thestyle "display:none;"] << html
diff --git a/src/Html.hs b/src/Html.hs
index 04294b81..81cbad93 100644
--- a/src/Html.hs
+++ b/src/Html.hs
@@ -9,7 +9,7 @@
-- Stability : experimental
-- Portability : portable
--
--- $Id: Html.hs,v 1.2 2002/07/24 09:42:18 simonmar Exp $
+-- $Id: Html.hs,v 1.3 2004/03/25 15:17:24 simonmar Exp $
--
-- An Html combinator library
--
@@ -214,6 +214,7 @@ blockquote :: Html -> Html
body :: Html -> Html
bold :: Html -> Html
br :: Html
+button :: Html -> Html
caption :: Html -> Html
center :: Html -> Html
cite :: Html -> Html
@@ -249,6 +250,7 @@ paragraph :: Html -> Html
param :: Html
pre :: Html -> Html
sample :: Html -> Html
+script :: Html -> Html
select :: Html -> Html
small :: Html -> Html
strong :: Html -> Html
@@ -283,6 +285,7 @@ blockquote = tag "BLOCKQUOTE"
body = tag "BODY"
bold = tag "B"
br = itag "BR"
+button = tag "BUTTON"
caption = tag "CAPTION"
center = tag "CENTER"
cite = tag "CITE"
@@ -318,6 +321,7 @@ paragraph = tag "P"
param = itag "PARAM"
pre = tag "PRE"
sample = tag "SAMP"
+script = tag "SCRIPT"
select = tag "SELECT"
small = tag "SMALL"
strong = tag "STRONG"
@@ -391,6 +395,7 @@ nohref :: HtmlAttr
noresize :: HtmlAttr
noshade :: HtmlAttr
nowrap :: HtmlAttr
+onclick :: String -> HtmlAttr
rel :: String -> HtmlAttr
rev :: String -> HtmlAttr
rows :: String -> HtmlAttr
@@ -460,6 +465,7 @@ nohref = emptyAttr "NOHREF"
noresize = emptyAttr "NORESIZE"
noshade = emptyAttr "NOSHADE"
nowrap = emptyAttr "NOWRAP"
+onclick = strAttr "ONCLICK"
rel = strAttr "REL"
rev = strAttr "REV"
rows = strAttr "ROWS"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-13 09:08:27 +0000