git.iko.soy/typeable/pandoc
on master help sign in
Create shared OOXML writer file.
6cc673dJesse Rosenthal
src/Text/Pandoc/Writers/Docx.hs+1−33
compare with master
unifiedsplit
@@ -73,6 +73,7 @@ import Text.Printf (printf)
73import Text.TeXMath
73import Text.TeXMath
74import Text.XML.Light as XML
74import Text.XML.Light as XML
75import Text.XML.Light.Cursor as XMLC
75import Text.XML.Light.Cursor as XMLC
76+import Text.Pandoc.Writers.OOXML
76
77
77data ListMarker = NoMarker
78data ListMarker = NoMarker
78 | BulletMarker
79 | BulletMarker
@@ -156,22 +157,6 @@ defaultWriterState = WriterState{
156
157
157type WS m = ReaderT WriterEnv (StateT WriterState m)
158type WS m = ReaderT WriterEnv (StateT WriterState m)
158
159
159−mknode :: Node t => String -> [(String,String)] -> t -> Element
160−mknode s attrs =
161− add_attrs (map (\(k,v) -> Attr (nodename k) v) attrs) . node (nodename s)
162−
163−nodename :: String -> QName
164−nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix }
165− where (name, prefix) = case break (==':') s of
166− (xs,[]) -> (xs, Nothing)
167− (ys, _:zs) -> (zs, Just ys)
168−
169−toLazy :: B.ByteString -> BL.ByteString
170−toLazy = BL.fromChunks . (:[])
171−
172−renderXml :: Element -> BL.ByteString
173−renderXml elt = BL8.pack "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" <>
174− UTF8.fromStringLazy (showElement elt)
175
160
176renumIdMap :: Int -> [Element] -> M.Map String String
161renumIdMap :: Int -> [Element] -> M.Map String String
177renumIdMap _ [] = M.empty
162renumIdMap _ [] = M.empty
@@ -1393,23 +1378,6 @@ defaultFootnotes = [ mknode "w:footnote"
1393 [ mknode "w:r" [] $
1378 [ mknode "w:r" [] $
1394 [ mknode "w:continuationSeparator" [] ()]]]]
1379 [ mknode "w:continuationSeparator" [] ()]]]]
1395
1380
1396−parseXml :: (PandocMonad m) => Archive -> Archive -> String -> m Element
1397−parseXml refArchive distArchive relpath =
1398− case findEntryByPath relpath refArchive `mplus`
1399− findEntryByPath relpath distArchive of
1400− Nothing -> fail $ relpath ++ " missing in reference docx"
1401− Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of
1402− Nothing -> fail $ relpath ++ " corrupt in reference docx"
1403− Just d -> return d
1404−
1405−-- | Scales the image to fit the page
1406−-- sizes are passed in emu
1407−fitToPage :: (Double, Double) -> Integer -> (Integer, Integer)
1408−fitToPage (x, y) pageWidth
1409− -- Fixes width to the page width and scales the height
1410− | x > fromIntegral pageWidth =
1411− (pageWidth, floor $ (fromIntegral pageWidth / x) * y)
1412− | otherwise = (floor x, floor y)
1413
1381
1414withDirection :: PandocMonad m => WS m a -> WS m a
1382withDirection :: PandocMonad m => WS m a -> WS m a
1415withDirection x = do
1383withDirection x = do
src/Text/Pandoc/Writers/OOXML.hsnew file+109
@@ -0,0 +1,109 @@
1+module Text.Pandoc.Writers.OOXML ( mknode
2+ , nodename
3+ , toLazy
4+ , renderXml
5+ , parseXml
6+ , elemToNameSpaces
7+ , elemName
8+ , isElem
9+ , NameSpaces
10+ , fitToPage
11+ ) where
12+import Codec.Archive.Zip
13+--import Control.Applicative ((<|>))
14+-- import Control.Monad.Except (catchError)
15+import Control.Monad.Reader
16+-- import Control.Monad.State
17+import qualified Data.ByteString as B
18+import qualified Data.ByteString.Lazy as BL
19+import qualified Data.ByteString.Lazy.Char8 as BL8
20+-- import Data.Char (isSpace, ord, toLower)
21+-- import Data.List (intercalate, isPrefixOf, isSuffixOf)
22+-- import qualified Data.Map as M
23+import Data.Maybe (mapMaybe)
24+import Data.Monoid ((<>))
25+-- import qualified Data.Set as Set
26+-- import qualified Data.Text as T
27+-- import Data.Time.Clock.POSIX
28+-- import Skylighting
29+-- import System.Random (randomR)
30+import Text.Pandoc.Class (PandocMonad)
31+-- import qualified Text.Pandoc.Class as P
32+-- import Text.Pandoc.Compat.Time
33+-- import Text.Pandoc.Definition
34+-- import Text.Pandoc.Generic
35+-- import Text.Pandoc.Highlighting (highlight)
36+-- import Text.Pandoc.ImageSize
37+-- import Text.Pandoc.Logging
38+-- import Text.Pandoc.MIME (MimeType, extensionFromMimeType, getMimeType,
39+-- getMimeTypeDef)
40+-- import Text.Pandoc.Options
41+-- import Text.Pandoc.Readers.Docx.StyleMap
42+-- import Text.Pandoc.Shared hiding (Element)
43+import qualified Text.Pandoc.UTF8 as UTF8
44+-- import Text.Pandoc.Walk
45+-- import Text.Pandoc.Writers.Math
46+-- import Text.Pandoc.Writers.Shared (fixDisplayMath)
47+-- import Text.Printf (printf)
48+-- import Text.TeXMath
49+import Text.XML.Light as XML
50+-- import Text.XML.Light.Cursor as XMLC
51+
52+
53+mknode :: Node t => String -> [(String,String)] -> t -> Element
54+mknode s attrs =
55+ add_attrs (map (\(k,v) -> Attr (nodename k) v) attrs) . node (nodename s)
56+
57+nodename :: String -> QName
58+nodename s = QName{ qName = name, qURI = Nothing, qPrefix = prefix }
59+ where (name, prefix) = case break (==':') s of
60+ (xs,[]) -> (xs, Nothing)
61+ (ys, _:zs) -> (zs, Just ys)
62+
63+toLazy :: B.ByteString -> BL.ByteString
64+toLazy = BL.fromChunks . (:[])
65+
66+renderXml :: Element -> BL.ByteString
67+renderXml elt = BL8.pack "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n" <>
68+ UTF8.fromStringLazy (showElement elt)
69+
70+parseXml :: (PandocMonad m) => Archive -> Archive -> String -> m Element
71+parseXml refArchive distArchive relpath =
72+ case findEntryByPath relpath refArchive `mplus`
73+ findEntryByPath relpath distArchive of
74+ Nothing -> fail $ relpath ++ " missing in reference file"
75+ Just e -> case parseXMLDoc . UTF8.toStringLazy . fromEntry $ e of
76+ Nothing -> fail $ relpath ++ " corrupt in reference file"
77+ Just d -> return d
78+
79+-- Copied from Util
80+
81+attrToNSPair :: XML.Attr -> Maybe (String, String)
82+attrToNSPair (XML.Attr (QName s _ (Just "xmlns")) val) = Just (s, val)
83+attrToNSPair _ = Nothing
84+
85+
86+elemToNameSpaces :: Element -> NameSpaces
87+elemToNameSpaces = mapMaybe attrToNSPair . elAttribs
88+
89+elemName :: NameSpaces -> String -> String -> QName
90+elemName ns prefix name =
91+ QName name (lookup prefix ns) (if null prefix then Nothing else Just prefix)
92+
93+isElem :: NameSpaces -> String -> String -> Element -> Bool
94+isElem ns prefix name element =
95+ let ns' = ns ++ elemToNameSpaces element
96+ in qName (elName element) == name &&
97+ qURI (elName element) == lookup prefix ns'
98+
99+type NameSpaces = [(String, String)]
100+
101+-- | Scales the image to fit the page
102+-- sizes are passed in emu
103+fitToPage :: (Double, Double) -> Integer -> (Integer, Integer)
104+fitToPage (x, y) pageWidth
105+ -- Fixes width to the page width and scales the height
106+ | x > fromIntegral pageWidth =
107+ (pageWidth, floor $ ((fromIntegral pageWidth) / x) * y)
108+ | otherwise = (floor x, floor y)
109+