@@ -21,12 +21,13 @@ module Text.Pandoc.Writers.JATS
21 , writeJatsPublishing
21 , writeJatsPublishing
22 , writeJatsArticleAuthoring
22 , writeJatsArticleAuthoring
24+import Control.Applicative ((<|>))
24import Control.Monad.Reader
25import Control.Monad.Reader
25import Control.Monad.State
26import Control.Monad.State
26import Data.Generics (everywhere, mkT)
27import Data.Generics (everywhere, mkT)
27import Data.List (partition)
28import Data.List (partition)
28import qualified Data.Map as M
29import qualified Data.Map as M
29−import Data.Maybe (fromMaybe)
30+import Data.Maybe (fromMaybe, listToMaybe)
30import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
31import Data.Time (toGregorian, Day, parseTimeM, defaultTimeLocale, formatTime)
31import qualified Data.Text as T
32import qualified Data.Text as T
32import Data.Text (Text)
33import Data.Text (Text)
@@ -449,18 +450,33 @@ inlineToJATS opts (Note contents) = do
449 $ text (show notenum)
450 $ text (show notenum)
450inlineToJATS opts (Cite _ lst) =
451inlineToJATS opts (Cite _ lst) =
451 inlinesToJATS opts lst
452 inlinesToJATS opts lst
452−inlineToJATS opts (Span (ident,_,kvs) ils) = do
453+inlineToJATS opts (Span (ident,classes,kvs) ils) = do
453 contents <- inlinesToJATS opts ils
454 contents <- inlinesToJATS opts ils
454− let attr = [("id", escapeNCName ident) | not (T.null ident)] ++
455+ let commonAttr = [("id", escapeNCName ident) | not (T.null ident)] ++
455− [("xml:lang",l) | ("lang",l) <- kvs] ++
456+ [("xml:lang",l) | ("lang",l) <- kvs] ++
456− [(k,v) | (k,v) <- kvs
457+ [(k,v) | (k,v) <- kvs, k `elem` ["alt", "specific-use"]]
458+ -- A named-content element is a good fit for spans, but requires a
459+ -- content-type attribute to be present. We use either the explicit
460+ -- attribute or the first class as content type. If neither is
461+ -- available, then we fall back to using a @styled-content@ element.
462+ let (tag, specificAttr) =
463+ case lookup "content-type" kvs <|> listToMaybe classes of
464+ Just ct -> ( "named-content"
457− , k `elem` ["alt", "content-type", "rid", "specific-use",
465+ , ("content-type", ct) :
466+ [(k, v) | (k, v) <- kvs
467+ , k `elem` ["rid", "vocab", "vocab-identifier",
458− "vocab", "vocab-identifier", "vocab-term",
468+ "vocab-term", "vocab-term-identifier"]])
459− "vocab-term-identifier"]]
469+ -- Fall back to styled-content
470+ Nothing -> ("styled-content"
471+ , [(k, v) | (k,v) <- kvs
472+ , k `elem` ["style", "style-type", "style-detail",
474+ let attr = commonAttr ++ specificAttr
475+ -- unwrap if wrapping element would have no attributes
461 if null attr
477 if null attr
462− then contents -- unwrap if no relevant attributes are given
478+ then contents
463− else inTags False "named-content" attr contents
479+ else inTags False tag attr contents
464inlineToJATS _ (Math t str) = do
480inlineToJATS _ (Math t str) = do
465 let addPref (Xml.Attr q v)
481 let addPref (Xml.Attr q v)
466 | Xml.qName q == "xmlns" = Xml.Attr q{ Xml.qName = "xmlns:mml" } v
482 | Xml.qName q == "xmlns" = Xml.Attr q{ Xml.qName = "xmlns:mml" } v