From 14b00517ae6df7d4bb24b418530c8b57182c787c Mon Sep 17 00:00:00 2001 From: Nikolay Yakimov Date: Sat, 14 Sep 2019 17:23:26 +0300 Subject: [Docx Writer] Consistently use style names, not style ids Styles that this change affects: paragraph styles: Author, Abstract, Compact, Figure, Captioned Figure, Image Caption, First Paragraph, Source Code, Table Caption, Definition, Definition Term; character styles: Verbatim Char, token styles (those with names ending in Tok) --- src/Text/Pandoc/Writers/Docx.hs | 52 ++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 27 deletions(-) diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index 62c7499e4..d62dbeedb 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -780,7 +780,7 @@ makeTOC opts = do return [mknode "w:sdt" [] [ mknode "w:sdtPr" [] ( - mknode "w:docPartObj" [] + mknode "w:docPartObj" [] [mknode "w:docPartGallery" [("w:val","Table of Contents")] (), mknode "w:docPartUnique" [] ()] -- w:docPartObj @@ -809,12 +809,12 @@ writeOpenXML opts (Pandoc meta blocks) = do let includeTOC = writerTableOfContents opts || lookupMetaBool "toc" meta title <- withParaPropM (pStyleM "Title") $ blocksToOpenXML opts [Para tit | not (null tit)] subtitle <- withParaPropM (pStyleM "Subtitle") $ blocksToOpenXML opts [Para subtitle' | not (null subtitle')] - authors <- withParaProp (pCustomStyle "Author") $ blocksToOpenXML opts $ + authors <- withParaPropM (pStyleM "Author") $ blocksToOpenXML opts $ map Para auths date <- withParaPropM (pStyleM "Date") $ blocksToOpenXML opts [Para dat | not (null dat)] abstract <- if null abstract' then return [] - else withParaProp (pCustomStyle "Abstract") $ blocksToOpenXML opts abstract' + else withParaPropM (pStyleM "Abstract") $ blocksToOpenXML opts abstract' let convertSpace (Str x : Space : Str y : xs) = Str (x ++ " " ++ y) : xs convertSpace (Str x : Str y : xs) = Str (x ++ y) : xs convertSpace xs = xs @@ -848,18 +848,12 @@ writeOpenXML opts (Pandoc meta blocks) = do blocksToOpenXML :: (PandocMonad m) => WriterOptions -> [Block] -> WS m [Element] blocksToOpenXML opts bls = concat `fmap` mapM (blockToOpenXML opts) bls -pCustomStyle :: String -> Element -pCustomStyle sty = mknode "w:pStyle" [("w:val",sty)] () - pStyleM :: (PandocMonad m) => String -> WS m XML.Element pStyleM styleName = do styleMaps <- gets stStyleMaps let sty' = getStyleId styleName $ sParaStyleMap styleMaps return $ mknode "w:pStyle" [("w:val",sty')] () -rCustomStyle :: String -> Element -rCustomStyle sty = mknode "w:rStyle" [("w:val",sty)] () - rStyleM :: (PandocMonad m) => String -> WS m XML.Element rStyleM styleName = do styleMaps <- gets stStyleMaps @@ -921,19 +915,19 @@ blockToOpenXML' opts (Header lev (ident,_,_) lst) = do blockToOpenXML' opts (Plain lst) = do isInTable <- gets stInTable let block = blockToOpenXML opts (Para lst) - para <- if isInTable then withParaProp (pCustomStyle "Compact") block else block + prop <- pStyleM "Compact" + para <- if isInTable then withParaProp prop block else block return $ para - -- title beginning with fig: indicates that the image is a figure blockToOpenXML' opts (Para [Image attr alt (src,'f':'i':'g':':':tit)]) = do setFirstPara - let prop = pCustomStyle $ + prop <- pStyleM $ if null alt then "Figure" - else "CaptionedFigure" + else "Captioned Figure" paraProps <- local (\env -> env { envParaProperties = EnvProps (Just prop) [] <> envParaProperties env }) (getParaProps False) contents <- inlinesToOpenXML opts [Image attr alt (src,tit)] - captionNode <- withParaProp (pCustomStyle "ImageCaption") + captionNode <- withParaPropM (pStyleM "Image Caption") $ blockToOpenXML opts (Para alt) return $ mknode "w:p" [] (paraProps ++ contents) : captionNode blockToOpenXML' opts (Para lst) @@ -944,10 +938,10 @@ blockToOpenXML' opts (Para lst) [x] -> isDisplayMath x _ -> False paraProps <- getParaProps displayMathPara - bodyTextStyle <- pStyleM "Body Text" + bodyTextStyle <- if isFirstPara + then pStyleM "First Paragraph" + else pStyleM "Body Text" let paraProps' = case paraProps of - [] | isFirstPara -> [mknode "w:pPr" [] - [pCustomStyle "FirstParagraph"]] [] -> [mknode "w:pPr" [] [bodyTextStyle]] ps -> ps modify $ \s -> s { stFirstPara = False } @@ -965,7 +959,7 @@ blockToOpenXML' opts (BlockQuote blocks) = do setFirstPara return p blockToOpenXML' opts (CodeBlock attrs@(ident, _, _) str) = do - p <- withParaProp (pCustomStyle "SourceCode") (blockToOpenXML opts $ Para [Code attrs str]) + p <- withParaPropM (pStyleM "Source Code") (blockToOpenXML opts $ Para [Code attrs str]) setFirstPara wrapBookmark ident p blockToOpenXML' _ HorizontalRule = do @@ -981,7 +975,7 @@ blockToOpenXML' opts (Table caption aligns widths headers rows) = do let captionStr = stringify caption caption' <- if null caption then return [] - else withParaProp (pCustomStyle "TableCaption") + else withParaPropM (pStyleM "Table Caption") $ blockToOpenXML opts (Para caption) let alignmentFor al = mknode "w:jc" [("w:val",alignmentToString al)] () -- Table cells require a element, even an empty one! @@ -997,7 +991,8 @@ blockToOpenXML' opts (Table caption aligns widths headers rows) = do [ mknode "w:tcBorders" [] $ mknode "w:bottom" [("w:val","single")] () , mknode "w:vAlign" [("w:val","bottom")] () ] - let emptyCell = [mknode "w:p" [] [mknode "w:pPr" [] [pCustomStyle "Compact"]]] + compactStyle <- pStyleM "Compact" + let emptyCell = [mknode "w:p" [] [mknode "w:pPr" [] [compactStyle]]] let mkcell border contents = mknode "w:tc" [] $ [ borderProps | border ] ++ if null contents @@ -1048,9 +1043,9 @@ blockToOpenXML' opts (DefinitionList items) = do definitionListItemToOpenXML :: (PandocMonad m) => WriterOptions -> ([Inline],[[Block]]) -> WS m [Element] definitionListItemToOpenXML opts (term,defs) = do - term' <- withParaProp (pCustomStyle "DefinitionTerm") + term' <- withParaPropM (pStyleM "Definition Term") $ blockToOpenXML opts (Para term) - defs' <- withParaProp (pCustomStyle "Definition") + defs' <- withParaPropM (pStyleM "Definition") $ concat `fmap` mapM (blocksToOpenXML opts) defs return $ term' ++ defs' @@ -1263,14 +1258,17 @@ inlineToOpenXML' opts (Math mathType str) = do Left il -> inlineToOpenXML' opts il inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst inlineToOpenXML' opts (Code attrs str) = do + let alltoktypes = [KeywordTok ..] + tokTypesMap <- mapM (\tt -> (,) tt <$> rStyleM (show tt)) alltoktypes let unhighlighted = intercalate [br] `fmap` mapM formattedString (lines str) formatOpenXML _fmtOpts = intercalate [br] . map (map toHlTok) - toHlTok (toktype,tok) = mknode "w:r" [] - [ mknode "w:rPr" [] - [ rCustomStyle (show toktype) ] - , mknode "w:t" [("xml:space","preserve")] (T.unpack tok) ] - withTextProp (rCustomStyle "VerbatimChar") + toHlTok (toktype,tok) = + mknode "w:r" [] + [ mknode "w:rPr" [] $ + maybeToList (lookup toktype tokTypesMap) + , mknode "w:t" [("xml:space","preserve")] (T.unpack tok) ] + withTextPropM (rStyleM "Verbatim Char") $ if isNothing (writerHighlightStyle opts) then unhighlighted else case highlight (writerSyntaxMap opts) -- cgit v1.2.3