From ec1693505c65ef5dfca1df09d415f852a2787c15 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie Date: Wed, 13 Dec 2017 12:06:22 +1300 Subject: fig, table-wrap & caption Divs for JATS writer Support writing and elements with 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. --- src/Text/Pandoc/Writers/JATS.hs | 36 ++++++++++++++++++++++++++++++------ 1 file changed, 30 insertions(+), 6 deletions(-) (limited to 'src/Text/Pandoc') 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 -- cgit v1.2.3 From fa0241592c0341c85246e94b5a0342ef3a301755 Mon Sep 17 00:00:00 2001 From: Hamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> Date: Thu, 14 Dec 2017 18:38:19 +1300 Subject: Deduplicate JATS writer image mime type code --- src/Text/Pandoc/Writers/JATS.hs | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) (limited to 'src/Text/Pandoc') diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index fe5a36d13..8824eeb24 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -159,6 +159,17 @@ listItemToJATS opts mbmarker item = do maybe empty (\lbl -> inTagsIndented "label" (text lbl)) mbmarker $$ contents +imageMimeType :: String -> [(String, String)] -> (String, String) +imageMimeType src kvs = + let mbMT = getMimeType src + maintype = fromMaybe "image" $ + lookup "mimetype" kvs `mplus` + (takeWhile (/='/') <$> mbMT) + subtype = fromMaybe "" $ + lookup "mime-subtype" kvs `mplus` + ((drop 1 . dropWhile (/='/')) <$> mbMT) + in (maintype, subtype) + -- | Convert a Pandoc block element to JATS. blockToJATS :: PandocMonad m => WriterOptions -> Block -> JATS m Doc blockToJATS _ Null = return empty @@ -191,33 +202,21 @@ blockToJATS opts (Plain lst) = blockToJATS opts (Para lst) blockToJATS opts (Para [Image (ident,_,kvs) txt (src,'f':'i':'g':':':tit)]) = do alt <- inlinesToJATS opts txt + let (maintype, subtype) = imageMimeType src kvs let capt = if null txt then empty else inTagsSimple "caption" alt let attr = [("id", ident) | not (null ident)] ++ [(k,v) | (k,v) <- kvs, k `elem` ["fig-type", "orientation", "position", "specific-use"]] - 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 graphicattr = [("mimetype",maintype), - ("mime-subtype",drop 1 subtype), + ("mime-subtype",subtype), ("xlink:href",src), -- do we need to URL escape this? ("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 (maintype, subtype) = imageMimeType src kvs let attr = [("id", ident) | not (null ident)] ++ [("mimetype", maintype), ("mime-subtype", subtype), -- cgit v1.2.3