diff options
| -rw-r--r-- | html/haddock-util.js | 53 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 19 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Themes.hs | 23 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Utils.hs | 7 |
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 ▾</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_ ++ "')" |