aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--html/haddock-util.js53
-rw-r--r--src/Haddock/Backends/Xhtml.hs19
-rw-r--r--src/Haddock/Backends/Xhtml/Themes.hs23
-rw-r--r--src/Haddock/Backends/Xhtml/Utils.hs7
4 files changed, 53 insertions, 49 deletions
diff --git a/html/haddock-util.js b/html/haddock-util.js
index 1a57b24b..c5bc6a8d 100644
--- a/html/haddock-util.js
+++ b/html/haddock-util.js
@@ -164,23 +164,27 @@ function perform_search(full)
}
}
-function addFramesButton() {
- if (parent.location.href == window.location.href) {
- var menu = document.getElementById("page-menu");
- if (menu) {
- var btn = menu.lastChild.cloneNode(false);
- btn.innerHTML = "<a href='#' onclick='reframe();return true;'>Frames</a>";
- menu.appendChild(btn);
- }
- }
-}
-
function setSynopsis(filename) {
if (parent.window.synopsis) {
parent.window.synopsis.location = filename;
}
}
+function addMenuItem(html) {
+ var menu = document.getElementById("page-menu");
+ if (menu) {
+ var btn = menu.firstChild.cloneNode(false);
+ btn.innerHTML = html;
+ menu.appendChild(btn);
+ }
+}
+
+function addFramesButton() {
+ if (parent.location.href == window.location.href) {
+ addMenuItem("<a href='#' onclick='reframe();return true;'>Frames</a>");
+ }
+}
+
function reframe() {
setCookie("haddock-reframe", document.URL);
window.location = "frames.html";
@@ -194,6 +198,26 @@ function postReframe() {
}
}
+function addStyleMenu() {
+ var i, a, c = 0, btns = "";
+ for(i=0; (a = document.getElementsByTagName("link")[i]); i++) {
+ if(a.getAttribute("rel").indexOf("style") != -1
+ && a.getAttribute("title")) {
+ btns += "<li><a href='#' onclick=\"setActiveStyleSheet('"
+ + a.getAttribute("href") + "'); return false;\">"
+ + a.getAttribute("title") + "</a></li>"
+ c += 1;
+ }
+ }
+ if (c > 1) {
+ var h = "<div id='style-menu-holder'>"
+ + "<a href='#' onclick='styleMenu(); return false;'>Style &#9662;</a>"
+ + "<ul id='style-menu' class='hide'>" + btns + "</ul>"
+ + "</div>";
+ addMenuItem(h);
+ }
+}
+
function setActiveStyleSheet(href) {
var i, a, found = false;
for(i=0; (a = document.getElementsByTagName("link")[i]); i++) {
@@ -223,3 +247,10 @@ function styleMenu(show) {
toggleClassShow(m, show);
}
+
+function pageLoad() {
+ addStyleMenu();
+ addFramesButton();
+ resetStyle();
+}
+
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index b1942561..d28c31cc 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -115,7 +115,7 @@ headHtml docTitle miniPage themes =
-- a <![CDATA[ section. Will break if the miniPage name could
-- have "]]>" in it!
<< primHtml (
- "//<![CDATA[\nwindow.onload = function () {addFramesButton();resetStyle();"
+ "//<![CDATA[\nwindow.onload = function () {pageLoad();"
++ setSynopsis ++ "};\n//]]>\n")
]
where
@@ -124,11 +124,11 @@ headHtml docTitle miniPage themes =
srcButton :: SourceURLs -> Maybe Interface -> Maybe Html
srcButton (Just src_base_url, _, _) Nothing =
- Just (anchor ! [href src_base_url] << "Source code")
+ Just (anchor ! [href src_base_url] << "Source")
srcButton (_, Just src_module_url, _) (Just iface) =
let url = spliceURL (Just $ ifaceOrigFilename iface)
(Just $ ifaceMod iface) Nothing Nothing src_module_url
- in Just (anchor ! [href url] << "Source code")
+ in Just (anchor ! [href url] << "Source")
srcButton _ _ =
Nothing
@@ -157,11 +157,11 @@ indexButton maybe_index_url
where url = maybe indexHtmlFile id maybe_index_url
-bodyHtml :: String -> Maybe Interface -> Themes
+bodyHtml :: String -> Maybe Interface
-> SourceURLs -> WikiURLs
-> Maybe String -> Maybe String
-> Html -> Html
-bodyHtml doctitle iface themes
+bodyHtml doctitle iface
maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url
pageContent =
@@ -171,8 +171,7 @@ bodyHtml doctitle iface themes
srcButton maybe_source_url iface,
wikiButton maybe_wiki_url (ifaceMod `fmap` iface),
contentsButton maybe_contents_url,
- indexButton maybe_index_url,
- styleMenu themes])
+ indexButton maybe_index_url])
! [theclass "links", identifier "page-menu"],
nonEmpty sectionName << doctitle
],
@@ -227,7 +226,7 @@ ppHtmlContents odir doctitle _maybe_package
[(instMod iface, toInstalledDescription iface) | iface <- ifaces]
html =
headHtml doctitle Nothing themes +++
- bodyHtml doctitle Nothing themes
+ bodyHtml doctitle Nothing
maybe_source_url maybe_wiki_url
Nothing maybe_index_url << [
ppPrologue doctitle prologue,
@@ -345,7 +344,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
where
indexPage showLetters ch items =
headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing themes +++
- bodyHtml doctitle Nothing themes
+ bodyHtml doctitle Nothing
maybe_source_url maybe_wiki_url
maybe_contents_url Nothing << [
if showLetters then indexInitialLetterLinks else noHtml,
@@ -451,7 +450,7 @@ ppHtmlModule odir doctitle themes
mdl_str = moduleString mdl
html =
headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes +++
- bodyHtml doctitle (Just iface) themes
+ bodyHtml doctitle (Just iface)
maybe_source_url maybe_wiki_url
maybe_contents_url maybe_index_url << [
divModuleHeader << (moduleInfo iface +++ (sectionName << mdl_str)),
diff --git a/src/Haddock/Backends/Xhtml/Themes.hs b/src/Haddock/Backends/Xhtml/Themes.hs
index 512b597c..cbcf10a4 100644
--- a/src/Haddock/Backends/Xhtml/Themes.hs
+++ b/src/Haddock/Backends/Xhtml/Themes.hs
@@ -12,11 +12,10 @@ module Haddock.Backends.Xhtml.Themes (
Themes,
getThemes,
- cssFiles, styleSheet, stylePickers, styleMenu
+ cssFiles, styleSheet
)
where
-import Haddock.Backends.Xhtml.Utils (onclick)
import Haddock.Options
import Control.Monad (liftM)
@@ -187,26 +186,6 @@ styleSheet ts = toHtml $ zipWith mkLink rels ts
]
<< noHtml
-
-stylePickers :: Themes -> [Html]
-stylePickers ts = map mkPicker ts
- where
- mkPicker t =
- let js = "setActiveStyleSheet('" ++ themeHref t ++ "'); return false;" in
- anchor ! [href "#", onclick js] << themeName t
-
-
-styleMenu :: Themes -> Maybe Html
-styleMenu [] = Nothing
-styleMenu [_] = Nothing
-styleMenu ts = Just $ thediv ! [identifier "style-menu-holder"] << [
- anchor ! [ href "#", onclick js ] << "Style \9662",
- unordList (stylePickers ts) ! [ identifier "style-menu", theclass "hide" ]
- ]
- where
- js = "styleMenu(); return false;"
-
-
--------------------------------------------------------------------------------
-- * Either Utilities
--------------------------------------------------------------------------------
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
index edb5e659..d3b75b43 100644
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/src/Haddock/Backends/Xhtml/Utils.hs
@@ -24,7 +24,6 @@ module Haddock.Backends.Xhtml.Utils (
hsep,
- onclick,
collapser, collapseId,
) where
@@ -153,10 +152,6 @@ ubxparens :: Html -> Html
ubxparens h = toHtml "(#" +++ h +++ toHtml "#)"
-onclick :: String -> HtmlAttr
-onclick = strAttr "onclick"
-
-
dcolon, arrow, darrow, forallSymbol :: Bool -> Html
dcolon unicode = toHtml (if unicode then "∷" else "::")
arrow unicode = toHtml (if unicode then "→" else "->")
@@ -186,7 +181,7 @@ linkedAnchor n = anchor ! [href ('#':n)]
-- use cookies from JavaScript to have a more persistent state.
collapser :: String -> String -> [HtmlAttr]
-collapser id_ classes = [ theclass cs, onclick js ]
+collapser id_ classes = [ theclass cs, strAttr "onclick" js ]
where
cs = unwords (words classes ++ ["collapser"])
js = "toggleSection(this,'" ++ id_ ++ "')"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-10 23:02:32 +0000