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.

1 files changed, 41 insertions, 7 deletions

diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index c9a7de642..dff4f8fcf 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -33,6 +33,7 @@ import Codec.Archive.Zip
 import Control.Monad.Except (catchError)
 import Control.Monad.State.Strict
 import qualified Data.ByteString.Lazy as B
+import Data.Generics (everywhere', mkT)
 import Data.List (isPrefixOf)
 import Data.Maybe (fromMaybe)
 import qualified Data.Text.Lazy as TL
@@ -46,13 +47,13 @@ import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)
 import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))
 import Text.Pandoc.Pretty
 import Text.Pandoc.Shared (stringify)
-import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy)
+import Text.Pandoc.UTF8 (fromStringLazy, fromTextLazy, toStringLazy)
 import Text.Pandoc.Walk
 import Text.Pandoc.Writers.OpenDocument (writeOpenDocument)
-import Text.Pandoc.Writers.Shared (fixDisplayMath)
+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang, splitLang)
 import Text.Pandoc.XML
 import Text.TeXMath
-import Text.XML.Light.Output
+import Text.XML.Light
 
 data ODTState = ODTState { stEntries :: [Entry]
                          }
@@ -78,6 +79,7 @@ pandocToODT :: PandocMonad m
 pandocToODT opts doc@(Pandoc meta _) = do
   let datadir = writerUserDataDir opts
   let title = docTitle meta
+  let lang = getLang opts meta
   refArchive <-
        case writerReferenceDoc opts of
              Just f -> liftM toArchive $ lift $ P.readFileLazy f
@@ -132,18 +134,50 @@ pandocToODT opts doc@(Pandoc meta _) = do
            ,("xmlns:ooo","http://openoffice.org/2004/office")
            ,("xmlns:grddl","http://www.w3.org/2003/g/data-view#")
            ,("office:version","1.2")]
-           $ ( inTagsSimple "office:meta"
-                $ ( inTagsSimple "dc:title" (text $ escapeStringForXML (stringify title))
-                  )
+           $ ( inTagsSimple "office:meta" $
+                 ( inTagsSimple "dc:title"
+                      (text $ escapeStringForXML (stringify title))
+                   $$
+                   case lang of
+                        Just l -> inTagsSimple "dc:language"
+                                    (text (escapeStringForXML l))
+                        Nothing -> empty
+                 )
              )
         )
   -- make sure mimetype is first
   let mimetypeEntry = toEntry "mimetype" epochtime
                       $ fromStringLazy "application/vnd.oasis.opendocument.text"
-  let archive'' = addEntryToArchive mimetypeEntry
+  archive'' <- updateStyleWithLang lang
+                  $ addEntryToArchive mimetypeEntry
                   $ addEntryToArchive metaEntry archive'
   return $ fromArchive archive''
 
+updateStyleWithLang :: PandocMonad m => Maybe String -> Archive -> O m Archive
+updateStyleWithLang Nothing arch = return arch
+updateStyleWithLang (Just l) arch = do
+  (mblang, mbcountry) <- splitLang l
+  epochtime <- floor `fmap` (lift P.getPOSIXTime)
+  return arch{ zEntries = [if eRelativePath e == "styles.xml"
+                              then case parseXMLDoc
+                                      (toStringLazy (fromEntry e)) of
+                                      Nothing -> e
+                                      Just d ->
+                                        toEntry "styles.xml" epochtime
+                                        ( fromStringLazy
+                                        . ppTopElement
+                                        . addLang mblang mbcountry $ d )
+                              else e
+                            | e <- zEntries arch] }
+
+addLang :: Maybe String -> Maybe String -> Element -> Element
+addLang mblang mbcountry = everywhere' (mkT updateLangAttr)
+    where updateLangAttr (Attr n@(QName "language" _ (Just "fo")) l)
+                           = Attr n (maybe l id mblang)
+          updateLangAttr (Attr n@(QName "country" _ (Just "fo")) c)
+                           = Attr n (maybe c id mbcountry)
+          updateLangAttr x = x
+
 -- | transform both Image and Math elements
 transformPicMath :: PandocMonad m => WriterOptions ->Inline -> O m Inline
 transformPicMath opts (Image attr@(id', cls, _) lab (src,t)) = catchError