@@ -40,7 +40,13 @@ import Text.XHtml.Strict
4040
4141type Notes = [Html]
4242type Ids = [String]
43−type WriterState = (Notes, Ids)
43+type ForHeader = [Html]
44+type WriterState = (Notes, Ids, ForHeader)
45+
46+-- | Add some Html to be included in the document header.
47+addToHeader :: Html -> State WriterState ()
48+addToHeader item = modify (\(notes, ids, forheader) ->
49+ (notes, ids, item:forheader))
4450
4551-- | Convert Pandoc document to Html string.
4652writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -53,11 +59,11 @@ writeHtmlString opts =
5359writeHtml :: WriterOptions -> Pandoc -> Html
5460writeHtml opts (Pandoc (Meta tit authors date) blocks) =
5561 let titlePrefix = writerTitlePrefix opts
56− topTitle = evalState (inlineListToHtml opts tit) ([],[])
62+ topTitle = evalState (inlineListToHtml opts tit) ([],[],[])
5763 topTitle' = if null titlePrefix
5864 then topTitle
5965 else titlePrefix +++ " - " +++ topTitle
60− head = header $ thetitle topTitle' +++
66+ metadata = thetitle topTitle' +++
6167 meta ! [httpequiv "Content-Type",
6268 content "text/html; charset=UTF-8"] +++
6369 meta ! [name "generator", content "pandoc"] +++
@@ -65,9 +71,7 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
6571 map (\a -> meta ! [name "author", content a]) authors) +++
6672 (if null date
6773 then noHtml
68− else meta ! [name "date", content date]) +++
69− (style ! [thetype "text/css"] $ (stringToHtml ".strikeout { text-decoration: line-through; }")) +++
70− primHtml (writerHeader opts)
74+ else meta ! [name "date", content date])
7175 titleHeader = if (writerStandalone opts) && (not (null tit)) &&
7276 (not (writerS5 opts))
7377 then h1 ! [theclass "title"] $ topTitle
@@ -77,8 +81,10 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
7781 toc = if writerTableOfContents opts
7882 then tableOfContents opts headerBlocks ids
7983 else noHtml
80− (blocks', (revnotes,_)) =
81− runState (blockListToHtml opts blocks) ([],ids)
84+ (blocks', (revnotes,_,forhead)) =
85+ runState (blockListToHtml opts blocks) ([],ids,[])
86+ head = header $ metadata +++ toHtmlFromList forhead +++
87+ primHtml (writerHeader opts)
8288 notes = reverse revnotes
8389 before = primHtml $ writerIncludeBefore opts
8490 after = primHtml $ writerIncludeAfter opts
@@ -95,7 +101,7 @@ tableOfContents opts headers ids =
95101 let opts' = opts { writerIgnoreNotes = True }
96102 contentsTree = hierarchicalize headers
97103 contents = evalState (mapM (elementToListItem opts') contentsTree)
98− ([],ids)
104+ ([],ids,[])
99105 in thediv ! [identifier "toc"] $ unordList contents
100106
101107-- | Converts an Element to a list item for a table of contents,
@@ -103,11 +109,11 @@ tableOfContents opts headers ids =
103109elementToListItem :: WriterOptions -> Element -> State WriterState Html
104110elementToListItem opts (Blk _) = return noHtml
105111elementToListItem opts (Sec headerText subsecs) = do
106− (notes, ids) <- get
112+ (notes, ids, forhead) <- get
107113 let (id, rest) = if null ids
108114 then ("",[])
109115 else (head ids, tail ids)
110− put (notes, rest)
116+ put (notes, rest, forhead)
111117 txt <- inlineListToHtml opts headerText
112118 subHeads <- mapM (elementToListItem opts) subsecs
113119 let subList = if null subHeads
@@ -237,11 +243,11 @@ blockToHtml opts block =
237243 (return . blockquote)
238244 else blockListToHtml opts blocks >>= (return . blockquote)
239245 (Header level lst) -> do contents <- inlineListToHtml opts lst
240− (notes, ids) <- get
246+ (notes, ids, forhead) <- get
241247 let (id, rest) = if null ids
242248 then ("", [])
243249 else (head ids, tail ids)
244− put (notes, rest)
250+ put (notes, rest, forhead)
245251 let attribs = [identifier id]
246252 let headerHtml = case level of
247253 1 -> h1 contents ! attribs
@@ -331,8 +337,10 @@ inlineToHtml opts inline =
331337 (Emph lst) -> inlineListToHtml opts lst >>= (return . emphasize)
332338 (Strong lst) -> inlineListToHtml opts lst >>= (return . strong)
333339 (Code str) -> return $ thecode << str
334− (Strikeout lst) -> inlineListToHtml opts lst >>=
335− (return . (thespan ! [theclass "strikeout"]))
340+ (Strikeout lst) -> addToHeader (style ! [thetype "text/css"] $ (stringToHtml
341+ ".strikeout { text-decoration: line-through; }")) >>
342+ inlineListToHtml opts lst >>=
343+ (return . (thespan ! [theclass "strikeout"]))
336344 (Superscript lst) -> inlineListToHtml opts lst >>= (return . sup)
337345 (Subscript lst) -> inlineListToHtml opts lst >>= (return . sub)
338346 (Quoted quoteType lst) ->
@@ -361,11 +369,11 @@ inlineToHtml opts inline =
361369 if null txt then [] else [alt alternate']
362370 return $ image ! attributes
363371 -- note: null title included, as in Markdown.pl
364− (Note contents) -> do (notes, ids) <- get
372+ (Note contents) -> do (notes, ids, forhead) <- get
365373 let number = (length notes) + 1
366374 let ref = show number
367375 htmlContents <- blockListToNote opts ref contents
368− put (htmlContents:notes, ids) -- push contents onto front of notes
376+ put (htmlContents:notes, ids, forhead) -- push contents onto front of notes
369377 return $ anchor ! [href ("#fn" ++ ref),
370378 theclass "footnoteRef",
371379 identifier ("fnref" ++ ref)] << sup << ref