8a1a594 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Getting the page width from the reference file

8a1a594Grégory Bataille12 years ago

src/Text/Pandoc/Writers/Docx.hs+36−17

compare with master

unifiedsplit

@@ -62,7 +62,7 @@ import Text.Printf (printf)

62import qualified Control.Exception as E

63import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,

64 extensionFromMimeType)

65−import Control.Applicative ((<$>), (<|>))

65+import Control.Applicative ((<$>), (<|>), (<*>))

66import Data.Maybe (fromMaybe, mapMaybe)

68data ListMarker = NoMarker

@@ -104,6 +104,7 @@ data WriterState = WriterState{

104 , stInDel :: Bool

105 , stChangesAuthor :: String

106 , stChangesDate :: String

107+ , stPrintWidth :: Integer

107 }

108 }

108

109

109defaultWriterState :: WriterState

110defaultWriterState :: WriterState

@@ -122,6 +123,7 @@ defaultWriterState = WriterState{

122 , stInDel = False

123 , stInDel = False

123 , stChangesAuthor = "unknown"

124 , stChangesAuthor = "unknown"

124 , stChangesDate = "1969-12-31T19:00:00Z"

125 , stChangesDate = "1969-12-31T19:00:00Z"

126+ , stPrintWidth = 1

125 }

127 }

126

128

127type WS a = StateT WriterState IO a

129type WS a = StateT WriterState IO a

@@ -183,9 +185,31 @@ writeDocx opts doc@(Pandoc meta _) = do

183 Nothing -> readDataFile datadir "reference.docx"

185 Nothing -> readDataFile datadir "reference.docx"

184 distArchive <- liftM (toArchive . toLazy) $ readDataFile Nothing "reference.docx"

186 distArchive <- liftM (toArchive . toLazy) $ readDataFile Nothing "reference.docx"

185

187

188+ parsedDoc <- parseXml refArchive distArchive "word/document.xml"

189+ let wname f qn = qPrefix qn == Just "w" && f (qName qn)

190+ let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc

191+

192+ -- Gets the template size

193+ let mbpgsz = mbsectpr >>= (filterElementName (wname (=="pgSz")))

194+ let mbAttrSzWidth = (elAttribs <$> mbpgsz) >>= (lookupAttrBy ((=="w") . qName))

195+

196+ let mbpgmar = mbsectpr >>= (filterElementName (wname (=="pgMar")))

197+ let mbAttrMarLeft = (elAttribs <$> mbpgmar) >>= (lookupAttrBy ((=="left") . qName))

198+ let mbAttrMarRight = (elAttribs <$> mbpgmar) >>= (lookupAttrBy ((=="right") . qName))

199+

200+ -- Get the avaible area (converting the size and the margins to int and

201+ -- doing the difference

202+ let pgContentWidth = (-) <$> (read <$> mbAttrSzWidth ::Maybe Integer)

203+ <*> (

204+ (+) <$> (read <$> mbAttrMarRight ::Maybe Integer)

205+ <*> (read <$> mbAttrMarLeft ::Maybe Integer)

206+ )

207+

186 ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc')

208 ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc')

187 defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username

209 defaultWriterState{ stChangesAuthor = fromMaybe "unknown" username

188− , stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime}

210+ , stChangesDate = formatTime defaultTimeLocale "%FT%XZ" utctime

211+ , stPrintWidth = (maybe 420 (\x -> quot x 20) pgContentWidth) }

212+

189 let epochtime = floor $ utcTimeToPOSIXSeconds utctime

213 let epochtime = floor $ utcTimeToPOSIXSeconds utctime

190 let imgs = M.elems $ stImages st

214 let imgs = M.elems $ stImages st

191

215

@@ -193,9 +217,6 @@ writeDocx opts doc@(Pandoc meta _) = do

193 let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img

217 let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img

194 let imageEntries = map toImageEntry imgs

218 let imageEntries = map toImageEntry imgs

195

219

196−

197−

198−

199 let stdAttributes =

220 let stdAttributes =

200 [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")

221 [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")

201 ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")

222 ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")

@@ -310,10 +331,7 @@ writeDocx opts doc@(Pandoc meta _) = do

310 $ renderXml reldoc

331 $ renderXml reldoc

311

332

312

333

313− -- adjust contents to add sectPr from reference.docx

334+ -- adjust contents to add sectPr from reference.docx

314− parsedDoc <- parseXml refArchive distArchive "word/document.xml"

315− let wname f qn = qPrefix qn == Just "w" && f (qName qn)

316− let mbsectpr = filterElementName (wname (=="sectPr")) parsedDoc

317 let sectpr = case mbsectpr of

335 let sectpr = case mbsectpr of

318 Just sectpr' -> let cs = renumIds

336 Just sectpr' -> let cs = renumIds

319 (\q -> qName q == "id" && qPrefix q == Just "r")

337 (\q -> qName q == "id" && qPrefix q == Just "r")

@@ -323,8 +341,6 @@ writeDocx opts doc@(Pandoc meta _) = do

323 add_attrs (elAttribs sectpr') $ mknode "w:sectPr" [] cs

341 add_attrs (elAttribs sectpr') $ mknode "w:sectPr" [] cs

324 Nothing -> (mknode "w:sectPr" [] ())

342 Nothing -> (mknode "w:sectPr" [] ())

325

343

326−

327−

328 -- let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr'

344 -- let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr'

329 let contents' = contents ++ [sectpr]

345 let contents' = contents ++ [sectpr]

330 let docContents = mknode "w:document" stdAttributes

346 let docContents = mknode "w:document" stdAttributes

@@ -927,6 +943,7 @@ inlineToOpenXML opts (Link txt (src,_)) = do

927 return [ mknode "w:hyperlink" [("r:id",id')] contents ]

943 return [ mknode "w:hyperlink" [("r:id",id')] contents ]

928inlineToOpenXML opts (Image alt (src, tit)) = do

944inlineToOpenXML opts (Image alt (src, tit)) = do

929 -- first, check to see if we've already done this image

945 -- first, check to see if we've already done this image

946+ pageWidth <- gets stPrintWidth

930 imgs <- gets stImages

947 imgs <- gets stImages

931 case M.lookup src imgs of

948 case M.lookup src imgs of

932 Just (_,_,_,elt,_) -> return [elt]

949 Just (_,_,_,elt,_) -> return [elt]

@@ -943,7 +960,7 @@ inlineToOpenXML opts (Image alt (src, tit)) = do

943 let size = imageSize img

960 let size = imageSize img

944 let (xpt,ypt) = maybe (120,120) sizeInPoints size

961 let (xpt,ypt) = maybe (120,120) sizeInPoints size

945 -- 12700 emu = 1 pt

962 -- 12700 emu = 1 pt

946− let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700)

963+ let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) (pageWidth * 12700)

947 let cNvPicPr = mknode "pic:cNvPicPr" [] $

964 let cNvPicPr = mknode "pic:cNvPicPr" [] $

948 mknode "a:picLocks" [("noChangeArrowheads","1"),("noChangeAspect","1")] ()

965 mknode "a:picLocks" [("noChangeArrowheads","1"),("noChangeAspect","1")] ()

949 let nvPicPr = mknode "pic:nvPicPr" []

966 let nvPicPr = mknode "pic:nvPicPr" []

@@ -1010,9 +1027,11 @@ parseXml refArchive distArchive relpath =

1010 Nothing -> fail $ relpath ++ " corrupt or missing in reference docx"

1027 Nothing -> fail $ relpath ++ " corrupt or missing in reference docx"

1011

1028

1012-- | Scales the image to fit the page

1029-- | Scales the image to fit the page

1013−fitToPage :: (Integer, Integer) -> (Integer, Integer)

1030+-- sizes are passed in emu

1014−fitToPage (x, y)

1031+fitToPage :: (Integer, Integer) -> Integer -> (Integer, Integer)

1015− --5440680 is the emu width size of a letter page in portrait, minus the margins

1032+fitToPage (x, y) pageWidth

1016− | x > 5440680 =

1033+ -- Fixes width to the page width and scales the height

1034+ | x > pageWidth =

1035+ (pageWidth, round $

1017− (5440680, round $ (5440680 / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y))

1036+ ((fromIntegral pageWidth) / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y))

1018 | otherwise = (x, y)

1037 | otherwise = (x, y)