From b67678234917d61b8393fa9b75092bfa2c399ab4 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Thu, 15 Jul 2010 23:53:01 +0000
Subject: added two new themes and rough css switcher

---
 src/Haddock/Backends/Xhtml/Util.hs | 30 +++++++++++++++++++++++++++---
 1 file changed, 27 insertions(+), 3 deletions(-)

(limited to 'src/Haddock/Backends/Xhtml/Util.hs')

diff --git a/src/Haddock/Backends/Xhtml/Util.hs b/src/Haddock/Backends/Xhtml/Util.hs
index f2527b06..de5f8180 100644
--- a/src/Haddock/Backends/Xhtml/Util.hs
+++ b/src/Haddock/Backends/Xhtml/Util.hs
@@ -26,7 +26,9 @@ module Haddock.Backends.Xhtml.Util (
   abovesSep, hsep,
   
   collapsebutton, collapseId, collapsed,
-  documentCharacterEncoding, styleSheet
+  documentCharacterEncoding,
+  
+  cssFiles, styleSheet, stylePickers
 ) where
 
 import Haddock.GhcUtils
@@ -217,6 +219,28 @@ documentCharacterEncoding :: Html
 documentCharacterEncoding =
    meta ! [httpequiv "Content-Type", content "text/html; charset=UTF-8"]
 
+-- Standard set of style sheets, first is the preferred
+cssThemes :: [(String, String)]
+cssThemes = [
+    ("Classic", "xhaddock.css"),
+    ("Tibbe", "thaddock.css"),
+    ("Snappy", "shaddock.css")
+    ]
+
+cssFiles :: [String]
+cssFiles = map snd cssThemes
+
 styleSheet :: Html
-styleSheet =
-   (thelink ! [href cssFile, rel "stylesheet", thetype "text/css"]) noHtml
+styleSheet = toHtml $ zipWith mkLink cssThemes rels
+  where
+    rels = ("stylesheet" : repeat "alternate stylesheet")
+    mkLink (aTitle, aFile) aRel =
+       (thelink ! [href aFile, rel aRel, thetype "text/css", Html.title aTitle]) noHtml
+
+stylePickers :: [Html]
+stylePickers = map mkPicker cssThemes
+  where
+    mkPicker (aTitle, aFile) = 
+      let js = "setActiveStyleSheet('" ++ aFile ++ "'); return false;" in
+      anchor ! [href "#", onclick js] << aTitle
+    
\ No newline at end of file
-- 
cgit v1.2.3