module Text.Highlighting.Kate.Format.LaTeX (
formatLaTeXInline, formatLaTeXBlock, styleToLaTeX
) where
import Text.Highlighting.Kate.Types
import Text.Printf
import Data.List (intercalate)
import Control.Monad (mplus)
import Data.Char (isSpace)
formatLaTeX :: Bool -> [SourceLine] -> String
formatLaTeX inline = intercalate "\n" . map (sourceLineToLaTeX inline)
formatLaTeXInline :: FormatOptions -> [SourceLine] -> String
formatLaTeXInline _opts ls = "\\VERB|" ++ formatLaTeX True ls ++ "|"
sourceLineToLaTeX :: Bool -> SourceLine -> String
sourceLineToLaTeX inline contents = concatMap (tokenToLaTeX inline) contents
tokenToLaTeX :: Bool -> Token -> String
tokenToLaTeX inline (NormalTok, txt) | all isSpace txt = escapeLaTeX inline txt
tokenToLaTeX inline (toktype, txt) = '\\':(show toktype ++ "{" ++ escapeLaTeX inline txt ++ "}")
escapeLaTeX :: Bool -> String -> String
escapeLaTeX inline = concatMap escapeLaTeXChar
where escapeLaTeXChar '\\' = "\\textbackslash{}"
escapeLaTeXChar '{' = "\\{"
escapeLaTeXChar '}' = "\\}"
escapeLaTeXChar '|' = if inline
then "\\VerbBar{}"
else "|"
escapeLaTeXChar x = [x]
formatLaTeXBlock :: FormatOptions -> [SourceLine] -> String
formatLaTeXBlock opts ls = unlines
["\\begin{Shaded}"
,"\\begin{Highlighting}[" ++
(if numberLines opts
then "numbers=left," ++
(if startNumber opts == 1
then ""
else ",firstnumber=" ++ show (startNumber opts)) ++ ","
else "") ++ "]"
,formatLaTeX False ls
,"\\end{Highlighting}"
,"\\end{Shaded}"]
styleToLaTeX :: Style -> String
styleToLaTeX f = unlines $
[ "\\usepackage{color}"
, "\\usepackage{fancyvrb}"
, "\\newcommand{\\VerbBar}{|}"
, "\\newcommand{\\VERB}{\\Verb[commandchars=\\\\\\{\\}]}"
, "\\DefineVerbatimEnvironment{Highlighting}{Verbatim}{commandchars=\\\\\\{\\}}"
, "% Add ',fontsize=\\small' for more characters per line"
] ++
(case backgroundColor f of
Nothing -> ["\\newenvironment{Shaded}{}{}"]
Just (RGB r g b) -> ["\\usepackage{framed}"
,printf "\\definecolor{shadecolor}{RGB}{%d,%d,%d}" r g b
,"\\newenvironment{Shaded}{\\begin{snugshade}}{\\end{snugshade}}"])
++ map (macrodef (defaultColor f) (tokenStyles f)) (enumFromTo KeywordTok NormalTok)
macrodef :: Maybe Color -> [(TokenType, TokenStyle)] -> TokenType -> String
macrodef defaultcol tokstyles tokt = "\\newcommand{\\" ++ show tokt ++
"}[1]{" ++ (co . ul . bf . it . bg $ "{#1}") ++ "}"
where tokf = case lookup tokt tokstyles of
Nothing -> defStyle
Just x -> x
ul x = if tokenUnderline tokf
then "\\underline{" ++ x ++ "}"
else x
it x = if tokenItalic tokf
then "\\textit{" ++ x ++ "}"
else x
bf x = if tokenBold tokf
then "\\textbf{" ++ x ++ "}"
else x
bcol = fromColor `fmap` tokenBackground tokf :: Maybe (Double, Double, Double)
bg x = case bcol of
Nothing -> x
Just (r, g, b) -> printf "\\colorbox[rgb]{%0.2f,%0.2f,%0.2f}{%s}" r g b x
col = fromColor `fmap`
(tokenColor tokf `mplus` defaultcol) :: Maybe (Double, Double, Double)
co x = case col of
Nothing -> x
Just (r, g, b) -> printf "\\textcolor[rgb]{%0.2f,%0.2f,%0.2f}{%s}" r g b x