diff options
Diffstat (limited to 'src/Text/Pandoc/Highlighting.hs')
-rw-r--r-- | src/Text/Pandoc/Highlighting.hs | 78 |
1 files changed, 40 insertions, 38 deletions
diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs index 5ddaf1379..4fb799cf1 100644 --- a/src/Text/Pandoc/Highlighting.hs +++ b/src/Text/Pandoc/Highlighting.hs @@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA {- | Module : Text.Pandoc.Highlighting Copyright : Copyright (C) 2008 John MacFarlane - License : GNU GPL, version 2 or above + License : GNU GPL, version 2 or above Maintainer : John MacFarlane <jgm@berkeley.edu> Stability : alpha @@ -28,47 +28,49 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Exports functions for syntax highlighting. -} -module Text.Pandoc.Highlighting ( languages, highlightHtml, defaultHighlightingCss, languagesByExtension ) where -import Text.XHtml +module Text.Pandoc.Highlighting ( languages + , languagesByExtension + , highlight + , formatLaTeXInline + , formatLaTeXBlock + , styleToLaTeX + , formatHtmlInline + , formatHtmlBlock + , styleToCss + , pygments + , espresso + , tango + , kate + , monochrome + , haddock + , Style + ) where import Text.Pandoc.Definition -#ifdef _HIGHLIGHTING -import Text.Highlighting.Kate ( languages, highlightAs, formatAsXHtml, FormatOption (..), defaultHighlightingCss, languagesByExtension ) +import Text.Highlighting.Kate import Data.List (find) import Data.Maybe (fromMaybe) import Data.Char (toLower) -highlightHtml :: Bool -- ^ True if inline HTML - -> Attr -- ^ Attributes of the Code or CodeBlock - -> String -- ^ Raw contents of the Code or CodeBlock - -> Either String Html -- ^ An error or the formatted Html -highlightHtml inline (_, classes, keyvals) rawCode = - let firstNum = read $ fromMaybe "1" $ lookup "startFrom" keyvals - fmtOpts = [OptNumberFrom firstNum] ++ - [OptInline | inline] ++ - 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 $ - if addBirdTracks - then map ((["Special"],"> "):) hl - else hl +lcLanguages :: [String] +lcLanguages = map (map toLower) languages -#else -defaultHighlightingCss :: String -defaultHighlightingCss = "" +highlight :: (FormatOptions -> [SourceLine] -> a) -- ^ Formatter + -> Attr -- ^ Attributes of the CodeBlock + -> String -- ^ Raw contents of the CodeBlock + -> Maybe a -- ^ Maybe the formatted result +highlight formatter (_, classes, keyvals) rawCode = + let firstNum = case reads (fromMaybe "1" $ lookup "startFrom" keyvals) of + ((n,_):_) -> n + [] -> 1 + fmtOpts = defaultFormatOpts{ + startNumber = firstNum, + numberLines = any (`elem` + ["number","numberLines", "number-lines"]) classes } + lcclasses = map (map toLower) classes + in case find (`elem` lcLanguages) lcclasses of + Nothing -> Nothing + Just language -> Just + $ formatter fmtOpts{ codeClasses = [language], + containerClasses = classes } + $ highlightAs language rawCode -languages :: [String] -languages = [] - -languagesByExtension :: String -> [String] -languagesByExtension _ = [] - -highlightHtml :: Bool -> Attr -> String -> Either String Html -highlightHtml _ _ _ = Left "Pandoc was not compiled with support for highlighting" -#endif |