hscolour 1.17 → 1.18

raw patch · 17 files changed

+463/−71 lines, 17 filesdep +containersdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• HsColour.hs +27/−12
• Language/Haskell/HsColour.hs +12/−6
• Language/Haskell/HsColour/ACSS.hs +146/−0
• Language/Haskell/HsColour/ANSI.hs +36/−8
• Language/Haskell/HsColour/Anchors.hs +24/−1
• Language/Haskell/HsColour/CSS.hs +7/−2
• Language/Haskell/HsColour/ColourHighlight.hs +72/−3
• Language/Haskell/HsColour/HTML.hs +11/−4
• Language/Haskell/HsColour/InlineCSS.hs +4/−2
• Language/Haskell/HsColour/LaTeX.hs +2/−0
• Language/Haskell/HsColour/MIRC.hs +1/−0
• Language/Haskell/HsColour/Options.hs +2/−0
• Language/Haskell/HsColour/Output.hs +9/−2
• Language/Haskell/HsColour/TTY.hs +11/−4
• data/rgb24-example-.hscolour +25/−0
• hscolour.cabal +41/−26
• hscolour.css +33/−1

@@ -5,9 +5,10 @@ import qualified Language.Haskell.HsColour as HSColour import Language.Haskell.HsColour.Colourise (readColourPrefs) import Language.Haskell.HsColour.Options+import Language.Haskell.HsColour.ACSS (breakS, srcModuleName) import System import IO-import Monad (when)+import Control.Monad (when, forM_) import List  (intersperse, isSuffixOf) --import Debug.Trace @@ -17,7 +18,7 @@ import System.IO (hSetEncoding, utf8) #endif -version = "1.17"+version = "1.18"  optionTable :: [(String,Option)] optionTable = [ ("help",    Help)@@ -27,6 +28,7 @@               , ("css",    Format CSS)               , ("icss",   Format ICSS)               , ("tty",    Format TTY)+              , ("tty256", Format (TTYg XTerm256Compatible))               , ("latex",  Format LaTeX)               , ("mirc",   Format MIRC)               , ("lit",    LHS True)@@ -40,6 +42,7 @@  parseOption :: String -> Either String Option parseOption ('-':'o':s) = Right (Output s)+parseOption ('-':'a':'n':'n':'o':'t':'=':s) = Right (Annot s) parseOption s@('-':_)   = maybe (Left s) Right                                 (lookup (dropWhile (== '-') s) optionTable) parseOption s           = Right (Input s)@@ -54,14 +57,15 @@       good    = [ o | Right o <- options ]       formats = [ f | Format f <- good ]       outFile = [ f | Output f <- good ]+      annFile = [ f | Annot f <- good ]       output    = useDefault  TTY         id           formats       anchors   = useDefault  False       id           [ b | Anchors b <- good ]       partial   = useDefault  False       id           [ b | Partial b <- good ]       lhs       = useDefault  Nothing     id           [ Just b | LHS b<- good ]       title     = useDefault  "Haskell code" id        [ f | Input f   <- good ]       ioWrapper = useDefaults (ttyInteract  outFile (guessLiterate lhs ""))-                              (fileInteract outFile)   [ (f,guessLiterate lhs f)-                                                           | Input f   <- good ]+                              (fileInteract outFile annFile)   +			      [(f, guessLiterate lhs f) | Input f <- good]   when (not (null bad)) $        errorOut ("Unrecognised option(s): "++unwords bad++"\n"++usage prog)   when (Help `elem` good)        $ writeResult [] (usage prog)@@ -72,20 +76,24 @@                  ++unwords (map show formats))   when (length outFile > 1) $        errorOut ("Can only have one output file at a time.")+  when (length annFile > 1) $+       errorOut ("Can only use a single annotation file for annotated-CSS output")+     ioWrapper (HSColour.hscolour output pref anchors partial title)    where     writeResult outF s = do if null outF then putStr s                                          else writeUTF8File (last outF) s                             exitSuccess-    fileInteract out inFs u = do h <- case out of-                                          []     -> return stdout-                                          [outF] -> openFile outF WriteMode >>=-                                                    set_utf8_io_enc-                                 mapM_ (\ (f,lit)->-                                           readUTF8File f >>= hPutStr h . u lit)-                                       inFs-                                 hClose h+    fileInteract out ann inFs u +      = do h <- case out of+                  []     -> return stdout+                  [outF] -> openFile outF WriteMode >>= set_utf8_io_enc+           forM_ inFs $ \ (f, lit) -> do+             src <- readUTF8File f+             a   <- readAnnots src ann+             hPutStr h $ u lit $ src ++ a +           hClose h     ttyInteract []     lit u = do hSetBuffering stdout NoBuffering                                   Prelude.interact (u lit)     ttyInteract [outF] lit u = do c <- hGetContents stdin@@ -96,6 +104,7 @@                   ++" options [file.hs]\n    where\n      options = [ "                   ++ (indent 15 . unwords . width 58 58 . intersperse "|"                      . ("-oOUTPUT":)+                     . ("-annot=ANNOTATIONFILE":)                      . map (('-':) . fst)) optionTable                   ++ " ]\n"     useDefault d f list  | null list = d@@ -105,6 +114,12 @@     guessLiterate Nothing  f = ".lhs" `isSuffixOf` f || ".ly" `isSuffixOf` f                                || ".lx" `isSuffixOf` f     guessLiterate (Just b) _ = b+    readAnnots _   []     = return ""+    readAnnots src [annF] = do putStrLn $ "HsColour Annot on Module: " ++ mname+                               annots <- readUTF8File annF+                               return $ breakS ++ "\n" ++ mname ++ "\n" ++ annots+                            where mname = srcModuleName src+  -- some simple text formatting for usage messages width n left  []    = []

@@ -20,6 +20,7 @@ import qualified Language.Haskell.HsColour.TTY        as TTY import qualified Language.Haskell.HsColour.HTML       as HTML import qualified Language.Haskell.HsColour.CSS        as CSS+import qualified Language.Haskell.HsColour.ACSS       as ACSS  import qualified Language.Haskell.HsColour.InlineCSS  as ICSS import qualified Language.Haskell.HsColour.LaTeX      as LaTeX import qualified Language.Haskell.HsColour.MIRC       as MIRC@@ -53,23 +54,27 @@           -> Bool        -- ^ Whether to include anchors.           -> String      -- ^ Haskell source code.           -> String      -- ^ Coloured Haskell source code.-hscolour' TTY   pref _      = TTY.hscolour   pref-hscolour' MIRC  pref _      = MIRC.hscolour  pref-hscolour' LaTeX pref _      = LaTeX.hscolour pref-hscolour' HTML  pref anchor = HTML.hscolour  pref anchor-hscolour' CSS   _    anchor = CSS.hscolour        anchor-hscolour' ICSS  pref anchor = ICSS.hscolour  pref anchor+hscolour' TTY       pref _      = TTY.hscolour     pref+hscolour' (TTYg tt) pref _      = TTY.hscolourG tt pref+hscolour' MIRC      pref _      = MIRC.hscolour    pref+hscolour' LaTeX     pref _      = LaTeX.hscolour   pref+hscolour' HTML      pref anchor = HTML.hscolour    pref anchor+hscolour' CSS       _    anchor = CSS.hscolour          anchor+hscolour' ICSS      pref anchor = ICSS.hscolour    pref anchor+hscolour' ACSS      _    anchor = ACSS.hscolour         anchor  -- | Choose the right headers\/footers, depending on the output format. top'n'tail :: Output           -- ^ Output format            -> String           -- ^ Title for output            -> (String->String) -- ^ Output transformer top'n'tail TTY   _     = id+top'n'tail (TTYg _) _  = id top'n'tail MIRC  _     = id top'n'tail LaTeX title = LaTeX.top'n'tail title top'n'tail HTML  title = HTML.top'n'tail title top'n'tail CSS   title = CSS.top'n'tail  title top'n'tail ICSS  title = ICSS.top'n'tail title+top'n'tail ACSS  title = CSS.top'n'tail  title  -- | Separating literate files into code\/comment chunks. data Lit = Code {unL :: String} | Lit {unL :: String} deriving (Show)@@ -88,6 +93,7 @@   -- | The code for classify is largely stolen from Language.Preprocessor.Unlit.+classify ::  [String] -> [Lit] classify []             = [] classify (x:xs) | "\\begin{code}"`isPrefixOf`x                         = Lit x: allProg xs

@@ -0,0 +1,146 @@+-- | Formats Haskell source code as HTML with CSS and Mouseover Type Annotations+module Language.Haskell.HsColour.ACSS (+    hscolour+  , hsannot+  , AnnMap (..)+  , Loc (..)+  , breakS+  , srcModuleName +  ) where++import Language.Haskell.HsColour.Anchors+import Language.Haskell.HsColour.Classify as Classify+import Language.Haskell.HsColour.HTML (renderAnchors, renderComment,+                                       renderNewLinesAnchors, escape)+import qualified Language.Haskell.HsColour.CSS as CSS++import Data.Maybe  (fromMaybe) +import qualified Data.Map as M+import Data.List   (isSuffixOf, findIndex, elemIndices, intercalate)+import Data.Char   (isLower, isSpace, isAlphaNum)+import Text.Printf+import Debug.Trace++newtype AnnMap = Ann (M.Map Loc (String, String))                    +newtype Loc    = L (Int, Int) deriving (Eq, Ord, Show)++-- | Formats Haskell source code using HTML and mouse-over annotations +hscolour :: Bool     -- ^ Whether to include anchors.+         -> String   -- ^ Haskell source code, Annotations as comments at end+         -> String   -- ^ Coloured Haskell source code.++hscolour anchor = hsannot anchor . splitSrcAndAnns++-- | Formats Haskell source code using HTML and mouse-over annotations +hsannot  :: Bool             -- ^ Whether to include anchors.+         -> (String, AnnMap) -- ^ Haskell Source, Annotations+         -> String           -- ^ Coloured Haskell source code.++hsannot anchor = +    CSS.pre+    . (if anchor then -- renderNewLinesAnchors .+                      concatMap (renderAnchors renderAnnotToken)+                      . insertAnnotAnchors+                 else concatMap renderAnnotToken)+    . annotTokenise++annotTokenise  :: (String, AnnMap) -> [(TokenType, String, Maybe String)] +annotTokenise (src, Ann annm) +  = zipWith (\(x,y) z -> (x,y, snd `fmap` z)) toks annots +  where toks       = tokenise src +        spans      = tokenSpans $ map snd toks +        annots     = map (`M.lookup` annm) spans++tokenSpans :: [String] -> [Loc]+tokenSpans = scanl plusLoc (L (1, 1)) ++plusLoc :: Loc -> String -> Loc+plusLoc (L (l, c)) s +  = case '\n' `elemIndices` s of+      [] -> L (l, (c + n))+      is -> L ((l + length is), (n - maximum is))+    where n = length s++renderAnnotToken :: (TokenType, String, Maybe String) -> String+renderAnnotToken (x,y, Nothing) +  = CSS.renderToken (x, y)+renderAnnotToken (x,y, Just ann)+  = printf template (escape ann) (CSS.renderToken (x, y))+    where template = "<a class=annot href=\"#\"><span class=annottext>%s</span>%s</a>"++{- Example Annotation:+<a class=annot href="#"><span class=annottext>x#agV:Int -&gt; {VV_int:Int | (0 &lt;= VV_int),(x#agV &lt;= VV_int)}</span>+<span class='hs-definition'>NOWTRYTHIS</span></a>+-}+++insertAnnotAnchors :: [(TokenType, String, a)] -> [Either String (TokenType, String, a)]+insertAnnotAnchors toks +  = stitch (zip toks' toks) $ insertAnchors toks'+  where toks' = [(x,y) | (x,y,_) <- toks] ++stitch ::  Eq b => [(b, c)] -> [Either a b] -> [Either a c]+stitch xys ((Left a) : rest)+  = (Left a) : stitch xys rest+stitch ((x,y):xys) ((Right x'):rest) +  | x == x' +  = (Right y) : stitch xys rest+  | otherwise+  = error "stitch"+stitch _ []+  = []+++splitSrcAndAnns ::  String -> (String, AnnMap) +splitSrcAndAnns s = +  let ls = lines s in+  case findIndex (breakS ==) ls of+    Nothing -> (s, Ann M.empty)+    Just i  -> (src, {- trace ("annm =" ++ show ann) -} ann)+               where (codes, _:mname:annots) = splitAt i ls+                     ann   = annotParse mname $ dropWhile isSpace $ unlines annots+                     src   = unlines codes+                     -- mname = srcModuleName src++srcModuleName :: String -> String+srcModuleName = fromMaybe "Main" . tokenModule . tokenise+  +tokenModule toks +  = do i <- findIndex ((Keyword, "module") ==) toks +       let (_, toks')  = splitAt (i+2) toks+       j <- findIndex ((Space ==) . fst) toks'+       let (toks'', _) = splitAt j toks'+       return $ concatMap snd toks''++breakS = "MOUSEOVER ANNOTATIONS" ++annotParse :: String -> String -> AnnMap+annotParse mname = Ann . M.fromList . parseLines mname 0 . lines++parseLines mname i [] +  = []+parseLines mname i ("":ls)      +  = parseLines mname (i+1) ls+parseLines mname i (x:f:l:c:n:rest) +  | f /= mname -- `isSuffixOf` mname +  = {- trace ("wrong annot f = " ++ f ++ " mname = " ++ mname) $ -} parseLines mname (i + 5 + num) rest'+  | otherwise +  = (L (line, col), (x, anns)) : parseLines mname (i + 5 + num) rest'+    where line  = (read l) :: Int+          col   = (read c) :: Int+          num   = (read n) :: Int+          anns  = intercalate "\n" $ take num rest+          rest' = drop num rest+parseLines _ i _              +  = error $ "Error Parsing Annot Input on Line: " ++ show i++takeFileName s = map slashWhite s+  where slashWhite '/' = ' '++instance Show AnnMap where+  show (Ann m) = "\n\n" ++ (concatMap ppAnnot $ M.toList m)+    where ppAnnot (L (l, c), (x,s)) =  x ++ "\n" +                                    ++ show l ++ "\n"+                                    ++ show c ++ "\n"+                                    ++ show (length $ lines s) ++ "\n"+                                    ++ s ++ "\n\n\n"

@@ -1,8 +1,8 @@ -- | Partially taken from Hugs AnsiScreen.hs library: module Language.Haskell.HsColour.ANSI-  ( highlightOn+  ( highlightOnG,highlightOn   , highlightOff-  , highlight+  , highlightG,highlight   , cleareol, clearbol, clearline, clearDown, clearUp, cls   , goto   , cursorUp, cursorDown, cursorLeft, cursorRight@@ -12,14 +12,17 @@   , colourCycle   , enableScrollRegion, scrollUp, scrollDown   , lineWrap+  , TerminalType(..)   ) where  import Language.Haskell.HsColour.ColourHighlight+import Language.Haskell.HsColour.Output(TerminalType(..))  import List (intersperse,isPrefixOf) import Char (isDigit)  + -- Basic screen control codes:  type Pos           = (Int,Int)@@ -64,20 +67,42 @@   fromEnum Blink        = 5   fromEnum ReverseVideo = 7   fromEnum Concealed    = 8+  -- The translation of these depends on the terminal type, and they don't translate to single numbers anyway. Should we really use the Enum class for this purpose rather than simply moving this table to 'renderAttrG'?+  fromEnum (Foreground (Rgb _ _ _)) = error "Internal error: fromEnum (Foreground (Rgb _ _ _))"+  fromEnum (Background (Rgb _ _ _)) = error "Internal error: fromEnum (Background (Rgb _ _ _))"   fromEnum (Foreground c) = 30 + fromEnum c   fromEnum (Background c) = 40 + fromEnum c   fromEnum Italic       = 2 ++-- | = 'highlightG' 'Ansi16Colour'+highlight ::  [Highlight] -> String -> String+highlight = highlightG Ansi16Colour++-- | = 'highlightOn' 'Ansi16Colour'+highlightOn ::  [Highlight] -> String+highlightOn = highlightOnG Ansi16Colour++ -- | Make the given string appear with all of the listed highlights-highlight :: [Highlight] -> String -> String-highlight attrs s = highlightOn attrs ++ s ++ highlightOff+highlightG :: TerminalType -> [Highlight] -> String -> String+highlightG tt attrs s = highlightOnG tt attrs ++ s ++ highlightOff -highlightOn []     = highlightOn [Normal]-highlightOn attrs  = "\ESC["-                     ++ concat (intersperse ";" (map (show.fromEnum) attrs))-                     ++"m"+highlightOnG :: TerminalType -> [Highlight] -> String+highlightOnG tt []     = highlightOnG tt [Normal]+highlightOnG tt attrs  = "\ESC["+                       ++ concat (intersperse ";" (concatMap (renderAttrG tt) attrs))+                       ++"m"+highlightOff ::  [Char] highlightOff = "\ESC[0m" +renderAttrG ::  TerminalType -> Highlight -> [String]+renderAttrG XTerm256Compatible (Foreground (Rgb r g b)) = +    [ "38", "5", show ( rgb24bit_to_xterm256 r g b ) ]+renderAttrG XTerm256Compatible (Background (Rgb r g b)) = +    [ "48", "5", show ( rgb24bit_to_xterm256 r g b ) ]+renderAttrG _ a                                         = +    [ show (fromEnum (hlProjectToBasicColour8 a)) ]  -- | An infinite supply of colours. colourCycle :: [Colour]@@ -88,10 +113,13 @@ enableScrollRegion :: Int -> Int -> String enableScrollRegion start end = "\ESC["++show start++';':show end++"r" +scrollDown ::  String scrollDown  = "\ESCD"+scrollUp ::  String scrollUp    = "\ESCM"  -- Line-wrapping mode+lineWrap ::  Bool -> [Char] lineWrap True  = "\ESC[7h" lineWrap False = "\ESC[7l" 

@@ -5,6 +5,7 @@ import Language.Haskell.HsColour.Classify import Language.Haskell.HsColour.General import List+import Char  -- This is an attempt to find the first defining occurrence of an -- identifier (function, datatype, class) in a Haskell source file.@@ -27,13 +28,29 @@  -- looks at first token in the left-most position of each line -- precondition: have just seen a newline token.+anchor :: ST -> [(TokenType, String)] -> [Either String (TokenType, String)] anchor st s = case identifier st s of                 Nothing -> emit st s-                Just v  -> Left v: emit (insertST v st) s+                Just v  -> Left (escape v): emit (insertST v st) s +-- some chars are not valid in anchor URIs: http://www.ietf.org/rfc/rfc3986+-- NOTE: This code assumes characters are 8-bit.+--       Ideally, it should transcode to utf8 octets first.+escape :: String -> String+escape = concatMap enc+    where enc x | isDigit x+                || isURIFragmentValid x+                || isLower x+                || isUpper x = [x]+                | otherwise  = ['%',hexHi (ord x), hexLo (ord x)]+          hexHi d = intToDigit (d`div`16)+          hexLo d = intToDigit (d`mod`16)+          isURIFragmentValid x = x `elem` "!$&'()*+,;=/?-._~:@"+ -- emit passes stuff through until the next newline has been encountered, -- then jumps back into the anchor function -- pre-condition: newlines are explicitly single tokens+emit :: ST -> [(TokenType, String)] -> [Either String (TokenType, String)] emit st (t@(Space,"\n"):stream) = Right t: anchor st stream emit st (t:stream)              = Right t: emit st stream emit _  []                      = []@@ -41,6 +58,7 @@ -- Given that we are at the beginning of a line, determine whether there -- is an identifier defined here, and if so, return it. -- precondition: have just seen a newline token.+identifier ::  ST -> [(TokenType, String)] -> Maybe String identifier st t@((kind,v):stream) | kind`elem`[Varid,Definition] =     case skip stream of         ((Varop,v):_) | not (v`inST`st) -> Just (fix v)@@ -75,6 +93,7 @@ typesig _                     = False  -- throw away everything from opening paren to matching close+munchParens ::  [(TokenType, String)] -> [(TokenType, String)] munchParens =  munch (0::Int)	-- already seen open paren   where munch 0 ((Layout,")"):rest) = rest         munch n ((Layout,")"):rest) = munch (n-1) rest@@ -83,16 +102,19 @@         munch _ []                  = []	-- source is ill-formed  -- ensure anchor name is correct for a Varop+fix ::  String -> String fix ('`':v) = dropLast '`' v fix v       = v  -- look past whitespace and comments to next "real" token+skip ::  [(TokenType, t)] -> [(TokenType, t)] skip ((Space,_):stream)   = skip stream skip ((Comment,_):stream) = skip stream skip stream               = stream  -- skip possible context up to and including "=>", returning next Conid token -- (this function is highly partial - relies on source being parse-correct)+getConid ::  [(TokenType, String)] -> Maybe String getConid stream =     case skip stream of         ((Conid,c):rest) -> case context rest of@@ -114,6 +136,7 @@        --                       ++"\n  in the context of: "++c)  -- jump past possible class context+context ::  [(TokenType, String)] -> [(TokenType, String)] context stream@((Keyglyph,"="):_) = stream context stream@((Keyglyph,"=>"):_) = stream context (_:stream) = context stream

@@ -1,5 +1,10 @@ -- | Formats Haskell source code as HTML with CSS.-module Language.Haskell.HsColour.CSS (hscolour,top'n'tail) where+module Language.Haskell.HsColour.CSS +  ( hscolour+  , top'n'tail+  , renderToken +  , pre +  ) where  import Language.Haskell.HsColour.Anchors import Language.Haskell.HsColour.Classify as Classify@@ -57,7 +62,7 @@     ,"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"     ,"<html>"     ,"<head>"-    ,"<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->"+    ,"<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->"     ,"<title>"++title++"</title>"     ,"<link type='text/css' rel='stylesheet' href='hscolour.css' />"     ,"</head>"

@@ -1,12 +1,78 @@ module Language.Haskell.HsColour.ColourHighlight   ( Colour(..)   , Highlight(..)+  , base256, unbase+  , rgb24bit_to_xterm256+  ,   projectToBasicColour8+  , hlProjectToBasicColour8   ) where +import Data.Word+ -- | Colours supported by ANSI codes.-data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White-  deriving (Eq,Show,Read,Enum)+data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White | Rgb Word8 Word8 Word8+  deriving (Eq,Show,Read) +-- | Convert an integer in the range [0,2^24-1] to its base 256-triplet, passing the result to the given continuation (avoid unnecessary tupleism).+base256 :: Integral int => (Word8 -> Word8 -> Word8 -> r) -> int -> r+base256 kont x =+    let+        (r,gb) = divMod x 256+        (g,b)  = divMod gb 256+        fi = fromIntegral+    in +        kont (fi r) (fi g) (fi b)++-- | Convert a three-digit numeral in the given (as arg 1) base to its integer value.+unbase :: Integral int => int -> Word8 -> Word8 -> Word8 -> int+unbase base r g b = (fi r*base+fi g)*base+fi b+    where fi = fromIntegral++-- | Approximate a 24-bit Rgb colour with a colour in the xterm256 6x6x6 colour cube, returning its index.+rgb24bit_to_xterm256 :: (Integral t) => Word8 -> Word8 -> Word8 -> t+rgb24bit_to_xterm256 r g b = let f = (`div` 43)+                          in 16 + unbase 6 (f r) (f g) (f b)+++-- | Ap\"proxi\"mate a 24-bit Rgb colour with an ANSI8 colour. Will leave other colours unchanged and will never return an 'Rgb' constructor value. +projectToBasicColour8 ::  Colour -> Colour+projectToBasicColour8 (Rgb r g b) = let f = (`div` 128)+                          in  toEnum ( unbase 2 (f r) (f g) (f b) )+projectToBasicColour8 x = x+++-- | Lift 'projectToBasicColour8' to 'Highlight's+hlProjectToBasicColour8 ::  Highlight -> Highlight+hlProjectToBasicColour8 (Foreground c) = Foreground (projectToBasicColour8 c)+hlProjectToBasicColour8 (Background c) = Background (projectToBasicColour8 c)+hlProjectToBasicColour8 h = h++        ++instance Enum Colour where+    toEnum 0 = Black+    toEnum 1 = Red +    toEnum 2 = Green +    toEnum 3 = Yellow +    toEnum 4 = Blue +    toEnum 5 = Magenta +    toEnum 6 = Cyan +    toEnum 7 = White +    -- Arbitrary extension; maybe just 'error' out instead+    toEnum x = base256 Rgb (x-8)+    +    fromEnum Black   = 0+    fromEnum Red     = 1+    fromEnum Green   = 2+    fromEnum Yellow  = 3+    fromEnum Blue    = 4+    fromEnum Magenta = 5+    fromEnum Cyan    = 6+    fromEnum White   = 7+    -- Arbitrary extension; maybe just 'error' out instead+    fromEnum (Rgb r g b) = 8 + unbase 256 r g b+ + -- | Types of highlighting supported by ANSI codes (and some extra styles). data Highlight =     Normal@@ -18,7 +84,10 @@   | Concealed   | Foreground Colour   | Background Colour-  -- Above are ANSI-only.  Below are extra styles.+  -- The above styles are ANSI-supported, with the exception of the 'Rgb' constructor for 'Colour's.  Below are extra styles (e.g. for Html rendering).   | Italic   deriving (Eq,Show,Read)+++ 

@@ -11,6 +11,7 @@ import Language.Haskell.HsColour.Colourise  import Char(isAlphaNum)+import Text.Printf   -- | Formats Haskell source code using HTML with font tags.@@ -36,8 +37,7 @@ renderToken pref (t,s) = fontify (colourise pref t)                          (if t == Comment then renderComment s else escape s) -renderAnchors :: ((TokenType,String)->String)-                 -> Either String (TokenType,String) -> String+renderAnchors :: (a -> String) -> Either String a -> String renderAnchors _      (Left v) = "<a name=\""++v++"\"></a>" renderAnchors render (Right r) = render r @@ -60,9 +60,11 @@     where render (line, s) = "<a name=\"line-" ++ show line ++ "\"></a>" ++ s  -- Html stuff+fontify ::  [Highlight] -> String -> String fontify [] s     = s fontify (h:hs) s = font h (fontify hs s) +font ::  Highlight -> String -> String font Normal         s = s font Bold           s = "<b>"++s++"</b>" font Dim            s = "<em>"++s++"</em>"@@ -70,23 +72,28 @@ font Blink          s = "<blink>"++s++"</blink>" font ReverseVideo   s = s font Concealed      s = s-font (Foreground c) s = "<font color="++show c++">"++s++"</font>"+font (Foreground (Rgb r g b)) s = printf   "<font color=\"#%02x%02x%02x\">%s</font>" r g b s+font (Background (Rgb r g b)) s = printf "<font bgcolor=\"#%02x%02x%02x\">%s</font>" r g b s+font (Foreground c) s =   "<font color="++show c++">"++s++"</font>" font (Background c) s = "<font bgcolor="++show c++">"++s++"</font>" font Italic         s = "<i>"++s++"</i>" +escape ::  String -> String escape ('<':cs) = "&lt;"++escape cs escape ('>':cs) = "&gt;"++escape cs escape ('&':cs) = "&amp;"++escape cs escape (c:cs)   = c: escape cs escape []       = [] +htmlHeader ::  String -> String htmlHeader title = unlines   [ "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 3.2 Final//EN\">"   , "<html>"   , "<head>"-  ,"<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->"+  ,"<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->"   , "<title>"++title++"</title>"   , "</head>"   , "<body>"   ]+htmlClose ::  String htmlClose  = "\n</body>\n</html>"

@@ -6,6 +6,7 @@ import Language.Haskell.HsColour.Colourise import Language.Haskell.HsColour.HTML (renderAnchors, renderComment,                                        renderNewLinesAnchors, escape)+import Text.Printf  -- | Formats Haskell source code as a complete HTML document with inline styling hscolour :: ColourPrefs	-- ^ Preferences for styling.@@ -42,7 +43,7 @@     ,"<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">"     ,"<html>"     ,"<head>"-    ,"<!-- Generated by HsColour, http://www.cs.york.ac.uk/fp/darcs/hscolour/ -->"+    ,"<!-- Generated by HsColour, http://code.haskell.org/~malcolm/hscolour/ -->"     ,"<title>"++title++"</title>"     ,"</head>"     ,"<body style=\"background-color: #131313; color: #ffffff;\">"@@ -62,7 +63,7 @@ style ReverseVideo   = "" style Concealed      = "text-decoration:  line-through;" style (Foreground c) = "color: "++csscolour c++";"-style (Background c) = "background-colour: "++csscolour c++";"+style (Background c) = "background-color: "++csscolour c++";" style Italic         = "font-style: italic;"  csscolour :: Colour -> String@@ -74,4 +75,5 @@ csscolour Magenta = "#ff00ff" csscolour Cyan    = "#00ffff" csscolour White   = "#ffffff"+csscolour (Rgb r g b) = printf "#%02x%02x%02x" r g b 

@@ -82,6 +82,8 @@ latexColour Magenta = "magenta" latexColour Cyan    = "cyan" latexColour White   = "white"+-- | TODO: How are these properly encoded in Latex?+latexColour c@(Rgb _ _ _) = latexColour (projectToBasicColour8 c)  -- | Generic LaTeX document preamble. latexPrefix title = unlines

@@ -66,3 +66,4 @@ code Magenta True  = "13" code Cyan    True  = "11" code White   True  = "15"+code c@(Rgb _ _ _) b = code (projectToBasicColour8 c) b

@@ -1,6 +1,7 @@ module Language.Haskell.HsColour.Options   ( Option(..)   , Output(..)+  , TerminalType(..)   ) where   import Language.Haskell.HsColour.Output@@ -16,4 +17,5 @@   | Partial Bool	-- ^ whether to produce a full document or partial   | Input FilePath	-- ^ input source file   | Output FilePath	-- ^ output source file+  | Annot FilePath  -- ^ annotations file   deriving Eq

@@ -1,10 +1,17 @@-module Language.Haskell.HsColour.Output where+module Language.Haskell.HsColour.Output(TerminalType(..),Output(..)) where +data TerminalType = +      Ansi16Colour -- ^ @\\033[Xm@-style escape sequences (with /X/ =~ [34][0-7]) +    | XTerm256Compatible -- ^ 'Ansi16Colour', and also @\\033[Y8;5;Zm]@-style escape sequences (with /Y/ =~ [3,4] and /Z/ an integer in [0,255] with the XTerm colour cube semantics).+    deriving (Show,Eq,Ord)+ -- | The supported output formats.-data Output = TTY   -- ^ ANSI terminal codes+data Output = TTY   -- ^ ANSI terminal codes. Equivalent to 'TTYg' 'Ansi16Colour' but left in for backwards compatibility. +            | TTYg TerminalType -- ^ Terminal codes appropriate for the 'TerminalType'.             | LaTeX -- ^ TeX macros             | HTML  -- ^ HTML with font tags             | CSS   -- ^ HTML with CSS.+            | ACSS  -- ^ HTML with CSS and mouseover types.              | ICSS  -- ^ HTML with inline CSS.             | MIRC  -- ^ mIRC chat clients   deriving (Eq,Show)

@@ -1,15 +1,22 @@ -- | Highlights Haskell code with ANSI terminal codes.-module Language.Haskell.HsColour.TTY (hscolour) where+module Language.Haskell.HsColour.TTY (hscolour,hscolourG) where  import Language.Haskell.HsColour.ANSI as ANSI import Language.Haskell.HsColour.Classify import Language.Haskell.HsColour.Colourise+import Language.Haskell.HsColour.Output(TerminalType(Ansi16Colour)) --- | Highlights Haskell code with ANSI terminal codes.+-- | = 'hscolourG' 'Ansi16Colour' hscolour :: ColourPrefs -- ^ Colour preferences.          -> String      -- ^ Haskell source code.          -> String      -- ^ Coloured Haskell source code.-hscolour pref = concatMap (renderToken pref) . tokenise+hscolour = hscolourG Ansi16Colour +-- | Highlights Haskell code with ANSI terminal codes.+hscolourG terminalType pref = concatMap (renderTokenG terminalType pref) . tokenise++ renderToken :: ColourPrefs -> (TokenType,String) -> String-renderToken pref (t,s) = ANSI.highlight (colourise pref t) s+renderToken = renderTokenG Ansi16Colour++renderTokenG terminalType pref (t,s) = ANSI.highlightG terminalType (colourise pref t) s

@@ -0,0 +1,25 @@+ColourPrefs+  { keyword          = [Foreground (Rgb  255 255 150 ), Background (Rgb  0 0 0)]+  , keyglyph         = [Foreground (Rgb  255 255 150 ), Background (Rgb  0 0 0)]+  , layout           = [Foreground (Rgb  150 255 150 ), Background (Rgb  0 0 0         ), Bold]+  , comment          = [Foreground (Rgb  0 0 0       ), Background (Rgb  150 255 150   ), Italic]+  , conid            = [Foreground (Rgb  150 150 255 ), Background (Rgb  0 0 0         ), Bold]+  , varid            = [Foreground (Rgb  150 150 255 ), Background (Rgb  0 0 0)]+  , conop            = [Foreground (Rgb  255 150 150 ), Background (Rgb  0 0 0         ), Bold]+  , varop            = [Foreground (Rgb  255 150 150 ), Background (Rgb  0 0 0)]+  , string           = [Foreground (Rgb  0 0 0       ), Background (Rgb  150 150 255)]+  , char             = [Foreground (Rgb  0 0 0       ), Background (Rgb  150 150 255)]+  , number           = [Foreground (Rgb  255 255 150 ), Background (Rgb  0 0 0)]+  , cpp              = [Foreground (Rgb  0 0 0       ), Background (Rgb  255 150 150)]+  , selection        = [Foreground (Rgb  150 255 150 ), Background (Rgb  0 0 0)]+  , variantselection = [Dim, Foreground Red, Underscore]+  , definition       = [Foreground (Rgb  150 255 150 ), Background (Rgb  0 0 0)]+  }++++-- This example configuration file would take effect if you moved it to ~/.hscolour.++-- Note: Comments currently have to come *after* the above block++-- vim: ft=haskell

@@ -1,43 +1,58 @@ Name: hscolour-Version: 1.17-Copyright: 2003-2010 Malcolm Wallace, University of York; 2006 Bjorn Bringert+Version: 1.18+Copyright: 2003-2011 Malcolm Wallace, University of York; 2006 Bjorn Bringert Maintainer: Malcolm Wallace Author: Malcolm Wallace-Homepage: http://www.cs.york.ac.uk/fp/darcs/hscolour/+Homepage: http://code.haskell.org/~malcolm/hscolour/ License: GPL License-file: LICENCE-GPL-Build-depends: haskell98, base < 10-Extensions:  Synopsis: Colourise Haskell code. Description:   hscolour is a small Haskell script to colourise Haskell code. It currently   has six output formats: -  ANSI terminal codes,+  ANSI terminal codes (optionally XTerm-256colour codes),   HTML 3.2 with <font> tags,   HTML 4.01 with CSS,+  HTML 4.01 with CSS and mouseover annotations,   XHTML 1.0 with inline CSS styling,   LaTeX,   and mIRC chat codes. Category: Language-Exposed-Modules: -  Language.Haskell.HsColour-  Language.Haskell.HsColour.ANSI-  Language.Haskell.HsColour.Anchors-  Language.Haskell.HsColour.CSS-  Language.Haskell.HsColour.Classify-  Language.Haskell.HsColour.ColourHighlight-  Language.Haskell.HsColour.Colourise-  Language.Haskell.HsColour.General-  Language.Haskell.HsColour.HTML-  Language.Haskell.HsColour.InlineCSS-  Language.Haskell.HsColour.LaTeX-  Language.Haskell.HsColour.MIRC-  Language.Haskell.HsColour.Options-  Language.Haskell.HsColour.Output-  Language.Haskell.HsColour.TTY-data-files: hscolour.css---ghc-options: -O -W Build-Type: Simple+Data-files: hscolour.css, data/rgb24-example-.hscolour+Cabal-version: >=1.6 -Executable: HsColour-Main-is: HsColour.hs++Library+  Build-depends: haskell98, base < 10, containers+  Exposed-Modules: +    Language.Haskell.HsColour+    Language.Haskell.HsColour.ANSI+    Language.Haskell.HsColour.Anchors+    Language.Haskell.HsColour.ACSS+    Language.Haskell.HsColour.CSS+    Language.Haskell.HsColour.Classify+    Language.Haskell.HsColour.ColourHighlight+    Language.Haskell.HsColour.Colourise+    Language.Haskell.HsColour.General+    Language.Haskell.HsColour.HTML+    Language.Haskell.HsColour.InlineCSS+    Language.Haskell.HsColour.LaTeX+    Language.Haskell.HsColour.MIRC+    Language.Haskell.HsColour.Options+    Language.Haskell.HsColour.Output+    Language.Haskell.HsColour.TTY+  --ghc-options: -O -W+  Extensions: +++Executable HsColour+  Build-depends: haskell98, base < 10, containers+  Main-is: HsColour.hs+  --ghc-options: -O -W+  Extensions: +++Source-repository head+  Type    : darcs+  Location: http://code.haskell.org/~malcolm/hscolour

@@ -1,6 +1,38 @@- .hs-keyglyph, .hs-layout {color: red;} .hs-keyword {color: blue;} .hs-comment, .hs-comment a {color: green;} .hs-str, .hs-chr {color: teal;} .hs-keyword,.hs-conid, .hs-varid, .hs-conop, .hs-varop, .hs-num, .hs-cpp, .hs-sel, .hs-definition {}+++/* For Mouseover Annotations */++a.annot{+    position:relative; +    color:#000;+    text-decoration:none+  }++a.annot:hover{z-index:25; background-color:#ff0}++a.annot span.annottext{display: none}++a.annot:hover span.annottext{ +  border-radius: 5px 5px;+  +  -moz-border-radius: 5px; +  -webkit-border-radius: 5px; +  +  box-shadow: 5px 5px 5px rgba(0, 0, 0, 0.1); +  -webkit-box-shadow: 5px 5px rgba(0, 0, 0, 0.1);+  -moz-box-shadow: 5px 5px rgba(0, 0, 0, 0.1); ++  display:block;+  position: absolute; +  left: 1em; top: 2em; +  z-index: 99;+  margin-left: 5; +  background: #FFFFAA; +  border: 2px solid #FFAD33;+  padding: 0.8em 1em;+}