git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #1518 from jkr/fontsmore
270e9a2John MacFarlane
src/Text/Pandoc/Readers/Docx/Fonts.hs+1
compare with master
unifiedsplit
@@ -32,6 +32,7 @@ module Text.Pandoc.Readers.Docx.Fonts (getUnicode, Font(..)) where
32
32
33-- | Enumeration of recognised fonts
33-- | Enumeration of recognised fonts
34data Font = Symbol -- ^ <http://en.wikipedia.org/wiki/Symbol_(typeface) Adobe Symbol>
34data Font = Symbol -- ^ <http://en.wikipedia.org/wiki/Symbol_(typeface) Adobe Symbol>
35+ deriving (Show, Eq)
35
36
36-- | Given a font and codepoint, returns the corresponding unicode
37-- | Given a font and codepoint, returns the corresponding unicode
37-- character
38-- character
src/Text/Pandoc/Readers/Docx/Parse.hs+27−8
@@ -1,4 +1,4 @@
1−{-# LANGUAGE PatternGuards #-}
1+{-# LANGUAGE PatternGuards, ViewPatterns #-}
2
2
3{-
3{-
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)
69
69
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
74 }
75 }
75 deriving Show
76 deriving Show
76
77
@@ -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
240
241
@@ -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
679+ case font of
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
687+ where
688+ lowerFromPrivate (ord -> c)
689+ | c >= ord '\xF000' = chr $ c - ord '\xF000'
690+ | otherwise = chr c
681
691
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"
715+ let font = do
716+ fontElem <- findElement (qualName "rFonts") element
717+ stringToFont =<<
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
722+
723+setFont :: Maybe Font -> ReaderEnv -> ReaderEnv
724+setFont f s = s{envFont = f}
tests/docx.unicode.docx

Binary file not shown.

tests/docx.unicode.native+1−1
@@ -1 +1 @@
1−[Para [Str "Hello,",Space,Str "\19990\30028.",Space,Str "This",Space,Str "costs",Space,Str "\8364\&10.\8744\8744"]]
1+[Para [Str "Hello,",Space,Str "\19990\30028.",Space,Str "This",Space,Str "costs",Space,Str "\8364\&10.\8744\8744("]]