From d08d1c04c54a91eceff2ad3e8cc628b730a7cc9b Mon Sep 17 00:00:00 2001 From: Albert Krewinkel Date: Fri, 17 Feb 2023 23:03:32 +0100 Subject: [PATCH] JATS writer: include alt-text in ``, `` elements Closes: #8631 --- src/Text/Pandoc/Writers/JATS.hs | 32 ++++++++++++++++++++++++------- test/Tests/Writers/JATS.hs | 4 +++- test/command/figures-jats.md | 17 ++++++++++++++++ test/writer.jats_archiving | 5 +++-- test/writer.jats_articleauthoring | 5 +++-- test/writer.jats_publishing | 5 +++-- 6 files changed, 54 insertions(+), 14 deletions(-) diff --git a/src/Text/Pandoc/Writers/JATS.hs b/src/Text/Pandoc/Writers/JATS.hs index 6b382367d..707c7bad7 100644 --- a/src/Text/Pandoc/Writers/JATS.hs +++ b/src/Text/Pandoc/Writers/JATS.hs @@ -351,11 +351,16 @@ blockToJATS _ b@(RawBlock f str) blockToJATS _ HorizontalRule = return empty -- not semantic blockToJATS opts (Table attr caption colspecs thead tbody tfoot) = tableToJATS opts (Ann.toTable attr caption colspecs thead tbody tfoot) -blockToJATS opts (Figure (ident, _, kvs) caption body) = do - capt <- case caption of - Caption _ [] -> pure empty - Caption _ cpt -> inTagsSimple "caption" <$> blocksToJATS opts cpt - figbod <- blocksToJATS opts body +blockToJATS opts (Figure (ident, _, kvs) (Caption _short longcapt) body) = do + -- Remove the alt text from images if it's the same as the caption text. + let unsetAltIfDupl = \case + Image attr alt tgt + | stringify alt == stringify longcapt -> Image attr [] tgt + inline -> inline + capt <- if null longcapt + then pure empty + else inTagsSimple "caption" <$> blocksToJATS opts longcapt + figbod <- blocksToJATS opts $ walk unsetAltIfDupl body let figattr = [("id", escapeNCName ident) | not (T.null ident)] ++ [(k,v) | (k,v) <- kvs , k `elem` [ "fig-type", "orientation" @@ -520,11 +525,17 @@ inlineToJATS opts (Link (ident,_,kvs) txt (src, tit)) = do contents <- inlinesToJATS opts txt return $ inTags False "ext-link" attr contents inlineToJATS _ (Image attr alt tgt) = do - return $ selfClosingTag "inline-graphic" (graphicAttr attr alt tgt) + let elattr = graphicAttr attr alt tgt + return $ case altToJATS alt of + Nothing -> selfClosingTag "inline-graphic" elattr + Just altTag -> inTags True "inline-graphic" elattr altTag graphic :: Attr -> [Inline] -> Target -> (Doc Text) graphic attr alt tgt = - selfClosingTag "graphic" (graphicAttr attr alt tgt) + let elattr = graphicAttr attr alt tgt + in case altToJATS alt of + Nothing -> selfClosingTag "graphic" elattr + Just altTag -> inTags True "graphic" elattr altTag graphicAttr :: Attr -> [Inline] -> Target -> [(Text, Text)] graphicAttr (ident, _, kvs) _alt (src, tit) = @@ -541,6 +552,13 @@ graphicAttr (ident, _, kvs) _alt (src, tit) = , "xlink:show", "xlink:type"] ] +altToJATS :: [Inline] -> Maybe (Doc Text) +altToJATS alt = + if null alt + then Nothing + else Just . inTagsSimple "alt-text" . + hsep . map literal . T.words $ stringify alt + imageMimeType :: Text -> [(Text, Text)] -> (Text, Text) imageMimeType src kvs = let mbMT = getMimeType (T.unpack src) diff --git a/test/Tests/Writers/JATS.hs b/test/Tests/Writers/JATS.hs index 8259c644e..8571ccd1d 100644 --- a/test/Tests/Writers/JATS.hs +++ b/test/Tests/Writers/JATS.hs @@ -134,7 +134,9 @@ tests = , "containing image" =: header 1 (image "imgs/foo.jpg" "" (text "Alt text")) =?> "\n\ - \ <inline-graphic mimetype=\"image\" mime-subtype=\"jpeg\" xlink:href=\"imgs/foo.jpg\" />\n\ + \ <inline-graphic mimetype=\"image\" mime-subtype=\"jpeg\" xlink:href=\"imgs/foo.jpg\">\n\ + \ <alt-text>Alt text</alt-text>\n\ + \ </inline-graphic>\n\ \" ] diff --git a/test/command/figures-jats.md b/test/command/figures-jats.md index a5089df2a..bc13bcb5b 100644 --- a/test/command/figures-jats.md +++ b/test/command/figures-jats.md @@ -12,3 +12,20 @@ Para [Image ("fig-id-2",[],[]) [] ("foo.png", "fig:")]]] ``` + +Figure float with caption and alt text. + +``` +% pandoc -f native -t jats +[Figure ("fig-id",[],[]) (Caption Nothing [Para [Str "Caption"]]) [Para [Str "Text"], +Para [Image ("fig-id-2",[],[]) [Str "alt"] ("foo.png", "fig:")]]] + +^D + +

Caption

+

Text

+ + alt + + +``` diff --git a/test/writer.jats_archiving b/test/writer.jats_archiving index d762c735a..31c619314 100644 --- a/test/writer.jats_archiving +++ b/test/writer.jats_archiving @@ -845,8 +845,9 @@ These should not be escaped: \$ \\ \> \[ \{

Here is a movie - - icon.

+ + movie + icon.

Footnotes diff --git a/test/writer.jats_articleauthoring b/test/writer.jats_articleauthoring index 74d24754f..3bdb5c0ed 100644 --- a/test/writer.jats_articleauthoring +++ b/test/writer.jats_articleauthoring @@ -830,8 +830,9 @@ These should not be escaped: \$ \\ \> \[ \{

Here is a movie - - icon.

+ + movie + icon.

 Footnotes diff --git a/test/writer.jats_publishing b/test/writer.jats_publishing index 5701e5db8..6d7c7d68d 100644 --- a/test/writer.jats_publishing +++ b/test/writer.jats_publishing @@ -845,8 +845,9 @@ These should not be escaped: \$ \\ \> \[ \{

Here is a movie - - icon.

+ + movie + icon.

 Footnotes