From 39f6af5de4f4059239fbeda4095d8f92b98912d3 Mon Sep 17 00:00:00 2001
From: fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b>
Date: Sat, 21 Nov 2009 04:40:59 +0000
Subject: Modified html+lhs output to use 'haskell' highlighter.

The bird tracks are added in the highlighting module.
This makes sense, because the kate's haskell highlighter
is much better than the literateHaskell highlighter.

git-svn-id: https://pandoc.googlecode.com/svn/trunk@1620 788f1e2b-df1e-0410-8736-df70ead52e1b
---
 src/Text/Pandoc/Highlighting.hs |  6 +++++-
 src/Text/Pandoc/Writers/HTML.hs | 25 ++++++++++++-------------
 2 files changed, 17 insertions(+), 14 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs
index 6a88e5d70..457e605a5 100644
--- a/src/Text/Pandoc/Highlighting.hs
+++ b/src/Text/Pandoc/Highlighting.hs
@@ -45,12 +45,16 @@ highlightHtml (_, classes, keyvals) rawCode =
                 case find (`elem` ["number","numberLines","number-lines"]) classes of
                   Nothing   -> []
                   Just _    -> [OptNumberLines]
+      addBirdTracks = "literate" `elem` classes
       lcLanguages = map (map toLower) languages
   in  case find (\c -> (map toLower c) `elem` lcLanguages) classes of
             Nothing        -> Left "Unknown or unsupported language"
             Just language  -> case highlightAs language rawCode of
                                    Left err -> Left err
-                                   Right hl -> Right $ formatAsXHtml fmtOpts language hl
+                                   Right hl -> Right $ formatAsXHtml fmtOpts language $
+                                                       if addBirdTracks
+                                                          then map ((["Special"],"> "):) hl
+                                                          else hl
 
 #else
 defaultHighlightingCss :: String
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index 28d0daacc..3f8bf3637 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -37,7 +37,7 @@ import Text.Pandoc.Readers.TeXMath
 import Text.Pandoc.Highlighting ( highlightHtml, defaultHighlightingCss )
 import Numeric ( showHex )
 import Data.Char ( ord, toLower )
-import Data.List ( isPrefixOf, intercalate )
+import Data.List ( isPrefixOf )
 import Data.Maybe ( catMaybes )
 import qualified Data.Set as S
 import Control.Monad.State
@@ -248,21 +248,20 @@ blockToHtml opts (Plain lst) = inlineListToHtml opts lst
 blockToHtml opts (Para lst) = inlineListToHtml opts lst >>= (return . paragraph)
 blockToHtml _ (RawHtml str) = return $ primHtml str
 blockToHtml _ (HorizontalRule) = return $ hr
-blockToHtml opts (CodeBlock (_,classes,_) rawCode) | "haskell" `elem` classes &&
-                                                     "literate" `elem` classes &&
-                                                     writerLiterateHaskell opts =
-  let classes' = map (\c -> if c == "haskell" then "literatehaskell" else c) classes
-  in  blockToHtml opts $ CodeBlock ("",classes',[]) $ intercalate "\n" $ map ("> " ++) $ lines rawCode
-blockToHtml _ (CodeBlock attr@(_,classes,_) rawCode) = do
-  case highlightHtml attr rawCode of
+blockToHtml opts (CodeBlock (id',classes,keyvals) rawCode) = do
+  let classes' = if writerLiterateHaskell opts
+                    then classes
+                    else filter (/= "literate") classes
+  case highlightHtml (id',classes',keyvals) rawCode of
          Left _  -> -- change leading newlines into <br /> tags, because some
                     -- browsers ignore leading newlines in pre blocks
                     let (leadingBreaks, rawCode') = span (=='\n') rawCode
-                    in  return $ pre ! (if null classes
-                                           then []
-                                           else [theclass $ unwords classes]) $ thecode <<
-                                                (replicate (length leadingBreaks) br +++
-                                                [stringToHtml $ rawCode' ++ "\n"])
+                        attrs = [theclass (unwords classes') | not (null classes')] ++
+                                [identifier id' | not (null id')] ++
+                                map (\(x,y) -> strAttr x y) keyvals
+                    in  return $ pre ! attrs $ thecode <<
+                                 (replicate (length leadingBreaks) br +++
+                                 [stringToHtml $ rawCode' ++ "\n"])
          Right h -> addToCSS defaultHighlightingCss >> return h
 blockToHtml opts (BlockQuote blocks) =
   -- in S5, treat list in blockquote specially
-- 
cgit v1.2.3