Added highlightLaTeX to Text.Pandoc.Highlighting.

1 files changed, 29 insertions, 11 deletions

diff --git a/src/Text/Pandoc/Highlighting.hs b/src/Text/Pandoc/Highlighting.hs
index 547ebc223..755e26e2e 100644
--- a/src/Text/Pandoc/Highlighting.hs
+++ b/src/Text/Pandoc/Highlighting.hs
@@ -28,21 +28,28 @@ 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
+module Text.Pandoc.Highlighting ( languages
+                                , highlightHtml
+                                , highlightLaTeX
+                                , defaultHighlightingCss
+                                , languagesByExtension
+                                ) where
 import Text.Blaze
 import Text.Pandoc.Definition
 #ifdef _HIGHLIGHTING
-import Text.Highlighting.Kate ( languages, highlightAs, formatAsHtml, FormatOption (..), defaultHighlightingCss, languagesByExtension )
+import Text.Highlighting.Kate ( SourceLine, languages, highlightAs, formatAsHtml,
+        TokenType(..), formatAsLaTeX, FormatOption (..), defaultHighlightingCss, languagesByExtension )
 import Data.List (find)
 import Data.Maybe (fromMaybe)
 import Data.Char (toLower)
 import qualified Text.Blaze.Html5.Attributes as A
 
-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 (id', classes, keyvals) rawCode =
+highlight :: ([FormatOption] -> String -> [SourceLine] -> a) -- ^ Formatter
+          -> Bool   -- ^ True if inline
+          -> Attr   -- ^ Attributes of the Code or CodeBlock
+          -> String -- ^ Raw contents of the Code or CodeBlock
+          -> Either String a  -- ^ An error or the formatted result
+highlight formatter inline (_, classes, keyvals) rawCode =
   let firstNum = case reads (fromMaybe "1" $ lookup "startFrom" keyvals) of
                       ((n,_):_) -> n
                       []        -> 1
@@ -53,17 +60,28 @@ highlightHtml inline (id', classes, keyvals) rawCode =
                   Just _    -> [OptNumberLines]
       addBirdTracks = "literate" `elem` classes
       lcLanguages = map (map toLower) languages
-      addId = if null id' then id else (! A.id (toValue id'))
   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 $ addId
-                                                     $ formatAsHtml fmtOpts language
+                                   Right hl -> Right $ formatter fmtOpts language
                                                      $ if addBirdTracks
-                                                          then map (("ot","> "):) hl
+                                                          then map ((OtherTok,"> "):) hl
                                                           else hl
 
+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 attr@(id',_,_) = fmap addId . highlight formatAsHtml inline attr
+      where addId = if null id' then id else (! A.id (toValue id'))
+
+highlightLaTeX  :: Bool   -- ^ True if inline
+                -> Attr   -- ^ Attributes of the Code or CodeBlock
+                -> String -- ^ Raw contents of the Code or CodeBlock
+                -> Either String String   -- ^ An error or the formatted LaTeX string
+highlightLaTeX = highlight formatAsLaTeX
+
 #else
 defaultHighlightingCss :: String
 defaultHighlightingCss = ""