aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonmar <unknown>2004-03-25 15:17:24 +0000
committersimonmar <unknown>2004-03-25 15:17:24 +0000
commit40f44d7bd3afb519fb92297cf03aa52db2844eda (patch)
tree4e680e63c17b7fb0c91218eaa738a1720d500af2
parent7b87344c5f8aa3017aa6aebc851ce14b7bee0696 (diff)
[haddock @ 2004-03-25 15:17:23 by simonmar]
Add support for collaspible parts of the page, with a +/- button and a bit of JavaScript. Make the instances collapsible, and collapse them by default. This makes documentation with long lists of instances (eg. the Prelude) much easier to read. Maybe we should give other documentation sections the same treatment.
-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"