083a224 · typeable/pandoc

git.iko.soy/typeable/pandoc

Support `lang` attribute in OpenDocument and ODT writers.

This adds the required attributes to the temporary styles, and also replaces existing language attributes in styles.xml. Support for lang attributes on Div and Span has also been added. Closes #1667.

commit083a224d1e3d791c459a998d18aa9975b8816c15 authorJohn MacFarlane <jgm@berkeley.edu> dateSun 25 Jun 2017, 10:38 (9 years ago) parenta02f08c

3 files changed+72−18

compare with master

unifiedsplit

src/Text/Pandoc/Writers/Docx.hs+2−5 src/Text/Pandoc/Writers/ODT.hs+41−7 src/Text/Pandoc/Writers/OpenDocument.hs+29−6

src/Text/Pandoc/Writers/Docx.hs+2−5

@@ -67,7 +67,7 @@ import Text.Pandoc.Shared hiding (Element)

6767import qualified Text.Pandoc.UTF8 as UTF8

6868import Text.Pandoc.Walk

6969import Text.Pandoc.Writers.Math

70−import Text.Pandoc.Writers.Shared (fixDisplayMath)

70+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang)

7171import Text.Printf (printf)

7272import Text.TeXMath

7373import Text.XML.Light as XML

@@ -257,10 +257,7 @@ writeDocx opts doc@(Pandoc meta _) = do

257257 )

258258

259259 -- styles

260− let lang = case lookupMeta "lang" meta of

261− Just (MetaInlines [Str s]) -> Just s

262− Just (MetaString s) -> Just s

263− _ -> Nothing

260+ let lang = getLang opts meta

264261 let addLang :: Element -> Element

265262 addLang e = case lang >>= \l -> (return . XMLC.toTree . go l . XMLC.fromElement) e of

266263 Just (Elem e') -> e'

src/Text/Pandoc/Writers/ODT.hs+41−7

@@ -33,6 +33,7 @@ import Codec.Archive.Zip

3333import Control.Monad.Except (catchError)

3434import Control.Monad.State.Strict

3535import qualified Data.ByteString.Lazy as B

36+import Data.Generics (everywhere', mkT)

3637import Data.List (isPrefixOf)

3738import Data.Maybe (fromMaybe)

3839import qualified Data.Text.Lazy as TL

@@ -46,13 +47,13 @@ import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)

4647import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))

4748import Text.Pandoc.Pretty

4849import Text.Pandoc.Shared (stringify)

49−import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy)

50+import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy)

5051import Text.Pandoc.Walk

5152import Text.Pandoc.Writers.OpenDocument (writeOpenDocument)

52−import Text.Pandoc.Writers.Shared (fixDisplayMath)

53+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, splitLang)

5354import Text.Pandoc.XML

5455import Text.TeXMath

55−import Text.XML.Light.Output

56+import Text.XML.Light

5657

5758data ODTState = ODTState { stEntries :: [Entry]

5859 }

@@ -78,6 +79,7 @@ pandocToODT :: PandocMonad m

7879pandocToODT opts doc@(Pandoc meta _) = do

7980 let datadir = writerUserDataDir opts

8081 let title = docTitle meta

82+ let lang = getLang opts meta

8183 refArchive <-

8284 case writerReferenceDoc opts of

8385 Just f -> liftM toArchive $ lift $ P.readFileLazy f

@@ -132,18 +134,50 @@ pandocToODT opts doc@(Pandoc meta _) = do

132134 ,("xmlns:ooo","http://openoffice.org/2004/office")

133135 ,("xmlns:grddl","http://www.w3.org/2003/g/data-view#")

134136 ,("office:version","1.2")]

135− $ ( inTagsSimple "office:meta"

136− $ ( inTagsSimple "dc:title" (text $ escapeStringForXML (stringify title))

137− )

137+ $ ( inTagsSimple "office:meta" $

138+ ( inTagsSimple "dc:title"

139+ (text $ escapeStringForXML (stringify title))

140+ $$

141+ case lang of

142+ Just l -> inTagsSimple "dc:language"

143+ (text (escapeStringForXML l))

144+ Nothing -> empty

145+ )

138146 )

139147 )

140148 -- make sure mimetype is first

141149 let mimetypeEntry = toEntry "mimetype" epochtime

142150 $ fromStringLazy "application/vnd.oasis.opendocument.text"

143− let archive'' = addEntryToArchive mimetypeEntry

151+ archive'' <- updateStyleWithLang lang

152+ $ addEntryToArchive mimetypeEntry

144153 $ addEntryToArchive metaEntry archive'

145154 return $ fromArchive archive''

146155

156+updateStyleWithLang :: PandocMonad m => Maybe String -> Archive -> O m Archive

157+updateStyleWithLang Nothing arch = return arch

158+updateStyleWithLang (Just l) arch = do

159+ (mblang, mbcountry) <- splitLang l

160+ epochtime <- floor `fmap` (lift P.getPOSIXTime)

161+ return arch{ zEntries = [if eRelativePath e == "styles.xml"

162+ then case parseXMLDoc

163+ (toStringLazy (fromEntry e)) of

164+ Nothing -> e

165+ Just d ->

166+ toEntry "styles.xml" epochtime

167+ ( fromStringLazy

168+ . ppTopElement

169+ . addLang mblang mbcountry $ d )

170+ else e

171+ | e <- zEntries arch] }

172+

173+addLang :: Maybe String -> Maybe String -> Element -> Element

174+addLang mblang mbcountry = everywhere' (mkT updateLangAttr)

175+ where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) l)

176+ = Attr n (maybe l id mblang)

177+ updateLangAttr (Attr n@(QName "country" _ (Just "fo")) c)

178+ = Attr n (maybe c id mbcountry)

179+ updateLangAttr x = x

180+

147181-- | transform both Image and Math elements

148182transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline

149183transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError

src/Text/Pandoc/Writers/OpenDocument.hs+29−6

@@ -45,7 +45,7 @@ import Text.Pandoc.Definition

4545import Text.Pandoc.Logging

4646import Text.Pandoc.Options

4747import Text.Pandoc.Pretty

48−import Text.Pandoc.Shared (linesToPara)

48+import Text.Pandoc.Shared (linesToPara, splitBy)

4949import Text.Pandoc.Templates (renderTemplate')

5050import Text.Pandoc.Writers.Math

5151import Text.Pandoc.Writers.Shared

@@ -75,6 +75,8 @@ data WriterState =

7575 , stTight :: Bool

7676 , stFirstPara :: Bool

7777 , stImageId :: Int

78+ , stLang :: Maybe String

79+ , stCountry :: Maybe String

7880 }

7981

8082defaultWriterState :: WriterState

@@ -90,6 +92,8 @@ defaultWriterState =

9092 , stTight = False

9193 , stFirstPara = False

9294 , stImageId = 1

95+ , stLang = Nothing

96+ , stCountry = Nothing

9397 }

9498

9599when :: Bool -> Doc -> Doc

@@ -155,6 +159,10 @@ withTextStyle s f = do

155159inTextStyle :: PandocMonad m => Doc -> OD m Doc

156160inTextStyle d = do

157161 at <- gets stTextStyleAttr

162+ mblang <- gets stLang

163+ mbcountry <- gets stCountry

164+ let langat = maybe [] (\la -> [("fo:language", la)]) mblang

165+ let countryat = maybe [] (\co -> [("fo:country", co)]) mbcountry

158166 if Set.null at

159167 then return d

160168 else do

@@ -168,8 +176,9 @@ inTextStyle d = do

168176 inTags False "style:style"

169177 [("style:name", styleName)

170178 ,("style:family", "text")]

171− $ selfClosingTag "style:text-properties"

172− (concatMap textStyleAttr (Set.toList at)))

179+ $ selfClosingTag "style:text-properties"

180+ (langat ++ countryat ++

181+ concatMap textStyleAttr (Set.toList at)))

173182 return $ inTags False

174183 "text:span" [("text:style-name",styleName)] d

175184

@@ -203,8 +212,10 @@ writeOpenDocument opts (Pandoc meta blocks) = do

203212 else Nothing

204213 let render' :: Doc -> Text

205214 render' = render colwidth

215+ let lang = getLang opts meta

216+ (mblang, mbcountry) <- maybe (return (Nothing, Nothing)) splitLang lang

206217 ((body, metadata),s) <- flip runStateT

207− defaultWriterState $ do

218+ defaultWriterState{ stLang = mblang, stCountry = mbcountry } $ do

208219 m <- metaToJSON opts

209220 (fmap render' . blocksToOpenDocument opts)

210221 (fmap render' . inlinesToOpenDocument opts)

@@ -326,7 +337,8 @@ blockToOpenDocument o bs

326337 then return empty

327338 else inParagraphTags =<< inlinesToOpenDocument o b

328339 | LineBlock b <- bs = blockToOpenDocument o $ linesToPara b

329− | Div _ xs <- bs = blocksToOpenDocument o xs

340+ | Div attr xs <- bs = withLangFromAttr attr

341+ (blocksToOpenDocument o xs)

330342 | Header i _ b <- bs = setFirstPara >>

331343 (inHeaderTags i =<< inlinesToOpenDocument o b)

332344 | BlockQuote b <- bs = setFirstPara >> mkBlockQuote b

@@ -444,7 +456,7 @@ inlineToOpenDocument o ils

444456 | writerWrapText o == WrapPreserve

445457 -> return $ preformatted "\n"

446458 | otherwise -> return $ space

447− Span _ xs -> inlinesToOpenDocument o xs

459+ Span attr xs -> withLangFromAttr attr (inlinesToOpenDocument o xs)

448460 LineBreak -> return $ selfClosingTag "text:line-break" []

449461 Str s -> return $ handleSpaces $ escapeStringForXML s

450462 Emph l -> withTextStyle Italic $ inlinesToOpenDocument o l

@@ -625,3 +637,14 @@ textStyleAttr s

625637 ,("style:font-name-asian" ,"Courier New")

626638 ,("style:font-name-complex" ,"Courier New")]

627639 | otherwise = []

640+

641+withLangFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a

642+withLangFromAttr (_,_,kvs) action = do

643+ oldlang <- gets stLang

644+ case lookup "lang" kvs of

645+ Nothing -> action

646+ Just l -> do

647+ modify (\st -> st{ stLang = Just l})

648+ result <- action

649+ modify (\st -> st{ stLang = oldlang})

650+ return result