diff options
| author | Albert Krewinkel <[email protected]> | 2025-08-11 19:54:23 +0200 |
|---|---|---|
| committer | John MacFarlane <[email protected]> | 2025-09-02 17:50:47 +0200 |
| commit | e0acb24528cbf409ae5723e537acb0c2ed4e2d91 (patch) | |
| tree | 77bf1d4ac09a2ec049da651d32bd97a04656dd4d /src | |
| parent | 64757254ab6e1d005cf8f4ee6c491d97aed7b16f (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.hs | 29 | ||||
| -rw-r--r-- | src/Text/Pandoc/App/Opt.hs | 30 | ||||
| -rw-r--r-- | src/Text/Pandoc/App/OutputSettings.hs | 11 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ANSI.hs | 25 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 24 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx.hs | 7 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Docx/OpenXML.hs | 18 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 37 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/LaTeX.hs | 35 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Man.hs | 5 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Ms.hs | 4 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ODT.hs | 7 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/OpenDocument.hs | 16 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Powerpoint/Presentation.hs | 18 |
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. |
