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.

src/Text/Pandoc/Writers/Docx.hs

@@ -67,7 +67,7 @@ import Text.Pandoc.Shared hiding (Element)
 import qualified Text.Pandoc.UTF8 as UTF8
 import Text.Pandoc.Walk
 import Text.Pandoc.Writers.Math
-import Text.Pandoc.Writers.Shared (fixDisplayMath)
+import Text.Pandoc.Writers.Shared (fixDisplayMath, getLang)
 import Text.Printf (printf)
 import Text.TeXMath
 import Text.XML.Light as XML
@@ -257,10 +257,7 @@ writeDocx opts doc@(Pandoc meta _) = do
                        )
 
   -- styles
-  let lang = case lookupMeta "lang" meta of
+  let lang = getLang opts meta
-               Just (MetaInlines [Str s]) -> Just s
-               Just (MetaString s)        -> Just s
-               _                          -> Nothing
   let addLang :: Element -> Element
       addLang e = case lang >>= \l -> (return . XMLC.toTree . go l . XMLC.fromElement) e of
                     Just (Elem e') -> e'

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 "office:meta" $
-                $ ( inTagsSimple "dc:title" (text $ escapeStringForXML (stringify title))
+                 ( 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

src/Text/Pandoc/Writers/OpenDocument.hs

@@ -45,7 +45,7 @@ import Text.Pandoc.Definition
 import Text.Pandoc.Logging
 import Text.Pandoc.Options
 import Text.Pandoc.Pretty
-import Text.Pandoc.Shared (linesToPara)
+import Text.Pandoc.Shared (linesToPara, splitBy)
 import Text.Pandoc.Templates (renderTemplate')
 import Text.Pandoc.Writers.Math
 import Text.Pandoc.Writers.Shared
@@ -75,6 +75,8 @@ data WriterState =
                 , stTight         :: Bool
                 , stFirstPara     :: Bool
                 , stImageId       :: Int
+                , stLang          :: Maybe String
+                , stCountry       :: Maybe String
                 }
 
 defaultWriterState :: WriterState
@@ -90,6 +92,8 @@ defaultWriterState =
                 , stTight         = False
                 , stFirstPara     = False
                 , stImageId       = 1
+                , stLang          = Nothing
+                , stCountry       = Nothing
                 }
 
 when :: Bool -> Doc -> Doc
@@ -155,6 +159,10 @@ withTextStyle s f = do
 inTextStyle :: PandocMonad m => Doc -> OD m Doc
 inTextStyle d = do
   at <- gets stTextStyleAttr
+  mblang <- gets stLang
+  mbcountry <- gets stCountry
+  let langat = maybe [] (\la -> [("fo:language", la)]) mblang
+  let countryat = maybe [] (\co -> [("fo:country", co)]) mbcountry
   if Set.null at
      then return d
      else do
@@ -168,8 +176,9 @@ inTextStyle d = do
                      inTags False "style:style"
                        [("style:name", styleName)
                        ,("style:family", "text")]
-                    $ selfClosingTag "style:text-properties"
+                       $ selfClosingTag "style:text-properties"
-                       (concatMap textStyleAttr (Set.toList at)))
+                          (langat ++ countryat ++
+                           concatMap textStyleAttr (Set.toList at)))
               return $ inTags False
                   "text:span" [("text:style-name",styleName)] d
 
@@ -203,8 +212,10 @@ writeOpenDocument opts (Pandoc meta blocks) = do
                     else Nothing
   let render' :: Doc -> Text
       render' = render colwidth
+  let lang = getLang opts meta
+  (mblang, mbcountry) <- maybe (return (Nothing, Nothing)) splitLang lang
   ((body, metadata),s) <- flip runStateT
-        defaultWriterState $ do
+        defaultWriterState{ stLang = mblang, stCountry = mbcountry } $ do
            m <- metaToJSON opts
                   (fmap render' . blocksToOpenDocument opts)
                   (fmap render' . inlinesToOpenDocument opts)
@@ -326,7 +337,8 @@ blockToOpenDocument o bs
                                   then return empty
                                   else inParagraphTags =<< inlinesToOpenDocument o b
     | LineBlock      b <- bs = blockToOpenDocument o $ linesToPara b
-    | Div _ xs         <- bs = blocksToOpenDocument o xs
+    | Div attr xs      <- bs = withLangFromAttr attr
+                                  (blocksToOpenDocument o xs)
     | Header     i _ b <- bs = setFirstPara >>
                                (inHeaderTags  i =<< inlinesToOpenDocument o b)
     | BlockQuote     b <- bs = setFirstPara >> mkBlockQuote b
@@ -444,7 +456,7 @@ inlineToOpenDocument o ils
      | writerWrapText o == WrapPreserve
                   -> return $ preformatted "\n"
      | otherwise  -> return $ space
-    Span _ xs     -> inlinesToOpenDocument o xs
+    Span attr xs  -> withLangFromAttr attr (inlinesToOpenDocument o xs)
     LineBreak     -> return $ selfClosingTag "text:line-break" []
     Str         s -> return $ handleSpaces $ escapeStringForXML s
     Emph        l -> withTextStyle Italic $ inlinesToOpenDocument o l
@@ -625,3 +637,14 @@ textStyleAttr s
                     ,("style:font-name-asian"        ,"Courier New")
                     ,("style:font-name-complex"      ,"Courier New")]
     | otherwise   = []
+
+withLangFromAttr :: PandocMonad m => Attr -> OD m a -> OD m a
+withLangFromAttr (_,_,kvs) action = do
+  oldlang <- gets stLang
+  case lookup "lang" kvs of
+       Nothing -> action
+       Just l  -> do
+         modify (\st -> st{ stLang = Just l})
+         result <- action
+         modify (\st -> st{ stLang = oldlang})
+         return result