@@ -54,6 +54,8 @@ import Text.Pandoc.Walk
5454import Text.Highlighting.Kate.Types ()
5555import Text.XML.Light as XML
5656import Text.TeXMath
57+import Text.Pandoc.Readers.Docx.StyleMap
58+import Text.Pandoc.Readers.Docx.Util (elemName)
5759import Control.Monad.State
5860import Text.Highlighting.Kate
5961import Data.Unique (hashUnique, newUnique)
@@ -64,7 +66,6 @@ import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
6466 extensionFromMimeType)
6567import Control.Applicative ((<$>), (<|>), (<*>))
6668import Data.Maybe (fromMaybe, mapMaybe, maybeToList)
67−import Data.Char (toLower)
6869
6970data ListMarker = NoMarker
7071 | BulletMarker
@@ -90,9 +91,6 @@ listMarkerToId (NumberMarker sty delim n) =
9091 OneParen -> '2'
9192 TwoParens -> '3'
9293
93−newtype ParaStyleMap = ParaStyleMap (M.Map String String) deriving Show
94−newtype CharStyleMap = CharStyleMap (M.Map String String) deriving Show
95−
9694data WriterState = WriterState{
9795 stTextProperties :: [Element]
9896 , stParaProperties :: [Element]
@@ -109,8 +107,7 @@ data WriterState = WriterState{
109107 , stChangesAuthor :: String
110108 , stChangesDate :: String
111109 , stPrintWidth :: Integer
112− , stParaStyles :: ParaStyleMap
113− , stCharStyles :: CharStyleMap
110+ , stStyleMaps :: StyleMaps
114111 , stFirstPara :: Bool
115112 }
116113
@@ -131,8 +128,7 @@ defaultWriterState = WriterState{
131128 , stChangesAuthor = "unknown"
132129 , stChangesDate = "1969-12-31T19:00:00Z"
133130 , stPrintWidth = 1
134− , stParaStyles = ParaStyleMap M.empty
135− , stCharStyles = CharStyleMap M.empty
131+ , stStyleMaps = defaultStyleMaps
136132 , stFirstPara = False
137133 }
138134
@@ -220,28 +216,14 @@ writeDocx opts doc@(Pandoc meta _) = do
220216 styledoc <- parseXml refArchive distArchive stylepath
221217
222218 -- parse styledoc for heading styles
223− let styleNamespaces = map ((,) <$> qName . attrKey <*> attrVal) .
224− filter ((==Just "xmlns") . qPrefix . attrKey) .
225− elAttribs $ styledoc
226− mywURI = lookup "w" styleNamespaces
227− myName name = QName name mywURI (Just "w")
228− getAttrStyleId = findAttr (myName "styleId")
229− getAttrType = findAttr (myName "type")
230− isParaStyle = (Just "paragraph" ==) . getAttrType
231− isCharStyle = (Just "character" ==) . getAttrType
232− getNameVal = findChild (myName "name") >=> findAttr (myName "val") >=> return . map toLower
233− genStyleItem f e | f e = liftM2 (,) <$> getNameVal <*> getAttrStyleId $ e
234− | otherwise = Nothing
235− genStyleMap f = M.fromList $ mapMaybe (genStyleItem f) $ findChildren (myName "style") styledoc
236− paraStyles = ParaStyleMap $ genStyleMap isParaStyle
237− charStyles = CharStyleMap $ genStyleMap isCharStyle
219+ let styleMaps = getStyleMaps styledoc
238220
239221 ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc')
240222 defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username
241223 , stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime
242224 , stPrintWidth = (maybe 420 (\x -> quot x 20) pgContentWidth)
243− , stParaStyles = paraStyles
244− , stCharStyles = charStyles}
225+ , stStyleMaps = styleMaps
226+ }
245227 let epochtime = floor $ utcTimeToPOSIXSeconds utctime
246228 let imgs = M.elems $ stImages st
247229
@@ -394,7 +376,7 @@ writeDocx opts doc@(Pandoc meta _) = do
394376 linkrels
395377
396378 -- styles
397− let newstyles = styleToOpenXml charStyles paraStyles $ writerHighlightStyle opts
379+ let newstyles = styleToOpenXml styleMaps $ writerHighlightStyle opts
398380 let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) }
399381 where
400382 modifyContent
@@ -402,9 +384,10 @@ writeDocx opts doc@(Pandoc meta _) = do
402384 | otherwise = filter notTokStyle
403385 notTokStyle (Elem el) = notStyle el || notTokId el
404386 notTokStyle _ = True
405− notStyle = (/= myName "style") . elName
406− notTokId = maybe True (`notElem` tokStys) . getAttrStyleId
387+ notStyle = (/= elemName' "style") . elName
388+ notTokId = maybe True (`notElem` tokStys) . findAttr (elemName' "styleId")
407389 tokStys = "SourceCode" : map show (enumFromTo KeywordTok NormalTok)
390+ elemName' = elemName (sNameSpaces styleMaps) "w"
408391 let styleEntry = toEntry stylepath epochtime $ renderXml styledoc'
409392
410393 -- construct word/numbering.xml
@@ -481,12 +464,11 @@ writeDocx opts doc@(Pandoc meta _) = do
481464 miscRelEntries ++ otherMediaEntries
482465 return $ fromArchive archive
483466
484−styleToOpenXml :: CharStyleMap -> ParaStyleMap -> Style -> [Element]
485−styleToOpenXml (CharStyleMap csm) (ParaStyleMap psm) style =
467+styleToOpenXml :: StyleMaps -> Style -> [Element]
468+styleToOpenXml sm style =
486469 maybeToList parStyle ++ mapMaybe toStyle alltoktypes
487470 where alltoktypes = enumFromTo KeywordTok NormalTok
488− styleExists m styleName = M.member (map toLower styleName) m
489− toStyle toktype | styleExists csm $ show toktype = Nothing
471+ toStyle toktype | hasStyleName (show toktype) (sCharStyleMap sm) = Nothing
490472 | otherwise = Just $
491473 mknode "w:style" [("w:type","character"),
492474 ("w:customStyle","1"),("w:styleId",show toktype)]
@@ -509,7 +491,7 @@ styleToOpenXml (CharStyleMap csm) (ParaStyleMap psm) style =
509491 tokBg toktype = maybe "auto" (drop 1 . fromColor)
510492 $ (tokenBackground =<< lookup toktype tokStyles)
511493 `mplus` backgroundColor style
512− parStyle | styleExists psm "Source Code" = Nothing
494+ parStyle | hasStyleName "Source Code" (sParaStyleMap sm) = Nothing
513495 | otherwise = Just $
514496 mknode "w:style" [("w:type","paragraph"),
515497 ("w:customStyle","1"),("w:styleId","SourceCode")]
@@ -638,30 +620,27 @@ writeOpenXML opts (Pandoc meta blocks) = do
638620blocksToOpenXML :: WriterOptions -> [Block] -> WS [Element]
639621blocksToOpenXML opts bls = concat `fmap` mapM (blockToOpenXML opts) bls
640622
641−getStyleId :: String -> M.Map String String -> String
642−getStyleId s = M.findWithDefault (filter (/=' ') s) (map toLower s)
643−
644−pStyle :: String -> ParaStyleMap -> Element
645−pStyle sty (ParaStyleMap m) = mknode "w:pStyle" [("w:val",sty')] ()
623+pStyle :: String -> StyleMaps -> Element
624+pStyle sty m = mknode "w:pStyle" [("w:val",sty')] ()
646625 where
647− sty' = getStyleId sty m
626+ sty' = getStyleId sty $ sParaStyleMap m
648627
649628pCustomStyle :: String -> Element
650629pCustomStyle sty = mknode "w:pStyle" [("w:val",sty)] ()
651630
652631pStyleM :: String -> WS XML.Element
653−pStyleM = flip fmap (gets stParaStyles) . pStyle
632+pStyleM = (`fmap` gets stStyleMaps) . pStyle
654633
655−rStyle :: String -> CharStyleMap -> Element
656−rStyle sty (CharStyleMap m) = mknode "w:rStyle" [("w:val",sty')] ()
634+rStyle :: String -> StyleMaps -> Element
635+rStyle sty m = mknode "w:rStyle" [("w:val",sty')] ()
657636 where
658− sty' = getStyleId sty m
637+ sty' = getStyleId sty $ sCharStyleMap m
659638
660639rCustomStyle :: String -> Element
661640rCustomStyle sty = mknode "w:rStyle" [("w:val",sty)] ()
662641
663642rStyleM :: String -> WS XML.Element
664−rStyleM = flip fmap (gets stCharStyles) . rStyle
643+rStyleM = (`fmap` gets stStyleMaps) . rStyle
665644
666645getUniqueId :: MonadIO m => m String
667646-- the + 20 is to ensure that there are no clashes with the rIds
@@ -710,10 +689,10 @@ blockToOpenXML opts (Para lst) = do
710689 paraProps <- getParaProps $ case lst of
711690 [Math DisplayMath _] -> True
712691 _ -> False
713− pSM <- gets stParaStyles
692+ sm <- gets stStyleMaps
714693 let paraProps' = case paraProps of
715694 [] | isFirstPara -> [mknode "w:pPr" [] [pCustomStyle "FirstParagraph"]]
716− [] -> [mknode "w:pPr" [] [pStyle "Body Text" pSM]]
695+ [] -> [mknode "w:pPr" [] [pStyle "Body Text" sm]]
717696 ps -> ps
718697 modify $ \s -> s { stFirstPara = False }
719698 contents <- inlinesToOpenXML opts lst