aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorAlbert Krewinkel <[email protected]>2025-08-11 19:54:23 +0200
committerJohn MacFarlane <[email protected]>2025-09-02 17:50:47 +0200
commite0acb24528cbf409ae5723e537acb0c2ed4e2d91 (patch)
tree77bf1d4ac09a2ec049da651d32bd97a04656dd4d /src
parent64757254ab6e1d005cf8f4ee6c491d97aed7b16f (diff)
Refactor highlighting options [API Change]
A new command line option `--syntax-highlighting` is provided; it takes the values `none`, `default`, `idiomatic`, a style name, or a path to a theme file. It replaces the `--no-highlighting`, `--highlighting-style`, and `--listings` options. The `writerListings` and `writerHighlightStyle` fields of the `WriterOptions` type are replaced with `writerHighlightStyle`. Closes: #10525
Diffstat (limited to 'src')
-rw-r--r--src/Text/Pandoc/App/CommandLineOptions.hs29
-rw-r--r--src/Text/Pandoc/App/Opt.hs30
-rw-r--r--src/Text/Pandoc/App/OutputSettings.hs11
-rw-r--r--src/Text/Pandoc/Writers/ANSI.hs25
-rw-r--r--src/Text/Pandoc/Writers/ConTeXt.hs24
-rw-r--r--src/Text/Pandoc/Writers/Docx.hs7
-rw-r--r--src/Text/Pandoc/Writers/Docx/OpenXML.hs18
-rw-r--r--src/Text/Pandoc/Writers/HTML.hs37
-rw-r--r--src/Text/Pandoc/Writers/LaTeX.hs35
-rw-r--r--src/Text/Pandoc/Writers/Man.hs5
-rw-r--r--src/Text/Pandoc/Writers/Ms.hs4
-rw-r--r--src/Text/Pandoc/Writers/ODT.hs7
-rw-r--r--src/Text/Pandoc/Writers/OpenDocument.hs16
-rw-r--r--src/Text/Pandoc/Writers/Powerpoint/Presentation.hs18
14 files changed, 166 insertions, 100 deletions
diff --git a/src/Text/Pandoc/App/CommandLineOptions.hs b/src/Text/Pandoc/App/CommandLineOptions.hs
index b28013107..e9d5e0597 100644
--- a/src/Text/Pandoc/App/CommandLineOptions.hs
+++ b/src/Text/Pandoc/App/CommandLineOptions.hs
@@ -520,13 +520,18 @@ options =
, Option "" ["no-highlight"]
(NoArg
- (\opt -> return opt { optHighlightStyle = Nothing }))
+ (\opt -> do
+ deprecatedOption "--no-highlight"
+ "Use --syntax-highlighting=none instead."
+ return opt { optSyntaxHighlighting = NoHighlightingString }))
"" -- "Don't highlight source code"
, Option "" ["highlight-style"]
(ReqArg
- (\arg opt ->
- return opt{ optHighlightStyle = Just $
+ (\arg opt -> do
+ deprecatedOption "--highlight-style"
+ "Use --syntax-highlighting instead."
+ return opt{ optSyntaxHighlighting =
T.pack $ normalizePath arg })
"STYLE|FILE")
"" -- "Style for highlighted code"
@@ -539,6 +544,14 @@ options =
"FILE")
"" -- "Syntax definition (xml) file"
+ , Option "" ["syntax-highlighting"]
+ (ReqArg
+ (\arg opt -> return opt{ optSyntaxHighlighting =
+ T.pack $ normalizePath arg })
+ "none|default|idiomatic|<stylename>|<themepath>")
+ "" -- "syntax highlighting method for code"
+
+
, Option "" ["dpi"]
(ReqArg
(\arg opt ->
@@ -809,8 +822,14 @@ options =
, Option "" ["listings"]
(OptArg
(\arg opt -> do
- boolValue <- readBoolFromOptArg "--listings" arg
- return opt { optListings = boolValue })
+ deprecatedOption "--listings"
+ "Use --syntax-highlighting=idiomatic instead."
+ boolValue <- readBoolFromOptArg "--listings" arg
+ return $
+ if boolValue
+ then opt { optSyntaxHighlighting =
+ IdiomaticHighlightingString }
+ else opt)
"true|false")
"" -- "Use listings package for LaTeX code blocks"
diff --git a/src/Text/Pandoc/App/Opt.hs b/src/Text/Pandoc/App/Opt.hs
index 3b90901d0..38111ea32 100644
--- a/src/Text/Pandoc/App/Opt.hs
+++ b/src/Text/Pandoc/App/Opt.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
@@ -36,7 +37,6 @@ import Data.Char (toLower)
import Data.Maybe (fromMaybe)
import GHC.Generics hiding (Meta)
import Text.Pandoc.Filter (Filter (..))
-import Text.Pandoc.Highlighting (defaultStyleName)
import Text.Pandoc.Logging (Verbosity (WARNING), LogMessage(..))
import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault),
TrackChanges (AcceptChanges),
@@ -44,7 +44,8 @@ import Text.Pandoc.Options (TopLevelDivision (TopLevelDefault),
ReferenceLocation (EndOfDocument),
CaptionPosition (..),
ObfuscationMethod (NoObfuscation),
- CiteMethod (Citeproc))
+ CiteMethod (Citeproc),
+ pattern DefaultHighlightingString)
import Text.Pandoc.Class (readFileStrict, fileExists, setVerbosity, report,
PandocMonad(lookupEnv), getUserDataDir)
import Text.Pandoc.Error (PandocError (PandocParseError, PandocSomeError))
@@ -125,8 +126,8 @@ data Opt = Opt
, optEmbedResources :: Bool -- ^ Make HTML accessible offline
, optLinkImages :: Bool -- ^ Link ODT images rather than embedding
, optHtmlQTags :: Bool -- ^ Use <q> tags in HTML
- , optHighlightStyle :: Maybe Text -- ^ Style to use for highlighted code
, optSyntaxDefinitions :: [FilePath] -- ^ xml syntax defs to load
+ , optSyntaxHighlighting :: Text -- ^ Syntax highlighting method for code
, optTopLevelDivision :: TopLevelDivision -- ^ Type of the top-level divisions
, optHTMLMathMethod :: HTMLMathMethod -- ^ Method to print HTML math
, optAbbreviations :: Maybe FilePath -- ^ Path to abbrevs file
@@ -158,7 +159,6 @@ data Opt = Opt
, optIndentedCodeClasses :: [Text] -- ^ Default classes for indented code blocks
, optDataDir :: Maybe FilePath
, optCiteMethod :: CiteMethod -- ^ Method to output cites
- , optListings :: Bool -- ^ Use listings package for code blocks
, optPdfEngine :: Maybe String -- ^ Program to use for latex/html -> pdf
, optPdfEngineOpts :: [String] -- ^ Flags to pass to the engine
, optSlideLevel :: Maybe Int -- ^ Header level that creates slides
@@ -212,8 +212,8 @@ instance FromJSON Opt where
<*> o .:? "embed-resources" .!= optEmbedResources defaultOpts
<*> o .:? "link-images" .!= optLinkImages defaultOpts
<*> o .:? "html-q-tags" .!= optHtmlQTags defaultOpts
- <*> o .:? "highlight-style"
<*> o .:? "syntax-definitions" .!= optSyntaxDefinitions defaultOpts
+ <*> o .:? "syntax-highlighting" .!= optSyntaxHighlighting defaultOpts
<*> o .:? "top-level-division" .!= optTopLevelDivision defaultOpts
<*> o .:? "html-math-method" .!= optHTMLMathMethod defaultOpts
<*> o .:? "abbreviations"
@@ -246,7 +246,6 @@ instance FromJSON Opt where
<*> o .:? "indented-code-classes" .!= optIndentedCodeClasses defaultOpts
<*> o .:? "data-dir"
<*> o .:? "cite-method" .!= optCiteMethod defaultOpts
- <*> o .:? "listings" .!= optListings defaultOpts
<*> o .:? "pdf-engine"
<*> o .:? "pdf-engine-opts" .!= optPdfEngineOpts defaultOpts
<*> o .:? "slide-level"
@@ -320,6 +319,7 @@ resolveVarsInOpt
, optOutputFile = oOutputFile
, optInputFiles = oInputFiles
, optSyntaxDefinitions = oSyntaxDefinitions
+ , optSyntaxHighlighting = oSyntaxHighlighting
, optAbbreviations = oAbbreviations
, optReferenceDoc = oReferenceDoc
, optEpubMetadata = oEpubMetadata
@@ -338,7 +338,6 @@ resolveVarsInOpt
, optBibliography = oBibliography
, optCitationAbbreviations = oCitationAbbreviations
, optPdfEngine = oPdfEngine
- , optHighlightStyle = oHighlightStyle
}
= do
oTo' <- mapM (fmap T.pack . resolveVars . T.unpack) oTo
@@ -366,7 +365,7 @@ resolveVarsInOpt
oBibliography' <- mapM resolveVars oBibliography
oCitationAbbreviations' <- mapM resolveVars oCitationAbbreviations
oPdfEngine' <- mapM resolveVars oPdfEngine
- oHighlightStyle' <- mapM (fmap T.pack . resolveVars . T.unpack) oHighlightStyle
+ oSyntaxHighlighting' <- T.pack <$> resolveVars (T.unpack oSyntaxHighlighting)
return opt{ optTo = oTo'
, optFrom = oFrom'
, optTemplate = oTemplate'
@@ -374,6 +373,7 @@ resolveVarsInOpt
, optOutputFile = oOutputFile'
, optInputFiles = oInputFiles'
, optSyntaxDefinitions = oSyntaxDefinitions'
+ , optSyntaxHighlighting = oSyntaxHighlighting'
, optAbbreviations = oAbbreviations'
, optReferenceDoc = oReferenceDoc'
, optEpubMetadata = oEpubMetadata'
@@ -392,7 +392,6 @@ resolveVarsInOpt
, optBibliography = oBibliography'
, optCitationAbbreviations = oCitationAbbreviations'
, optPdfEngine = oPdfEngine'
- , optHighlightStyle = oHighlightStyle'
}
where
@@ -556,8 +555,9 @@ doOpt (k,v) = do
parseJSON v >>= \x -> return (\o -> o{ optLinkImages = x })
"html-q-tags" ->
parseJSON v >>= \x -> return (\o -> o{ optHtmlQTags = x })
+ -- Deprecated
"highlight-style" ->
- parseJSON v >>= \x -> return (\o -> o{ optHighlightStyle = x })
+ parseJSON v >>= \x -> return (\o -> o{ optSyntaxHighlighting = x })
"syntax-definition" ->
(parseJSON v >>= \x ->
return (\o -> o{ optSyntaxDefinitions =
@@ -570,6 +570,8 @@ doOpt (k,v) = do
parseJSON v >>= \x ->
return (\o -> o{ optSyntaxDefinitions =
optSyntaxDefinitions o <> map unpack x })
+ "syntax-highlighting" ->
+ parseJSON v >>= \x -> return (\o -> o{ optSyntaxHighlighting = x })
"top-level-division" ->
parseJSON v >>= \x -> return (\o -> o{ optTopLevelDivision = x })
"html-math-method" ->
@@ -648,7 +650,10 @@ doOpt (k,v) = do
"cite-method" ->
parseJSON v >>= \x -> return (\o -> o{ optCiteMethod = x })
"listings" ->
- parseJSON v >>= \x -> return (\o -> o{ optListings = x })
+ parseJSON v >>= \x ->
+ if x
+ then return (\o -> o{ optSyntaxHighlighting = "idiomatic" })
+ else return id
"pdf-engine" ->
parseJSON v >>= \x -> return (\o -> o{ optPdfEngine = unpack <$> x })
"pdf-engine-opts" ->
@@ -774,8 +779,8 @@ defaultOpts = Opt
, optEmbedResources = False
, optLinkImages = False
, optHtmlQTags = False
- , optHighlightStyle = Just defaultStyleName
, optSyntaxDefinitions = []
+ , optSyntaxHighlighting = DefaultHighlightingString
, optTopLevelDivision = TopLevelDefault
, optHTMLMathMethod = PlainMath
, optAbbreviations = Nothing
@@ -807,7 +812,6 @@ defaultOpts = Opt
, optIndentedCodeClasses = []
, optDataDir = Nothing
, optCiteMethod = Citeproc
- , optListings = False
, optPdfEngine = Nothing
, optPdfEngineOpts = []
, optSlideLevel = Nothing
diff --git a/src/Text/Pandoc/App/OutputSettings.hs b/src/Text/Pandoc/App/OutputSettings.hs
index 21a5df629..657613978 100644
--- a/src/Text/Pandoc/App/OutputSettings.hs
+++ b/src/Text/Pandoc/App/OutputSettings.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{- |
@@ -165,8 +166,11 @@ optToOutputSettings scriptingEngine opts = do
syntaxMap <- foldM addSyntaxMap defaultSyntaxMap
(optSyntaxDefinitions opts)
- hlStyle <- traverse (lookupHighlightingStyle . T.unpack) $
- optHighlightStyle opts
+ hlStyle <- case optSyntaxHighlighting opts of
+ NoHighlightingString -> pure NoHighlighting
+ DefaultHighlightingString -> pure DefaultHighlighting
+ IdiomaticHighlightingString -> pure IdiomaticHighlighting
+ style -> Skylighting <$> lookupHighlightingStyle (T.unpack style)
let setListVariableM _ [] ctx = return ctx
setListVariableM k vs ctx = do
@@ -251,9 +255,8 @@ optToOutputSettings scriptingEngine opts = do
, writerIdentifierPrefix = optIdentifierPrefix opts
, writerHtmlQTags = optHtmlQTags opts
, writerTopLevelDivision = optTopLevelDivision opts
- , writerListings = optListings opts
, writerSlideLevel = optSlideLevel opts
- , writerHighlightStyle = hlStyle
+ , writerHighlightMethod = hlStyle
, writerSetextHeaders = optSetextHeaders opts
, writerListTables = optListTables opts
, writerEpubSubdirectory = T.pack $ optEpubSubdirectory opts
diff --git a/src/Text/Pandoc/Writers/ANSI.hs b/src/Text/Pandoc/Writers/ANSI.hs
index 6a2b89737..cc731aea1 100644
--- a/src/Text/Pandoc/Writers/ANSI.hs
+++ b/src/Text/Pandoc/Writers/ANSI.hs
@@ -1,7 +1,8 @@
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Writers.ANSI
- Copyright : Copyright (C) 2024 Evan Silberman
+ Copyright : © 2024 Evan Silberman
+ © 2025 Pandoc contributors
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <[email protected]>
@@ -30,6 +31,7 @@ import Text.Pandoc.Writers.Shared
import qualified Data.Text as T
import Data.Text.Lazy (toStrict)
import qualified Text.DocLayout as D
+import qualified Text.Pandoc.Highlighting as HL
hr :: D.HasChars a => D.Doc a
hr = rule 20
@@ -168,15 +170,20 @@ blockToANSI opts (Header level (_, classes, kvs) inlines) = do
-- Doc Text.
blockToANSI opts (CodeBlock attr str) = do
table <- gets stInTable
- inner <- case (table, writerHighlightStyle opts) of
- (_, Nothing) -> return $ defaultStyle str
+ let highlightWithStyle s = do
+ let fmt o = formatANSI o s
+ result = highlight (writerSyntaxMap opts) fmt attr str
+ return $ case result of
+ Left _ -> defaultStyle str
+ Right f -> D.literal f
+ inner <- case (table, writerHighlightMethod opts) of
+ (_, NoHighlighting) -> return $ defaultStyle str
(True, _) -> return $ defaultStyle str
- (False, Just s) -> do
- let fmt o = formatANSI o s
- result = highlight (writerSyntaxMap opts) fmt attr str
- return $ case result of
- Left _ -> defaultStyle str
- Right f -> D.literal f
+ (False, Skylighting s) -> highlightWithStyle s
+ (False, DefaultHighlighting) -> highlightWithStyle HL.defaultStyle
+ (False, IdiomaticHighlighting) -> do
+ report $ CouldNotHighlight "no idiomatic highlighting in ANSI"
+ return $ defaultStyle str
return $ nest table inner
where defaultStyle = (D.fg D.red) . D.literal
nest False = D.nest 4
diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs
index 65a0fa9dd..1920ddd70 100644
--- a/src/Text/Pandoc/Writers/ConTeXt.hs
+++ b/src/Text/Pandoc/Writers/ConTeXt.hs
@@ -4,7 +4,7 @@
{-# LANGUAGE ViewPatterns #-}
{- |
Module : Text.Pandoc.Writers.ConTeXt
- Copyright : Copyright (C) 2007-2024 John MacFarlane
+ Copyright : Copyright (C) 2007-2025 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <[email protected]>
@@ -20,7 +20,7 @@ import Control.Monad.State.Strict
import Data.Char (ord, isDigit)
import Data.List (intersperse)
import Data.List.NonEmpty (NonEmpty ((:|)))
-import Data.Maybe (isNothing, mapMaybe, catMaybes)
+import Data.Maybe (mapMaybe, catMaybes)
import Data.Monoid (Any (Any, getAny))
import Data.Text (Text)
import qualified Data.Text as T
@@ -131,10 +131,10 @@ pandocToConTeXt options (Pandoc meta blocks) = do
_ -> id)
$ defField "emphasis-commands"
(mconcat $ Map.elems (stEmphasisCommands st))
- $ (case writerHighlightStyle options of
- Just sty | stHighlighting st ->
- defField "highlighting-commands" (styleToConTeXt sty)
- _ -> id)
+ $ (case writerHighlightMethod options of
+ Skylighting sty | stHighlighting st ->
+ defField "highlighting-commands" (styleToConTeXt sty)
+ _ -> id)
$ (case T.toLower $ lookupMetaString "pdfa" meta of
"true" -> resetField "pdfa" (T.pack "1b:2005")
_ -> id) metadata
@@ -233,9 +233,9 @@ blockToConTeXt (CodeBlock (_ident, classes, kv) str) = do
return (literal h)
-- blankline because \stoptyping can't have anything after it, inc. '}'
($$ blankline) . flush <$>
- if null classes || isNothing (writerHighlightStyle opts)
- then pure unhighlighted
- else highlighted
+ case writerHighlightMethod opts of
+ Skylighting _ | not (null classes) -> pure unhighlighted
+ _ -> highlighted
blockToConTeXt b@(RawBlock f str)
| f == Format "context" || f == Format "tex" = return $ literal str <> blankline
| otherwise = empty <$ report (BlockNotRendered b)
@@ -625,9 +625,9 @@ inlineToConTeXt (Code (_ident, classes, _kv) str) = do
Right h -> do
modify (\st -> st{ stHighlighting = True })
return (text (T.unpack h))
- if isNothing (writerHighlightStyle opts) || null classes
- then rawCode
- else highlightCode
+ case writerHighlightMethod opts of
+ Skylighting _ | not (null classes) -> highlightCode
+ _ -> rawCode
inlineToConTeXt (Quoted SingleQuote lst) = do
contents <- inlineListToConTeXt lst
return $ "\\quote" <> braces contents
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index 5e12bed47..1a4bc4ca2 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -48,6 +48,7 @@ import Data.Time
import qualified Text.Pandoc.UTF8 as UTF8
import Text.Pandoc.Definition
import Text.Pandoc.Error
+import Text.Pandoc.Highlighting (defaultStyle)
import Text.Pandoc.MIME (getMimeTypeDef)
import Text.Pandoc.Options
import Text.Pandoc.Readers.Docx.Parse (extractTarget)
@@ -350,7 +351,11 @@ writeDocx opts doc = do
let newstyles = map newParaPropToOpenXml newDynamicParaProps ++
map newTextPropToOpenXml newDynamicTextProps ++
- maybe [] (styleToOpenXml styleMaps) (writerHighlightStyle opts)
+ (case writerHighlightMethod opts of
+ Skylighting sty -> styleToOpenXml styleMaps sty
+ DefaultHighlighting -> styleToOpenXml styleMaps
+ defaultStyle
+ _ -> [])
let styledoc' = styledoc{ elContent = elContent styledoc ++
map Elem newstyles }
let styleEntry = toEntry stylepath epochtime $ renderXml styledoc'
diff --git a/src/Text/Pandoc/Writers/Docx/OpenXML.hs b/src/Text/Pandoc/Writers/Docx/OpenXML.hs
index e061b19f1..f9203a1e6 100644
--- a/src/Text/Pandoc/Writers/Docx/OpenXML.hs
+++ b/src/Text/Pandoc/Writers/Docx/OpenXML.hs
@@ -30,7 +30,7 @@ import Text.Pandoc.Char (isCJK)
import Data.Ord (comparing)
import Data.String (fromString)
import qualified Data.Map as M
-import Data.Maybe (fromMaybe, isNothing, maybeToList, isJust)
+import Data.Maybe (fromMaybe, maybeToList, isJust)
import Control.Monad.State ( gets, modify, MonadTrans(lift) )
import Control.Monad.Reader ( asks, MonadReader(local) )
import qualified Data.Set as Set
@@ -889,14 +889,14 @@ inlineToOpenXML' opts (Code attrs str) = do
maybeToList (lookup toktype tokTypesMap)
, mknode "w:t" [("xml:space","preserve")] tok ]
withTextPropM (rStyleM "Verbatim Char")
- $ if isNothing (writerHighlightStyle opts)
- then unhighlighted
- else case highlight (writerSyntaxMap opts)
- formatOpenXML attrs str of
- Right h -> return (map Elem h)
- Left msg -> do
- unless (T.null msg) $ report $ CouldNotHighlight msg
- unhighlighted
+ $ case writerHighlightMethod opts of
+ Skylighting _ ->
+ case highlight (writerSyntaxMap opts) formatOpenXML attrs str of
+ Right h -> return (map Elem h)
+ Left msg -> do
+ unless (T.null msg) $ report $ CouldNotHighlight msg
+ unhighlighted
+ _ -> unhighlighted
inlineToOpenXML' opts (Note bs) = do
notes <- gets stFootnotes
notenum <- getUniqueId
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index d48a29c5b..bf01f663b 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -53,7 +53,7 @@ import qualified Text.DocTemplates.Internal as DT
import Text.Blaze.Html hiding (contents)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (formatHtmlBlock, formatHtml4Block,
- formatHtmlInline, highlight, styleToCss)
+ formatHtmlInline, highlight, styleToCss, defaultStyle)
import Text.Pandoc.ImageSize
import Text.Pandoc.Options
import Text.Pandoc.Shared
@@ -356,10 +356,14 @@ pandocToHtml opts (Pandoc meta blocks) = do
let mCss :: Maybe [Text] = lookupContext "css" metadata
let context :: Context Text
context = (if stHighlighting st
- then case writerHighlightStyle opts of
- Just sty -> defField "highlighting-css"
- (literal $ T.pack $ styleToCss sty)
- Nothing -> id
+ then case writerHighlightMethod opts of
+ Skylighting sty ->
+ defField "highlighting-css"
+ (literal $ T.pack $ styleToCss sty)
+ DefaultHighlighting ->
+ defField "highlighting-css"
+ (literal $ T.pack $ styleToCss defaultStyle)
+ _ -> id
else id) .
(if stCsl st
then defField "csl-css" True .
@@ -948,11 +952,13 @@ blockToHtmlInner opts (CodeBlock (id',classes,keyvals) rawCode) = do
adjCode = if tolhs
then T.unlines . map ("> " <>) . T.lines $ rawCode
else rawCode
- hlCode = if isJust (writerHighlightStyle opts)
- then highlight (writerSyntaxMap opts)
- (if html5 then formatHtmlBlock else formatHtml4Block)
- (id'',classes',keyvals) adjCode
- else Left ""
+ highlighted = highlight (writerSyntaxMap opts)
+ (if html5 then formatHtmlBlock else formatHtml4Block)
+ (id'',classes',keyvals) adjCode
+ hlCode = case writerHighlightMethod opts of
+ Skylighting _ -> highlighted
+ DefaultHighlighting -> highlighted
+ _ -> Left ""
case hlCode of
Left msg -> do
unless (T.null msg) $
@@ -1442,11 +1448,12 @@ inlineToHtml opts inline = do
modify $ \st -> st{ stHighlighting = True }
addAttrs opts (ids,[],kvs) $
fromMaybe id sampOrVar h
- where hlCode = if isJust (writerHighlightStyle opts)
- then highlight
- (writerSyntaxMap opts)
- formatHtmlInline attr str
- else Left ""
+ where hlCode = case writerHighlightMethod opts of
+ Skylighting _ -> highlighted
+ DefaultHighlighting -> highlighted
+ _ -> Left ""
+ highlighted = highlight (writerSyntaxMap opts)
+ formatHtmlInline attr str
(sampOrVar,cs')
| "sample" `elem` cs =
(Just H.samp,"sample" `delete` cs)
diff --git a/src/Text/Pandoc/Writers/LaTeX.hs b/src/Text/Pandoc/Writers/LaTeX.hs
index d544e5401..4793abd06 100644
--- a/src/Text/Pandoc/Writers/LaTeX.hs
+++ b/src/Text/Pandoc/Writers/LaTeX.hs
@@ -45,7 +45,7 @@ import Text.Pandoc.Class.PandocMonad (PandocMonad, getPOSIXTime, lookupEnv,
report, toLang)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (formatLaTeXBlock, formatLaTeXInline, highlight,
- styleToLaTeX)
+ defaultStyle, styleToLaTeX)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
@@ -242,15 +242,20 @@ pandocToLaTeX options (Pandoc meta blocks) = do
defField "svg" (stSVG st) $
defField "has-chapters" (stHasChapters st) $
defField "has-frontmatter" (documentClass `elem` frontmatterClasses) $
- defField "listings" (writerListings options || stLHS st) $
+ defField "listings" (writerHighlightMethod options ==
+ IdiomaticHighlighting
+ || stLHS st) $
defField "zero-width-non-joiner" (stZwnj st) $
defField "beamer" beamer $
(if stHighlighting st
- then case writerHighlightStyle options of
- Just sty ->
+ then case writerHighlightMethod options of
+ Skylighting sty ->
defField "highlighting-macros"
(T.stripEnd $ styleToLaTeX sty)
- Nothing -> id
+ DefaultHighlighting ->
+ defField "highlighting-macros"
+ (T.stripEnd $ styleToLaTeX defaultStyle)
+ _ -> id
else id) $
(case writerCiteMethod options of
Natbib -> defField "biblio-title" biblioTitle .
@@ -497,7 +502,8 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do
ref <- toLabel identifier
kvs <- mapM (\(k,v) -> (k,) <$>
stringToLaTeX TextString v) keyvalAttr
- let params = if writerListings (stOptions st)
+ let params = if writerHighlightMethod (stOptions st)
+ == IdiomaticHighlighting
then (case getListingsLanguage classes of
Just l -> [ "language=" <> mbBraced l ]
Nothing -> []) ++
@@ -534,8 +540,11 @@ blockToLaTeX (CodeBlock (identifier,classes,keyvalAttr) str) = do
case () of
_ | isEnabled Ext_literate_haskell opts && "haskell" `elem` classes &&
"literate" `elem` classes -> lhsCodeBlock
- | writerListings opts -> listingsCodeBlock
- | not (null classes) && isJust (writerHighlightStyle opts)
+ | writerHighlightMethod opts == IdiomaticHighlighting
+ -> listingsCodeBlock
+ | not (null classes), Skylighting _ <- writerHighlightMethod opts
+ -> highlightedCodeBlock
+ | not (null classes), DefaultHighlighting <- writerHighlightMethod opts
-> highlightedCodeBlock
-- we don't want to use \begin{verbatim} if our code
-- contains \end{verbatim}:
@@ -991,12 +1000,14 @@ inlineToLaTeX (Code (_,classes,kvs) str) = do
-- incorrect results if there is a space (see #5529).
let inMbox x = "\\mbox" <> braces x
(if inSoul then inMbox else id) <$>
- case () of
+ case writerHighlightMethod opts of
_ | inHeading || inItem -> rawCode -- see #5574
- | writerListings opts -> listingsCode
- | isJust (writerHighlightStyle opts) && not (null classes)
+ IdiomaticHighlighting -> listingsCode
+ Skylighting _ | not (null classes)
+ -> highlightCode
+ DefaultHighlighting | not (null classes)
-> highlightCode
- | otherwise -> rawCode
+ _noHighlighting -> rawCode
inlineToLaTeX (Quoted qt lst) = do
contents <- inlineListToLaTeX lst
csquotes <- liftM stCsquotes get
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 23eff037f..49ff84bc9 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -362,7 +362,10 @@ formatSourceLine wopts fopts ts@((_,firstTxt):_) =
formatTok :: WriterOptions -> FormatOptions -> (TokenType, Text) -> Doc Text
formatTok wopts _fopts (toktype, t) =
let txt = literal (escString wopts t)
- styleMap = tokenStyles <$> writerHighlightStyle wopts
+ styleMap = case writerHighlightMethod wopts of
+ Skylighting style -> Just $ tokenStyles style
+ DefaultHighlighting -> Just $ tokenStyles defaultStyle
+ _ -> Nothing
tokStyle = fromMaybe defStyle $ styleMap >>= M.lookup toktype
in if toktype == NormalTok
then txt
diff --git a/src/Text/Pandoc/Writers/Ms.hs b/src/Text/Pandoc/Writers/Ms.hs
index 242cfaa46..2ae56a880 100644
--- a/src/Text/Pandoc/Writers/Ms.hs
+++ b/src/Text/Pandoc/Writers/Ms.hs
@@ -76,7 +76,9 @@ pandocToMs opts (Pandoc meta blocks) = do
let authorsMeta = map (escapeStr opts . stringify) $ docAuthors meta
hasHighlighting <- gets stHighlighting
let highlightingMacros = if hasHighlighting
- then maybe mempty styleToMs $ writerHighlightStyle opts
+ then case writerHighlightMethod opts of
+ Skylighting sty -> styleToMs sty
+ _ -> mempty
else mempty
let context = defField "body" main
diff --git a/src/Text/Pandoc/Writers/ODT.hs b/src/Text/Pandoc/Writers/ODT.hs
index 29ee3bd47..53c358309 100644
--- a/src/Text/Pandoc/Writers/ODT.hs
+++ b/src/Text/Pandoc/Writers/ODT.hs
@@ -34,7 +34,8 @@ import Text.Pandoc.Error (PandocError(..))
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.MIME (extensionFromMimeType, getMimeType)
-import Text.Pandoc.Options (WrapOption (..), WriterOptions (..))
+import Text.Pandoc.Options (WrapOption (..), WriterOptions (..),
+ HighlightMethod(Skylighting))
import Text.DocLayout
import Text.Pandoc.Shared (stringify, tshow)
import Text.Pandoc.Version (pandocVersionText)
@@ -211,7 +212,9 @@ updateStyle opts mbLang arch = do
. maybe id addLang mbLang
. transformElement (\qn -> qName qn == "styles" &&
qPrefix qn == Just "office" )
- (maybe id addHlStyles (writerHighlightStyle opts))
+ (case writerHighlightMethod opts of
+ Skylighting style -> addHlStyles style
+ _ -> id)
$ d )
| otherwise = pure e
entries <- mapM goEntry (zEntries arch)
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 80fdb4177..28f0d13f1 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -21,7 +21,6 @@ import Data.Char (chr)
import Data.Foldable (find)
import Data.List (sortOn, sortBy, foldl')
import qualified Data.Map as Map
-import Data.Maybe (isNothing)
import Data.Ord (comparing)
import qualified Data.Set as Set
import Data.Text (Text)
@@ -390,15 +389,16 @@ blockToOpenDocument o = \case
OrderedList a b -> setFirstPara >> orderedList a b
CodeBlock attrs s -> do
setFirstPara
- if isNothing (writerHighlightStyle o)
- then unhighlighted s
- else case highlight (writerSyntaxMap o) formatOpenDocument attrs s of
+ case writerHighlightMethod o of
+ Skylighting {} ->
+ case highlight (writerSyntaxMap o) formatOpenDocument attrs s of
Right h -> return $ flush . vcat $ map (inTags True "text:p"
[("text:style-name",
"Preformatted_20_Text")] . hcat) h
Left msg -> do
unless (T.null msg) $ report $ CouldNotHighlight msg
unhighlighted s
+ _ -> unhighlighted s
Table a bc s th tb tf -> setFirstPara >>
table o (Ann.toTable a bc s th tb tf)
HorizontalRule -> setFirstPara >> return (selfClosingTag "text:p"
@@ -630,14 +630,14 @@ inlineToOpenDocument o ils
Subscript l -> withTextStyle Sub $ inlinesToOpenDocument o l
SmallCaps l -> withTextStyle SmallC $ inlinesToOpenDocument o l
Quoted t l -> inQuotes t <$> inlinesToOpenDocument o l
- Code attrs s -> if isNothing (writerHighlightStyle o)
- then unhighlighted s
- else case highlight (writerSyntaxMap o)
- formatOpenDocument attrs s of
+ Code attrs s -> case writerHighlightMethod o of
+ Skylighting {} ->
+ case highlight (writerSyntaxMap o) formatOpenDocument attrs s of
Right h -> inlinedCode $ mconcat $ mconcat h
Left msg -> do
unless (T.null msg) $ report $ CouldNotHighlight msg
unhighlighted s
+ _ -> unhighlighted s
Math t s -> lift (texMathToInlines t s) >>=
inlinesToOpenDocument o
Cite _ l -> inlinesToOpenDocument o l
diff --git a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
index fb07d8810..b3b61d51c 100644
--- a/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
+++ b/src/Text/Pandoc/Writers/Powerpoint/Presentation.hs
@@ -460,15 +460,17 @@ blockToParagraphs (CodeBlock attr str) = do
, pPropIndent = Just 0
}
, envRunProps = (envRunProps r){rPropCode = True}}) $ do
- mbSty <- writerHighlightStyle <$> asks envOpts
+ highlightOpt <- writerHighlightMethod <$> asks envOpts
synMap <- writerSyntaxMap <$> asks envOpts
- case mbSty of
- Just sty ->
- case highlight synMap (formatSourceLines sty) attr str of
- Right pElems -> do pPropsNew <- asks envParaProps
- return [Paragraph pPropsNew pElems]
- Left _ -> blockToParagraphs $ Para [Str str]
- Nothing -> blockToParagraphs $ Para [Str str]
+ let highlightWithStyle style = do
+ case highlight synMap (formatSourceLines style) attr str of
+ Right pElems -> do pPropsNew <- asks envParaProps
+ return [Paragraph pPropsNew pElems]
+ Left _ -> blockToParagraphs $ Para [Str str]
+ case highlightOpt of
+ Skylighting sty -> highlightWithStyle sty
+ DefaultHighlighting -> highlightWithStyle defaultStyle
+ _ -> blockToParagraphs $ Para [Str str]
-- We can't yet do incremental lists, but we should render a
-- (BlockQuote List) as a list to maintain compatibility with other
-- formats.