fig, table-wrap & caption Divs for JATS writer

Support writing <fig> and <table-wrap> elements with <title> and
<caption> inside them by using Divs with class set to on of
fig, table-wrap or cation.  The title is included as a Heading
so the constraint on where Heading can occur is also relaxed.

Also leaves out empty alt attributes on links.

1 files changed, 30 insertions, 6 deletions

diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs
index 0ac37efba..fe5a36d13 100644
--- a/src/Text/Pandoc/Writers/JATS.hs
+++ b/src/Text/Pandoc/Writers/JATS.hs
@@ -168,6 +168,13 @@ blockToJATS opts (Div ('r':'e':'f':'-':_,_,_) [Para lst]) =
 blockToJATS opts (Div ("refs",_,_) xs) = do
   contents <- blocksToJATS opts xs
   return $ inTagsIndented "ref-list" contents
+blockToJATS opts (Div (ident,[cls],kvs) bs) | cls `elem` ["fig", "caption", "table-wrap"] = do
+  contents <- blocksToJATS opts bs
+  let attr = [("id", ident) | not (null ident)] ++
+             [("xml:lang",l) | ("lang",l) <- kvs] ++
+             [(k,v) | (k,v) <- kvs, k `elem` ["specific-use",
+                 "content-type", "orientation", "position"]]
+  return $ inTags True cls attr contents
 blockToJATS opts (Div (ident,_,kvs) bs) = do
   contents <- blocksToJATS opts bs
   let attr = [("id", ident) | not (null ident)] ++
@@ -175,10 +182,9 @@ blockToJATS opts (Div (ident,_,kvs) bs) = do
              [(k,v) | (k,v) <- kvs, k `elem` ["specific-use",
                  "content-type", "orientation", "position"]]
   return $ inTags True "boxed-text" attr contents
-blockToJATS _ h@(Header{}) = do
-  -- should not occur after hierarchicalize, except inside lists/blockquotes
-  report $ BlockNotRendered h
-  return empty
+blockToJATS opts (Header _ _ title) = do
+  title' <- inlinesToJATS opts title
+  return $ inTagsSimple "title" title'
 -- No Plain, everything needs to be in a block-level tag
 blockToJATS opts (Plain lst) = blockToJATS opts (Para lst)
 -- title beginning with fig: indicates that the image is a figure
@@ -204,6 +210,24 @@ blockToJATS opts (Para [Image (ident,_,kvs) txt
                      ("xlink:title",tit)]
   return $ inTags True "fig" attr $
               capt $$ selfClosingTag "graphic" graphicattr
+blockToJATS _ (Para [Image (ident,_,kvs) _ (src, tit)]) = do
+  let mbMT = getMimeType src
+  let maintype = fromMaybe "image" $
+                  lookup "mimetype" kvs `mplus`
+                  (takeWhile (/='/') <$> mbMT)
+  let subtype = fromMaybe "" $
+                  lookup "mime-subtype" kvs `mplus`
+                  ((drop 1 . dropWhile (/='/')) <$> mbMT)
+  let attr = [("id", ident) | not (null ident)] ++
+             [("mimetype", maintype),
+              ("mime-subtype", subtype),
+              ("xlink:href", src)] ++
+             [("xlink:title", tit) | not (null tit)] ++
+             [(k,v) | (k,v) <- kvs, k `elem` ["baseline-shift",
+                        "content-type", "specific-use", "xlink:actuate",
+                        "xlink:href", "xlink:role", "xlink:show",
+                        "xlink:type"]]
+  return $ selfClosingTag "graphic" attr
 blockToJATS opts (Para lst) =
   inTagsIndented "p" <$> inlinesToJATS opts lst
 blockToJATS opts (LineBlock lns) =
@@ -379,8 +403,8 @@ inlineToJATS _ (Link _attr [Str t] ('m':'a':'i':'l':'t':'o':':':email, _))
   return $ inTagsSimple "email" $ text (escapeStringForXML email)
 inlineToJATS opts (Link (ident,_,kvs) txt ('#':src, _)) = do
   let attr = [("id", ident) | not (null ident)] ++
-             [("alt", stringify txt),
-              ("rid", src)] ++
+             [("alt", stringify txt) | not (null txt)] ++
+             [("rid", src)] ++
              [(k,v) | (k,v) <- kvs, k `elem` ["ref-type", "specific-use"]]
   contents <- inlinesToJATS opts txt
   return $ inTags False "xref" attr contents