3156722 · typeable/pandoc

git.iko.soy/typeable/pandoc

Powerpoint writer: Fix anchor links.

They were broken when I refactored (the Output module wanted to use state left over from the construction of the Presentation type). This change introduces a new type `LinkTarget = InternalTarget | ExternalTarget`. Internal target points to a slide number, and these will all be resolved before the Presentation is passed along to the Output module.

commit3156722ac413ddbc200dfcfdabcf08e7c2e1875d authorJesse Rosenthal <jrosenthal@jhu.edu> dateSun 14 Jan 2018, 21:56 (9 years ago) parent2c00540

2 files changed+81−60

compare with master

unifiedsplit

src/Text/Pandoc/Writers/Powerpoint/Output.hs+22−43 src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+59−17

src/Text/Pandoc/Writers/Powerpoint/Output.hs+22−43

@@ -54,7 +54,7 @@ import Text.Pandoc.MIME

5454import qualified Data.ByteString.Lazy as BL

5555import Text.Pandoc.Writers.OOXML

5656import qualified Data.Map as M

57−import Data.Maybe (mapMaybe, listToMaybe, catMaybes)

57+import Data.Maybe (mapMaybe, listToMaybe)

5858import Text.Pandoc.ImageSize

5959import Control.Applicative ((<|>))

6060import System.FilePath.Glob

@@ -135,24 +135,16 @@ data MediaInfo = MediaInfo { mInfoFilePath :: FilePath

135135 , mInfoCaption :: Bool

136136 } deriving (Show, Eq)

137137

138−data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int (URL, String))

138+data WriterState = WriterState { stLinkIds :: M.Map Int (M.Map Int LinkTarget)

139139 -- (FP, Local ID, Global ID, Maybe Mime)

140140 , stMediaIds :: M.Map Int [MediaInfo]

141141 , stMediaGlobalIds :: M.Map FilePath Int

142− , stNoteIds :: M.Map Int [Block]

143− -- associate anchors with slide id

144− , stAnchorMap :: M.Map String Int

145− -- media inherited from the template.

146− , stTemplateMedia :: [FilePath]

147142 } deriving (Show, Eq)

148143

149144instance Default WriterState where

150145 def = WriterState { stLinkIds = mempty

151146 , stMediaIds = mempty

152147 , stMediaGlobalIds = mempty

153− , stNoteIds = mempty

154− , stAnchorMap= mempty

155− , stTemplateMedia = []

156148 }

157149

158150type P m = ReaderT WriterEnv (StateT WriterState m)

@@ -420,7 +412,7 @@ replaceNamedChildren ns prefix name newKids element =

420412

421413----------------------------------------------------------------

422414

423−registerLink :: PandocMonad m => (URL, String) -> P m Int

415+registerLink :: PandocMonad m => LinkTarget -> P m Int

424416registerLink link = do

425417 curSlideId <- asks envCurSlideId

426418 linkReg <- gets stLinkIds

@@ -729,20 +721,15 @@ paraElemToElement (Run rpr s) = do

729721 -- first we have to make sure that if it's an

730722 -- anchor, it's in the anchor map. If not, there's

731723 -- no link.

732− anchorMap <- gets stAnchorMap

733724 return $ case link of

734− -- anchor with nothing in the map

735− ('#':target, _) | Nothing <- M.lookup target anchorMap ->

736− []

737− -- anchor that is in the map

738− ('#':_, _) ->

725+ InternalTarget _ ->

739726 let linkAttrs =

740727 [ ("r:id", "rId" ++ show idNum)

741728 , ("action", "ppaction://hlinksldjump")

742729 ]

743730 in [mknode "a:hlinkClick" linkAttrs ()]

744731 -- external

745− _ ->

732+ ExternalTarget _ ->

746733 let linkAttrs =

747734 [ ("r:id", "rId" ++ show idNum)

748735 ]

@@ -1191,31 +1178,23 @@ slideToSlideRelEntry slide idNum = do

11911178 element <- slideToSlideRelElement slide idNum

11921179 elemToEntry ("ppt/slides/_rels/" ++ slideToFilePath slide idNum ++ ".rels") element

11931180

1194−linkRelElement :: PandocMonad m => Int -> (URL, String) -> P m (Maybe Element)

1195−linkRelElement idNum (url, _) = do

1196− anchorMap <- gets stAnchorMap

1197− case url of

1198− -- if it's an anchor in the map, we use the slide number for an

1199− -- internal link.

1200− '#' : anchor | Just num <- M.lookup anchor anchorMap ->

1201− return $ Just $

1202− mknode "Relationship" [ ("Id", "rId" ++ show idNum)

1203− , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")

1204− , ("Target", "slide" ++ show num ++ ".xml")

1205− ] ()

1206− -- if it's an anchor not in the map, we return nothing.

1207− '#' : _ -> return Nothing

1208− -- Anything else we treat as an external link

1209− _ ->

1210− return $ Just $

1211− mknode "Relationship" [ ("Id", "rId" ++ show idNum)

1212− , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")

1213− , ("Target", url)

1214− , ("TargetMode", "External")

1215− ] ()

1216−

1217−linkRelElements :: PandocMonad m => M.Map Int (URL, String) -> P m [Element]

1218−linkRelElements mp = catMaybes <$> mapM (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)

1181+linkRelElement :: PandocMonad m => Int -> LinkTarget -> P m Element

1182+linkRelElement idNum (InternalTarget num) = do

1183+ return $

1184+ mknode "Relationship" [ ("Id", "rId" ++ show idNum)

1185+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/slide")

1186+ , ("Target", "slide" ++ show num ++ ".xml")

1187+ ] ()

1188+linkRelElement idNum (ExternalTarget (url, _)) = do

1189+ return $

1190+ mknode "Relationship" [ ("Id", "rId" ++ show idNum)

1191+ , ("Type", "http://schemas.openxmlformats.org/officeDocument/2006/relationships/hyperlink")

1192+ , ("Target", url)

1193+ , ("TargetMode", "External")

1194+ ] ()

1195+

1196+linkRelElements :: PandocMonad m => M.Map Int LinkTarget -> P m [Element]

1197+linkRelElements mp = mapM (\(n, lnk) -> linkRelElement n lnk) (M.toList mp)

12191198

12201199mediaRelElement :: MediaInfo -> Element

12211200mediaRelElement mInfo =

src/Text/Pandoc/Writers/Powerpoint/Presentation.hs+59−17

@@ -35,7 +35,6 @@ Presentation.

3535module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation

3636 , Presentation(..)

3737 , Slide(..)

38− , SlideElement(..)

3938 , Shape(..)

4039 , Graphic(..)

4140 , BulletType(..)

@@ -50,6 +49,7 @@ module Text.Pandoc.Writers.Powerpoint.Presentation ( documentToPresentation

5049 , PicProps(..)

5150 , URL

5251 , TeXString(..)

52+ , LinkTarget(..)

5353 ) where

5454

5555

@@ -78,10 +78,6 @@ data WriterEnv = WriterEnv { envMetadata :: Meta

7878 , envInList :: Bool

7979 , envInNoteSlide :: Bool

8080 , envCurSlideId :: Int

81− -- the difference between the number at

82− -- the end of the slide file name and

83− -- the rId number

84− , envSlideIdOffset :: Int

8581 }

8682 deriving (Show)

8783

@@ -95,7 +91,6 @@ instance Default WriterEnv where

9591 , envInList = False

9692 , envInNoteSlide = False

9793 , envCurSlideId = 1

98− , envSlideIdOffset = 1

9994 }

10095

10196

@@ -139,9 +134,6 @@ data Slide = MetadataSlide { metadataSlideTitle :: [ParaElem]

139134 }

140135 deriving (Show, Eq)

141136

142−data SlideElement = SlideElement Pixels Pixels Pixels Pixels Shape

143− deriving (Show, Eq)

144−

145137data Shape = Pic PicProps FilePath Text.Pandoc.Definition.Attr [ParaElem]

146138 | GraphicFrame [Graphic] [ParaElem]

147139 | TextBox [Paragraph]

@@ -206,12 +198,16 @@ data Capitals = NoCapitals | SmallCapitals | AllCapitals

206198

207199type URL = String

208200

201+data LinkTarget = ExternalTarget (URL, String)

202+ | InternalTarget Int -- slideId

203+ deriving (Show, Eq)

204+

209205data RunProps = RunProps { rPropBold :: Bool

210206 , rPropItalics :: Bool

211207 , rStrikethrough :: Maybe Strikethrough

212208 , rBaseline :: Maybe Int

213209 , rCap :: Maybe Capitals

214− , rLink :: Maybe (URL, String)

210+ , rLink :: Maybe LinkTarget

215211 , rPropCode :: Bool

216212 , rPropBlockQuote :: Bool

217213 , rPropForceSize :: Maybe Pixels

@@ -229,7 +225,7 @@ instance Default RunProps where

229225 , rPropForceSize = Nothing

230226 }

231227

232−data PicProps = PicProps { picPropLink :: Maybe (URL, String)

228+data PicProps = PicProps { picPropLink :: Maybe LinkTarget

233229 } deriving (Show, Eq)

234230

235231instance Default PicProps where

@@ -267,7 +263,7 @@ inlineToParElems Space = inlineToParElems (Str " ")

267263inlineToParElems SoftBreak = inlineToParElems (Str " ")

268264inlineToParElems LineBreak = return [Break]

269265inlineToParElems (Link _ ils (url, title)) = do

270− local (\r ->r{envRunProps = (envRunProps r){rLink = Just (url, title)}}) $

266+ local (\r ->r{envRunProps = (envRunProps r){rLink = Just $ ExternalTarget (url, title)}}) $

271267 inlinesToParElems ils

272268inlineToParElems (Code _ str) = do

273269 local (\r ->r{envRunProps = (envRunProps r){rPropCode = True}}) $

@@ -414,10 +410,10 @@ blockToShape (Para (il:_)) | Image attr ils (url, _) <- il =

414410 Pic def url attr <$> (inlinesToParElems ils)

415411blockToShape (Plain (il:_)) | Link _ (il':_) target <- il

416412 , Image attr ils (url, _) <- il' =

417− Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)

413+ Pic def{picPropLink = Just $ ExternalTarget target} url attr <$> (inlinesToParElems ils)

418414blockToShape (Para (il:_)) | Link _ (il':_) target <- il

419415 , Image attr ils (url, _) <- il' =

420− Pic def{picPropLink = Just target} url attr <$> (inlinesToParElems ils)

416+ Pic def{picPropLink = Just $ ExternalTarget target} url attr <$> (inlinesToParElems ils)

421417blockToShape (Table caption algn _ hdrCells rows) = do

422418 caption' <- inlinesToParElems caption

423419 hdrCells' <- rowToParagraphs algn hdrCells

@@ -644,6 +640,51 @@ combineParaElems' (Just pElem') (pElem : pElems)

644640combineParaElems :: [ParaElem] -> [ParaElem]

645641combineParaElems = combineParaElems' Nothing

646642

643+applyToParagraph :: Monad m => (ParaElem -> m ParaElem) -> Paragraph -> m Paragraph

644+applyToParagraph f para = do

645+ paraElems' <- mapM f $ paraElems para

646+ return $ para {paraElems = paraElems'}

647+

648+applyToShape :: Monad m => (ParaElem -> m ParaElem) -> Shape -> m Shape

649+applyToShape f (Pic pPr fp attr pes) = do

650+ pes' <- mapM f pes

651+ return $ Pic pPr fp attr pes'

652+applyToShape f (GraphicFrame gfx pes) = do

653+ pes' <- mapM f pes

654+ return $ GraphicFrame gfx pes'

655+applyToShape f (TextBox paras) = do

656+ paras' <- mapM (applyToParagraph f) paras

657+ return $ TextBox paras'

658+

659+applyToSlide :: Monad m => (ParaElem -> m ParaElem) -> Slide -> m Slide

660+applyToSlide f (MetadataSlide title subtitle authors date) = do

661+ title' <- mapM f title

662+ subtitle' <- mapM f subtitle

663+ authors' <- mapM (mapM f) authors

664+ date' <- mapM f date

665+ return $ MetadataSlide title' subtitle' authors' date'

666+applyToSlide f (TitleSlide title) = do

667+ title' <- mapM f title

668+ return $ TitleSlide title'

669+applyToSlide f (ContentSlide hdr content) = do

670+ hdr' <- mapM f hdr

671+ content' <- mapM (applyToShape f) content

672+ return $ ContentSlide hdr' content'

673+applyToSlide f (TwoColumnSlide hdr contentL contentR) = do

674+ hdr' <- mapM f hdr

675+ contentL' <- mapM (applyToShape f) contentL

676+ contentR' <- mapM (applyToShape f) contentR

677+ return $ TwoColumnSlide hdr' contentL' contentR'

678+

679+replaceAnchor :: PandocMonad m => ParaElem -> Pres m ParaElem

680+replaceAnchor (Run rProps s)

681+ | Just (ExternalTarget ('#':anchor, _)) <- rLink rProps = do

682+ anchorMap <- gets stAnchorMap

683+ return $ case M.lookup anchor anchorMap of

684+ Just n -> Run (rProps{rLink = Just $ InternalTarget n}) s

685+ Nothing -> Run rProps s

686+replaceAnchor pe = return pe

687+

647688blocksToPresentation :: PandocMonad m => [Block] -> Pres m Presentation

648689blocksToPresentation blks = do

649690 opts <- asks envOpts

@@ -683,9 +724,10 @@ blocksToPresentation blks = do

683724 })

684725 (blocksToSlide $ notesSlideBlocks)

685726 return [notesSlide]

686− return $

687− Presentation $

688− metadataslides ++ tocSlides ++ bodyslides ++ notesSlides

727+

728+ let slides = metadataslides ++ tocSlides ++ bodyslides ++ notesSlides

729+ slides' <- mapM (applyToSlide replaceAnchor) slides

730+ return $ Presentation slides'

689731

690732documentToPresentation :: PandocMonad m

691733 => WriterOptions