aboutsummaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs7
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs48
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs35
3 files changed, 72 insertions, 18 deletions
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index b488f2479..d93b99486 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/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
- Just (MetaInlines [Str s]) -> Just s
- Just (MetaString s) -> Just s
- _ -> Nothing
+ let lang = getLang opts meta
let addLang :: Element -> Element
addLang e = case lang >>= \l -> (return . XMLC.toTree . go l . XMLC.fromElement) e of
Just (Elem e') -> e'
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
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 95a800c94..a4c9e0ef2 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/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"
- (concatMap textStyleAttr (Set.toList at)))
+ $ selfClosingTag "style:text-properties"
+ (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
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-30 09:07:14 +0000