From 2ba3903b23ef41e3a0b08579f23bb38405b96ab6 Mon Sep 17 00:00:00 2001 From: Mark Lentczner 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.hs | 8 +++---- src/Haddock/Backends/Xhtml/Decl.hs | 4 ++-- src/Haddock/Backends/Xhtml/Layout.hs | 9 ++++---- src/Haddock/Backends/Xhtml/Utils.hs | 42 +++++++++++++++++++++--------------- 4 files changed, 36 insertions(+), 27 deletions(-) (limited to 'src/Haddock/Backends') diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index d28c31cc..8ea55e9b 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -264,7 +264,7 @@ mkNode ss p (Node s leaf pkg short ts) = where modAttrs = case ts of [] -> [theclass "module"] - _ -> collapser p "module" + _ -> collapseControl p True "module" htmlModule = thespan ! modAttrs << (if leaf @@ -278,7 +278,7 @@ mkNode ss p (Node s leaf pkg short ts) = shortDescr = maybe noHtml origDocToHtml short htmlPkg = maybe noHtml (thespan ! [theclass "package"] <<) pkg - subtree = mkNodeList (s:ss) p ts ! [identifier p, theclass "show"] + subtree = mkNodeList (s:ss) p ts ! collapseSection p True "" -- | Turn a module tree into a flat list of full module names. E.g., @@ -504,10 +504,10 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode | no_doc_at_all = noHtml | otherwise = divSynposis $ - paragraph ! collapser "syn" "caption" << "Synopsis" +++ + paragraph ! collapseControl "syn" False "caption" << "Synopsis" +++ shortDeclList ( mapMaybe (processExport True linksInfo unicode) exports - ) ! ([identifier "syn"] ++ collapser "syn" "hide") + ) ! (collapseSection "syn" False "" ++ collapseToggle "syn") -- if the documentation doesn't begin with a section header, then -- add one ("Documentation"). 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