summaryrefslogtreecommitdiff
path: root/src/Text
diff options
context:
space:
mode:
authorJohn MacFarlane <jgm@berkeley.edu>2017-01-22 11:36:30 +0100
committerJohn MacFarlane <jgm@berkeley.edu>2017-01-25 17:07:43 +0100
commitd1efc839f129d23fe8a6523e33a01b0b463ee409 (patch)
tree73149a80a0dbd001689ee91d00692ea792209512 /src/Text
parent6f9df9b4f1d3d22c53b9d6f3c333efc23a84ffe7 (diff)
Removed writerHighlight; made writerHighlightStyle a Maybe.
API change. For no highlighting, set writerHighlightStyle to Nothing.
Diffstat (limited to 'src/Text')
-rw-r--r--src/Text/Pandoc/Options.hs7
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs29
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs19
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs19
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