ConTeXt writer: support syntax highlighting for code.

5 files changed, 83 insertions, 30 deletions

diff --git a/data/templates/default.context b/data/templates/default.context
index c7aca89cb..9081a08b2 100644
--- a/data/templates/default.context
+++ b/data/templates/default.context
@@ -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}]
diff --git a/pandoc.cabal b/pandoc.cabal
index 06e7cc43f..3d694bf3c 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -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,
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
diff --git a/stack.yaml b/stack.yaml
index a69527445..579149535 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -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