JATS writer: use either styled-content or named-content for spans.

If the element has a content-type attribute, or at least one class, then
that value is used as `content-type` and the span is put inside a
`<named-content>` element. Otherwise a `<styled-content>` element is
used instead.

Closes: #7211
This commit is contained in:
Albert Krewinkel 2021-04-28 12:46:52 +02:00
parent 0921b82d98
commit 85f379e474
No known key found for this signature in database
GPG key ID: 388DC0B21F631124
2 changed files with 35 additions and 15 deletions

View file

@ -21,12 +21,13 @@ module Text.Pandoc.Writers.JATS
, writeJatsPublishing
, writeJatsArticleAuthoring
) where
import Control.Applicative ((<|>))
import Control.Monad.Reader
import Control.Monad.State
import Data.Generics (everywhere, mkT)
import Data.List (partition)
import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, listToMaybe)
import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
import qualified Data.Text as T
import Data.Text (Text)
@ -449,18 +450,33 @@ inlineToJATS opts (Note contents) = do
$ text (show notenum)
inlineToJATS opts (Cite _ lst) =
inlinesToJATS opts lst
inlineToJATS opts (Span (ident,_,kvs) ils) = do
inlineToJATS opts (Span (ident,classes,kvs) ils) = do
contents <- inlinesToJATS opts ils
let attr = [("id", escapeNCName ident) | not (T.null ident)] ++
[("xml:lang",l) | ("lang",l) <- kvs] ++
[(k,v) | (k,v) <- kvs
, k `elem` ["alt", "content-type", "rid", "specific-use",
"vocab", "vocab-identifier", "vocab-term",
"vocab-term-identifier"]]
let commonAttr = [("id", escapeNCName ident) | not (T.null ident)] ++
[("xml:lang",l) | ("lang",l) <- kvs] ++
[(k,v) | (k,v) <- kvs, k `elem` ["alt", "specific-use"]]
-- A named-content element is a good fit for spans, but requires a
-- content-type attribute to be present. We use either the explicit
-- attribute or the first class as content type. If neither is
-- available, then we fall back to using a @styled-content@ element.
let (tag, specificAttr) =
case lookup "content-type" kvs <|> listToMaybe classes of
Just ct -> ( "named-content"
, ("content-type", ct) :
[(k, v) | (k, v) <- kvs
, k `elem` ["rid", "vocab", "vocab-identifier",
"vocab-term", "vocab-term-identifier"]])
-- Fall back to styled-content
Nothing -> ("styled-content"
, [(k, v) | (k,v) <- kvs
, k `elem` ["style", "style-type", "style-detail",
"toggle"]])
let attr = commonAttr ++ specificAttr
-- unwrap if wrapping element would have no attributes
return $
if null attr
then contents -- unwrap if no relevant attributes are given
else inTags False "named-content" attr contents
then contents
else inTags False tag attr contents
inlineToJATS _ (Math t str) = do
let addPref (Xml.Attr q v)
| Xml.qName q == "xmlns" = Xml.Attr q{ Xml.qName = "xmlns:mml" } v

View file

@ -148,13 +148,17 @@ tests =
spanWith nullAttr "text in span" =?>
"<p>text in span</p>"
, "converted to named-content element" =:
spanWith ("a", ["ignored"], [("alt", "aa")]) "text" =?>
"<p><named-content id=\"a\" alt=\"aa\">text</named-content></p>"
, "converted to named-content element if class given" =:
spanWith ("a", ["genus-species"], [("alt", "aa")]) "C. elegans" =?>
("<p><named-content id=\"a\" alt=\"aa\" content-type=\"genus-species\">"
<> "C. elegans</named-content></p>")
, "unwrapped if named-content element would have no attributes" =:
spanWith ("", ["ignored"], [("hidden", "true")]) "text in span" =?>
, "unwrapped if styled-content element would have no attributes" =:
spanWith ("", [], [("hidden", "true")]) "text in span" =?>
"<p>text in span</p>"
, "use content-type attribute if present" =:
spanWith ("", [], [("content-type", "species")]) "E. coli" =?>
"<p><named-content content-type=\"species\">E. coli</named-content></p>"
]
]