aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
authorfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2007-07-22 19:32:39 +0000
committerfiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>2007-07-22 19:32:39 +0000
commitb4d289c65ea422b91482e31b7b24879e73b4ecb5 (patch)
treebf7ae8458c59e92439ae08a0c0f6535a8dd47029 /src/Text/Pandoc
parentf7d0da28e9b7d0b6ab5027cbaba0b7aca4d1e52d (diff)
downloadpandoc-b4d289c65ea422b91482e31b7b24879e73b4ecb5.tar.gz
HTML writer: include css for .strikethrough only if strikethrough
is actually used in the document. git-svn-id: https://pandoc.googlecode.com/svn/trunk@768 788f1e2b-df1e-0410-8736-df70ead52e1b
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs42
1 files changed, 25 insertions, 17 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index d8fbdb9b4..ab85a3472 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -40,7 +40,13 @@ import Text.XHtml.Strict
type Notes = [Html]
type Ids = [String]
-type WriterState = (Notes, Ids)
+type ForHeader = [Html]
+type WriterState = (Notes, Ids, ForHeader)
+
+-- | Add some Html to be included in the document header.
+addToHeader :: Html -> State WriterState ()
+addToHeader item = modify (\(notes, ids, forheader) ->
+ (notes, ids, item:forheader))
-- | Convert Pandoc document to Html string.
writeHtmlString :: WriterOptions -> Pandoc -> String
@@ -53,11 +59,11 @@ writeHtmlString opts =
writeHtml :: WriterOptions -> Pandoc -> Html
writeHtml opts (Pandoc (Meta tit authors date) blocks) =
let titlePrefix = writerTitlePrefix opts
- topTitle = evalState (inlineListToHtml opts tit) ([],[])
+ topTitle = evalState (inlineListToHtml opts tit) ([],[],[])
topTitle' = if null titlePrefix
then topTitle
else titlePrefix +++ " - " +++ topTitle
- head = header $ thetitle topTitle' +++
+ metadata = thetitle topTitle' +++
meta ! [httpequiv "Content-Type",
content "text/html; charset=UTF-8"] +++
meta ! [name "generator", content "pandoc"] +++
@@ -65,9 +71,7 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
map (\a -> meta ! [name "author", content a]) authors) +++
(if null date
then noHtml
- else meta ! [name "date", content date]) +++
- (style ! [thetype "text/css"] $ (stringToHtml ".strikeout { text-decoration: line-through; }")) +++
- primHtml (writerHeader opts)
+ else meta ! [name "date", content date])
titleHeader = if (writerStandalone opts) && (not (null tit)) &&
(not (writerS5 opts))
then h1 ! [theclass "title"] $ topTitle
@@ -77,8 +81,10 @@ writeHtml opts (Pandoc (Meta tit authors date) blocks) =
toc = if writerTableOfContents opts
then tableOfContents opts headerBlocks ids
else noHtml
- (blocks', (revnotes,_)) =
- runState (blockListToHtml opts blocks) ([],ids)
+ (blocks', (revnotes,_,forhead)) =
+ runState (blockListToHtml opts blocks) ([],ids,[])
+ head = header $ metadata +++ toHtmlFromList forhead +++
+ primHtml (writerHeader opts)
notes = reverse revnotes
before = primHtml $ writerIncludeBefore opts
after = primHtml $ writerIncludeAfter opts
@@ -95,7 +101,7 @@ tableOfContents opts headers ids =
let opts' = opts { writerIgnoreNotes = True }
contentsTree = hierarchicalize headers
contents = evalState (mapM (elementToListItem opts') contentsTree)
- ([],ids)
+ ([],ids,[])
in thediv ! [identifier "toc"] $ unordList contents
-- | Converts an Element to a list item for a table of contents,
@@ -103,11 +109,11 @@ tableOfContents opts headers ids =
elementToListItem :: WriterOptions -> Element -> State WriterState Html
elementToListItem opts (Blk _) = return noHtml
elementToListItem opts (Sec headerText subsecs) = do
- (notes, ids) <- get
+ (notes, ids, forhead) <- get
let (id, rest) = if null ids
then ("",[])
else (head ids, tail ids)
- put (notes, rest)
+ put (notes, rest, forhead)
txt <- inlineListToHtml opts headerText
subHeads <- mapM (elementToListItem opts) subsecs
let subList = if null subHeads
@@ -237,11 +243,11 @@ blockToHtml opts block =
(return . blockquote)
else blockListToHtml opts blocks >>= (return . blockquote)
(Header level lst) -> do contents <- inlineListToHtml opts lst
- (notes, ids) <- get
+ (notes, ids, forhead) <- get
let (id, rest) = if null ids
then ("", [])
else (head ids, tail ids)
- put (notes, rest)
+ put (notes, rest, forhead)
let attribs = [identifier id]
let headerHtml = case level of
1 -> h1 contents ! attribs
@@ -331,8 +337,10 @@ inlineToHtml opts inline =
(Emph lst) -> inlineListToHtml opts lst >>= (return . emphasize)
(Strong lst) -> inlineListToHtml opts lst >>= (return . strong)
(Code str) -> return $ thecode << str
- (Strikeout lst) -> inlineListToHtml opts lst >>=
- (return . (thespan ! [theclass "strikeout"]))
+ (Strikeout lst) -> addToHeader (style ! [thetype "text/css"] $ (stringToHtml
+ ".strikeout { text-decoration: line-through; }")) >>
+ inlineListToHtml opts lst >>=
+ (return . (thespan ! [theclass "strikeout"]))
(Superscript lst) -> inlineListToHtml opts lst >>= (return . sup)
(Subscript lst) -> inlineListToHtml opts lst >>= (return . sub)
(Quoted quoteType lst) ->
@@ -361,11 +369,11 @@ inlineToHtml opts inline =
if null txt then [] else [alt alternate']
return $ image ! attributes
-- note: null title included, as in Markdown.pl
- (Note contents) -> do (notes, ids) <- get
+ (Note contents) -> do (notes, ids, forhead) <- get
let number = (length notes) + 1
let ref = show number
htmlContents <- blockListToNote opts ref contents
- put (htmlContents:notes, ids) -- push contents onto front of notes
+ put (htmlContents:notes, ids, forhead) -- push contents onto front of notes
return $ anchor ! [href ("#fn" ++ ref),
theclass "footnoteRef",
identifier ("fnref" ++ ref)] << sup << ref