From 7832c8030a203510b89bd13fdc98eaf7279eb172 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Fri, 16 Jul 2010 04:57:38 +0000
Subject: fixed package catpion, added style menu

---
 src/Haddock/Backends/Xhtml.hs      |  4 ++--
 src/Haddock/Backends/Xhtml/Util.hs | 12 ++++++++++--
 2 files changed, 12 insertions(+), 4 deletions(-)

(limited to 'src/Haddock/Backends')

diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index c24dec6a..e204a9da 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -204,7 +204,7 @@ simpleHeader doctitle maybe_contents_url maybe_index_url
       wikiButton maybe_wiki_url Nothing,
       contentsButton maybe_contents_url,
       indexButton maybe_index_url
-      ] ++ stylePickers) ! [theclass "links"]
+      ] ++ [styleMenu]) ! [theclass "links"]
   )
 
 pageHeader :: String -> Interface -> String
@@ -220,7 +220,7 @@ pageHeader mdl iface doctitle
         wikiButton maybe_wiki_url (Just $ ifaceMod iface),
         contentsButton maybe_contents_url,
         indexButton maybe_index_url
-        ] ++ stylePickers) ! [theclass "links"]
+        ] ++ [styleMenu]) ! [theclass "links"]
    ) +++
   divModuleHeader << (
     sectionName << mdl +++
diff --git a/src/Haddock/Backends/Xhtml/Util.hs b/src/Haddock/Backends/Xhtml/Util.hs
index de5f8180..13215bb7 100644
--- a/src/Haddock/Backends/Xhtml/Util.hs
+++ b/src/Haddock/Backends/Xhtml/Util.hs
@@ -28,7 +28,7 @@ module Haddock.Backends.Xhtml.Util (
   collapsebutton, collapseId, collapsed,
   documentCharacterEncoding,
   
-  cssFiles, styleSheet, stylePickers
+  cssFiles, styleSheet, stylePickers, styleMenu
 ) where
 
 import Haddock.GhcUtils
@@ -243,4 +243,12 @@ stylePickers = map mkPicker cssThemes
     mkPicker (aTitle, aFile) = 
       let js = "setActiveStyleSheet('" ++ aFile ++ "'); return false;" in
       anchor ! [href "#", onclick js] << aTitle
-    
\ No newline at end of file
+
+styleMenu :: Html
+styleMenu = thediv ! [identifier "style-menu-holder"] << [
+    anchor ! [ href "#", onclick js ] << "Style\9662",
+    unordList stylePickers ! [ identifier "style-menu", theclass "hide" ]
+  ]
+  where
+    js = "styleMenu(); return false;"
+        
\ No newline at end of file
-- 
cgit v1.2.3