From 59065c103f334514e1b743fec5359d9fd4833b55 Mon Sep 17 00:00:00 2001
From: fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>
Date: Mon, 26 Feb 2007 19:08:10 +0000
Subject: [PATCH] Modified HTML writer to use the Text.XHtml library. This
results in cleaner, faster code, and it makes it easier to use Pandoc in
other projects, like wikis, that use Text.XHtml. Two functions are now
provided, writeHtml and writeHtmlString: the former outputs an Html
structure, the latter a rendered string. The S5 writer is also changed, in
parallel ways (writeS5, writeS5String). The Html header is now written
programmatically, so it has been removed from the 'headers' directory. The
S5 header is still needed, but the doctype and some of the meta declarations
have been removed, since they are written programatically. The INSTALL file
and cabalize have been updated to reflect the new dependency on the xhtml
package.
git-svn-id: https://pandoc.googlecode.com/svn/trunk@549 788f1e2b-df1e-0410-8736-df70ead52e1b
---
INSTALL | 6 +
cabalize | 2 +-
src/Main.hs | 15 +-
src/Text/Pandoc/Writers/HTML.hs | 295 +++++++++++++++-----------------
src/headers/HtmlHeader | 6 -
src/headers/S5Header | 5 -
src/templates/DefaultHeaders.hs | 6 +-
src/templates/S5.hs | 18 +-
8 files changed, 172 insertions(+), 181 deletions(-)
delete mode 100644 src/headers/HtmlHeader
diff --git a/INSTALL b/INSTALL
index 32a19018a..106351feb 100644
--- a/INSTALL
+++ b/INSTALL
@@ -9,6 +9,12 @@ page.
[GHC]: http://www.haskell.org/ghc/
[GHC Download]: http://www.haskell.org/ghc/download.html
+If you're using GHC 6.4, you'll also need to install the
+[Text.XHtml] library. This library is included in the standard
+hierarchical libraries in GHC 6.6.
+
+[Text.XHtml]: http://www.cs.chalmers.se/~bringert/darcs/haskell-xhtml/doc/
+
You'll also need standard build tools: [GNU `make`], `sed`, `bash`,
and `perl`. These are standard on unix systems (including MacOS
X). If you're using Windows, you can install [Cygwin].
diff --git a/cabalize b/cabalize
index 407336c9b..0e31240e4 100755
--- a/cabalize
+++ b/cabalize
@@ -1,7 +1,7 @@
#!/bin/sh
# Preprocesses cabal file.
-BASE_DEPENDS="base haskell98 parsec"
+BASE_DEPENDS="base haskell98 parsec xhtml"
GHC64_DEPENDS=${GHC64_DEPENDS}
GHC66_DEPENDS=${GHC66_DEPENDS-"regex-compat html"}
diff --git a/src/Main.hs b/src/Main.hs
index 39686bafb..275a89f0d 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -32,19 +32,20 @@ module Main where
import Text.Pandoc.UTF8 ( decodeUTF8, encodeUTF8 )
import Text.Pandoc.Readers.Markdown ( readMarkdown )
import Text.Pandoc.Readers.HTML ( readHtml )
-import Text.Pandoc.Writers.S5 ( s5CSS, s5Javascript, writeS5 )
+import Text.Pandoc.Writers.S5 ( writeS5String )
import Text.Pandoc.Writers.RST ( writeRST )
import Text.Pandoc.Readers.RST ( readRST )
import Text.Pandoc.ASCIIMathML ( asciiMathMLScript )
-import Text.Pandoc.Writers.HTML ( writeHtml )
+import Text.Pandoc.Writers.HTML ( writeHtmlString )
import Text.Pandoc.Writers.Docbook ( writeDocbook )
import Text.Pandoc.Writers.LaTeX ( writeLaTeX )
import Text.Pandoc.Readers.LaTeX ( readLaTeX )
import Text.Pandoc.Writers.RTF ( writeRTF )
import Text.Pandoc.Writers.Markdown ( writeMarkdown )
-import Text.Pandoc.Writers.DefaultHeaders ( defaultHtmlHeader,
- defaultRTFHeader, defaultS5Header, defaultLaTeXHeader,
- defaultDocbookHeader )
+import Text.Pandoc.Writers.DefaultHeaders ( defaultRTFHeader,
+ defaultS5Header,
+ defaultLaTeXHeader,
+ defaultDocbookHeader )
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Text.Regex ( mkRegex, matchRegex )
@@ -82,8 +83,8 @@ readPandoc state input = read input
-- | Association list of formats and pairs of writers and default headers.
writers :: [ ( String, ( WriterOptions -> Pandoc -> String, String ) ) ]
writers = [("native" , (writeDoc, ""))
- ,("html" , (writeHtml, defaultHtmlHeader))
- ,("s5" , (writeS5, defaultS5Header))
+ ,("html" , (writeHtmlString, ""))
+ ,("s5" , (writeS5String, defaultS5Header))
,("docbook" , (writeDocbook, defaultDocbookHeader))
,("latex" , (writeLaTeX, defaultLaTeXHeader))
,("markdown" , (writeMarkdown, ""))
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index a7ee9c0f3..06ebf2ca1 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -27,69 +27,78 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of 'Pandoc' documents to HTML.
-}
-module Text.Pandoc.Writers.HTML (
- writeHtml,
- ) where
+module Text.Pandoc.Writers.HTML ( writeHtml, writeHtmlString ) where
import Text.Pandoc.Definition
import Text.Pandoc.Shared
-import Text.Pandoc.Entities ( escapeSGMLString )
import Text.Regex ( mkRegex, matchRegex )
import Numeric ( showHex )
import Data.Char ( ord, toLower )
import Data.List ( isPrefixOf, partition )
-import Text.PrettyPrint.HughesPJ hiding ( Str )
+import Text.XHtml.Strict
--- | Convert Pandoc document to string in HTML format.
-writeHtml :: WriterOptions -> Pandoc -> String
-writeHtml opts (Pandoc (Meta title authors date) blocks) =
- let titlePrefix = writerTitlePrefix opts in
- let topTitle = if not (null titlePrefix)
- then [Str titlePrefix] ++ (if not (null title)
- then [Str " - "] ++ title
- else [])
- else title in
- let head = if (writerStandalone opts)
- then htmlHeader opts (Meta topTitle authors date)
- else empty
- titleBlocks = if (writerStandalone opts) && (not (null title)) &&
+-- | Convert Pandoc document to Html string.
+writeHtmlString :: WriterOptions -> Pandoc -> String
+writeHtmlString opts =
+ if writerStandalone opts
+ then renderHtml . (writeHtml opts)
+ else renderHtmlFragment . (writeHtml opts)
+
+-- | Convert Pandoc document to Html structure.
+writeHtml :: WriterOptions -> Pandoc -> Html
+writeHtml opts (Pandoc (Meta tit authors date) blocks) =
+ let titlePrefix = writerTitlePrefix opts
+ topTitle = inlineListToHtml opts tit
+ topTitle' = if not (null titlePrefix)
+ then stringToHtml titlePrefix +++
+ if not (null tit)
+ then '-' +++ topTitle
+ else noHtml
+ else topTitle
+ head = header $ thetitle topTitle' +++
+ meta ! [httpequiv "Content-Type",
+ content "text/html; charset=UTF-8"] +++
+ meta ! [name "generator", content "pandoc"] +++
+ (toHtmlFromList $
+ map (\a -> meta ! [name "author", content a]) authors) +++
+ (if null date
+ then noHtml
+ else meta ! [name "date", content date]) +++
+ primHtml (writerHeader opts)
+ titleHeader = if (writerStandalone opts) && (not (null tit)) &&
(not (writerS5 opts))
- then [RawHtml "<h1 class=\"title\">", Plain title,
- RawHtml "</h1>"]
- else []
- foot = if (writerStandalone opts)
- then text "</body>\n</html>"
- else empty
- blocks' = replaceReferenceLinks (titleBlocks ++ blocks)
+ then h1 ! [theclass "title"] $ topTitle
+ else noHtml
+ blocks' = replaceReferenceLinks blocks
(noteBlocks, blocks'') = partition isNoteBlock blocks'
- before = writerIncludeBefore opts
- after = writerIncludeAfter opts
- body = (if null before then empty else text before) $$
- vcat (map (blockToHtml opts) blocks'') $$
- footnoteSection opts noteBlocks $$
- (if null after then empty else text after) in
- render $ head $$ body $$ foot $$ text ""
+ before = primHtml $ writerIncludeBefore opts
+ after = primHtml $ writerIncludeAfter opts
+ thebody = before +++ titleHeader +++
+ toHtmlFromList (map (blockToHtml opts) blocks'') +++
+ footnoteSection opts noteBlocks +++ after
+ in if writerStandalone opts
+ then head +++ (body thebody)
+ else thebody
-- | Convert list of Note blocks to a footnote <div>.
-- Assumes notes are sorted.
-footnoteSection :: WriterOptions -> [Block] -> Doc
+footnoteSection :: WriterOptions -> [Block] -> Html
footnoteSection opts notes =
if null notes
- then empty
- else inTags True "div" [("class","footnotes")] $
- selfClosingTag "hr" [] $$ (inTagsIndented "ol"
- (vcat $ map (blockToHtml opts) notes))
+ then noHtml
+ else thediv ! [theclass "footnotes"] $
+ hr +++ (olist $ toHtmlFromList $ map (blockToHtml opts) notes)
-- | Obfuscate a "mailto:" link using Javascript.
-obfuscateLink :: WriterOptions -> [Inline] -> String -> Doc
+obfuscateLink :: WriterOptions -> [Inline] -> String -> Html
obfuscateLink opts txt src =
let emailRegex = mkRegex "mailto:*([^@]*)@(.*)"
- text' = render $ inlineListToHtml opts txt
- src' = map toLower src in
+ text' = show $ inlineListToHtml opts txt
+ src' = map toLower src in
case (matchRegex emailRegex src') of
(Just [name, domain]) ->
- let domain' = substitute "." " dot " domain
- at' = obfuscateChar '@' in
- let linkText = if src' == ("mailto:" ++ text')
+ let domain' = substitute "." " dot " domain
+ at' = obfuscateChar '@'
+ linkText = if src' == ("mailto:" ++ text')
then "e"
else "'" ++ text' ++ "'"
altText = if src' == ("mailto:" ++ text')
@@ -97,16 +106,16 @@ obfuscateLink opts txt src =
else text' ++ " (" ++ name ++ " at " ++
domain' ++ ")" in
if writerStrictMarkdown opts
- then inTags False "a" [("href", obfuscateString src')] $
- text $ obfuscateString text'
- else inTags False "script" [("type", "text/javascript")]
- (text ("\n<!--\nh='" ++
+ then anchor ! [href $ obfuscateString src'] $
+ stringToHtml $ obfuscateString text'
+ else (script ! [thetype "text/javascript"] $
+ primHtml ("\n<!--\nh='" ++
obfuscateString domain ++ "';a='" ++ at' ++ "';n='" ++
obfuscateString name ++ "';e=n+a+h;\n" ++
"document.write('<a h'+'ref'+'=\"ma'+'ilto'+':'+e+'\">'+" ++
- linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) <>
- inTagsSimple "noscript" (text (obfuscateString altText))
- _ -> inTags False "a" [("href", src)] (text text') -- malformed email
+ linkText ++ "+'<\\/'+'a'+'>');\n// -->\n")) +++
+ noscript (stringToHtml $ obfuscateString altText)
+ _ -> anchor ! [href src] $ inlineListToHtml opts txt -- malformed email
-- | Obfuscate character as entity.
obfuscateChar :: Char -> String
@@ -119,32 +128,12 @@ obfuscateChar char =
obfuscateString :: String -> String
obfuscateString = concatMap obfuscateChar
--- | Return an HTML header with appropriate bibliographic information.
-htmlHeader :: WriterOptions -> Meta -> Doc
-htmlHeader opts (Meta title authors date) =
- let titletext = inTagsSimple "title" (wrap opts title)
- authortext = if (null authors)
- then empty
- else selfClosingTag "meta" [("name", "author"),
- ("content",
- joinWithSep ", " (map escapeSGMLString authors))]
- datetext = if (date == "")
- then empty
- else selfClosingTag "meta" [("name", "date"),
- ("content", escapeSGMLString date)] in
- text (writerHeader opts) $$ authortext $$ datetext $$ titletext $$
- text "</head>\n<body>"
-
--- | Take list of inline elements and return wrapped doc.
-wrap :: WriterOptions -> [Inline] -> Doc
-wrap opts lst = fsep $ map (inlineListToHtml opts) (splitBy Space lst)
-
-- | Convert Pandoc block element to HTML.
-blockToHtml :: WriterOptions -> Block -> Doc
-blockToHtml opts Blank = text ""
-blockToHtml opts Null = empty
-blockToHtml opts (Plain lst) = wrap opts lst
-blockToHtml opts (Para lst) = inTagsIndented "p" $ wrap opts lst
+blockToHtml :: WriterOptions -> Block -> Html
+blockToHtml opts Blank = noHtml
+blockToHtml opts Null = noHtml
+blockToHtml opts (Plain lst) = inlineListToHtml opts lst
+blockToHtml opts (Para lst) = paragraph $ inlineListToHtml opts lst
blockToHtml opts (BlockQuote blocks) =
if (writerS5 opts)
then -- in S5, treat list in blockquote specially
@@ -152,120 +141,120 @@ blockToHtml opts (BlockQuote blocks) =
-- otherwise incremental
let inc = not (writerIncremental opts) in
case blocks of
- [BulletList lst] -> blockToHtml (opts {writerIncremental =
+ [BulletList lst] -> blockToHtml (opts {writerIncremental =
inc}) (BulletList lst)
[OrderedList lst] -> blockToHtml (opts {writerIncremental =
inc}) (OrderedList lst)
- otherwise -> inTagsIndented "blockquote" $
- vcat $ map (blockToHtml opts) blocks
- else inTagsIndented "blockquote" $ vcat $ map (blockToHtml opts) blocks
+ otherwise -> blockquote $ toHtmlFromList $
+ map (blockToHtml opts) blocks
+ else blockquote $ toHtmlFromList $ map (blockToHtml opts) blocks
blockToHtml opts (Note ref lst) =
- let contents = (vcat $ map (blockToHtml opts) lst) in
- inTags True "li" [("id", "fn" ++ ref)] $
- contents <> inTags False "a" [("href", "#fnref" ++ ref),
- ("class", "footnoteBacklink"),
- ("title", "Jump back to footnote " ++ ref)]
- (text "↩")
-blockToHtml opts (Key _ _) = empty
+ let contents = toHtmlFromList $ map (blockToHtml opts) lst
+ backlink = anchor ! [href ("#fnref" ++ ref), theclass "footnoteBacklink",
+ title ("Jump back to footnote " ++ ref)] $
+ (primHtmlChar "#8617") in
+ li ! [identifier ("fn" ++ ref)] $ contents +++ backlink
+blockToHtml opts (Key _ _) = noHtml
blockToHtml opts (CodeBlock str) =
- text "<pre><code>" <> text (escapeSGMLString str) <> text "\n</code></pre>"
-blockToHtml opts (RawHtml str) = text str
+ pre $ thecode $ stringToHtml (str ++ "\n") -- the final \n for consistency with Markdown.pl
+blockToHtml opts (RawHtml str) = primHtml str
blockToHtml opts (BulletList lst) =
- let attribs = if (writerIncremental opts)
- then [("class","incremental")]
+ let attribs = if writerIncremental opts
+ then [theclass "incremental"]
else [] in
- inTags True "ul" attribs $ vcat $ map (listItemToHtml opts) lst
+ ulist ! attribs $ toHtmlFromList $ map (listItemToHtml opts) lst
blockToHtml opts (OrderedList lst) =
- let attribs = if (writerIncremental opts)
- then [("class","incremental")]
+ let attribs = if writerIncremental opts
+ then [theclass "incremental"]
else [] in
- inTags True "ol" attribs $ vcat $ map (listItemToHtml opts) lst
-blockToHtml opts HorizontalRule = selfClosingTag "hr" []
+ olist ! attribs $ toHtmlFromList $ map (listItemToHtml opts) lst
+blockToHtml opts HorizontalRule = hr
blockToHtml opts (Header level lst) =
- let contents = wrap opts lst in
- if ((level > 0) && (level <= 6))
- then inTagsSimple ("h" ++ show level) contents
- else inTagsSimple "p" contents
-blockToHtml opts (Table caption aligns widths headers rows) =
+ let contents = inlineListToHtml opts lst in
+ case level of
+ 1 -> h1 contents
+ 2 -> h2 contents
+ 3 -> h3 contents
+ 4 -> h4 contents
+ 5 -> h5 contents
+ 6 -> h6 contents
+ _ -> paragraph contents
+blockToHtml opts (Table capt aligns widths headers rows) =
let alignStrings = map alignmentToString aligns
- captionDoc = if null caption
- then empty
- else inTagsSimple "caption"
- (inlineListToHtml opts caption) in
- inTagsIndented "table" $ captionDoc $$
- (colHeadsToHtml opts alignStrings widths headers) $$
- (vcat $ map (tableRowToHtml opts alignStrings) rows)
+ captionDoc = if null capt
+ then noHtml
+ else caption $ inlineListToHtml opts capt in
+ table $ captionDoc +++
+ (colHeadsToHtml opts alignStrings widths headers) +++
+ (toHtmlFromList $ map (tableRowToHtml opts alignStrings) rows)
colHeadsToHtml opts alignStrings widths headers =
let heads = zipWith3
- (\align width item -> tableItemToHtml opts "th" align width item)
+ (\align width item -> tableItemToHtml opts th align width item)
alignStrings widths headers in
- inTagsIndented "tr" $ vcat heads
+ tr $ toHtmlFromList heads
alignmentToString alignment = case alignment of
- AlignLeft -> "left"
- AlignRight -> "right"
- AlignCenter -> "center"
+ AlignLeft -> "left"
+ AlignRight -> "right"
+ AlignCenter -> "center"
AlignDefault -> "left"
-
tableRowToHtml opts aligns cols =
- inTagsIndented "tr" $ vcat $ zipWith3 (tableItemToHtml opts "td") aligns (repeat 0) cols
+ tr $ toHtmlFromList $ zipWith3 (tableItemToHtml opts td) aligns (repeat 0) cols
-tableItemToHtml opts tag align width item =
- let attrib = [("align", align)] ++
+tableItemToHtml opts tag align' width item =
+ let attrib = [align align'] ++
if (width /= 0)
- then [("style", "{width: " ++
- show (truncate (100*width)) ++ "%;}")]
+ then [thestyle ("{width: " ++ show (truncate (100*width)) ++ "%;}")]
else [] in
- inTags False tag attrib $ vcat $ map (blockToHtml opts) item
+ tag ! attrib $ toHtmlFromList $ map (blockToHtml opts) item
-listItemToHtml :: WriterOptions -> [Block] -> Doc
+listItemToHtml :: WriterOptions -> [Block] -> Html
listItemToHtml opts list =
- inTagsSimple "li" $ vcat $ map (blockToHtml opts) list
+ li $ toHtmlFromList $ map (blockToHtml opts) list
-- | Convert list of Pandoc inline elements to HTML.
-inlineListToHtml :: WriterOptions -> [Inline] -> Doc
-inlineListToHtml opts lst = hcat (map (inlineToHtml opts) lst)
+inlineListToHtml :: WriterOptions -> [Inline] -> Html
+inlineListToHtml opts lst = toHtmlFromList $ map (inlineToHtml opts) lst
-- | Convert Pandoc inline element to HTML.
-inlineToHtml :: WriterOptions -> Inline -> Doc
+inlineToHtml :: WriterOptions -> Inline -> Html
inlineToHtml opts (Emph lst) =
- inTagsSimple "em" (inlineListToHtml opts lst)
+ emphasize $ inlineListToHtml opts lst
inlineToHtml opts (Strong lst) =
- inTagsSimple "strong" (inlineListToHtml opts lst)
+ strong $ inlineListToHtml opts lst
inlineToHtml opts (Code str) =
- inTagsSimple "code" $ text (escapeSGMLString str)
+ thecode $ stringToHtml $ str
inlineToHtml opts (Quoted SingleQuote lst) =
- text "‘" <> (inlineListToHtml opts lst) <> text "’"
+ primHtmlChar "lsquo" +++ inlineListToHtml opts lst +++ primHtmlChar "rsquo"
inlineToHtml opts (Quoted DoubleQuote lst) =
- text "“" <> (inlineListToHtml opts lst) <> text "”"
-inlineToHtml opts EmDash = text "—"
-inlineToHtml opts EnDash = text "–"
-inlineToHtml opts Ellipses = text "…"
-inlineToHtml opts Apostrophe = text "’"
-inlineToHtml opts (Str str) = text $ escapeSGMLString str
-inlineToHtml opts (TeX str) = text $ escapeSGMLString str
-inlineToHtml opts (HtmlInline str) = text str
-inlineToHtml opts (LineBreak) = selfClosingTag "br" []
-inlineToHtml opts Space = space
-inlineToHtml opts (Link txt (Src src title)) =
+ primHtmlChar "ldquo" +++ inlineListToHtml opts lst +++ primHtmlChar "rdquo"
+inlineToHtml opts EmDash = primHtmlChar "mdash"
+inlineToHtml opts EnDash = primHtmlChar "ndash"
+inlineToHtml opts Ellipses = primHtmlChar "hellip"
+inlineToHtml opts Apostrophe = primHtmlChar "rsquo"
+inlineToHtml opts (Str str) = stringToHtml str
+inlineToHtml opts (TeX str) = stringToHtml str
+inlineToHtml opts (HtmlInline str) = primHtml str
+inlineToHtml opts (LineBreak) = br
+inlineToHtml opts Space = stringToHtml " "
+inlineToHtml opts (Link txt (Src src tit)) =
if (isPrefixOf "mailto:" src)
then obfuscateLink opts txt src
- else inTags False "a" ([("href", src)] ++
- if null title then [] else [("title", title)])
- (inlineListToHtml opts txt)
+ else anchor ! ([href src] ++ if null tit then [] else [title tit]) $
+ inlineListToHtml opts txt
inlineToHtml opts (Link txt (Ref ref)) =
- char '[' <> (inlineListToHtml opts txt) <> text "][" <>
- (inlineListToHtml opts ref) <> char ']'
+ '[' +++ (inlineListToHtml opts txt) +++
+ ']' +++ '[' +++ (inlineListToHtml opts ref) +++
+ ']'
-- this is what markdown does, for better or worse
-inlineToHtml opts (Image alt (Src source title)) =
- let alternate = render $ inlineListToHtml opts alt in
- selfClosingTag "img" $ [("src", source)] ++
- (if null alternate then [] else [("alt", alternate)]) ++
- [("title", title)] -- note: null title is included, as in Markdown.pl
+inlineToHtml opts (Image alttext (Src source tit)) =
+ let alternate = renderHtml $ inlineListToHtml opts alttext in
+ image ! ([src source, title tit] ++ if null alttext then [] else [alt alternate])
+ -- note: null title is included, as in Markdown.pl
inlineToHtml opts (Image alternate (Ref ref)) =
- text "![" <> (inlineListToHtml opts alternate) <> text "][" <>
- (inlineListToHtml opts ref) <> char ']'
+ '!' +++ inlineToHtml opts (Link alternate (Ref ref))
inlineToHtml opts (NoteRef ref) =
- inTags False "sup" [("class", "footnoteRef"), ("id", "fnref" ++ ref)]
- (inTags False "a" [("href", "#fn" ++ ref)] $ text ref)
+ anchor ! [href ("#fn" ++ ref), theclass "footnoteRef", identifier ("fnref" ++ ref)] $
+ sup (stringToHtml ref)
+
diff --git a/src/headers/HtmlHeader b/src/headers/HtmlHeader
deleted file mode 100644
index 26b0bad94..000000000
--- a/src/headers/HtmlHeader
+++ /dev/null
@@ -1,6 +0,0 @@
-<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
- "http://www.w3.org/TR/html4/loose.dtd">
-<html>
-<head>
-<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
-<meta name="generator" content="pandoc" />
diff --git a/src/headers/S5Header b/src/headers/S5Header
index 0cec6c8f3..ebb24ebe2 100644
--- a/src/headers/S5Header
+++ b/src/headers/S5Header
@@ -1,8 +1,3 @@
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
-<html xmlns="http://www.w3.org/1999/xhtml">
-<head>
<!-- configuration parameters -->
<meta name="defaultView" content="slideshow" />
<meta name="controlVis" content="hidden" />
-<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
-<meta name="generator" content="pandoc" />
diff --git a/src/templates/DefaultHeaders.hs b/src/templates/DefaultHeaders.hs
index 0274aa30f..7aee8c945 100644
--- a/src/templates/DefaultHeaders.hs
+++ b/src/templates/DefaultHeaders.hs
@@ -2,7 +2,6 @@
module Text.Pandoc.Writers.DefaultHeaders (
defaultLaTeXHeader,
defaultDocbookHeader,
- defaultHtmlHeader,
defaultS5Header,
defaultRTFHeader
) where
@@ -14,11 +13,8 @@ defaultLaTeXHeader = "@LaTeXHeader@"
defaultDocbookHeader :: String
defaultDocbookHeader = "@DocbookHeader@"
-defaultHtmlHeader :: String
-defaultHtmlHeader = "@HtmlHeader@"
-
defaultS5Header :: String
-defaultS5Header = "@S5Header@" ++ s5CSS ++ s5Javascript
+defaultS5Header = s5Meta ++ s5CSS ++ s5Javascript
defaultRTFHeader :: String
defaultRTFHeader = "@RTFHeader@"
diff --git a/src/templates/S5.hs b/src/templates/S5.hs
index 537286040..b015d8ca6 100644
--- a/src/templates/S5.hs
+++ b/src/templates/S5.hs
@@ -2,16 +2,22 @@
-- (See <http://meyerweb.com/eric/tools/s5/>.)
module Text.Pandoc.Writers.S5 (
-- * Strings
+ s5Meta,
s5Javascript,
s5CSS,
s5Links,
-- * Functions
writeS5,
+ writeS5String,
insertS5Structure
) where
import Text.Pandoc.Shared ( joinWithSep, WriterOptions )
-import Text.Pandoc.Writers.HTML ( writeHtml )
+import Text.Pandoc.Writers.HTML ( writeHtml, writeHtmlString )
import Text.Pandoc.Definition
+import Text.XHtml.Strict
+
+s5Meta :: String
+s5Meta = "<!-- configuration parameters -->\n<meta name=\"defaultView\" content=\"slideshow\" />\n<meta name=\"controlVis\" content=\"hidden\" />\n"
s5Javascript :: String
s5Javascript = "<script type=\"text/javascript\">\n@slides.js@</script>\n"
@@ -40,9 +46,13 @@ s5CSS = "<style type=\"text/css\" media=\"projection\" id=\"slideProj\">\n" ++ s
s5Links :: String
s5Links = "<!-- style sheet links -->\n<link rel=\"stylesheet\" href=\"ui/default/slides.css\" type=\"text/css\" media=\"projection\" id=\"slideProj\" />\n<link rel=\"stylesheet\" href=\"ui/default/outline.css\" type=\"text/css\" media=\"screen\" id=\"outlineStyle\" />\n<link rel=\"stylesheet\" href=\"ui/default/print.css\" type=\"text/css\" media=\"print\" id=\"slidePrint\" />\n<link rel=\"stylesheet\" href=\"ui/default/opera.css\" type=\"text/css\" media=\"projection\" id=\"operaFix\" />\n<!-- S5 JS -->\n<script src=\"ui/default/slides.js\" type=\"text/javascript\"></script>\n"
--- | Converts 'Pandoc' to an S5 HTML presentation.
-writeS5 :: WriterOptions -> Pandoc -> String
-writeS5 options = writeHtml options . insertS5Structure
+-- | Converts Pandoc document to an S5 HTML presentation (Html structure).
+writeS5 :: WriterOptions -> Pandoc -> Html
+writeS5 options = (writeHtml options) . insertS5Structure
+
+-- | Converts Pandoc document to an S5 HTML presentation (string).
+writeS5String :: WriterOptions -> Pandoc -> String
+writeS5String options = (writeHtmlString options) . insertS5Structure
-- | Inserts HTML needed for an S5 presentation (e.g. around slides).
layoutDiv :: [Inline] -- ^ Title of document (for header or footer)