64c4451 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Powerpoint writer: Position images correctly in two-column layout.

64c4451Jesse Rosenthal9 years ago

src/Text/Pandoc/Writers/Powerpoint.hs+33−45

compare with master

unifiedsplit

@@ -42,7 +42,6 @@ import Data.Time.Clock (UTCTime)

42import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)

43import System.FilePath.Posix (splitDirectories, splitExtension, takeExtension)

44import Text.XML.Light

45−import qualified Text.XML.Light.Cursor as XMLC

46import Text.Pandoc.Definition

45import Text.Pandoc.Definition

47import qualified Text.Pandoc.UTF8 as UTF8

46import qualified Text.Pandoc.UTF8 as UTF8

48import Text.Pandoc.Class (PandocMonad)

47import Text.Pandoc.Class (PandocMonad)

@@ -126,7 +125,7 @@ data WriterEnv = WriterEnv { envMetadata :: Meta

126 -- the end of the slide file name and

125 -- the end of the slide file name and

127 -- the rId number

126 -- the rId number

128 , envSlideIdOffset :: Int

127 , envSlideIdOffset :: Int

129− , envColumnNumber :: Maybe Int

128+ , envContentType :: ContentType

130 }

129 }

131 deriving (Show)

130 deriving (Show)

132

131

@@ -145,9 +144,14 @@ instance Default WriterEnv where

145 , envInNoteSlide = False

144 , envInNoteSlide = False

146 , envCurSlideId = 1

145 , envCurSlideId = 1

147 , envSlideIdOffset = 1

146 , envSlideIdOffset = 1

148− , envColumnNumber = Nothing

147+ , envContentType = NormalContent

149 }

148 }

150

149

150+data ContentType = NormalContent

151+ | TwoColumnLeftContent

152+ | TwoColumnRightContent

153+ deriving (Show, Eq)

154+

151data MediaInfo = MediaInfo { mInfoFilePath :: FilePath

155data MediaInfo = MediaInfo { mInfoFilePath :: FilePath

152 , mInfoLocalId :: Int

156 , mInfoLocalId :: Int

153 , mInfoGlobalId :: Int

157 , mInfoGlobalId :: Int

@@ -912,15 +916,20 @@ shapeHasId ns ident element

912-- column is id=4.

916-- column is id=4.

913getContentShape :: PandocMonad m => NameSpaces -> Element -> P m Element

917getContentShape :: PandocMonad m => NameSpaces -> Element -> P m Element

914getContentShape ns spTreeElem

918getContentShape ns spTreeElem

915− | isElem ns "p" "spTree" spTreeElem =

919+ | isElem ns "p" "spTree" spTreeElem = do

920+ contentType <- asks envContentType

921+ let ident = case contentType of

922+ NormalContent -> "3"

923+ TwoColumnLeftContent -> "3"

924+ TwoColumnRightContent -> "4"

916− case filterChild

925+ case filterChild

917− (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns "3" e))

926+ (\e -> (isElem ns "p" "sp" e) && (shapeHasId ns ident e))

918− spTreeElem

927+ spTreeElem

919− of

928+ of

920− Just e -> return e

929+ Just e -> return e

921− Nothing -> throwError $

930+ Nothing -> throwError $

922− PandocSomeError $

931+ PandocSomeError $

923− "Could not find shape for Powerpoint content"

932+ "Could not find shape for Powerpoint content"

924getContentShape _ _ = throwError $

933getContentShape _ _ = throwError $

925 PandocSomeError $

934 PandocSomeError $

926 "Attempted to find content on non shapeTree"

935 "Attempted to find content on non shapeTree"

@@ -1552,40 +1561,15 @@ contentToElement layout hdrShape shapes

1552 let hdrShapeElements = if null hdrShape

1561 let hdrShapeElements = if null hdrShape

1553 then []

1562 then []

1554 else [element]

1563 else [element]

1564+ contentElements <- local

1565+ (\env -> env {envContentType = NormalContent})

1555− contentElements <- shapesToElements layout shapes

1566+ (shapesToElements layout shapes)

1556 return $

1567 return $

1557 replaceNamedChildren ns "p" "sp"

1568 replaceNamedChildren ns "p" "sp"

1558 (hdrShapeElements ++ contentElements)

1569 (hdrShapeElements ++ contentElements)

1559 spTree

1570 spTree

1560contentToElement _ _ _ = return $ mknode "p:sp" [] ()

1571contentToElement _ _ _ = return $ mknode "p:sp" [] ()

1561

1572

1562−setIdx'' :: NameSpaces -> String -> Content -> Content

1563−setIdx'' _ idx (Elem element) =

1564− let tag = XMLC.getTag element

1565− attrs = XMLC.tagAttribs tag

1566− idxKey = (QName "idx" Nothing Nothing)

1567− attrs' = Attr idxKey idx : (filter (\a -> attrKey a /= idxKey) attrs)

1568− tag' = tag {XMLC.tagAttribs = attrs'}

1569− in Elem $ XMLC.setTag tag' element

1570−setIdx'' _ _ c = c

1571−

1572−setIdx' :: NameSpaces -> String -> XMLC.Cursor -> XMLC.Cursor

1573−setIdx' ns idx cur =

1574− let modifiedCur = XMLC.modifyContent (setIdx'' ns idx) cur

1575− in

1576− case XMLC.nextDF modifiedCur of

1577− Just cur' -> setIdx' ns idx cur'

1578− Nothing -> XMLC.root modifiedCur

1579−

1580−setIdx :: NameSpaces -> String -> Element -> Element

1581−setIdx ns idx element =

1582− let cur = XMLC.fromContent (Elem element)

1583− cur' = setIdx' ns idx cur

1584− in

1585− case XMLC.toTree cur' of

1586− Elem element' -> element'

1587− _ -> element

1588−

1589twoColumnToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element

1573twoColumnToElement :: PandocMonad m => Element -> [ParaElem] -> [Shape] -> [Shape] -> P m Element

1590twoColumnToElement layout hdrShape shapesL shapesR

1574twoColumnToElement layout hdrShape shapesL shapesR

1591 | ns <- elemToNameSpaces layout

1575 | ns <- elemToNameSpaces layout

@@ -1595,13 +1579,17 @@ twoColumnToElement layout hdrShape shapesL shapesR

1595 let hdrShapeElements = if null hdrShape

1579 let hdrShapeElements = if null hdrShape

1596 then []

1580 then []

1597 else [element]

1581 else [element]

1582+ contentElementsL <- local

1583+ (\env -> env {envContentType =TwoColumnLeftContent})

1598− contentElementsL <- shapesToElements layout shapesL

1584+ (shapesToElements layout shapesL)

1585+ contentElementsR <- local

1586+ (\env -> env {envContentType =TwoColumnRightContent})

1599− contentElementsR <- shapesToElements layout shapesR

1587+ (shapesToElements layout shapesR)

1600− let contentElementsL' = map (setIdx ns "1") contentElementsL

1588+ -- let contentElementsL' = map (setIdx ns "1") contentElementsL

1601− contentElementsR' = map (setIdx ns "2") contentElementsR

1589+ -- contentElementsR' = map (setIdx ns "2") contentElementsR

1602 return $

1590 return $

1603 replaceNamedChildren ns "p" "sp"

1591 replaceNamedChildren ns "p" "sp"

1604− (hdrShapeElements ++ contentElementsL' ++ contentElementsR')

1592+ (hdrShapeElements ++ contentElementsL ++ contentElementsR)

1605 spTree

1593 spTree

1606twoColumnToElement _ _ _ _= return $ mknode "p:sp" [] ()

1594twoColumnToElement _ _ _ _= return $ mknode "p:sp" [] ()

1607

1595