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.

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