aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
authorJohn MacFarlane <fiddlosopher@gmail.com>2011-12-30 13:03:31 -0800
committerJohn MacFarlane <fiddlosopher@gmail.com>2011-12-30 13:03:31 -0800
commit673c044a157e49c1cd6458c70d55afeac7d91970 (patch)
treed49535ee85a4225e8b6c8502d78d2269c083010f /src/Text/Pandoc
parentedf646a90de4dcb420a7b7426d266335e2f7c67f (diff)
downloadpandoc-673c044a157e49c1cd6458c70d55afeac7d91970.tar.gz
HTML writer: Better handling of authors in meta tags.
Footnotes and email addresses now come out in a more pleasing way. Modified from a patch by B. Scott Michel.
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs38
1 files changed, 26 insertions, 12 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 8eb5092f9..d6077c63e 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -34,6 +34,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )
import Text.Pandoc.Shared
import Text.Pandoc.Templates
+import Text.Pandoc.Generic
import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Highlighting ( highlight, styleToHtml,
formatHtmlInline, formatHtmlBlock )
@@ -80,25 +81,25 @@ nl opts = if writerWrapText opts
-- | Convert Pandoc document to Html string.
writeHtmlString :: WriterOptions -> Pandoc -> String
writeHtmlString opts d =
- let (tit, auths, date, toc, body', newvars) = evalState (pandocToHtml opts d)
- defaultWriterState
+ let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d)
+ defaultWriterState
in if writerStandalone opts
- then inTemplate opts tit auths date toc body' newvars
+ then inTemplate opts tit auths authsMeta date toc body' newvars
else renderHtml body'
-- | Convert Pandoc document to Html structure.
writeHtml :: WriterOptions -> Pandoc -> Html
writeHtml opts d =
- let (tit, auths, date, toc, body', newvars) = evalState (pandocToHtml opts d)
- defaultWriterState
+ let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d)
+ defaultWriterState
in if writerStandalone opts
- then inTemplate opts tit auths date toc body' newvars
+ then inTemplate opts tit auths authsMeta date toc body' newvars
else body'
-- result is (title, authors, date, toc, body, new variables)
pandocToHtml :: WriterOptions
-> Pandoc
- -> State WriterState (Html, [Html], Html, Maybe Html, Html, [(String,String)])
+ -> State WriterState (Html, [Html], [Html], Html, Maybe Html, Html, [(String,String)])
pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
let standalone = writerStandalone opts
tit <- if standalone
@@ -107,6 +108,9 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
auths <- if standalone
then mapM (inlineListToHtml opts) authors'
else return []
+ authsMeta <- if standalone
+ then mapM (inlineListToHtml opts . prepForMeta) authors'
+ else return []
date <- if standalone
then inlineListToHtml opts date'
else return mempty
@@ -158,20 +162,30 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do
$ writerHighlightStyle opts) |
stHighlighting st] ++
[("math", renderHtml math) | stMath st]
- return (tit, auths, date, toc, thebody, newvars)
+ return (tit, auths, authsMeta, date, toc, thebody, newvars)
+
+-- | Prepare author for meta tag, converting notes into
+-- bracketed text and removing links.
+prepForMeta :: [Inline] -> [Inline]
+prepForMeta = bottomUp (concatMap fixInline)
+ where fixInline (Note [Para xs]) = [Str " ["] ++ xs ++ [Str "]"]
+ fixInline (Note [Plain xs]) = [Str " ["] ++ xs ++ [Str "]"]
+ fixInline (Link lab _) = lab
+ fixInline (Image lab _) = lab
+ fixInline x = [x]
inTemplate :: TemplateTarget a
=> WriterOptions
-> Html
-> [Html]
+ -> [Html]
-> Html
-> Maybe Html
-> Html
-> [(String,String)]
-> a
-inTemplate opts tit auths date toc body' newvars =
+inTemplate opts tit auths authsMeta date toc body' newvars =
let title' = renderHtml tit
- authors = map renderHtml auths
date' = renderHtml date
variables = writerVariables opts ++ newvars
context = variables ++
@@ -187,8 +201,8 @@ inTemplate opts tit auths date toc body' newvars =
(case toc of
Just t -> [ ("toc", renderHtml t)]
Nothing -> []) ++
- [ ("author", a) | a <- authors ] ++
- [ ("author-meta", stripTags a) | a <- authors ]
+ [ ("author", renderHtml a) | a <- auths ] ++
+ [ ("author-meta", stripTags $ renderHtml a) | a <- authsMeta ]
in renderTemplate context $ writerTemplate opts
-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix