diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Text/Pandoc/Highlighting.hs | 8 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/ConTeXt.hs | 93 |
2 files changed, 75 insertions, 26 deletions
diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs index 54f62bb82..1beace360 100644 --- a/src/Text/Pandoc/Highlighting.hs +++ b/src/Text/Pandoc/Highlighting.hs @@ -15,13 +15,21 @@ module Text.Pandoc.Highlighting ( highlightingStyles , languages , languagesByExtension , highlight + -- * Formats + -- ** LaTeX , formatLaTeXInline , formatLaTeXBlock , styleToLaTeX + -- ** HTML , formatHtmlInline , formatHtmlBlock , formatHtml4Block , styleToCss + -- ** ConTeXt + , formatConTeXtInline + , formatConTeXtBlock + , styleToConTeXt + -- * Styles , pygments , espresso , zenburn diff --git a/src/Text/Pandoc/Writers/ConTeXt.hs b/src/Text/Pandoc/Writers/ConTeXt.hs index 9443988e0..2dc448694 100644 --- a/src/Text/Pandoc/Writers/ConTeXt.hs +++ b/src/Text/Pandoc/Writers/ConTeXt.hs @@ -14,19 +14,21 @@ Conversion of 'Pandoc' format into ConTeXt. -} module Text.Pandoc.Writers.ConTeXt ( writeConTeXt ) where -import Control.Monad (liftM) +import Control.Monad (liftM, unless) import Control.Monad.State.Strict ( StateT, MonadState(put, get), gets, modify, evalStateT ) import Data.Char (ord, isDigit) import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty ((:|))) -import Data.Maybe (mapMaybe, catMaybes) +import Data.Maybe (isNothing, mapMaybe, catMaybes) import Data.Text (Text) import qualified Data.Text as T import Network.URI (unEscapeString) import Text.Collate.Lang (Lang(..)) import Text.Pandoc.Class.PandocMonad (PandocMonad, report, toLang) import Text.Pandoc.Definition +import Text.Pandoc.Highlighting + (formatConTeXtBlock, formatConTeXtInline, highlight, styleToConTeXt) import Text.Pandoc.ImageSize import Text.Pandoc.Logging import Text.Pandoc.Options @@ -42,12 +44,14 @@ import qualified Data.List.NonEmpty as NonEmpty import qualified Text.Pandoc.Writers.AnnotatedTable as Ann data WriterState = - WriterState { stNextRef :: Int -- number of next URL reference - , stOrderedListLevel :: Int -- level of ordered list - , stOptions :: WriterOptions -- writer options - , stHasCslRefs :: Bool -- has CSL citations - , stCslHangingIndent :: Bool -- CSL hanging indent - } + WriterState + { stCslHangingIndent :: Bool -- CSL hanging indent + , stHasCslRefs :: Bool -- has CSL citations + , stHighlighting :: Bool -- has syntax-highlighted code blocks + , stNextRef :: Int -- number of next URL reference + , stOptions :: WriterOptions -- writer options + , stOrderedListLevel :: Int -- level of ordered list + } -- | Table type data Tabl = Xtb -- ^ Extreme tables @@ -63,12 +67,14 @@ orderedListStyles = cycle "narg" -- | Convert Pandoc to ConTeXt. writeConTeXt :: PandocMonad m => WriterOptions -> Pandoc -> m Text writeConTeXt options document = - let defaultWriterState = WriterState { stNextRef = 1 - , stOrderedListLevel = 0 - , stOptions = options - , stHasCslRefs = False - , stCslHangingIndent = False - } + let defaultWriterState = WriterState + { stCslHangingIndent = False + , stHasCslRefs = False + , stHighlighting = False + , stNextRef = 1 + , stOptions = options + , stOrderedListLevel = 0 + } in evalStateT (pandocToConTeXt options document) defaultWriterState type WM = StateT WriterState @@ -116,6 +122,10 @@ pandocToConTeXt options (Pandoc meta blocks) = do | all isDigit (d:ds) -> resetField "papersize" (T.pack ('A':d:ds)) _ -> id) + $ (case writerHighlightStyle options of + Just 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 @@ -197,9 +207,25 @@ blockToConTeXt (LineBlock lns) = do blockToConTeXt (BlockQuote lst) = do contents <- blockListToConTeXt lst return $ "\\startblockquote" $$ nest 0 contents $$ "\\stopblockquote" <> blankline -blockToConTeXt (CodeBlock _ str) = - return $ flush ("\\starttyping" <> cr <> literal str <> cr <> "\\stoptyping") $$ blankline +blockToConTeXt (CodeBlock (_ident, classes, kv) str) = do + opts <- gets stOptions + let syntaxMap = writerSyntaxMap opts + let attr' = ("", classes, kv) + let unhighlighted = vcat ["\\starttyping", literal str, "\\stoptyping"] + let highlighted = + case highlight syntaxMap formatConTeXtBlock attr' str of + Left msg -> do + unless (T.null msg) $ + report (CouldNotHighlight msg) + return unhighlighted + Right h -> do + modify (\s -> s{ stHighlighting = True }) + 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 blockToConTeXt b@(RawBlock f str) | f == Format "context" || f == Format "tex" = return $ literal str <> blankline | otherwise = empty <$ report (BlockNotRendered b) @@ -540,16 +566,31 @@ inlineToConTeXt (Subscript lst) = do inlineToConTeXt (SmallCaps lst) = do contents <- inlineListToConTeXt lst return $ braces $ "\\sc " <> contents -inlineToConTeXt (Code _ str) = - return . literal $ - case typeDelim str of - Just (open, close) -> - "\\type" <> (open `T.cons` str) `T.snoc` close - Nothing -> - "\\type[escape=yes]{" <> - (T.replace "{" "/BTEX\\letteropenbrace /ETEX" . - T.replace "}" "/BTEX\\letterclosebrace /ETEX" $ - str) `T.snoc` '}' +inlineToConTeXt (Code (_ident, classes, _kv) str) = do + let rawCode = + pure . literal $ + case typeDelim str of + Just (open, close) -> + "\\type" <> (open `T.cons` str) `T.snoc` close + Nothing -> + "\\type[escape=yes]{" <> + (T.replace "{" "/BTEX\\letteropenbrace /ETEX" . + T.replace "}" "/BTEX\\letterclosebrace /ETEX" $ + str) `T.snoc` '}' + opts <- gets stOptions + let syntaxMap = writerSyntaxMap opts + let attr' = ("", classes, []) + let highlightCode = + case highlight syntaxMap formatConTeXtInline attr' str of + Left msg -> do + unless (T.null msg) $ report (CouldNotHighlight msg) + rawCode + Right h -> do + modify (\st -> st{ stHighlighting = True }) + return (text (T.unpack h)) + if isNothing (writerHighlightStyle opts) || null classes + then rawCode + else highlightCode inlineToConTeXt (Quoted SingleQuote lst) = do contents <- inlineListToConTeXt lst return $ "\\quote" <> braces contents |