diff options
author | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2009-11-21 04:40:59 +0000 |
---|---|---|
committer | fiddlosopher <fiddlosopher@788f1e2b-df1e-0410-8736-df70ead52e1b> | 2009-11-21 04:40:59 +0000 |
commit | 39f6af5de4f4059239fbeda4095d8f92b98912d3 (patch) | |
tree | 346e64bf4ec4e35e797f231e40fe2da53e374e92 /src/Text/Pandoc | |
parent | 9d20eeb019a6c5208342bfc3f03ae47c9aa83483 (diff) | |
download | pandoc-39f6af5de4f4059239fbeda4095d8f92b98912d3.tar.gz |
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
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r-- | src/Text/Pandoc/Highlighting.hs | 6 | ||||
-rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 25 |
2 files changed, 17 insertions, 14 deletions
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 |