From 8106b086a5ce09914fdc9f331a7bc91a5b2e0c1a Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Fri, 2 Aug 2002 09:25:23 +0000
Subject: [haddock @ 2002-08-02 09:25:20 by simonmar] Remove <P>..</P> from
 around list items, to reduce excess whitespace between the items of bulleted
 and ordered lists.

(Suggestion from Daan Leijen).
---
 src/HaddockHtml.hs | 20 +++++++++++++++++---
 src/HsSyn.lhs      | 20 ++++++++++++--------
 2 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs
index 7009ba89..db4016bf 100644
--- a/src/HaddockHtml.hs
+++ b/src/HaddockHtml.hs
@@ -860,6 +860,7 @@ ppHsModule mdl = anchor ! [href ((moduleHtmlFile fp modname) ++ ref)] << toHtml
 
 -- -----------------------------------------------------------------------------
 -- * Doc Markup
+
 htmlMarkup :: DocMarkup [HsQName] Html
 htmlMarkup = Markup {
   markupParagraph     = paragraph,
@@ -880,9 +881,22 @@ htmlMarkup = Markup {
 -- If the doc is a single paragraph, don't surround it with <P> (this causes
 -- ugly extra whitespace with some browsers).
 docToHtml :: Doc -> Html
-docToHtml (DocParagraph d) = docToHtml d
-docToHtml (DocCodeBlock d) = docToHtml (DocMonospaced d)
-docToHtml doc              = markup htmlMarkup doc
+docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc))
+
+-- If there is a single paragraph, then surrounding it with <P>..</P>
+-- can add too much whitespace in some browsers (eg. IE).  However if
+-- we have multiple paragraphs, then we want the extra whitespace to
+-- separate them.  So we catch the single paragraph case and transform it
+-- here.
+unParagraph (DocParagraph d) = d
+unParagraph (DocCodeBlock d) = (DocMonospaced d)
+unParagraph doc              = doc
+
+htmlCleanup :: DocMarkup [HsQName] Doc
+htmlCleanup = idMarkup { 
+  markupUnorderedList = DocUnorderedList . map unParagraph,
+  markupOrderedList   = DocOrderedList   . map unParagraph
+  } 
 
 -- -----------------------------------------------------------------------------
 -- * Misc
diff --git a/src/HsSyn.lhs b/src/HsSyn.lhs
index cde2ce63..d7d18f20 100644
--- a/src/HsSyn.lhs
+++ b/src/HsSyn.lhs
@@ -1,5 +1,5 @@
 % -----------------------------------------------------------------------------
-% $Id: HsSyn.lhs,v 1.14 2002/07/25 14:37:29 simonmar Exp $
+% $Id: HsSyn.lhs,v 1.15 2002/08/02 09:25:23 simonmar Exp $
 %
 % (c) The GHC Team, 1997-2002
 %
@@ -31,7 +31,7 @@ module HsSyn (
     unit_tycon, fun_tycon, list_tycon, tuple_tycon,
 
     GenDoc(..), Doc, DocMarkup(..),
-    markup, mapIdent, 
+    markup, mapIdent, idMarkup,
     docAppend, docParagraph,
   ) where
 
@@ -432,16 +432,14 @@ markup m (DocCodeBlock d)	= markupCodeBlock m (markup m d)
 markup m (DocURL url)		= markupURL m url
 markup m (DocAName ref)		= markupAName m ref
 
--- | Since marking up is just a matter of mapping 'Doc' into some
--- other type, we can \'rename\' documentation by marking up 'Doc' into
--- the same thing, modifying only the identifiers embedded in it.
-mapIdent :: (a -> GenDoc b) -> DocMarkup a (GenDoc b)
-mapIdent f = Markup {
+-- | The identity markup
+idMarkup :: DocMarkup a (GenDoc a)
+idMarkup = Markup {
   markupEmpty         = DocEmpty,
   markupString        = DocString,
   markupParagraph     = DocParagraph,
   markupAppend        = DocAppend,
-  markupIdentifier    = f,
+  markupIdentifier    = DocIdentifier,
   markupModule        = DocModule,
   markupEmphasis      = DocEmphasis,
   markupMonospaced    = DocMonospaced,
@@ -452,6 +450,12 @@ mapIdent f = Markup {
   markupAName	      = DocAName
   }
 
+-- | Since marking up is just a matter of mapping 'Doc' into some
+-- other type, we can \'rename\' documentation by marking up 'Doc' into
+-- the same thing, modifying only the identifiers embedded in it.
+mapIdent :: (a -> GenDoc b) -> DocMarkup a (GenDoc b)
+mapIdent f = idMarkup{ markupIdentifier = f }
+
 -- -----------------------------------------------------------------------------
 -- ** Smart constructors
 
-- 
cgit v1.2.3