From b3709022ef2e636aa5853ba95e0cf5bfc3f942b7 Mon Sep 17 00:00:00 2001
From: fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>
Date: Sat, 9 Feb 2008 03:20:13 +0000
Subject: Added preliminary support for syntax highlighting to HTML writer.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1213 788f1e2b-df1e-0410-8736-df70ead52e1b
---
 Text/Pandoc/Writers/HTML.hs | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

(limited to 'Text/Pandoc')

diff --git a/Text/Pandoc/Writers/HTML.hs b/Text/Pandoc/Writers/HTML.hs
index 4f9bf0d8e..df9a682a5 100644
--- a/Text/Pandoc/Writers/HTML.hs
+++ b/Text/Pandoc/Writers/HTML.hs
@@ -36,10 +36,11 @@ import Text.Pandoc.Readers.TeXMath
 import Text.Regex ( mkRegex, matchRegex )
 import Numeric ( showHex )
 import Data.Char ( ord, toLower, isAlpha )
-import Data.List ( isPrefixOf, intersperse )
+import Data.List ( isPrefixOf, intersperse, find )
 import qualified Data.Set as S
 import Control.Monad.State
 import Text.XHtml.Transitional
+import Text.Highlighting.Kate
 
 data WriterState = WriterState
     { stNotes            :: [Html]       -- ^ List of notes
@@ -263,9 +264,18 @@ blockToHtml opts (Plain lst) = inlineListToHtml opts lst
 blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
 blockToHtml opts (RawHtml str) = return $ primHtml str
 blockToHtml opts (HorizontalRule) = return $ hr
-blockToHtml opts (CodeBlock (_,classes,_) str) = return $ 
-  pre ! (if null classes then [] else [theclass $ unwords classes]) $
-  thecode << (str ++ "\n") -- the final \n for consistency with Markdown.pl
+blockToHtml opts (CodeBlock (_,classes,_) rawCode) = do
+  let fmtOpts = 
+        case find (`elem` ["number","numberLines","number-lines"]) classes of
+              Nothing   -> []
+              Just _    -> [OptNumberLines]
+  let toPre str = pre ! (if null classes then [] else [theclass $ unwords classes]) $ thecode << str 
+  let lcLanguages = map (map toLower) languages
+  return $ case find (\c -> (map toLower c) `elem` lcLanguages) classes of
+                 Nothing   -> toPre (rawCode ++ "\n")
+                 Just lang -> case highlightAs lang rawCode of
+                                    Left _   -> toPre (rawCode ++ "\n")
+                                    Right hl -> formatAsXHtml fmtOpts lang hl
 blockToHtml opts (BlockQuote blocks) =
   -- in S5, treat list in blockquote specially
   -- if default is incremental, make it nonincremental; 
-- 
cgit v1.2.3