lee/pandoc
1
0
Fork 0
mirror of https://github.com/jgm/pandoc.git synced 2026-08-23 08:46:56 +00:00
Code Issues Packages Projects Releases Wiki Activity

ConTeXt writer: support syntax highlighting for code.

Browse Source
This commit is contained in:
Albert Krewinkel
2022-12-18 15:47:48 +01:00
committed by Albert Krewinkel
parent 8f5af5a06c
commit e83120fd2d
5 changed files with 83 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files
data/templates/default.context
+3
View File
@@ -114,6 +114,9 @@ $endif$
\setupxtable[foot][]
\setupxtable[lastrow][bottomframe=on]
$if(highlighting-commands)$
$highlighting-commands$
$endif$
$if(csl-refs)$
\definemeasure[cslhangindent][1.5em]
\definenarrower[hangingreferences][left=\measure{cslhangindent}]
pandoc.cabal
+2 -2
View File
@@ -507,8 +507,8 @@ library
random >= 1 && < 1.3,
safe >= 0.3.18 && < 0.4,
scientific >= 0.3 && < 0.4,
skylighting >= 0.13.1.2 && < 0.14,
skylighting-core >= 0.13.1.2 && < 0.14,
skylighting >= 0.13.2 && < 0.14,
skylighting-core >= 0.13.2 && < 0.14,
split >= 0.2 && < 0.3,
syb >= 0.1 && < 0.8,
tagsoup >= 0.14.6 && < 0.15,
src/Text/Pandoc/Highlighting.hs
+8
View File
@@ -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
src/Text/Pandoc/Writers/ConTeXt.hs
+67 -26
View File
@@ -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
stack.yaml
+3 -2
View File
@@ -9,8 +9,9 @@ packages:
- 'pandoc-lua-engine'
- 'pandoc-server'
extra-deps:
- skylighting-core-0.13.1.2
- skylighting-0.13.1.2
- skylighting-core-0.13.2
- skylighting-0.13.2
- skylighting-format-context-0.1
- skylighting-format-ansi-0.1
- skylighting-format-latex-0.1
- skylighting-format-blaze-html-0.1.1