aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--html/Ocean.std-theme/ocean.css46
-rw-r--r--html/haddock-util.js64
-rw-r--r--src/Haddock/Backends/Xhtml.hs8
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs4
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs9
-rw-r--r--src/Haddock/Backends/Xhtml/Utils.hs42
6 files changed, 101 insertions, 72 deletions
diff --git a/html/Ocean.std-theme/ocean.css b/html/Ocean.std-theme/ocean.css
index 74cb1b1b..0baa1443 100644
--- a/html/Ocean.std-theme/ocean.css
+++ b/html/Ocean.std-theme/ocean.css
@@ -281,8 +281,8 @@ div#style-menu-holder {
#table-of-contents {
float: right;
clear: right;
- background: rgb(239,238,209);
- border: 1px solid rgba(196,69,29,0.2);
+ background: #f9f8db;
+ border: 1px solid #d8d7ad;
padding: 0.5em 1em;
position: relative;
top: 0em;
@@ -317,7 +317,6 @@ div#style-menu-holder {
}
#synopsis .caption {
- text-align: right;
float: left;
width: 29px;
color: rgba(255,255,255,0);
@@ -328,23 +327,14 @@ div#style-menu-holder {
}
#synopsis p.caption.collapser {
- background: url(synopsis.png) no-repeat 0 -8px;
-}
-
-#synopsis p.caption.expander {
background: url(synopsis.png) no-repeat -64px -8px;
}
-#synopsis ul,
-#synopsis ul li.src {
- background-color: #f9f8db;
- white-space: nowrap;
+#synopsis p.caption.expander {
+ background: url(synopsis.png) no-repeat 0px -8px;
}
-#synopsis ul.collapser,
-#synopsis ul.expander {
- background-image: none;
- list-style: none;
+#synopsis ul {
height: 100%;
overflow: auto;
padding: 0.5em;
@@ -355,6 +345,14 @@ div#style-menu-holder {
overflow: hidden;
}
+#synopsis ul,
+#synopsis ul li.src {
+ background-color: #f9f8db;
+ white-space: nowrap;
+ list-style: none;
+ margin-left: 0;
+}
+
/* @end */
/* @group Main Content */
@@ -418,25 +416,11 @@ div#style-menu-holder {
border-top: 1px solid #ccc;
}
-/* @group Left Margin */
-
.subs, .doc {
/* use this selector for one level of indent */
padding-left: 2em;
}
-/* use these two for two levels of indent */
-/*
-#description .doc, #interface div.top {
- padding-left: 1.25em;
-}
-
-div.top .subs, div.top .doc {
- padding-left: 1.875em;
-}
-*/
-/* @end */
-
.arguments {
margin-top: -0.4em;
}
@@ -530,6 +514,10 @@ div.top .subs, div.top .doc {
margin: 0 0 0 2em;
}
+#module-list li {
+ clear: right;
+}
+
#module-list .package {
float: right;
}
diff --git a/html/haddock-util.js b/html/haddock-util.js
index c5bc6a8d..e9e4f64d 100644
--- a/html/haddock-util.js
+++ b/html/haddock-util.js
@@ -1,26 +1,58 @@
// Haddock JavaScript utilities
-function makeClassToggle(cOn, cOff)
+var rspace = /\s\s+/g,
+ rtrim = /^\s+|\s+$/g;
+
+function spaced(s) { return (" " + s + " ").replace(rspace, " "); }
+function trim(s) { return s.replace(rtrim, ""); }
+
+function hasClass(elem, value) {
+ var className = spaced(elem.className || "");
+ return className.indexOf( " " + value + " " ) >= 0;
+}
+
+function addClass(elem, value) {
+ var className = spaced(elem.className || "");
+ if ( className.indexOf( " " + value + " " ) < 0 ) {
+ elem.className = trim(className + " " + value);
+ }
+}
+
+function removeClass(elem, value) {
+ var className = spaced(elem.className || "");
+ className = className.replace(" " + value + " ", " ");
+ elem.className = trim(className);
+}
+
+function toggleClass(elem, valueOn, valueOff, bool) {
+ if (bool == null) { bool = ! hasClass(elem, valueOn); }
+ if (bool) {
+ removeClass(elem, valueOff);
+ addClass(elem, valueOn);
+ }
+ else {
+ removeClass(elem, valueOn);
+ addClass(elem, valueOff);
+ }
+ return bool;
+}
+
+
+function makeClassToggle(valueOn, valueOff)
{
- var rOn = new RegExp('\\b'+cOn+'\\b');
- var rOff = new RegExp('\\b'+cOff+'\\b');
-
- return function(e, a) {
- var c = e.className;
- if (a == null) { a = rOff.test(c); }
- if (a) { c = c.replace(rOff, cOn); }
- else { c = c.replace(rOn, cOff); }
- e.className = c;
+ return function(elem, bool) {
+ return toggleClass(elem, valueOn, valueOff, bool);
}
}
-toggleClassShow = makeClassToggle("show", "hide");
-toggleClassCollapser = makeClassToggle("collapser", "expander");
+toggleShow = makeClassToggle("show", "hide");
+toggleCollapser = makeClassToggle("collapser", "expander");
-function toggleSection(toggler,id)
+function toggleSection(id)
{
- toggleClassShow(document.getElementById(id))
- toggleClassCollapser(toggler);
+ var b = toggleShow(document.getElementById("section." + id))
+ toggleCollapser(document.getElementById("control." + id), b)
+ return b;
}
@@ -244,7 +276,7 @@ function resetStyle() {
function styleMenu(show) {
var m = document.getElementById('style-menu');
- toggleClassShow(m, show);
+ if (m) toggleClassShow(m, show);
}
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index d28c31cc..8ea55e9b 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -264,7 +264,7 @@ mkNode ss p (Node s leaf pkg short ts) =
where
modAttrs = case ts of
[] -> [theclass "module"]
- _ -> collapser p "module"
+ _ -> collapseControl p True "module"
htmlModule = thespan ! modAttrs <<
(if leaf
@@ -278,7 +278,7 @@ mkNode ss p (Node s leaf pkg short ts) =
shortDescr = maybe noHtml origDocToHtml short
htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) pkg
- subtree = mkNodeList (s:ss) p ts ! [identifier p, theclass "show"]
+ subtree = mkNodeList (s:ss) p ts ! collapseSection p True ""
-- | Turn a module tree into a flat list of full module names. E.g.,
@@ -504,10 +504,10 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
| no_doc_at_all = noHtml
| otherwise
= divSynposis $
- paragraph ! collapser "syn" "caption" << "Synopsis" +++
+ paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++
shortDeclList (
mapMaybe (processExport True linksInfo unicode) exports
- ) ! ([identifier "syn"] ++ collapser "syn" "hide")
+ ) ! (collapseSection "syn" False "" ++ collapseToggle "syn")
-- if the documentation doesn't begin with a section header, then
-- add one ("Documentation").
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 65830055..7031a9ae 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -385,9 +385,9 @@ ppClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortCl
ppInstances :: [DocInstance DocName] -> DocName -> Bool -> Html
ppInstances instances baseName unicode
- = subInstances instId (map instDecl instances)
+ = subInstances instName (map instDecl instances)
where
- instId = collapseId (getName baseName)
+ instName = getOccString $ getName baseName
instDecl :: DocInstance DocName -> SubDecl
instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
instHead ([], n, ts) = ppAppNameTypes n ts unicode
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 02146476..1a0feeb4 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -40,6 +40,7 @@ import Haddock.Backends.Xhtml.DocMarkup
import Haddock.Backends.Xhtml.Types
import Haddock.Backends.Xhtml.Utils
import Haddock.Types
+import Haddock.Utils (makeAnchorId)
import Text.XHtml hiding ( name, title, p, quote )
@@ -154,13 +155,13 @@ subFields = divSubDecls "fields" "Fields" . subDlist
subInstances :: String -> [SubDecl] -> Html
-subInstances id_ = maybe noHtml wrap . instTable
+subInstances nm = maybe noHtml wrap . instTable
where
wrap = (subSection <<) . (subCaption +++)
- instTable = fmap (thediv ! [identifier id_, theclass "show"] <<) . subTable
+ instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTable
subSection = thediv ! [theclass $ "subs instances"]
- subCaption = paragraph ! collapser id_ "caption" << "Instances"
-
+ subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
+ id_ = makeAnchorId $ "i:" ++ nm
subMethods :: [Html] -> Html
subMethods = divSubDecls "methods" "Methods" . subBlock
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
index d3b75b43..10f9e766 100644
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/src/Haddock/Backends/Xhtml/Utils.hs
@@ -24,7 +24,7 @@ module Haddock.Backends.Xhtml.Utils (
hsep,
- collapser, collapseId,
+ collapseSection, collapseToggle, collapseControl,
) where
@@ -173,21 +173,29 @@ linkedAnchor n = anchor ! [href ('#':n)]
--
--- A section of HTML which is collapsible via a +/- button.
+-- A section of HTML which is collapsible.
--
--- TODO: Currently the initial state is non-collapsed. Change the 'minusFile'
--- below to a 'plusFile' and the 'display:block;' to a 'display:none;' when we
--- use cookies from JavaScript to have a more persistent state.
-
-collapser :: String -> String -> [HtmlAttr]
-collapser id_ classes = [ theclass cs, strAttr "onclick" js ]
- where
- cs = unwords (words classes ++ ["collapser"])
- js = "toggleSection(this,'" ++ id_ ++ "')"
-
-
--- A quote is a valid part of a Haskell identifier, but it would interfere with
--- the ECMA script string delimiter used in collapsebutton above.
-collapseId :: Name -> String
-collapseId nm = "i:" ++ escapeStr (getOccString nm)
+-- | Attributes for an area that can be collapsed
+collapseSection :: String -> Bool -> String -> [HtmlAttr]
+collapseSection id_ state classes = [ identifier sid, theclass cs ]
+ where cs = unwords (words classes ++ [pick state "show" "hide"])
+ sid = "section." ++ id_
+
+-- | Attributes for an area that toggles a collapsed area
+collapseToggle :: String -> [HtmlAttr]
+collapseToggle id_ = [ strAttr "onclick" js ]
+ where js = "toggleSection('" ++ id_ ++ "')";
+
+-- | Attributes for an area that toggles a collapsed area,
+-- and displays a control.
+collapseControl :: String -> Bool -> String -> [HtmlAttr]
+collapseControl id_ state classes =
+ [ identifier cid, theclass cs ] ++ collapseToggle id_
+ where cs = unwords (words classes ++ [pick state "collapser" "expander"])
+ cid = "control." ++ id_
+
+
+pick :: Bool -> a -> a -> a
+pick True t _ = t
+pick False _ f = f