build style menu in javascript

	moved to javascript, so as to not polute the content with the style menu
	removed menu building code in Themes.hs
	removed onclick in Utils.hs
changed text of button in header from "Source code" to "Source"
	more consistent with links in rest of page

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_ ++ "')"