@@ -62,7 +62,7 @@ import Text.Printf (printf)
6262import qualified Control.Exception as E
6363import Text.Pandoc.MIME (MimeType, getMimeType, getMimeTypeDef,
6464 extensionFromMimeType)
65−import Control.Applicative ((<$>), (<|>))
65+import Control.Applicative ((<$>), (<|>), (<*>))
6666import Data.Maybe (fromMaybe, mapMaybe)
6767
6868data ListMarker = NoMarker
@@ -104,6 +104,7 @@ data WriterState = WriterState{
104104 , stInDel :: Bool
105105 , stChangesAuthor :: String
106106 , stChangesDate :: String
107+ , stPrintWidth :: Integer
107108 }
108109
109110defaultWriterState :: WriterState
@@ -122,6 +123,7 @@ defaultWriterState = WriterState{
122123 , stInDel = False
123124 , stChangesAuthor = "unknown"
124125 , stChangesDate = "1969-12-31T19:00:00Z"
126+ , stPrintWidth = 1
125127 }
126128
127129type WS a = StateT WriterState IO a
@@ -183,9 +185,31 @@ writeDocx opts doc@(Pandoc meta _) = do
183185 Nothing -> readDataFile datadir "reference.docx"
184186 distArchive <- liftM (toArchive . toLazy) $ readDataFile Nothing "reference.docx"
185187
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+
186208 ((contents, footnotes), st) <- runStateT (writeOpenXML opts{writerWrapText = False} doc')
187209 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+
189213 let epochtime = floor $ utcTimeToPOSIXSeconds utctime
190214 let imgs = M.elems $ stImages st
191215
@@ -193,9 +217,6 @@ writeDocx opts doc@(Pandoc meta _) = do
193217 let toImageEntry (_,path,_,_,img) = toEntry ("word/" ++ path) epochtime $ toLazy img
194218 let imageEntries = map toImageEntry imgs
195219
196−
197−
198−
199220 let stdAttributes =
200221 [("xmlns:w","http://schemas.openxmlformats.org/wordprocessingml/2006/main")
201222 ,("xmlns:m","http://schemas.openxmlformats.org/officeDocument/2006/math")
@@ -310,10 +331,7 @@ writeDocx opts doc@(Pandoc meta _) = do
310331 $ renderXml reldoc
311332
312333
313− -- 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
334+ -- adjust contents to add sectPr from reference.docx
317335 let sectpr = case mbsectpr of
318336 Just sectpr' -> let cs = renumIds
319337 (\q -> qName q == "id" && qPrefix q == Just "r")
@@ -323,8 +341,6 @@ writeDocx opts doc@(Pandoc meta _) = do
323341 add_attrs (elAttribs sectpr') $ mknode "w:sectPr" [] cs
324342 Nothing -> (mknode "w:sectPr" [] ())
325343
326−
327−
328344 -- let sectpr = fromMaybe (mknode "w:sectPr" [] ()) mbsectpr'
329345 let contents' = contents ++ [sectpr]
330346 let docContents = mknode "w:document" stdAttributes
@@ -927,6 +943,7 @@ inlineToOpenXML opts (Link txt (src,_)) = do
927943 return [ mknode "w:hyperlink" [("r:id",id')] contents ]
928944inlineToOpenXML opts (Image alt (src, tit)) = do
929945 -- first, check to see if we've already done this image
946+ pageWidth <- gets stPrintWidth
930947 imgs <- gets stImages
931948 case M.lookup src imgs of
932949 Just (_,_,_,elt,_) -> return [elt]
@@ -943,7 +960,7 @@ inlineToOpenXML opts (Image alt (src, tit)) = do
943960 let size = imageSize img
944961 let (xpt,ypt) = maybe (120,120) sizeInPoints size
945962 -- 12700 emu = 1 pt
946− let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700)
963+ let (xemu,yemu) = fitToPage (xpt * 12700, ypt * 12700) (pageWidth * 12700)
947964 let cNvPicPr = mknode "pic:cNvPicPr" [] $
948965 mknode "a:picLocks" [("noChangeArrowheads","1"),("noChangeAspect","1")] ()
949966 let nvPicPr = mknode "pic:nvPicPr" []
@@ -1010,9 +1027,11 @@ parseXml refArchive distArchive relpath =
10101027 Nothing -> fail $ relpath ++ " corrupt or missing in reference docx"
10111028
10121029-- | Scales the image to fit the page
1013−fitToPage :: (Integer, Integer) -> (Integer, Integer)
1014−fitToPage (x, y)
1015− --5440680 is the emu width size of a letter page in portrait, minus the margins
1016− | x > 5440680 =
1017− (5440680, round $ (5440680 / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y))
1030+-- sizes are passed in emu
1031+fitToPage :: (Integer, Integer) -> Integer -> (Integer, Integer)
1032+fitToPage (x, y) pageWidth
1033+ -- Fixes width to the page width and scales the height
1034+ | x > pageWidth =
1035+ (pageWidth, round $
1036+ ((fromIntegral pageWidth) / ((fromIntegral :: Integer -> Double) x)) * (fromIntegral y))
10181037 | otherwise = (x, y)