diff options
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Options.hs | 7 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 29 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 19 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 19 |
4 files changed, 35 insertions, 39 deletions
diff --git a/src/Text/Pandoc/Options.hs b/src/Text/Pandoc/Options.hs index 3a787a733..e7dec6492 100644 --- a/src/Text/Pandoc/Options.hs +++ b/src/Text/Pandoc/Options.hs @@ -171,8 +171,8 @@ data WriterOptions = WriterOptions , writerSlideLevel :: Maybe Int -- ^ Force header level of slides , writerTopLevelDivision :: TopLevelDivision -- ^ Type of top-level divisions , writerListings :: Bool -- ^ Use listings package for code - , writerHighlight :: Bool -- ^ Highlight source code - , writerHighlightStyle :: Style -- ^ Style to use for highlighting + , writerHighlightStyle :: Maybe Style -- ^ Style to use for highlighting + -- (Nothing = no highlighting) , writerSetextHeaders :: Bool -- ^ Use setext headers for levels 1-2 in markdown , writerEpubVersion :: Maybe EPUBVersion -- ^ Nothing or EPUB version , writerEpubMetadata :: String -- ^ Metadata to include in EPUB @@ -214,8 +214,7 @@ instance Default WriterOptions where , writerSlideLevel = Nothing , writerTopLevelDivision = TopLevelDefault , writerListings = False - , writerHighlight = False - , writerHighlightStyle = pygments + , writerHighlightStyle = Just pygments , writerSetextHeaders = True , writerEpubVersion = Nothing , writerEpubMetadata = "" diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs index b7fd3e2a3..6a53485c4 100644 --- a/src/Text/Pandoc/Writers/Docx.hs +++ b/src/Text/Pandoc/Writers/Docx.hs @@ -52,7 +52,6 @@ import Text.Pandoc.Error (PandocError) import Text.XML.Light as XML import Text.TeXMath import Text.Pandoc.Readers.Docx.StyleMap -import Text.Pandoc.Readers.Docx.Util (elemName) import Control.Monad.Reader import Control.Monad.State import Skylighting @@ -450,18 +449,11 @@ writeDocx opts doc@(Pandoc meta _) = do let newstyles = map newParaPropToOpenXml newDynamicParaProps ++ map newTextPropToOpenXml newDynamicTextProps ++ - (styleToOpenXml styleMaps $ writerHighlightStyle opts) - let styledoc' = styledoc{ elContent = modifyContent (elContent styledoc) } - where - modifyContent - | writerHighlight opts = (++ map Elem newstyles) - | otherwise = filter notTokStyle - notTokStyle (Elem el) = notStyle el || notTokId el - notTokStyle _ = True - notStyle = (/= elemName' "style") . elName - notTokId = maybe True (`notElem` tokStys) . findAttr (elemName' "styleId") - tokStys = "SourceCode" : map show (enumFromTo KeywordTok NormalTok) - elemName' = elemName (sNameSpaces styleMaps) "w" + (case writerHighlightStyle opts of + Nothing -> [] + Just sty -> (styleToOpenXml styleMaps sty)) + let styledoc' = styledoc{ elContent = elContent styledoc ++ + map Elem newstyles } let styleEntry = toEntry stylepath epochtime $ renderXml styledoc' -- construct word/numbering.xml @@ -1130,11 +1122,9 @@ inlineToOpenXML' opts (Code attrs str) = do [ rCustomStyle (show toktype) ] , mknode "w:t" [("xml:space","preserve")] (T.unpack tok) ] withTextProp (rCustomStyle "VerbatimChar") - $ if writerHighlight opts - then case highlight formatOpenXML attrs str of - Nothing -> unhighlighted - Just h -> return h - else unhighlighted + $ case writerHighlightStyle opts >> highlight formatOpenXML attrs str of + Just h -> return h + Nothing -> unhighlighted inlineToOpenXML' opts (Note bs) = do notes <- gets stFootnotes notenum <- (lift . lift) getUniqueId @@ -1249,9 +1239,6 @@ inlineToOpenXML' opts (Image attr alt (src, title)) = do br :: Element br = breakElement "textWrapping" -pageBreak :: Element -pageBreak = breakElement "page" - breakElement :: String -> Element breakElement kind = mknode "w:r" [] [mknode "w:br" [("w:type",kind)] () ] diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index e144d0d63..c6d7b7f6a 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -179,8 +179,10 @@ pandocToHtml opts (Pandoc meta blocks) = do | otherwise -> mempty Nothing -> mempty let context = (if stHighlighting st - then defField "highlighting-css" - (styleToCss $ writerHighlightStyle opts) + then case writerHighlightStyle opts of + Just sty -> defField "highlighting-css" + (styleToCss sty) + Nothing -> id else id) $ (if stMath st then defField "math" (renderHtml math) @@ -509,8 +511,9 @@ blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do adjCode = if tolhs then unlines . map ("> " ++) . lines $ rawCode else rawCode - hlCode = if writerHighlight opts -- check highlighting options - then highlight formatHtmlBlock (id',classes',keyvals) adjCode + hlCode = if isJust (writerHighlightStyle opts) + then highlight formatHtmlBlock + (id',classes',keyvals) adjCode else Nothing case hlCode of Nothing -> return $ addAttrs opts (id',classes,keyvals) @@ -702,7 +705,8 @@ annotateMML e tex = math (unode "semantics" [cs, unode "annotation" (annotAttrs, -- | Convert Pandoc inline element to HTML. -inlineToHtml :: PandocMonad m => WriterOptions -> Inline -> StateT WriterState m Html +inlineToHtml :: PandocMonad m + => WriterOptions -> Inline -> StateT WriterState m Html inlineToHtml opts inline = case inline of (Str str) -> return $ strToHtml str @@ -739,8 +743,9 @@ inlineToHtml opts inline = modify $ \st -> st{ stHighlighting = True } return $ addAttrs opts (id',[],keyvals) h where (id',_,keyvals) = attr - hlCode = if writerHighlight opts - then highlight formatHtmlInline attr str + hlCode = if isJust (writerHighlightStyle opts) + then highlight formatHtmlInline + attr str else Nothing (Strikeout lst) -> inlineListToHtml opts lst >>= return . H.del diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs index 031cd584e..953e4250f 100644 --- a/src/Text/Pandoc/Writers/LaTeX.hs +++ b/src/Text/Pandoc/Writers/LaTeX.hs @@ -188,8 +188,11 @@ pandocToLaTeX options (Pandoc meta blocks) = do defField "listings" (writerListings options || stLHS st) $ defField "beamer" (writerBeamer options) $ (if stHighlighting st - then defField "highlighting-macros" (styleToLaTeX - $ writerHighlightStyle options ) + then case writerHighlightStyle options of + Just sty -> + defField "highlighting-macros" + (styleToLaTeX sty) + Nothing -> id else id) $ (case writerCiteMethod options of Natbib -> defField "biblio-title" biblioTitle . @@ -512,10 +515,11 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do return (flush $ linkAnchor $$ text (T.unpack h)) case () of _ | isEnabled Ext_literate_haskell opts && "haskell" `elem` classes && - "literate" `elem` classes -> lhsCodeBlock - | writerListings opts -> listingsCodeBlock - | writerHighlight opts && not (null classes) -> highlightedCodeBlock - | otherwise -> rawCodeBlock + "literate" `elem` classes -> lhsCodeBlock + | writerListings opts -> listingsCodeBlock + | not (null classes) && isJust (writerHighlightStyle opts) + -> highlightedCodeBlock + | otherwise -> rawCodeBlock blockToLaTeX (RawBlock f x) | f == Format "latex" || f == Format "tex" = return $ text x @@ -904,7 +908,8 @@ inlineToLaTeX (Code (_,classes,_) str) = do inHeading <- gets stInHeading case () of _ | writerListings opts && not inHeading -> listingsCode - | writerHighlight opts && not (null classes) -> highlightCode + | isJust (writerHighlightStyle opts) && not (null classes) + -> highlightCode | otherwise -> rawCode where listingsCode = do inNote <- gets stInNote |