Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Powerpoint writer: allow arbitrary OOXML in raw inline elements

Browse source 
The raw text is now included verbatim in the output. Previously is was parsed
into XML elements, which prevented the inclusion of partial XML snippets.
This commit is contained in:
Albert Krewinkel 2020-12-26 22:51:22 +01:00 committed by Albert Krewinkel
parent 47f435276a
commit dcd89413f3
2 changed files with 28 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

49
src/Text/Pandoc/Writers/Powerpoint/Output.hs
View file

@ -437,10 +437,10 @@ getContentShapeSize ns layout master
getContentShapeSize _ _ _ = throwError $ PandocSomeError
"Attempted to find content shape size in non-layout"
buildSpTree :: NameSpaces -> Element -> [Element] -> Element
buildSpTree :: NameSpaces -> Element -> [Content] -> Element
buildSpTree ns spTreeElem newShapes =
emptySpTreeElem { elContent = newContent }
where newContent = elContent emptySpTreeElem <> map Elem newShapes
where newContent = elContent emptySpTreeElem <> newShapes
emptySpTreeElem = spTreeElem { elContent = filter fn (elContent spTreeElem) }
fn :: Content -> Bool
fn (Elem e) = isElem ns "p" "nvGrpSpPr" e ||
@ -744,8 +744,8 @@ makePicElements layout picProps mInfo alt = do
else return [picShape]
paraElemToElements :: PandocMonad m => ParaElem -> P m [Element]
paraElemToElements Break = return [mknode "a:br" [] ()]
paraElemToElements :: PandocMonad m => ParaElem -> P m [Content]
paraElemToElements Break = return [Elem $ mknode "a:br" [] ()]
paraElemToElements (Run rpr s) = do
sizeAttrs <- fontSizeAttributes rpr
let attrs = sizeAttrs <>
@ -801,19 +801,20 @@ paraElemToElements (Run rpr s) = do
let codeContents =
[mknode "a:latin" [("typeface", T.unpack codeFont)] () | rPropCode rpr]
let propContents = linkProps <> colorContents <> codeContents
return [mknode "a:r" [] [ mknode "a:rPr" attrs propContents
, mknode "a:t" [] $ T.unpack s
]]
return [Elem $ mknode "a:r" [] [ mknode "a:rPr" attrs propContents
, mknode "a:t" [] $ T.unpack s
]]
paraElemToElements (MathElem mathType texStr) = do
isInSpkrNotes <- asks envInSpeakerNotes
if isInSpkrNotes
then paraElemToElements $ Run def $ unTeXString texStr
else do res <- convertMath writeOMML mathType (unTeXString texStr)
case res of
Right r -> return [mknode "a14:m" [] $ addMathInfo r]
Right r -> return [Elem $ mknode "a14:m" [] $ addMathInfo r]
Left (Str s) -> paraElemToElements (Run def s)
Left _ -> throwError $ PandocShouldNeverHappenError "non-string math fallback"
paraElemToElements (RawOOXMLParaElem str) = return [ x | Elem x <- parseXML str ]
paraElemToElements (RawOOXMLParaElem str) = return
[Text (CData CDataRaw (T.unpack str) Nothing)]
-- This is a bit of a kludge -- really requires adding an option to
@ -875,8 +876,9 @@ paragraphToElement par = do
[mknode "a:buAutoNum" (autoNumAttrs attrs') ()]
Nothing -> [mknode "a:buNone" [] ()]
)
paras <- concat <$> mapM paraElemToElements (paraElems par)
return $ mknode "a:p" [] $ [mknode "a:pPr" attrs props] <> paras
paras <- mapM paraElemToElements (paraElems par)
return $ mknode "a:p" [] $
[Elem $ mknode "a:pPr" attrs props] <> concat paras
shapeToElement :: PandocMonad m => Element -> Shape -> P m Element
shapeToElement layout (TextBox paras)
@ -896,21 +898,22 @@ shapeToElement layout (TextBox paras)
-- GraphicFrame and Pic should never reach this.
shapeToElement _ _ = return $ mknode "p:sp" [] ()
shapeToElements :: PandocMonad m => Element -> Shape -> P m [Element]
shapeToElements :: PandocMonad m => Element -> Shape -> P m [Content]
shapeToElements layout (Pic picProps fp alt) = do
mInfo <- registerMedia fp alt
case mInfoExt mInfo of
Just _ ->
Just _ -> map Elem <$>
makePicElements layout picProps mInfo alt
Nothing -> shapeToElements layout $ TextBox [Paragraph def alt]
shapeToElements layout (GraphicFrame tbls cptn) =
shapeToElements layout (GraphicFrame tbls cptn) = map Elem <$>
graphicFrameToElements layout tbls cptn
shapeToElements _ (RawOOXMLShape str) = return [ x | Elem x <- parseXML str ]
shapeToElements _ (RawOOXMLShape str) = return
[Text (CData CDataRaw (T.unpack str) Nothing)]
shapeToElements layout shp = do
element <- shapeToElement layout shp
return [element]
return [Elem element]
shapesToElements :: PandocMonad m => Element -> [Shape] -> P m [Element]
shapesToElements :: PandocMonad m => Element -> [Shape] -> P m [Content]
shapesToElements layout shps =
concat <$> mapM (shapeToElements layout) shps
@ -1083,7 +1086,7 @@ contentToElement layout hdrShape shapes
, Just cSld <- findChild (elemName ns "p" "cSld") layout
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
element <- nonBodyTextToElement layout [PHType "title"] hdrShape
let hdrShapeElements = [element | not (null hdrShape)]
let hdrShapeElements = [Elem element | not (null hdrShape)]
contentElements <- local
(\env -> env {envContentType = NormalContent})
(shapesToElements layout shapes)
@ -1096,7 +1099,7 @@ twoColumnToElement layout hdrShape shapesL shapesR
, Just cSld <- findChild (elemName ns "p" "cSld") layout
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
element <- nonBodyTextToElement layout [PHType "title"] hdrShape
let hdrShapeElements = [element | not (null hdrShape)]
let hdrShapeElements = [Elem element | not (null hdrShape)]
contentElementsL <- local
(\env -> env {envContentType =TwoColumnLeftContent})
(shapesToElements layout shapesL)
@ -1105,7 +1108,8 @@ twoColumnToElement layout hdrShape shapesL shapesR
(shapesToElements layout shapesR)
-- let contentElementsL' = map (setIdx ns "1") contentElementsL
-- contentElementsR' = map (setIdx ns "2") contentElementsR
return $ buildSpTree ns spTree (hdrShapeElements <> contentElementsL <> contentElementsR)
return $ buildSpTree ns spTree $
hdrShapeElements <> contentElementsL <> contentElementsR
twoColumnToElement _ _ _ _= return $ mknode "p:sp" [] ()
@ -1115,7 +1119,7 @@ titleToElement layout titleElems
, Just cSld <- findChild (elemName ns "p" "cSld") layout
, Just spTree <- findChild (elemName ns "p" "spTree") cSld = do
element <- nonBodyTextToElement layout [PHType "title", PHType "ctrTitle"] titleElems
let titleShapeElements = [element | not (null titleElems)]
let titleShapeElements = [Elem element | not (null titleElems)]
return $ buildSpTree ns spTree titleShapeElements
titleToElement _ _ = return $ mknode "p:sp" [] ()
@ -1135,7 +1139,8 @@ metadataToElement layout titleElems subtitleElems authorsElems dateElems
dateShapeElements <- if null dateElems
then return []
else sequence [nonBodyTextToElement layout [PHType "dt"] dateElems]
return $ buildSpTree ns spTree (titleShapeElements <> subtitleShapeElements <> dateShapeElements)
return . buildSpTree ns spTree . map Elem $
(titleShapeElements <> subtitleShapeElements <> dateShapeElements)
metadataToElement _ _ _ _ _ = return $ mknode "p:sp" [] ()
slideToElement :: PandocMonad m => Slide -> P m Element

2
test/pptx/raw_ooxml.native
View file

@ -1,3 +1,3 @@
[Para [Str "Here",Space,Str "is",Space,Str "some",Space,Str "text,",Space,Str "written",Space,Str "as",Space,Str "a",Space,Str "raw",Space,Str "inline:",Space,RawInline (Format "openxml") "<a:r><a:rPr /><a:t>Here are examples of </a:t></a:r><a:r><a:rPr i=\"1\" /><a:t>italics</a:t></a:r><a:r><a:rPr /><a:t>, </a:t></a:r><a:r><a:rPr b=\"1\" /><a:t>bold</a:t></a:r>"]
,HorizontalRule
,RawBlock (Format "openxml") " <p:sp>\n <p:nvSpPr>\n <p:cNvPr id=\"3\" name=\"Content Placeholder 2\"/>\n <p:cNvSpPr>\n <a:spLocks noGrp=\"1\"/>\n </p:cNvSpPr>\n <p:nvPr>\n <p:ph idx=\"1\"/>\n </p:nvPr>\n </p:nvSpPr>\n <p:spPr/>\n <p:txBody>\n <a:bodyPr/>\n <a:lstStyle/>\n <a:p>\n <a:pPr lvl=\"1\"/>\n <a:r>\n <a:rPr/>\n <a:t>Bulleted bulleted lists.</a:t>\n </a:r>\n </a:p>\n <a:p>\n <a:pPr lvl=\"1\"/>\n <a:r>\n <a:rPr/>\n <a:t>And go to arbitrary depth.</a:t>\n </a:r>\n </a:p>\n <a:p>\n <a:pPr lvl=\"2\"/>\n <a:r>\n <a:rPr/>\n <a:t>Like this</a:t>\n </a:r>\n </a:p>\n <a:p>\n <a:pPr lvl=\"3\"/>\n <a:r>\n <a:rPr/>\n <a:t>Or this</a:t>\n </a:r>\n </a:p>\n <a:p>\n <a:pPr lvl=\"2\"/>\n <a:r>\n <a:rPr/>\n <a:t>Back to here.</a:t>\n </a:r>\n </a:p>\n </p:txBody>\n </p:sp>"]
,RawBlock (Format "openxml") "<p:sp>\n <p:nvSpPr>\n <p:cNvPr id=\"3\" name=\"Content Placeholder 2\" />\n <p:cNvSpPr>\n <a:spLocks noGrp=\"1\" />\n </p:cNvSpPr>\n <p:nvPr>\n <p:ph idx=\"1\" />\n </p:nvPr>\n </p:nvSpPr>\n <p:spPr />\n <p:txBody>\n <a:bodyPr />\n <a:lstStyle />\n <a:p>\n <a:pPr lvl=\"1\" />\n <a:r>\n <a:rPr />\n <a:t>Bulleted bulleted lists.</a:t>\n </a:r>\n </a:p>\n <a:p>\n <a:pPr lvl=\"1\" />\n <a:r>\n <a:rPr />\n <a:t>And go to arbitrary depth.</a:t>\n </a:r>\n </a:p>\n <a:p>\n <a:pPr lvl=\"2\" />\n <a:r>\n <a:rPr />\n <a:t>Like this</a:t>\n </a:r>\n </a:p>\n <a:p>\n <a:pPr lvl=\"3\" />\n <a:r>\n <a:rPr />\n <a:t>Or this</a:t>\n </a:r>\n </a:p>\n <a:p>\n <a:pPr lvl=\"2\" />\n <a:r>\n <a:rPr />\n <a:t>Back to here.</a:t>\n </a:r>\n </a:p>\n </p:txBody>\n </p:sp>"]