@@ -1,4 +1,4 @@
1−{-# LANGUAGE PatternGuards #-}
1+{-# LANGUAGE PatternGuards, ViewPatterns #-}
4Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
4Copyright (C) 2014 Jesse Rosenthal <jrosenthal@jhu.edu>
@@ -59,18 +59,19 @@ import Data.Bits ((.|.))
59import qualified Data.ByteString.Lazy as B
59import qualified Data.ByteString.Lazy as B
60import qualified Text.Pandoc.UTF8 as UTF8
60import qualified Text.Pandoc.UTF8 as UTF8
61import Control.Monad.Reader
61import Control.Monad.Reader
62−import Control.Applicative ((<$>))
62+import Control.Applicative ((<$>), (<|>))
63import qualified Data.Map as M
63import qualified Data.Map as M
64import Text.Pandoc.Compat.Except
64import Text.Pandoc.Compat.Except
65import Text.TeXMath.Readers.OMML (readOMML)
65import Text.TeXMath.Readers.OMML (readOMML)
66import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..))
66import Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..))
67import Text.TeXMath (Exp)
67import Text.TeXMath (Exp)
68−import Data.Char (readLitChar)
68+import Data.Char (readLitChar, ord, chr)
70data ReaderEnv = ReaderEnv { envNotes :: Notes
70data ReaderEnv = ReaderEnv { envNotes :: Notes
71 , envNumbering :: Numbering
71 , envNumbering :: Numbering
72 , envRelationships :: [Relationship]
72 , envRelationships :: [Relationship]
73 , envMedia :: Media
73 , envMedia :: Media
74+ , envFont :: Maybe Font
75 deriving Show
76 deriving Show
@@ -234,7 +235,7 @@ archiveToDocx archive = do
234 numbering = archiveToNumbering archive
235 numbering = archiveToNumbering archive
235 rels = archiveToRelationships archive
236 rels = archiveToRelationships archive
236 media = archiveToMedia archive
237 media = archiveToMedia archive
237− rEnv = ReaderEnv notes numbering rels media
238+ rEnv = ReaderEnv notes numbering rels media Nothing
238 doc <- runD (archiveToDocument archive) rEnv
239 doc <- runD (archiveToDocument archive) rEnv
239 return $ Docx doc
240 return $ Docx doc
@@ -672,12 +673,21 @@ elemToRunElem :: NameSpaces -> Element -> D RunElem
672elemToRunElem ns element
673elemToRunElem ns element
673 | isElem ns "w" "t" element
674 | isElem ns "w" "t" element
674 || isElem ns "w" "delText" element
675 || isElem ns "w" "delText" element
675− || isElem ns "m" "t" element =
676+ || isElem ns "m" "t" element = do
676− return $ TextRun $ strContent element
677+ let str = strContent element
678+ font <- asks envFont
680+ Nothing -> return $ TextRun str
681+ Just f -> return . TextRun $
682+ map (\x -> fromMaybe x . getUnicode f . lowerFromPrivate $ x) str
677 | isElem ns "w" "br" element = return LnBrk
683 | isElem ns "w" "br" element = return LnBrk
678 | isElem ns "w" "tab" element = return Tab
684 | isElem ns "w" "tab" element = return Tab
679 | isElem ns "w" "sym" element = return (getSymChar ns element)
685 | isElem ns "w" "sym" element = return (getSymChar ns element)
680 | otherwise = throwError WrongElem
686 | otherwise = throwError WrongElem
688+ lowerFromPrivate (ord -> c)
689+ | c >= ord '\xF000' = chr $ c - ord '\xF000'
682-- The char attribute is a hex string
692-- The char attribute is a hex string
683getSymChar :: NameSpaces -> Element -> RunElem
693getSymChar :: NameSpaces -> Element -> RunElem
@@ -700,6 +710,15 @@ stringToFont _ = Nothing
700elemToRunElems :: NameSpaces -> Element -> D [RunElem]
710elemToRunElems :: NameSpaces -> Element -> D [RunElem]
701elemToRunElems ns element
711elemToRunElems ns element
702 | isElem ns "w" "r" element
712 | isElem ns "w" "r" element
703− || isElem ns "m" "r" element =
713+ || isElem ns "m" "r" element = do
714+ let qualName = elemName ns "w"
716+ fontElem <- findElement (qualName "rFonts") element
718+ (foldr (<|>) Nothing $
719+ map (flip findAttr fontElem . qualName) ["ascii", "hAnsi"])
704− mapD (elemToRunElem ns) (elChildren element)
720+ local (setFont font) (mapD (elemToRunElem ns) (elChildren element))
705elemToRunElems _ _ = throwError WrongElem
721elemToRunElems _ _ = throwError WrongElem
723+setFont :: Maybe Font -> ReaderEnv -> ReaderEnv
724+setFont f s = s{envFont = f}