From 2ba3903b23ef41e3a0b08579f23bb38405b96ab6 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Tue, 17 Aug 2010 18:19:52 +0000
Subject: clean up collapser logics 	javascript code for collapasble
 sections cleaned up 	rewrote class utilities in javascript to be more
 robust 	refactored utilities for generating collapsable sections made
 toc be same color as synopsis module list has needed clear attribute in CSS

---
 src/Haddock/Backends/Xhtml/Decl.hs   |  4 ++--
 src/Haddock/Backends/Xhtml/Layout.hs |  9 ++++----
 src/Haddock/Backends/Xhtml/Utils.hs  | 42 +++++++++++++++++++++---------------
 3 files changed, 32 insertions(+), 23 deletions(-)

(limited to 'src/Haddock/Backends/Xhtml')

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 65830055..7031a9ae 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -385,9 +385,9 @@ ppClassDecl _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortCl
 
 ppInstances :: [DocInstance DocName] -> DocName -> Bool -> Html
 ppInstances instances baseName unicode
-  = subInstances instId (map instDecl instances)
+  = subInstances instName (map instDecl instances)
   where
-    instId = collapseId (getName baseName)
+    instName = getOccString $ getName baseName
     instDecl :: DocInstance DocName -> SubDecl
     instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
     instHead ([],   n, ts) = ppAppNameTypes n ts unicode
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 02146476..1a0feeb4 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -40,6 +40,7 @@ import Haddock.Backends.Xhtml.DocMarkup
 import Haddock.Backends.Xhtml.Types
 import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
+import Haddock.Utils (makeAnchorId)
 
 import Text.XHtml hiding ( name, title, p, quote )
 
@@ -154,13 +155,13 @@ subFields = divSubDecls "fields" "Fields" . subDlist
 
 
 subInstances :: String -> [SubDecl] -> Html
-subInstances id_ = maybe noHtml wrap . instTable
+subInstances nm = maybe noHtml wrap . instTable
   where
     wrap = (subSection <<) . (subCaption +++)
-    instTable = fmap (thediv ! [identifier id_, theclass "show"] <<) . subTable
+    instTable = fmap (thediv ! collapseSection id_ True [] <<) . subTable
     subSection = thediv ! [theclass $ "subs instances"]
-    subCaption = paragraph ! collapser id_ "caption" << "Instances"
-
+    subCaption = paragraph ! collapseControl id_ True "caption" << "Instances"
+    id_ = makeAnchorId $ "i:" ++ nm
 
 subMethods :: [Html] -> Html
 subMethods = divSubDecls "methods" "Methods" . subBlock
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
index d3b75b43..10f9e766 100644
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/src/Haddock/Backends/Xhtml/Utils.hs
@@ -24,7 +24,7 @@ module Haddock.Backends.Xhtml.Utils (
 
   hsep,
 
-  collapser, collapseId,
+  collapseSection, collapseToggle, collapseControl,
 ) where
 
 
@@ -173,21 +173,29 @@ linkedAnchor n = anchor ! [href ('#':n)]
 
 
 --
--- A section of HTML which is collapsible via a +/- button.
+-- A section of HTML which is collapsible.
 --
 
--- TODO: Currently the initial state is non-collapsed. Change the 'minusFile'
--- below to a 'plusFile' and the 'display:block;' to a 'display:none;' when we
--- use cookies from JavaScript to have a more persistent state.
-
-collapser :: String -> String -> [HtmlAttr]
-collapser id_ classes = [ theclass cs, strAttr "onclick" js ]
-  where
-    cs = unwords (words classes ++ ["collapser"])
-    js = "toggleSection(this,'" ++ id_ ++ "')"
-
-
--- A quote is a valid part of a Haskell identifier, but it would interfere with
--- the ECMA script string delimiter used in collapsebutton above.
-collapseId :: Name -> String
-collapseId nm = "i:" ++ escapeStr (getOccString nm)
+-- | Attributes for an area that can be collapsed
+collapseSection :: String -> Bool -> String -> [HtmlAttr]
+collapseSection id_ state classes = [ identifier sid, theclass cs ]
+  where cs = unwords (words classes ++ [pick state "show" "hide"])
+        sid = "section." ++ id_
+
+-- | Attributes for an area that toggles a collapsed area
+collapseToggle :: String -> [HtmlAttr]
+collapseToggle id_ = [ strAttr "onclick" js ]
+  where js = "toggleSection('" ++ id_ ++ "')";
+  
+-- | Attributes for an area that toggles a collapsed area,
+-- and displays a control.
+collapseControl :: String -> Bool -> String -> [HtmlAttr]
+collapseControl id_ state classes =
+  [ identifier cid, theclass cs ] ++ collapseToggle id_
+  where cs = unwords (words classes ++ [pick state "collapser" "expander"])
+        cid = "control." ++ id_
+
+
+pick :: Bool -> a -> a -> a
+pick True  t _ = t
+pick False _ f = f
-- 
cgit v1.2.3