diff --git a/HsColour.hs b/HsColour.hs --- a/HsColour.hs +++ b/HsColour.hs @@ -62,6 +62,7 @@ anchors = useDefault False id [ b | Anchors b <- good ] partial = useDefault False id [ b | Partial b <- good ] lhs = useDefault False id [ b | LHS b <- good ] + title = useDefault "Haskell code" id [ f | Input f <- good ] when (not (null bad)) (errorOut ("Unrecognised option(s): "++unwords bad++"\n"++usage prog)) when (Help `elem` good) (do putStrLn (usage prog); exitSuccess) @@ -73,7 +74,7 @@ ++unwords (map show formats))) when (length outFile > 1) (errorOut ("Can only have one output file at a time.")) - ioWrapper (hscolour output pref anchors partial lhs) + ioWrapper (hscolour output pref anchors partial lhs title) hFlush stdout where diff --git a/Language/Haskell/HsColour.hs b/Language/Haskell/HsColour.hs --- a/Language/Haskell/HsColour.hs +++ b/Language/Haskell/HsColour.hs @@ -1,5 +1,5 @@ --- | This is a library with colourises Haskell code. --- It currently has four output formats: +-- | This is a library which colourises Haskell code. +-- It currently has five output formats: -- -- * ANSI terminal codes -- @@ -31,31 +31,32 @@ -- | Colourise Haskell source code with the given output format. hscolour :: Output -- ^ Output format. - -> ColourPrefs -- ^ Colour preferences for formats that support it. + -> ColourPrefs -- ^ Colour preferences (for formats that support them). -> Bool -- ^ Whether to include anchors. -> Bool -- ^ Whether output document is partial or complete. -> Bool -- ^ Whether input document is literate haskell or not + -> String -- ^ Title for output. -> String -- ^ Haskell source code. -> String -- ^ Coloured Haskell source code. -hscolour output pref anchor partial False = - hscolour' output pref anchor partial -hscolour output pref anchor partial True = - concatMap chunk . joinL . map lhsClassify . inlines +hscolour output pref anchor partial literate title + | literate = concatMap chunk . joinL . map lhsClassify . inlines + | otherwise = hscolour' output pref anchor partial title where chunk (Literate c) = c - chunk (Code c) = hscolour' output pref anchor True c + chunk (Code c) = hscolour' output pref anchor True title c hscolour' :: Output -- ^ Output format. - -> ColourPrefs -- ^ Colour preferences for formats that support it. + -> ColourPrefs -- ^ Colour preferences (for formats that support them). -> Bool -- ^ Whether to include anchors. -> Bool -- ^ Whether output document is partial or complete. + -> String -- ^ Title for output. -> String -- ^ Haskell source code. -> String -- ^ Coloured Haskell source code. -hscolour' TTY pref _ _ = TTY.hscolour pref -hscolour' MIRC pref _ _ = MIRC.hscolour pref -hscolour' LaTeX pref _ partial = LaTeX.hscolour pref partial -hscolour' HTML pref anchor partial = HTML.hscolour pref anchor partial -hscolour' CSS _ anchor partial = CSS.hscolour anchor partial +hscolour' TTY pref _ _ _ = TTY.hscolour pref +hscolour' MIRC pref _ _ _ = MIRC.hscolour pref +hscolour' LaTeX pref _ partial _ = LaTeX.hscolour pref partial +hscolour' HTML pref anchor partial top = HTML.hscolour pref anchor partial top +hscolour' CSS _ anchor partial top = CSS.hscolour anchor partial top -- | Separating literate files into code\/comment chunks. data Literate = Code {unL :: String} | Literate {unL :: String} diff --git a/Language/Haskell/HsColour/ANSI.hs b/Language/Haskell/HsColour/ANSI.hs --- a/Language/Haskell/HsColour/ANSI.hs +++ b/Language/Haskell/HsColour/ANSI.hs @@ -1,4 +1,4 @@ --- Partially taken from Hugs AnsiScreen.hs library: +-- | Partially taken from Hugs AnsiScreen.hs library: module Language.Haskell.HsColour.ANSI ( highlightOn , highlightOff @@ -25,8 +25,10 @@ type Pos = (Int,Int) at :: Pos -> String -> String +-- | Move the screen cursor to the given position. goto :: Int -> Int -> String home :: String +-- | Clear the screen. cls :: String at (x,y) s = goto x y ++ s @@ -65,6 +67,7 @@ fromEnum (Foreground c) = 30 + fromEnum c fromEnum (Background c) = 40 + fromEnum c +-- | Make the given string appear with all of the listed highlights highlight :: [Highlight] -> String -> String highlight attrs s = highlightOn attrs ++ s ++ highlightOff @@ -75,12 +78,12 @@ highlightOff = "\ESC[0m" --- An infinite supply of colours. +-- | An infinite supply of colours. colourCycle :: [Colour] colourCycle = cycle [Red,Blue,Magenta,Green,Cyan] --- Scrolling +-- | Scrolling enableScrollRegion :: Int -> Int -> String enableScrollRegion start end = "\ESC["++show start++';':show end++"r" diff --git a/Language/Haskell/HsColour/CSS.hs b/Language/Haskell/HsColour/CSS.hs --- a/Language/Haskell/HsColour/CSS.hs +++ b/Language/Haskell/HsColour/CSS.hs @@ -10,11 +10,12 @@ hscolour :: Bool -- ^ Whether to include anchors. -> Bool -- ^ Whether output should be partial -- (= no stylesheet link will be included.) + -> String -- ^ Title for HTML page. -> String -- ^ Haskell source code. -> String -- ^ An HTML document containing the coloured -- Haskell source code. -hscolour anchor partial = - (if partial then id else top'n'tail) +hscolour anchor partial title = + (if partial then id else top'n'tail title) . pre . (if anchor then renderNewLinesAnchors @@ -23,8 +24,8 @@ else concatMap renderToken) . tokenise -top'n'tail :: String -> String -top'n'tail = (cssPrefix++) . (++cssSuffix) +top'n'tail :: String -> String -> String +top'n'tail title = (cssPrefix title ++) . (++cssSuffix) pre :: String -> String pre = ("
"++) . (++"
") @@ -55,12 +56,12 @@ cssClass _ = "" -cssPrefix = unlines +cssPrefix title = unlines ["" ,"" ,"" ,"" - ,"Haskell Code by HsColour" + ,""++title++"" ,"" ,"" ,"" diff --git a/Language/Haskell/HsColour/Classify.hs b/Language/Haskell/HsColour/Classify.hs --- a/Language/Haskell/HsColour/Classify.hs +++ b/Language/Haskell/HsColour/Classify.hs @@ -6,8 +6,8 @@ import Char import List --- Lex Haskell source code into an annotated token stream, without --- discarding any characters or layout. +-- | Lex Haskell source code into an annotated token stream, without +-- discarding any characters or layout. tokenise :: String -> [(TokenType,String)] tokenise str = let chunks = glue . chunk $ str @@ -71,7 +71,7 @@ eolcomment (c:s) = (c:cs, s') where (cs,s') = eolcomment s eolcomment [] = ([],[]) --- Classify tokens +-- | Classification of tokens as lexical entities data TokenType = Space | Keyword | Keyglyph | Layout | Comment | Conid | Varid | Conop | Varop | String | Char | Number | Cpp | Error | diff --git a/Language/Haskell/HsColour/ColourHighlight.hs b/Language/Haskell/HsColour/ColourHighlight.hs --- a/Language/Haskell/HsColour/ColourHighlight.hs +++ b/Language/Haskell/HsColour/ColourHighlight.hs @@ -3,9 +3,11 @@ , Highlight(..) ) where +-- | Colours supported by ANSI codes. data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Eq,Show,Read,Enum) +-- | Types of highlighting supported by ANSI codes. data Highlight = Normal | Bold diff --git a/Language/Haskell/HsColour/Colourise.hs b/Language/Haskell/HsColour/Colourise.hs --- a/Language/Haskell/HsColour/Colourise.hs +++ b/Language/Haskell/HsColour/Colourise.hs @@ -47,6 +47,8 @@ ++": reverting to defaults") return defaultColourPrefs +-- | Read colour preferences from .hscolour file in the current directory, or failing that, +-- from \$HOME\/.hscolour, and failing that, returns a default set of prefs. readColourPrefs :: IO ColourPrefs readColourPrefs = catch (do val <- readFile ".hscolour" @@ -57,7 +59,7 @@ parseColourPrefs (home++"/.hscolour") val) (\_-> return defaultColourPrefs)) --- Convert classification to colour highlights. +-- | Convert token classification to colour highlights. colourise :: ColourPrefs -> TokenType -> [Highlight] colourise pref Space = [Normal] colourise pref Comment = comment pref diff --git a/Language/Haskell/HsColour/HTML.hs b/Language/Haskell/HsColour/HTML.hs --- a/Language/Haskell/HsColour/HTML.hs +++ b/Language/Haskell/HsColour/HTML.hs @@ -15,10 +15,11 @@ hscolour :: ColourPrefs -- ^ Colour preferences. -> Bool -- ^ Whether to include anchors. -> Bool -- ^ Whether output should be partial. + -> String -- ^ Title for webpage output. -> String -- ^ Haskell source code. -> String -- ^ Coloured Haskell source code. -hscolour pref anchor partial = - (if partial then id else top'n'tail) +hscolour pref anchor partial title = + (if partial then id else top'n'tail title) . pre . (if anchor then renderNewLinesAnchors . concatMap (renderAnchors (renderToken pref)) @@ -26,8 +27,8 @@ else concatMap (renderToken pref)) . tokenise -top'n'tail :: String -> String -top'n'tail = (htmlHeader++) . (++htmlClose) +top'n'tail :: String -> String -> String +top'n'tail title = (htmlHeader title ++) . (++htmlClose) pre :: String -> String pre = ("
"++) . (++"
") @@ -79,6 +80,13 @@ escape (c:cs) = c: escape cs escape [] = [] -htmlHeader = "" - ++"\n\n" -htmlClose = "\n" +htmlHeader title = unlines + [ "" + , "" + , "" + ,"" + , ""++title++"" + , "" + , "" + ] +htmlClose = "\n\n" diff --git a/Language/Haskell/HsColour/MIRC.hs b/Language/Haskell/HsColour/MIRC.hs --- a/Language/Haskell/HsColour/MIRC.hs +++ b/Language/Haskell/HsColour/MIRC.hs @@ -1,5 +1,5 @@ -- | Formats Haskell source code using mIRC codes. --- (see http://irssi.org/documentation/formats) +-- (see http:\/\/irssi.org\/documentation\/formats) module Language.Haskell.HsColour.MIRC (hscolour) where import Language.Haskell.HsColour.Classify as Classify diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ LIBRARY = hscolour -VERSION = 1.9 +VERSION = 1.10 DIRS = Language/Haskell/HsColour diff --git a/docs/hscolour/Language-Haskell-HsColour-ANSI.html b/docs/hscolour/Language-Haskell-HsColour-ANSI.html --- a/docs/hscolour/Language-Haskell-HsColour-ANSI.html +++ b/docs/hscolour/Language-Haskell-HsColour-ANSI.html @@ -63,14 +63,241 @@ >DescriptionPartially taken from Hugs AnsiScreen.hs library: +Synopsis
highlight :: [Highlight] -> String -> String
cls :: String
goto :: Int -> Int -> String
data Highlight
= Normal
| Bold
| Dim
| Underscore
| Blink
| ReverseVideo
| Concealed
| Foreground Colour
| Background Colour
data Colour
= Black
| Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| White
colourCycle :: [Colour]
enableScrollRegion :: Int -> Int -> String
DocumentationMake the given string appear with all of the listed highlights +Clear the screen. +Move the screen cursor to the given position. + :: Bool -> Bool -> String -> String -> String
Types of highlighting supported by ANSI codes. +
Constructors
Colours supported by ANSI codes. +
Constructors
An infinite supply of colours. +
Scrolling +
hscolour :: Bool -> String -> String
hscolourFragment :: Bool -> String -> String
:: BoolWhether to include anchors +>Whether to include anchors. -> String-> BoolHaskell source code. +>Whether output should be partial + (= no stylesheet link will be included.) -> StringAn HTML document containing the coloured - Haskell source code. -Formats Haskell source code as a complete HTML document with CSS. -
hscolourFragmentSource
:: BoolWhether to include anchors +>Title for HTML page.
-> StringAn HTML fragment containing the coloured +>An HTML document containing the coloured Haskell source code.
Formats Haskell source code as an HTML fragment with CSS. - No stylesheet link is included in the output. +>Formats Haskell source code as a complete HTML document with CSS.
Synopsis
data TokenType
= Space
| Keyword
| Keyglyph
| Layout
| Comment
| Conid
| Varid
| Conop
| Varop
| String
| Char
| Number
| Cpp
| Error
| Definition
tokenise :: String -> [(TokenType, String)]
Documentation
Classification of tokens as lexical entities +
Constructors
Cpp
Definition
Lex Haskell source code into an annotated token stream, without + discarding any characters or layout. +Synopsis
data Colour
= Black
| Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
| White
data Highlight
= Normal
| Bold
| Dim
| Underscore
| Blink
| ReverseVideo
| Concealed
| Foreground Colour
| Background Colour
Documentation -> Bool -> Bool -> String -> String -> String
Colours supported by ANSI codes. +
Constructors
char, number, cpp, selection, variantselection, definition :: [Highlight]number, cpp, variantselection, definition :: [Highlight]
Types of highlighting supported by ANSI codes. +
Constructors
Read colour preferences from .hscolour file in the current directory, or failing that, + from $HOME/.hscolour, and failing that, returns a default set of prefs. +
Convert token classification to colour highlights. +
+ +Language.Haskell.HsColour.General
hscolourSource codeContentsIndex
Language.Haskell.HsColour.General
Documentation
dropLast :: Eq a => a -> [a] -> [a]Source
dropFirst :: Eq a => a -> [a] -> [a]Source
Produced by Haddock version 0.8
diff --git a/docs/hscolour/Language-Haskell-HsColour-HTML.html b/docs/hscolour/Language-Haskell-HsColour-HTML.html --- a/docs/hscolour/Language-Haskell-HsColour-HTML.html +++ b/docs/hscolour/Language-Haskell-HsColour-HTML.html @@ -109,7 +109,7 @@ >hscolour :: ColourPrefs -> Bool -> String -> String
renderComment :: String -> String
renderNewLinesAnchors :: String -> String
-> BoolWhether to include anchors +>Whether to include anchors. -> BoolWhether output should be partial. +-> StringTitle for webpage output. +-> StringHaskell source code. :: String -> StringSourcehscolour :: ColourPrefs -> String -> String -> Bool -> String -> String
renderNewLinesAnchors :: String -> StringSource
hscolourFragment :: ColourPrefs -> String -> String
-> StringHaskell source code. --> StringAn LaTeX document containing the coloured - Haskell source code. -Formats Haskell source code as a complete LaTeX document. -
hscolourFragmentSource
-> Bool
:: ColourPrefsColour preferences. +>Whether output should be partial (= no prologue).
-> StringAn LaTeX fragment containing the coloured +>A LaTeX document/fragment containing the coloured Haskell source code.
Formats Haskell source code as an LaTeX fragment. +>Formats Haskell source code as a complete LaTeX document.
+ +Language.Haskell.HsColour.MIRC
hscolourSource codeContentsIndex
Language.Haskell.HsColour.MIRC
Description
Formats Haskell source code using mIRC codes. + (see http://irssi.org/documentation/formats) +
Synopsis
hscolour :: ColourPrefs -> String -> String
Documentation
hscolourSource
:: ColourPrefsColour preferences. +
-> StringHaskell source code. +
-> StringColoured Haskell source code. +
Formats Haskell source code using mIRC codes. +
Produced by Haddock version 0.8
diff --git a/docs/hscolour/Language-Haskell-HsColour.html b/docs/hscolour/Language-Haskell-HsColour.html --- a/docs/hscolour/Language-Haskell-HsColour.html +++ b/docs/hscolour/Language-Haskell-HsColour.html @@ -69,8 +69,8 @@ >

This is a library with colourises Haskell code. - It currently has three output formats: +>This is a library which colourises Haskell code. + It currently has five output formats:

CSS| MIRCchar, number, cpp, selection, variantselection, definition :: [Highlight]Output -> ColourPrefs -> Bool -> String -> String -> Bool -> Bool -> Bool -> String -> String -> StringHTML with CSS. MIRCmIRC chat clients +show/hide Instances
Eq Output
Show Output
number, cpp, variantselection, definition :: [Highlight]ColourPrefsColour preferences for formats that support it. +>Colour preferences (for formats that support them). -> BoolWhether output document is partial or complete. +-> BoolWhether input document is literate haskell or not +-> StringTitle for output. +-> StringHaskell source code. Colourise Haskell source code with the give output format. +>Colourise Haskell source code with the given output format. -- | This is a library with colourises Haskell code. --- It currently has three output formats: --- --- * ANSI terminal codes --- --- * LaTeX macros --- --- * HTML with font tags --- --- * HTML with CSS. --- -module Language.Haskell.HsColour (Output(..), ColourPrefs(..), - hscolour) where - -import Language.Haskell.HsColour.Colourise (ColourPrefs(..)) -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.LaTeX as LaTeX - --- | The supported output formats. -data Output = TTY -- ^ ANSI terminal codes - | LaTeX -- ^ TeX macros - | HTML -- ^ HTML with font tags - | CSS -- ^ HTML with CSS. - --- | Colourise Haskell source code with the give output format. -hscolour :: Output -- ^ Output format. - -> ColourPrefs -- ^ Colour preferences for formats that support it. - -> Bool -- ^ Whether to include anchors. - -> String -- ^ Haskell source code. - -> String -- ^ Coloured Haskell source code. -hscolour TTY pref _ = TTY.hscolour pref -hscolour LaTeX pref _ = LaTeX.hscolour pref -hscolour HTML pref anchor = HTML.hscolour pref anchor -hscolour CSS _ anchor = CSS.hscolour anchor + + + + +Language/Haskell/HsColour.hs + + +
-- | This is a library which colourises Haskell code.
+--   It currently has five output formats:
+--
+-- * ANSI terminal codes
+--
+-- * LaTeX macros
+--
+-- * HTML with font tags
+--
+-- * HTML with CSS.
+--
+-- * mIRC chat client colour codes.
+--
+module Language.Haskell.HsColour (Output(..), ColourPrefs(..),
+                                  hscolour) where
+
+import Language.Haskell.HsColour.Colourise (ColourPrefs(..))
+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.LaTeX as LaTeX
+import qualified Language.Haskell.HsColour.MIRC  as MIRC
+
+-- | The supported output formats.
+data Output = TTY   -- ^ ANSI terminal codes
+            | LaTeX -- ^ TeX macros
+            | HTML  -- ^ HTML with font tags
+            | CSS   -- ^ HTML with CSS.
+            | MIRC  -- ^ mIRC chat clients
+  deriving (Eq,Show)
+
+-- | Colourise Haskell source code with the given output format.
+hscolour :: Output      -- ^ Output format.
+         -> ColourPrefs -- ^ Colour preferences (for formats that support them).
+         -> Bool        -- ^ Whether to include anchors.
+         -> Bool        -- ^ Whether output document is partial or complete.
+         -> Bool        -- ^ Whether input document is literate haskell or not
+         -> String	-- ^ Title for output.
+         -> String      -- ^ Haskell source code.
+         -> String      -- ^ Coloured Haskell source code.
+hscolour output pref anchor partial literate title
+    | literate  = concatMap chunk . joinL . map lhsClassify . inlines
+    | otherwise = hscolour' output pref anchor partial title
+  where
+    chunk (Literate c) = c
+    chunk (Code c)     = hscolour' output pref anchor True title c
+
+hscolour' :: Output      -- ^ Output format.
+          -> ColourPrefs -- ^ Colour preferences (for formats that support them).
+          -> Bool        -- ^ Whether to include anchors.
+          -> Bool        -- ^ Whether output document is partial or complete.
+          -> String      -- ^ Title for output.
+          -> String      -- ^ Haskell source code.
+          -> String      -- ^ Coloured Haskell source code.
+hscolour' TTY   pref _      _       _   = TTY.hscolour pref
+hscolour' MIRC  pref _      _       _   = MIRC.hscolour pref
+hscolour' LaTeX pref _      partial _   = LaTeX.hscolour pref partial
+hscolour' HTML  pref anchor partial top = HTML.hscolour pref anchor partial top
+hscolour' CSS   _    anchor partial top = CSS.hscolour anchor partial top
+
+-- | Separating literate files into code\/comment chunks.
+data Literate = Code {unL :: String} | Literate {unL :: String}
+
+-- Re-implementation of 'lines', for better efficiency (but decreased laziness).
+-- Also, importantly, accepts non-standard DOS and Mac line ending characters.
+-- And retains the trailing '\n' character in each resultant string.
+inlines :: String -> [String]
+inlines s = lines' s id
+  where
+  lines' []             acc = [acc []]
+  lines' ('\^M':'\n':s) acc = acc ['\n'] : lines' s id	-- DOS
+--lines' ('\^M':s)      acc = acc ['\n'] : lines' s id	-- MacOS
+  lines' ('\n':s)       acc = acc ['\n'] : lines' s id	-- Unix
+  lines' (c:s)          acc = lines' s (acc . (c:))
+
+-- Note, I just pass the > symbol to the colouriser, which assumes that
+-- it's token based and not parse-based!!!
+lhsClassify :: String -> Literate
+lhsClassify ('>':xs)  = Code ('>':xs)
+lhsClassify xs        = Literate xs
+
+joinL :: [Literate] -> [Literate]
+joinL []                          = []
+joinL (Code c:Code c2:xs)         = joinL (Code (c++c2):xs)
+joinL (Literate c:Literate c2:xs) = joinL (Literate (c++c2):xs)
+joinL (any:xs)                    = any: joinL xs
+
+ + diff --git a/docs/hscolour/Language/Haskell/HsColour/ANSI.html b/docs/hscolour/Language/Haskell/HsColour/ANSI.html --- a/docs/hscolour/Language/Haskell/HsColour/ANSI.html +++ b/docs/hscolour/Language/Haskell/HsColour/ANSI.html @@ -1,94 +1,106 @@ -
-- Partially taken from Hugs AnsiScreen.hs library:
-module Language.Haskell.HsColour.ANSI
-  ( highlightOn
-  , highlightOff
-  , highlight
-  , cleareol, clearbol, clearline, clearDown, clearUp, cls
-  , goto
-  , cursorUp, cursorDown, cursorLeft, cursorRight
-  , savePosition, restorePosition
-  , Highlight(..)
-  , Colour(..)
-  , colourCycle
-  , enableScrollRegion, scrollUp, scrollDown
-  , lineWrap
-  ) where
-
-import Language.Haskell.HsColour.ColourHighlight
-
-import List (intersperse,isPrefixOf)
-import Char (isDigit)
-
-
--- Basic screen control codes:
-
-type Pos           = (Int,Int)
-
-at        :: Pos -> String -> String
-goto      :: Int -> Int -> String
-home      :: String
-cls       :: String
-
-at (x,y) s  = goto x y ++ s
-goto x y    = '\ESC':'[':(show y ++(';':show x ++ "H"))
-home        = goto 1 1
-
-cursorUp    = "\ESC[A"
-cursorDown  = "\ESC[B"
-cursorRight = "\ESC[C"
-cursorLeft  = "\ESC[D"
-
-cleareol    = "\ESC[K"
-clearbol    = "\ESC[1K"
-clearline   = "\ESC[2K"
-clearDown   = "\ESC[J"
-clearUp     = "\ESC[1J"
--- Choose whichever of the following lines is suitable for your system:
-cls         = "\ESC[2J"     -- for PC with ANSI.SYS
---cls         = "\^L"         -- for Sun window
-
-savePosition    = "\ESC7"
-restorePosition = "\ESC8"
-
-
--- data Colour    -- imported from ColourHighlight
--- data Highlight -- imported from ColourHighlight
-
-instance Enum Highlight where
-  fromEnum Normal       = 0
-  fromEnum Bold         = 1
-  fromEnum Dim          = 2
-  fromEnum Underscore   = 4
-  fromEnum Blink        = 5
-  fromEnum ReverseVideo = 7
-  fromEnum Concealed    = 8
-  fromEnum (Foreground c) = 30 + fromEnum c
-  fromEnum (Background c) = 40 + fromEnum c
-
-highlight :: [Highlight] -> String -> String
-highlight attrs s = highlightOn attrs ++ s ++ highlightOff
-
-highlightOn []     = highlightOn [Normal]
-highlightOn attrs  = "\ESC["
-                     ++ concat (intersperse ";" (map (show.fromEnum) attrs))
-                     ++"m"
-highlightOff = "\ESC[0m"
-
-
--- An infinite supply of colours.
-colourCycle :: [Colour]
-colourCycle = cycle [Red,Blue,Magenta,Green,Cyan]
-
-
--- Scrolling
-enableScrollRegion :: Int -> Int -> String
-enableScrollRegion start end = "\ESC["++show start++';':show end++"r"
-
-scrollDown  = "\ESCD"
-scrollUp    = "\ESCM"
-
--- Line-wrapping mode
-lineWrap True  = "\ESC[7h"
-lineWrap False = "\ESC[7l"
-
+
+
+
+
+Language/Haskell/HsColour/ANSI.hs
+
+
+
-- | Partially taken from Hugs AnsiScreen.hs library:
+module Language.Haskell.HsColour.ANSI
+  ( highlightOn
+  , highlightOff
+  , highlight
+  , cleareol, clearbol, clearline, clearDown, clearUp, cls
+  , goto
+  , cursorUp, cursorDown, cursorLeft, cursorRight
+  , savePosition, restorePosition
+  , Highlight(..)
+  , Colour(..)
+  , colourCycle
+  , enableScrollRegion, scrollUp, scrollDown
+  , lineWrap
+  ) where
+
+import Language.Haskell.HsColour.ColourHighlight
+
+import List (intersperse,isPrefixOf)
+import Char (isDigit)
+
+
+-- Basic screen control codes:
+
+type Pos           = (Int,Int)
+
+at        :: Pos -> String -> String
+-- | Move the screen cursor to the given position.
+goto      :: Int -> Int -> String
+home      :: String
+-- | Clear the screen.
+cls       :: String
+
+at (x,y) s  = goto x y ++ s
+goto x y    = '\ESC':'[':(show y ++(';':show x ++ "H"))
+home        = goto 1 1
+
+cursorUp    = "\ESC[A"
+cursorDown  = "\ESC[B"
+cursorRight = "\ESC[C"
+cursorLeft  = "\ESC[D"
+
+cleareol    = "\ESC[K"
+clearbol    = "\ESC[1K"
+clearline   = "\ESC[2K"
+clearDown   = "\ESC[J"
+clearUp     = "\ESC[1J"
+-- Choose whichever of the following lines is suitable for your system:
+cls         = "\ESC[2J"     -- for PC with ANSI.SYS
+--cls         = "\^L"         -- for Sun window
+
+savePosition    = "\ESC7"
+restorePosition = "\ESC8"
+
+
+-- data Colour    -- imported from ColourHighlight
+-- data Highlight -- imported from ColourHighlight
+
+instance Enum Highlight where
+  fromEnum Normal       = 0
+  fromEnum Bold         = 1
+  fromEnum Dim          = 2
+  fromEnum Underscore   = 4
+  fromEnum Blink        = 5
+  fromEnum ReverseVideo = 7
+  fromEnum Concealed    = 8
+  fromEnum (Foreground c) = 30 + fromEnum c
+  fromEnum (Background c) = 40 + fromEnum c
+
+-- | Make the given string appear with all of the listed highlights
+highlight :: [Highlight] -> String -> String
+highlight attrs s = highlightOn attrs ++ s ++ highlightOff
+
+highlightOn []     = highlightOn [Normal]
+highlightOn attrs  = "\ESC["
+                     ++ concat (intersperse ";" (map (show.fromEnum) attrs))
+                     ++"m"
+highlightOff = "\ESC[0m"
+
+
+-- | An infinite supply of colours.
+colourCycle :: [Colour]
+colourCycle = cycle [Red,Blue,Magenta,Green,Cyan]
+
+
+-- | Scrolling
+enableScrollRegion :: Int -> Int -> String
+enableScrollRegion start end = "\ESC["++show start++';':show end++"r"
+
+scrollDown  = "\ESCD"
+scrollUp    = "\ESCM"
+
+-- Line-wrapping mode
+lineWrap True  = "\ESC[7h"
+lineWrap False = "\ESC[7l"
+
 

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/Anchors.html b/docs/hscolour/Language/Haskell/HsColour/Anchors.html
--- a/docs/hscolour/Language/Haskell/HsColour/Anchors.html
+++ b/docs/hscolour/Language/Haskell/HsColour/Anchors.html
@@ -1,131 +1,143 @@
-
module Language.Haskell.HsColour.Anchors
-  ( insertAnchors
-  ) where
-
-import Language.Haskell.HsColour.Classify
-import List
-
--- This is an attempt to find the first defining occurrence of an
--- identifier (function, datatype, class) in a Haskell source file.
--- Rather than parse the module properly, we try to get by with just
--- a finite state automaton.  Keeping a record of identifiers we
--- have already seen, we look at the beginning of every line to see
--- if it starts with the right tokens to introduce a defn.  If so,
--- we look a little bit further until we can be certain.  Then plonk
--- (or not) an anchor at the beginning of the line.
-
-type Anchor = String
-
--- | 'insertAnchors' places an anchor marker in the token stream before the
---   first defining occurrence of any identifier.  Here, /before/ means
---   immediately preceding its type signature, or preceding a (haddock)
---   comment that comes immediately before the type signature, or failing
---   either of those, before the first equation.
-insertAnchors :: [(TokenType,String)] -> [Either Anchor (TokenType,String)]
-insertAnchors = anchor emptyST
-
--- looks at first token in the left-most position of each line
--- precondition: have just seen a newline token.
-anchor st s = case identifier st s of
-                Nothing -> emit st s
-                Just v  -> Left v: emit (insertST v st) s
-
--- 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 (t@(Space,"\n"):stream) = Right t: anchor st stream
-emit st (t:stream)              = Right t: emit st stream
-emit _  []                      = []
-
--- 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 t@((Varid,v):stream) =
-    case skip stream of
-        ((Varop,v):_) | not (v`inST`st) -> Just (fix v)
-        notVarop  --  | typesig stream  -> Nothing    -- not a defn
-                      | v `inST` st     -> Nothing    -- already defined
-                      | otherwise       -> Just v
-identifier st t@((Layout,"("):stream) =
-    case stream of
-      ((Varop,v):(Layout,")"):_)
-                  --  | typesig stream  -> Nothing
-	              | v `inST` st     -> Nothing
-	              | otherwise	-> Just (fix v)
-      notVarop -> case skip (munchParens stream) of
-          ((Varop,v):_) | not (v`inST`st) -> Just (fix v)
-          _             -> Nothing
-identifier st t@((Keyword,"foreign"):stream) = Nothing -- not yet implemented
-identifier st t@((Keyword,"data"):stream)    = getConid stream
-identifier st t@((Keyword,"type"):stream)    = getConid stream
-identifier st t@((Keyword,"class"):stream)   = getConid stream
-identifier st t@((Comment,_):(Space,"\n"):stream) = identifier st stream
-identifier st stream = Nothing
-
--- Is this really a type signature?  (no longer used)
-typesig :: [(TokenType,String)] -> Bool
-typesig ((Keyglyph,"::"):_)   = True
-typesig ((Varid,_):stream)    = typesig stream
-typesig ((Layout,"("):(Varop,_):(Layout,")"):stream)    = typesig stream
-typesig ((Layout,","):stream) = typesig stream
-typesig ((Space,_):stream)    = typesig stream
-typesig ((Comment,_):stream)  = typesig stream
-typesig _                     = False
-
--- throw away everything from opening paren to matching close
-munchParens =  munch (0::Int)	-- already seen open paren
-  where munch 0 ((Layout,")"):rest) = rest
-        munch n ((Layout,")"):rest) = munch (n-1) rest
-        munch n ((Layout,"("):rest) = munch (n+1) rest
-        munch n (_:rest)            = munch n rest
-        munch _ []                  = []	-- source is ill-formed
-
--- ensure anchor name is correct for a Varop
-fix ('`':v) = init v
-fix v       = v
-
--- look past whitespace and comments to next "real" token
-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 stream =
-    case skip stream of
-        ((Conid,c):rest) -> case context rest of
-                              ((Keyglyph,"="):_)     -> Just c
-                              ((Keyglyph,"=>"):more) ->
-                                  case skip more of
-                                      ((Conid,c'):_) -> Just c'
-                                      v -> debug v ("Conid "++c++" =>")
-                              v -> debug v ("Conid "++c++" no = or =>")
-        ((Layout,"("):rest) -> case context rest of
-                                   ((Keyglyph,"=>"):more) ->
-                                       case skip more of
-                                           ((Conid,c'):_) -> Just c'
-                                           v -> debug v ("(...) =>")
-                                   v -> debug v ("(...) no =>")
-        v -> debug v ("no Conid or (...)")
-    where debug (s:t) c = Nothing
-       -- debug (s:t) c = error ("HsColour: getConid failed: "++show s
-       --                       ++"\n  in the context of: "++c)
-
--- jump past possible class context
-context stream@((Keyglyph,"="):_) = stream
-context stream@((Keyglyph,"=>"):_) = stream
-context (_:stream) = context stream
-
--- simple implementation of a string lookup table.
--- replace this with something more sophisticated if needed.
-type ST = [String]
-
-emptyST :: ST
-emptyST = []
-
-insertST :: String -> ST -> ST
-insertST k st = insert k st
-
-inST :: String -> ST -> Bool
-inST k st = k `elem` st
+
+
+
+
+Language/Haskell/HsColour/Anchors.hs
+
+
+
module Language.Haskell.HsColour.Anchors
+  ( insertAnchors
+  ) where
+
+import Language.Haskell.HsColour.Classify
+import Language.Haskell.HsColour.General
+import List
+
+-- This is an attempt to find the first defining occurrence of an
+-- identifier (function, datatype, class) in a Haskell source file.
+-- Rather than parse the module properly, we try to get by with just
+-- a finite state automaton.  Keeping a record of identifiers we
+-- have already seen, we look at the beginning of every line to see
+-- if it starts with the right tokens to introduce a defn.  If so,
+-- we look a little bit further until we can be certain.  Then plonk
+-- (or not) an anchor at the beginning of the line.
+
+type Anchor = String
+
+-- | 'insertAnchors' places an anchor marker in the token stream before the
+--   first defining occurrence of any identifier.  Here, /before/ means
+--   immediately preceding its type signature, or preceding a (haddock)
+--   comment that comes immediately before the type signature, or failing
+--   either of those, before the first equation.
+insertAnchors :: [(TokenType,String)] -> [Either Anchor (TokenType,String)]
+insertAnchors = anchor emptyST
+
+-- looks at first token in the left-most position of each line
+-- precondition: have just seen a newline token.
+anchor st s = case identifier st s of
+                Nothing -> emit st s
+                Just v  -> Left v: emit (insertST v st) s
+
+-- 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 (t@(Space,"\n"):stream) = Right t: anchor st stream
+emit st (t:stream)              = Right t: emit st stream
+emit _  []                      = []
+
+-- 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 t@((kind,v):stream) | kind`elem`[Varid,Definition] =
+    case skip stream of
+        ((Varop,v):_) | not (v`inST`st) -> Just (fix v)
+        notVarop  --  | typesig stream  -> Nothing    -- not a defn
+                      | v `inST` st     -> Nothing    -- already defined
+                      | otherwise       -> Just v
+identifier st t@((Layout,"("):stream) =
+    case stream of
+      ((Varop,v):(Layout,")"):_)
+                  --  | typesig stream  -> Nothing
+	              | v `inST` st     -> Nothing
+	              | otherwise	-> Just (fix v)
+      notVarop -> case skip (munchParens stream) of
+          ((Varop,v):_) | not (v`inST`st) -> Just (fix v)
+          _             -> Nothing
+identifier st t@((Keyword,"foreign"):stream) = Nothing -- not yet implemented
+identifier st t@((Keyword,"data"):stream)    = getConid stream
+identifier st t@((Keyword,"newtype"):stream) = getConid stream
+identifier st t@((Keyword,"type"):stream)    = getConid stream
+identifier st t@((Keyword,"class"):stream)   = getConid stream
+identifier st t@((Comment,_):(Space,"\n"):stream) = identifier st stream
+identifier st stream = Nothing
+
+-- Is this really a type signature?  (no longer used)
+typesig :: [(TokenType,String)] -> Bool
+typesig ((Keyglyph,"::"):_)   = True
+typesig ((Varid,_):stream)    = typesig stream
+typesig ((Layout,"("):(Varop,_):(Layout,")"):stream)    = typesig stream
+typesig ((Layout,","):stream) = typesig stream
+typesig ((Space,_):stream)    = typesig stream
+typesig ((Comment,_):stream)  = typesig stream
+typesig _                     = False
+
+-- throw away everything from opening paren to matching close
+munchParens =  munch (0::Int)	-- already seen open paren
+  where munch 0 ((Layout,")"):rest) = rest
+        munch n ((Layout,")"):rest) = munch (n-1) rest
+        munch n ((Layout,"("):rest) = munch (n+1) rest
+        munch n (_:rest)            = munch n rest
+        munch _ []                  = []	-- source is ill-formed
+
+-- ensure anchor name is correct for a Varop
+fix ('`':v) = dropLast '`' v
+fix v       = v
+
+-- look past whitespace and comments to next "real" token
+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 stream =
+    case skip stream of
+        ((Conid,c):rest) -> case context rest of
+                              ((Keyglyph,"="):_)     -> Just c
+                              ((Keyglyph,"=>"):more) ->
+                                  case skip more of
+                                      ((Conid,c'):_) -> Just c'
+                                      v -> debug v ("Conid "++c++" =>")
+                              v -> debug v ("Conid "++c++" no = or =>")
+        ((Layout,"("):rest) -> case context rest of
+                                   ((Keyglyph,"=>"):more) ->
+                                       case skip more of
+                                           ((Conid,c'):_) -> Just c'
+                                           v -> debug v ("(...) =>")
+                                   v -> debug v ("(...) no =>")
+        v -> debug v ("no Conid or (...)")
+    where debug   _   _ = Nothing
+       -- debug (s:t) c = error ("HsColour: getConid failed: "++show s
+       --                       ++"\n  in the context of: "++c)
+
+-- jump past possible class context
+context stream@((Keyglyph,"="):_) = stream
+context stream@((Keyglyph,"=>"):_) = stream
+context (_:stream) = context stream
+context [] = []
+
+-- simple implementation of a string lookup table.
+-- replace this with something more sophisticated if needed.
+type ST = [String]
+
+emptyST :: ST
+emptyST = []
+
+insertST :: String -> ST -> ST
+insertST k st = insert k st
+
+inST :: String -> ST -> Bool
+inST k st = k `elem` st
 

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/CSS.html b/docs/hscolour/Language/Haskell/HsColour/CSS.html
--- a/docs/hscolour/Language/Haskell/HsColour/CSS.html
+++ b/docs/hscolour/Language/Haskell/HsColour/CSS.html
@@ -1,66 +1,83 @@
-
-- | Formats Haskell source code as HTML with CSS.
-module Language.Haskell.HsColour.CSS (hscolour, hscolourFragment) where
-
-import Language.Haskell.HsColour.Anchors
-import Language.Haskell.HsColour.Classify as Classify
-import Language.Haskell.HsColour.HTML (renderAnchors, renderComment, escape)
-
--- | Formats Haskell source code as a complete HTML document with CSS.
-hscolour :: Bool   -- ^ Whether to include anchors
-         -> String -- ^ Haskell source code.
-         -> String -- ^ An HTML document containing the coloured 
-                   --   Haskell source code.
-hscolour anchor = top'n'tail . hscolourFragment anchor
-
--- | Formats Haskell source code as an HTML fragment with CSS.
---   No stylesheet link is included in the output.
-hscolourFragment :: Bool   -- ^ Whether to include anchors
-                 -> String -- ^ Haskell source code.
-                 -> String -- ^ An HTML fragment containing the coloured 
-                           --   Haskell source code.
-hscolourFragment anchor = 
-    pre . (if anchor 
-           then concatMap (renderAnchors renderToken) . insertAnchors
-           else concatMap renderToken) . tokenise
-
-top'n'tail :: String -> String
-top'n'tail  = (cssPrefix++) . (++cssSuffix)
-
-pre :: String -> String
-pre = ("<pre>"++) . (++"</pre>")
-
-renderToken :: (TokenType,String) -> String
-renderToken (Space,text) = text
-renderToken (cls,text)   = "<span class='" ++ cssClass cls ++ "'>" ++
-                           (if cls == Comment then renderComment text else escape text) ++
-                           "</span>"
-
-cssClass Keyword  = "keyword"
-cssClass Keyglyph = "keyglyph"
-cssClass Layout   = "layout"
-cssClass Comment  = "comment"
-cssClass Conid    = "conid"
-cssClass Varid    = "varid"
-cssClass Conop    = "conop"
-cssClass Varop    = "varop"
-cssClass String   = "str"
-cssClass Char     = "chr"
-cssClass Number   = "num"
-cssClass Error    = "sel"
-
-cssPrefix = unlines
-    ["<!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/ -->"
-    ,"<title>Haskell Code by HsColour</title>"
-    ,"<link type='text/css' rel='stylesheet' href='hscolour.css' />"
-    ,"</head>"
-    ,"<body>"
-    ]
-    
-cssSuffix = unlines
-    ["</body>"
-    ,"</html>"
-    ]
+
+
+
+
+Language/Haskell/HsColour/CSS.hs
+
+
+
-- | Formats Haskell source code as HTML with CSS.
+module Language.Haskell.HsColour.CSS (hscolour) where
+
+import Language.Haskell.HsColour.Anchors
+import Language.Haskell.HsColour.Classify as Classify
+import Language.Haskell.HsColour.HTML (renderAnchors, renderComment,
+                                       renderNewLinesAnchors, escape)
+
+-- | Formats Haskell source code as a complete HTML document with CSS.
+hscolour :: Bool   -- ^ Whether to include anchors.
+         -> Bool   -- ^ Whether output should be partial
+                   --   (= no stylesheet link will be included.)
+         -> String -- ^ Title for HTML page.
+         -> String -- ^ Haskell source code.
+         -> String -- ^ An HTML document containing the coloured 
+                   --   Haskell source code.
+hscolour anchor partial title =
+  (if partial then id else top'n'tail title)
+  . pre
+  . (if anchor 
+        then renderNewLinesAnchors
+             . concatMap (renderAnchors renderToken)
+             . insertAnchors
+        else concatMap renderToken)
+  . tokenise
+
+top'n'tail :: String -> String -> String
+top'n'tail title  = (cssPrefix title ++) . (++cssSuffix)
+
+pre :: String -> String
+pre = ("<pre>"++) . (++"</pre>")
+
+renderToken :: (TokenType,String) -> String
+renderToken (cls,text) =
+        before ++ (if cls == Comment then renderComment text else escape text) ++ after
+    where
+        before = if null cls2 then "" else "<span class='" ++ cls2 ++ "'>"
+        after  = if null cls2 then "" else "</span>"
+        cls2 = cssClass cls
+
+
+cssClass Keyword  = "keyword"
+cssClass Keyglyph = "keyglyph"
+cssClass Layout   = "layout"
+cssClass Comment  = "comment"
+cssClass Conid    = "conid"
+cssClass Varid    = "varid"
+cssClass Conop    = "conop"
+cssClass Varop    = "varop"
+cssClass String   = "str"
+cssClass Char     = "chr"
+cssClass Number   = "num"
+cssClass Cpp      = "cpp"
+cssClass Error    = "sel"
+cssClass Definition = "definition"
+cssClass _        = ""
+
+
+cssPrefix title = unlines
+    ["<!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/ -->"
+    ,"<title>"++title++"</title>"
+    ,"<link type='text/css' rel='stylesheet' href='hscolour.css' />"
+    ,"</head>"
+    ,"<body>"
+    ]
+    
+cssSuffix = unlines
+    ["</body>"
+    ,"</html>"
+    ]
 

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/Classify.html b/docs/hscolour/Language/Haskell/HsColour/Classify.html
--- a/docs/hscolour/Language/Haskell/HsColour/Classify.html
+++ b/docs/hscolour/Language/Haskell/HsColour/Classify.html
@@ -1,100 +1,131 @@
-
module Language.Haskell.HsColour.Classify
-  ( TokenType(..)
-  , tokenise
-  ) where
-
-import Char
-import List
-
--- Lex Haskell source code into an annotated token stream, without
--- discarding any characters or layout.
-tokenise :: String -> [(TokenType,String)]
-tokenise = map (\s-> (classify s,s)) . glue . chunk
-
--- Basic Haskell lexing, except we keep whitespace.
-chunk :: String -> [String]
-chunk []    = []
-chunk ('\r':s) = chunk s -- get rid of DOS newline stuff
-chunk ('\n':s) = "\n": chunk s
-chunk (c:s) | isLinearSpace c
-            = (c:ss): chunk rest where (ss,rest) = span isLinearSpace s
-chunk ('{':'-':s) = let (com,s') = nestcomment 0 s
-                    in ('{':'-':com) : chunk s'
-chunk s = case Prelude.lex s of
-              []             -> [head s]: chunk (tail s) -- e.g. inside comment
-              ((tok@('-':'-':_),rest):_)
-                  | all (=='-') tok -> (tok++com): chunk s'
-                                       where (com,s') = eolcomment rest
-              ((tok,rest):_) -> tok: chunk rest
-
-isLinearSpace c = c `elem` " \t" -- " \t\xa0"
-
--- Glue sequences of tokens into more useful blobs
---glue (q:".":n:rest) | Char.isUpper (head q)	-- qualified names
---                    = glue ((q++"."++n): rest)
-glue ("`":rest) =				-- `varid` -> varop
-  case glue rest of
-    (qn:"`":rest) -> ("`"++qn++"`"): glue rest
-    _             -> ("`": rest)
-glue (s:ss)       | all (=='-') s && length s >=2	-- eol comment
-                  = (s++concat c): glue rest
-                  where (c,rest) = break ('\n'`elem`) ss
---glue ("{":"-":ss)  = ("{-"++c): glue rest	-- nested comment
---                  where (c,rest) = nestcomment 0 ss
-glue (s:ss)       = s: glue ss
-glue []           = []
-
--- Deal with comments.
-nestcomment :: Int -> String -> (String,String)
-nestcomment n ('{':'-':ss) | n>=0 = (("{-"++cs),rm)
-                                  where (cs,rm) = nestcomment (n+1) ss
-nestcomment n ('-':'}':ss) | n>0  = (("-}"++cs),rm)
-                                  where (cs,rm) = nestcomment (n-1) ss
-nestcomment n ('-':'}':ss) | n==0 = ("-}",ss)
-nestcomment n (s:ss)       | n>=0 = ((s:cs),rm)
-                                  where (cs,rm) = nestcomment n ss
-nestcomment n [] = ([],[])
-
-eolcomment :: String -> (String,String)
-eolcomment s@('\n':_) = ([], s)
-eolcomment (c:s)      = (c:cs, s') where (cs,s') = eolcomment s
-eolcomment []         = ([],[])
-
--- Classify tokens
-data TokenType =
-  Space | Keyword | Keyglyph | Layout | Comment | Conid | Varid |
-  Conop | Varop   | String   | Char   | Number  | Error
-  deriving (Eq,Show)
-
-classify :: String -> TokenType
-classify s@(h:_)
-    | isSpace h              = Space
-    | all (=='-') s          = Comment
-    | "--" `isPrefixOf` s
-      && any isSpace s       = Comment		-- not fully correct
-    | "{-" `isPrefixOf` s    = Comment
-    | s `elem` keywords      = Keyword
-    | s `elem` keyglyphs     = Keyglyph
-    | s `elem` layoutchars   = Layout
-    | isUpper h              = Conid
-    | isLower h              = Varid
-    | h `elem` symbols       = Varop
-    | h==':'                 = Conop
-    | h=='`'                 = Varop
-    | h=='"'                 = String
-    | h=='\''                = Char
-    | isDigit h              = Number
-    | otherwise              = Error
-
--- Haskell keywords
-keywords =
-  ["case","class","data","default","deriving","do","else"
-  ,"if","import","in","infix","infixl","infixr","instance","let","module"
-  ,"newtype","of","then","type","where","_","foreign","ccall","as"]
-keyglyphs =
-  ["..","::","=","\\","|","<-","->","@","~","=>","[","]"]
-layoutchars =
-  map (:[]) ";{}(),"
-symbols =
-  "!#$%&*+./<=>?@\\^|-~"
+
+
+
+
+Language/Haskell/HsColour/Classify.hs
+
+
+
module Language.Haskell.HsColour.Classify
+  ( TokenType(..)
+  , tokenise
+  ) where
+
+import Char
+import List
+
+-- | Lex Haskell source code into an annotated token stream, without
+--   discarding any characters or layout.
+tokenise :: String -> [(TokenType,String)]
+tokenise str = 
+    let chunks = glue . chunk $ str 
+        newline = True : (map ("\n" `isPrefixOf`) chunks)
+    in map (\(s,n)-> (classify s n,s)) (zip chunks newline)
+
+-- Basic Haskell lexing, except we keep whitespace.
+chunk :: String -> [String]
+chunk []    = []
+chunk ('\r':s) = chunk s -- get rid of DOS newline stuff
+chunk ('\n':s) = "\n": chunk s
+chunk (c:s) | isLinearSpace c
+            = (c:ss): chunk rest where (ss,rest) = span isLinearSpace s
+chunk ('{':'-':s) = let (com,s') = nestcomment 0 s
+                    in ('{':'-':com) : chunk s'
+chunk s = case Prelude.lex s of
+              []             -> [head s]: chunk (tail s) -- e.g. inside comment
+              ((tok@('-':'-':_),rest):_)
+                  | all (=='-') tok -> (tok++com): chunk s'
+                                       where (com,s') = eolcomment rest
+              ((tok,rest):_) -> tok: chunk rest
+
+isLinearSpace c = c `elem` " \t\f" -- " \t\xa0"
+
+-- Glue sequences of tokens into more useful blobs
+--glue (q:".":n:rest) | Char.isUpper (head q)	-- qualified names
+--                    = glue ((q++"."++n): rest)
+glue ("`":rest) =				-- `varid` -> varop
+  case glue rest of
+    (qn:"`":rest) -> ("`"++qn++"`"): glue rest
+    _             -> "`": glue rest
+glue (s:ss)       | all (=='-') s && length s >=2	-- eol comment
+                  = (s++concat c): glue rest
+                  where (c,rest) = break ('\n'`elem`) ss
+--glue ("{":"-":ss)  = ("{-"++c): glue rest	-- nested comment
+--                  where (c,rest) = nestcomment 0 ss
+glue ("(":ss) = case rest of
+                ")":rest -> ("(" ++ concat tuple ++ ")") : glue rest
+                _         -> "(" : glue ss
+              where (tuple,rest) = span (==",") ss
+glue ("[":"]":ss) = "[]" : glue ss
+glue ("\n":"#":ss)= "\n" : ('#':concat line) : glue rest
+                  where (line,rest) = break ('\n'`elem`) ss
+glue (s:ss)       = s: glue ss
+glue []           = []
+
+-- Deal with comments.
+nestcomment :: Int -> String -> (String,String)
+nestcomment n ('{':'-':ss) | n>=0 = (("{-"++cs),rm)
+                                  where (cs,rm) = nestcomment (n+1) ss
+nestcomment n ('-':'}':ss) | n>0  = (("-}"++cs),rm)
+                                  where (cs,rm) = nestcomment (n-1) ss
+nestcomment n ('-':'}':ss) | n==0 = ("-}",ss)
+nestcomment n (s:ss)       | n>=0 = ((s:cs),rm)
+                                  where (cs,rm) = nestcomment n ss
+nestcomment n [] = ([],[])
+
+eolcomment :: String -> (String,String)
+eolcomment s@('\n':_) = ([], s)
+eolcomment ('\r':s)   = eolcomment s
+eolcomment (c:s)      = (c:cs, s') where (cs,s') = eolcomment s
+eolcomment []         = ([],[])
+
+-- | Classification of tokens as lexical entities
+data TokenType =
+  Space | Keyword | Keyglyph | Layout | Comment | Conid | Varid |
+  Conop | Varop   | String   | Char   | Number  | Cpp   | Error |
+  Definition
+  deriving (Eq,Show)
+
+classify :: String -> Bool -> TokenType
+classify s@(h:t) newline
+    | isSpace h              = Space
+    | all (=='-') s          = Comment
+    | "--" `isPrefixOf` s
+      && any isSpace s       = Comment		-- not fully correct
+    | "{-" `isPrefixOf` s    = Comment
+    | s `elem` keywords      = Keyword
+    | s `elem` keyglyphs     = Keyglyph
+    | s `elem` layoutchars   = Layout
+    | isUpper h              = Conid
+    | s == "[]"              = Conid
+    | h == '(' && isTupleTail t = Conid
+    | h == '#'               = Cpp
+    | isLower h              = if newline then Definition else Varid
+    | h `elem` symbols       = Varop
+    | h==':'                 = Conop
+    | h=='`'                 = Varop
+    | h=='"'                 = String
+    | h=='\''                = Char
+    | isDigit h              = Number
+    | otherwise              = Error
+classify _ _ = Space
+
+isTupleTail [')'] = True
+isTupleTail (',':xs) = isTupleTail xs
+isTupleTail _ = False
+
+
+-- Haskell keywords
+keywords =
+  ["case","class","data","default","deriving","do","else","forall"
+  ,"if","import","in","infix","infixl","infixr","instance","let","module"
+  ,"newtype","of","qualified","then","type","where","_"
+  ,"foreign","ccall","as","safe","unsafe"]
+keyglyphs =
+  ["..","::","=","\\","|","<-","->","@","~","=>","[","]"]
+layoutchars =
+  map (:[]) ";{}(),"
+symbols =
+  "!#$%&*+./<=>?@\\^|-~"
 

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/ColourHighlight.html b/docs/hscolour/Language/Haskell/HsColour/ColourHighlight.html
--- a/docs/hscolour/Language/Haskell/HsColour/ColourHighlight.html
+++ b/docs/hscolour/Language/Haskell/HsColour/ColourHighlight.html
@@ -1,21 +1,32 @@
-
module Language.Haskell.HsColour.ColourHighlight
-  ( Colour(..)
-  , Highlight(..)
-  ) where
-
-data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White
-  deriving (Eq,Show,Read,Enum)
-
-data Highlight =
-    Normal
-  | Bold
-  | Dim
-  | Underscore
-  | Blink
-  | ReverseVideo
-  | Concealed
-  | Foreground Colour
-  | Background Colour
-  deriving (Eq,Show,Read)
-
+
+
+
+
+Language/Haskell/HsColour/ColourHighlight.hs
+
+
+
module Language.Haskell.HsColour.ColourHighlight
+  ( Colour(..)
+  , Highlight(..)
+  ) where
+
+-- | Colours supported by ANSI codes.
+data Colour = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White
+  deriving (Eq,Show,Read,Enum)
+
+-- | Types of highlighting supported by ANSI codes.
+data Highlight =
+    Normal
+  | Bold
+  | Dim
+  | Underscore
+  | Blink
+  | ReverseVideo
+  | Concealed
+  | Foreground Colour
+  | Background Colour
+  deriving (Eq,Show,Read)
+
 

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/Colourise.html b/docs/hscolour/Language/Haskell/HsColour/Colourise.html
--- a/docs/hscolour/Language/Haskell/HsColour/Colourise.html
+++ b/docs/hscolour/Language/Haskell/HsColour/Colourise.html
@@ -1,65 +1,89 @@
-
module Language.Haskell.HsColour.Colourise
-  ( module Language.Haskell.HsColour.ColourHighlight
-  , ColourPrefs(..)
-  , readColourPrefs
-  , colourise
-  ) where
-
-import Language.Haskell.HsColour.ColourHighlight
-import Language.Haskell.HsColour.Classify (TokenType(..))
-
-import System (getEnv)
-import Char
-import List
-
--- | Colour preferences.
-data ColourPrefs = ColourPrefs
-  { keyword, keyglyph, layout, comment
-  , conid, varid, conop, varop
-  , string, char, number
-  , selection, variantselection :: [Highlight]
-  } deriving (Eq,Show,Read)
-
-defaultColourPrefs = ColourPrefs
-  { keyword  = [Foreground Green,Underscore]
-  , keyglyph = [Foreground Red]
-  , layout   = [Foreground Cyan]
-  , comment  = [Foreground Blue]
-  , conid    = [Normal]
-  , varid    = [Normal]
-  , conop    = [Foreground Red,Bold]
-  , varop    = [Foreground Cyan]
-  , string   = [Foreground Magenta]
-  , char     = [Foreground Magenta]
-  , number   = [Foreground Magenta]
-  , selection = [Bold, Foreground Magenta]
-  , variantselection = [Dim, Foreground Red, Underscore]
-  }
-
-readColourPrefs :: IO ColourPrefs
-readColourPrefs = catch
-  (do val <- readFile ".hscolour"
-      return (read val))
-  (\e-> catch
-    (do home <- getEnv "HOME"
-        val <- readFile (home++"/.hscolour")
-        return (read val))
-    (\e-> return defaultColourPrefs))
-
--- Convert classification to colour highlights.
-colourise :: ColourPrefs -> TokenType -> [Highlight]
-colourise pref Space    = [Normal]
-colourise pref Comment  = comment pref
-colourise pref Keyword  = keyword pref
-colourise pref Keyglyph = keyglyph pref
-colourise pref Layout   = layout pref
-colourise pref Conid    = conid pref
-colourise pref Varid    = varid pref
-colourise pref Conop    = conop pref
-colourise pref Varop    = varop pref
-colourise pref String   = string pref
-colourise pref Char     = char pref
-colourise pref Number   = number pref
-colourise pref Error    = selection pref
-
+
+
+
+
+Language/Haskell/HsColour/Colourise.hs
+
+
+
module Language.Haskell.HsColour.Colourise
+  ( module Language.Haskell.HsColour.ColourHighlight
+  , ColourPrefs(..)
+  , readColourPrefs
+  , colourise
+  ) where
+
+import Language.Haskell.HsColour.ColourHighlight
+import Language.Haskell.HsColour.Classify (TokenType(..))
+
+import IO (hPutStrLn,stderr)
+import System (getEnv)
+import List
+
+-- | Colour preferences.
+data ColourPrefs = ColourPrefs
+  { keyword, keyglyph, layout, comment
+  , conid, varid, conop, varop
+  , string, char, number, cpp
+  , selection, variantselection, definition :: [Highlight]
+  } deriving (Eq,Show,Read)
+
+defaultColourPrefs = ColourPrefs
+  { keyword  = [Foreground Green,Underscore]
+  , keyglyph = [Foreground Red]
+  , layout   = [Foreground Cyan]
+  , comment  = [Foreground Blue]
+  , conid    = [Normal]
+  , varid    = [Normal]
+  , conop    = [Foreground Red,Bold]
+  , varop    = [Foreground Cyan]
+  , string   = [Foreground Magenta]
+  , char     = [Foreground Magenta]
+  , number   = [Foreground Magenta]
+  , cpp      = [Foreground Magenta,Dim]
+  , selection = [Bold, Foreground Magenta]
+  , variantselection = [Dim, Foreground Red, Underscore]
+  , definition = [Foreground Blue]
+  }
+
+-- NOTE, should we give a warning message on a failed reading?
+parseColourPrefs :: String -> String -> IO ColourPrefs
+parseColourPrefs file x =
+    case reads x of
+        (res,_):_ -> return res
+        _ -> do hPutStrLn stderr ("Could not parse colour prefs from "++file
+                                  ++": reverting to defaults")
+                return defaultColourPrefs
+
+-- | Read colour preferences from .hscolour file in the current directory, or failing that,
+--   from \$HOME\/.hscolour, and failing that, returns a default set of prefs.
+readColourPrefs :: IO ColourPrefs
+readColourPrefs = catch
+  (do val <- readFile ".hscolour"
+      parseColourPrefs ".hscolour" val)
+  (\_-> catch
+    (do home <- getEnv "HOME"
+        val <- readFile (home++"/.hscolour")
+        parseColourPrefs (home++"/.hscolour") val)
+    (\_-> return defaultColourPrefs))
+
+-- | Convert token classification to colour highlights.
+colourise :: ColourPrefs -> TokenType -> [Highlight]
+colourise pref Space    = [Normal]
+colourise pref Comment  = comment pref
+colourise pref Keyword  = keyword pref
+colourise pref Keyglyph = keyglyph pref
+colourise pref Layout   = layout pref
+colourise pref Conid    = conid pref
+colourise pref Varid    = varid pref
+colourise pref Conop    = conop pref
+colourise pref Varop    = varop pref
+colourise pref String   = string pref
+colourise pref Char     = char pref
+colourise pref Number   = number pref
+colourise pref Cpp      = cpp pref
+colourise pref Error    = selection pref
+colourise pref Definition = definition pref
+
 

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/General.html b/docs/hscolour/Language/Haskell/HsColour/General.html
new file mode 100644
--- /dev/null
+++ b/docs/hscolour/Language/Haskell/HsColour/General.html
@@ -0,0 +1,25 @@
+
+
+
+
+Language/Haskell/HsColour/General.hs
+
+
+

+module Language.Haskell.HsColour.General(
+    dropLast, dropFirst
+    ) where
+
+
+dropLast :: Eq a => a -> [a] -> [a]
+dropLast x [y] | x == y = []
+dropLast x (y:ys) = y : dropLast x ys
+dropLast x [] = []
+
+
+dropFirst :: Eq a => a -> [a] -> [a]
+dropFirst x (y:ys) | x == y = ys
+dropFirst x ys = ys
+

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/HTML.html b/docs/hscolour/Language/Haskell/HsColour/HTML.html
--- a/docs/hscolour/Language/Haskell/HsColour/HTML.html
+++ b/docs/hscolour/Language/Haskell/HsColour/HTML.html
@@ -1,69 +1,102 @@
-
-- | Formats Haskell source code using HTML with font tags.
-module Language.Haskell.HsColour.HTML 
-    (hscolour, 
-     -- * Internals
-     renderAnchors, renderComment, escape) where
-
-import Language.Haskell.HsColour.Anchors
-import Language.Haskell.HsColour.Classify as Classify
-import Language.Haskell.HsColour.Colourise
-
-import Data.Char(isAlphaNum)
-
-
--- | Formats Haskell source code using HTML with font tags.
-hscolour :: ColourPrefs -- ^ Colour preferences.
-         -> Bool        -- ^ Whether to include anchors
-         -> String      -- ^ Haskell source code.
-         -> String      -- ^ Coloured Haskell source code.
-hscolour pref anchor = 
-    top'n'tail . (if anchor then concatMap (renderAnchors (renderToken pref)) 
-                                   . insertAnchors
-                            else concatMap (renderToken pref)) . tokenise
-
-top'n'tail :: String -> String
-top'n'tail = ("<pre>"++) . (++"</pre>")
-
-renderToken :: ColourPrefs -> (TokenType,String) -> String
-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 _      (Left v) = "<a name=\""++v++"\"></a>"
-renderAnchors render (Right r) = render r
-
--- if there are http://links/ in a comment, turn them into
--- hyperlinks
-renderComment :: String -> String
-renderComment xs@('h':'t':'t':'p':':':'/':'/':_) =
-        renderLink a ++ renderComment b
-    where
-        -- see http://www.gbiv.com/protocols/uri/rfc/rfc3986.html#characters
-        isUrlChar x = isAlphaNum x || x `elem` ":/?#[]@!$&'()*+,;=-._~%"
-        (a,b) = span isUrlChar xs
-        renderLink link = "<a href=\"" ++ link ++ "\">" ++ escape link ++ "</a>"
-        
-renderComment (x:xs) = escape [x] ++ renderComment xs
-renderComment [] = []
-
--- Html stuff
-fontify [] s     = s
-fontify (h:hs) s = font h (fontify hs s)
-
-font Normal         s = s
-font Bold           s = "<b>"++s++"</b>"
-font Dim            s = "<em>"++s++"</em>"
-font Underscore     s = "<u>"++s++"</u>"
-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 (Background c) s = "<font bgcolor="++show c++">"++s++"</font>"
-
-escape ('<':cs) = "&lt;"++escape cs
-escape ('>':cs) = "&gt;"++escape cs
-escape ('&':cs) = "&amp;"++escape cs
-escape (c:cs)   = c: escape cs
-escape []       = []
+
+
+
+
+Language/Haskell/HsColour/HTML.hs
+
+
+
-- | Formats Haskell source code using HTML with font tags.
+module Language.Haskell.HsColour.HTML 
+    (hscolour, 
+     -- * Internals
+     renderAnchors, renderComment, renderNewLinesAnchors, escape) where
+
+import Language.Haskell.HsColour.Anchors
+import Language.Haskell.HsColour.Classify as Classify
+import Language.Haskell.HsColour.Colourise
+
+import Data.Char(isAlphaNum)
+
+
+-- | Formats Haskell source code using HTML with font tags.
+hscolour :: ColourPrefs -- ^ Colour preferences.
+         -> Bool        -- ^ Whether to include anchors.
+         -> Bool        -- ^ Whether output should be partial.
+         -> String      -- ^ Title for webpage output.
+         -> String      -- ^ Haskell source code.
+         -> String      -- ^ Coloured Haskell source code.
+hscolour pref anchor partial title = 
+    (if partial then id else top'n'tail title)
+    . pre
+    . (if anchor then renderNewLinesAnchors
+                      . concatMap (renderAnchors (renderToken pref))
+                      . insertAnchors
+                 else concatMap (renderToken pref))
+    . tokenise
+
+top'n'tail :: String -> String -> String
+top'n'tail title = (htmlHeader title ++) . (++htmlClose)
+
+pre :: String -> String
+pre = ("<pre>"++) . (++"</pre>")
+
+renderToken :: ColourPrefs -> (TokenType,String) -> String
+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 _      (Left v) = "<a name=\""++v++"\"></a>"
+renderAnchors render (Right r) = render r
+
+-- if there are http://links/ in a comment, turn them into
+-- hyperlinks
+renderComment :: String -> String
+renderComment xs@('h':'t':'t':'p':':':'/':'/':_) =
+        renderLink a ++ renderComment b
+    where
+        -- see http://www.gbiv.com/protocols/uri/rfc/rfc3986.html#characters
+        isUrlChar x = isAlphaNum x || x `elem` ":/?#[]@!$&'()*+,;=-._~%"
+        (a,b) = span isUrlChar xs
+        renderLink link = "<a href=\"" ++ link ++ "\">" ++ escape link ++ "</a>"
+        
+renderComment (x:xs) = escape [x] ++ renderComment xs
+renderComment [] = []
+
+renderNewLinesAnchors :: String -> String
+renderNewLinesAnchors = unlines . map render . zip [1..] . lines
+    where render (line, s) = "<a name=\"line-" ++ show line ++ "\"></a>" ++ s
+
+-- Html stuff
+fontify [] s     = s
+fontify (h:hs) s = font h (fontify hs s)
+
+font Normal         s = s
+font Bold           s = "<b>"++s++"</b>"
+font Dim            s = "<em>"++s++"</em>"
+font Underscore     s = "<u>"++s++"</u>"
+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 (Background c) s = "<font bgcolor="++show c++">"++s++"</font>"
+
+escape ('<':cs) = "&lt;"++escape cs
+escape ('>':cs) = "&gt;"++escape cs
+escape ('&':cs) = "&amp;"++escape cs
+escape (c:cs)   = c: escape cs
+escape []       = []
+
+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/ -->"
+  , "<title>"++title++"</title>"
+  , "</head>"
+  , "<body>"
+  ]
+htmlClose  = "\n</body>\n</html>"
 

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/LaTeX.html b/docs/hscolour/Language/Haskell/HsColour/LaTeX.html
--- a/docs/hscolour/Language/Haskell/HsColour/LaTeX.html
+++ b/docs/hscolour/Language/Haskell/HsColour/LaTeX.html
@@ -1,112 +1,119 @@
-
-- | Formats Haskell source code using LaTeX macros.
-module Language.Haskell.HsColour.LaTeX (hscolour, hscolourFragment) where
-
-import Language.Haskell.HsColour.Classify as Classify
-import Language.Haskell.HsColour.Colourise
-
--- | Formats Haskell source code as a complete LaTeX document.
-hscolour :: ColourPrefs -- ^ Colour preferences.
-         -> String      -- ^ Haskell source code.
-         -> String      -- ^ An LaTeX document containing the coloured 
-                        --   Haskell source code.
-hscolour pref = top'n'tail . hscolourFragment pref
-
--- | Formats Haskell source code as an LaTeX fragment.
-hscolourFragment :: ColourPrefs -- ^ Colour preferences.
-                 -> String -- ^ Haskell source code.
-                 -> String -- ^ An LaTeX fragment containing the coloured 
-                           --   Haskell source code.
-hscolourFragment pref = concatMap (renderToken pref) . tokenise
-
-top'n'tail :: String -> String
-top'n'tail  = (latexPrefix++) . (++latexSuffix)
-
--- | Wrap each lexeme in the appropriate LaTeX macro.
---   TODO: filter dangerous characters like "{}_$"
-renderToken :: ColourPrefs -> (TokenType,String) -> String
-renderToken pref (Space,text) = filterSpace text
-renderToken pref (cls,text)   = let 
-	symb = case cls of
-		String -> "``" ++ (reverse . tail . reverse . tail $ text) ++ "''"
-		_      -> text
-	style = colourise pref cls
-	(pre, post) = unzip $ map latexHighlight style in
-	(concat pre) ++ filterSpecial symb ++ (concat post) 
-
--- | Filter white space characters.
-filterSpace :: String
-            -> String
-filterSpace ('\n':ss) = '\\':'\\':(filterSpace ss)
-filterSpace (' ':ss)  = "\\hsspace "++(filterSpace ss)
-filterSpace ('\t':ss) = "\\hstab "++(filterSpace ss)
-filterSpace (c:ss)    = c:(filterSpace ss)
-filterSpace []        = []
-
--- | Filters the characters "#$%&~_^\{}" which are special
---   in LaTeX.
-filterSpecial :: String  -- ^ The string to filter. 
-              -> String  -- ^ The LaTeX-safe string.
-filterSpecial ('#':cs)  = '\\':'#':(filterSpecial cs)
-filterSpecial ('$':cs)  = '\\':'$':(filterSpecial cs)
-filterSpecial ('%':cs)  = '\\':'%':(filterSpecial cs)
-filterSpecial ('&':cs)  = '\\':'&':(filterSpecial cs)
-filterSpecial ('~':cs)  = "\\tilde{ }"++(filterSpecial cs)
-filterSpecial ('_':cs)  = '\\':'_':(filterSpecial cs)
-filterSpecial ('^':cs)  = "\\hat{ }"++(filterSpecial cs)
-filterSpecial ('\\':cs) = "$\\backslash$"++(filterSpecial cs)
-filterSpecial ('{':cs)  = '\\':'{':(filterSpecial cs)
-filterSpecial ('}':cs)  = '\\':'}':(filterSpecial cs)
-filterSpecial ('|':cs)  = "\\ensuremath{|}"++(filterSpecial cs)
-filterSpecial ('<':'-':cs)  = "\\ensuremath{\\leftarrow}"++(filterSpecial cs)
-filterSpecial ('<':cs)  = "\\ensuremath{\\langle}"++(filterSpecial cs)
-filterSpecial ('-':'>':cs)  = "\\ensuremath{\\rightarrow}"++(filterSpecial cs)
-filterSpecial ('>':cs)  = "\\ensuremath{\\rangle}"++(filterSpecial cs)
-filterSpecial (c:cs)    = c:(filterSpecial cs)
-filterSpecial []        = []
-
-
--- | Constructs the appropriate LaTeX macro for the given style.
-latexHighlight :: Highlight -> (String, String)
-latexHighlight Normal         = ("{\\rm{}", "}")
-latexHighlight Bold           = ("{\\bf{}", "}")
-latexHighlight Dim            = ("", "")
-latexHighlight Underscore     = ("\\underline{", "}")
-latexHighlight Blink          = ("", "")
-latexHighlight ReverseVideo   = ("", "")
-latexHighlight Concealed      = ("\\conceal{", "}")
-latexHighlight (Foreground c) = ("\\textcolor{"++ latexColour c ++"}{", "}")
-latexHighlight (Background c) = ("\\colorbox{"++ latexColour c ++"}{", "}")
-
--- | Translate a 'Colour' into a LaTeX colour name.
-latexColour :: Colour -> String
-latexColour Black   = "black"
-latexColour Red     = "red"
-latexColour Green   = "green"
-latexColour Yellow  = "yellow"
-latexColour Blue    = "blue"
-latexColour Magenta = "magenta"
-latexColour Cyan    = "cyan"
-latexColour White   = "white"
-
--- | Generic LaTeX document preamble.
-latexPrefix = unlines
-    ["\\documentclass[a4paper, 12pt]{article}"
-    ,"\\usepackage[usenames]{color}"
-    ,"\\usepackage{hyperref}"
-    ,"\\newsavebox{\\spaceb}"
-    ,"\\newsavebox{\\tabb}"
-    ,"\\savebox{\\spaceb}[1ex]{~}"
-    ,"\\savebox{\\tabb}[4ex]{~}"
-    ,"\\newcommand{\\hsspace}{\\usebox{\\spaceb}}"
-    ,"\\newcommand{\\hstab}{\\usebox{\\tabb}}"
-    ,"\\newcommand{\\conceal}[1]{}"
-    ,"\\begin{document}"
-    ,"\\noindent"
-    ]
-
--- | Generic LaTeX document postamble.
-latexSuffix = unlines
-    [""
-    ,"\\end{document}"
-    ]
+
+
+
+
+Language/Haskell/HsColour/LaTeX.hs
+
+
+
-- | Formats Haskell source code using LaTeX macros.
+module Language.Haskell.HsColour.LaTeX (hscolour) where
+
+import Language.Haskell.HsColour.Classify as Classify
+import Language.Haskell.HsColour.Colourise
+import Language.Haskell.HsColour.General
+
+-- | Formats Haskell source code as a complete LaTeX document.
+hscolour :: ColourPrefs -- ^ Colour preferences.
+         -> Bool        -- ^ Whether output should be partial (= no prologue).
+         -> String      -- ^ Haskell source code.
+         -> String      -- ^ A LaTeX document\/fragment containing the coloured 
+                        --   Haskell source code.
+hscolour pref partial =
+  ( if partial then id else top'n'tail)
+  . concatMap (renderToken pref)
+  . tokenise
+
+top'n'tail :: String -> String
+top'n'tail  = (latexPrefix++) . (++latexSuffix)
+
+-- | Wrap each lexeme in the appropriate LaTeX macro.
+--   TODO: filter dangerous characters like "{}_$"
+renderToken :: ColourPrefs -> (TokenType,String) -> String
+renderToken pref (Space,text) = filterSpace text
+renderToken pref (cls,text)   =
+  let symb = case cls of
+              String -> "``" ++ (dropFirst '\"' $ dropLast '\"' $ text) ++ "''"
+              _      -> text
+      style = colourise pref cls
+      (pre, post) = unzip $ map latexHighlight style
+  in concat pre ++ filterSpecial symb ++ concat post
+
+-- | Filter white space characters.
+filterSpace :: String
+            -> String
+filterSpace ('\n':ss) = '\\':'\\':(filterSpace ss)
+filterSpace (' ':ss)  = "\\hsspace "++(filterSpace ss)
+filterSpace ('\t':ss) = "\\hstab "++(filterSpace ss)
+filterSpace (c:ss)    = c:(filterSpace ss)
+filterSpace []        = []
+
+-- | Filters the characters "#$%&~_^\{}" which are special
+--   in LaTeX.
+filterSpecial :: String  -- ^ The string to filter. 
+              -> String  -- ^ The LaTeX-safe string.
+filterSpecial ('#':cs)  = '\\':'#':(filterSpecial cs)
+filterSpecial ('$':cs)  = '\\':'$':(filterSpecial cs)
+filterSpecial ('%':cs)  = '\\':'%':(filterSpecial cs)
+filterSpecial ('&':cs)  = '\\':'&':(filterSpecial cs)
+filterSpecial ('~':cs)  = "\\tilde{ }"++(filterSpecial cs)
+filterSpecial ('_':cs)  = '\\':'_':(filterSpecial cs)
+filterSpecial ('^':cs)  = "\\ensuremath{\\hat{ }}"++(filterSpecial cs)
+filterSpecial ('\\':cs) = "$\\backslash$"++(filterSpecial cs)
+filterSpecial ('{':cs)  = '\\':'{':(filterSpecial cs)
+filterSpecial ('}':cs)  = '\\':'}':(filterSpecial cs)
+filterSpecial ('|':cs)  = "\\ensuremath{|}"++(filterSpecial cs)
+filterSpecial ('<':'-':cs)  = "\\ensuremath{\\leftarrow}"++(filterSpecial cs)
+filterSpecial ('<':cs)  = "\\ensuremath{\\langle}"++(filterSpecial cs)
+filterSpecial ('-':'>':cs)  = "\\ensuremath{\\rightarrow}"++(filterSpecial cs)
+filterSpecial ('>':cs)  = "\\ensuremath{\\rangle}"++(filterSpecial cs)
+filterSpecial (c:cs)    = c:(filterSpecial cs)
+filterSpecial []        = []
+
+
+-- | Constructs the appropriate LaTeX macro for the given style.
+latexHighlight :: Highlight -> (String, String)
+latexHighlight Normal         = ("{\\rm{}", "}")
+latexHighlight Bold           = ("{\\bf{}", "}")
+latexHighlight Dim            = ("", "")
+latexHighlight Underscore     = ("\\underline{", "}")
+latexHighlight Blink          = ("", "")
+latexHighlight ReverseVideo   = ("", "")
+latexHighlight Concealed      = ("\\conceal{", "}")
+latexHighlight (Foreground c) = ("\\textcolor{"++ latexColour c ++"}{", "}")
+latexHighlight (Background c) = ("\\colorbox{"++ latexColour c ++"}{", "}")
+
+-- | Translate a 'Colour' into a LaTeX colour name.
+latexColour :: Colour -> String
+latexColour Black   = "black"
+latexColour Red     = "red"
+latexColour Green   = "green"
+latexColour Yellow  = "yellow"
+latexColour Blue    = "blue"
+latexColour Magenta = "magenta"
+latexColour Cyan    = "cyan"
+latexColour White   = "white"
+
+-- | Generic LaTeX document preamble.
+latexPrefix = unlines
+    ["\\documentclass[a4paper, 12pt]{article}"
+    ,"\\usepackage[usenames]{color}"
+    ,"\\usepackage{hyperref}"
+    ,"\\newsavebox{\\spaceb}"
+    ,"\\newsavebox{\\tabb}"
+    ,"\\savebox{\\spaceb}[1ex]{~}"
+    ,"\\savebox{\\tabb}[4ex]{~}"
+    ,"\\newcommand{\\hsspace}{\\usebox{\\spaceb}}"
+    ,"\\newcommand{\\hstab}{\\usebox{\\tabb}}"
+    ,"\\newcommand{\\conceal}[1]{}"
+    ,"\\begin{document}"
+    ,"\\noindent"
+    ]
+
+-- | Generic LaTeX document postamble.
+latexSuffix = unlines
+    [""
+    ,"\\end{document}"
+    ]
 

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/MIRC.html b/docs/hscolour/Language/Haskell/HsColour/MIRC.html
new file mode 100644
--- /dev/null
+++ b/docs/hscolour/Language/Haskell/HsColour/MIRC.html
@@ -0,0 +1,78 @@
+
+
+
+
+Language/Haskell/HsColour/MIRC.hs
+
+
+
-- | Formats Haskell source code using mIRC codes.
+--   (see http:\/\/irssi.org\/documentation\/formats)
+module Language.Haskell.HsColour.MIRC (hscolour) where
+
+import Language.Haskell.HsColour.Classify as Classify
+import Language.Haskell.HsColour.Colourise
+
+import Data.Char(isAlphaNum)
+
+
+-- | Formats Haskell source code using mIRC codes.
+hscolour :: ColourPrefs -- ^ Colour preferences.
+         -> String      -- ^ Haskell source code.
+         -> String      -- ^ Coloured Haskell source code.
+hscolour pref = concatMap (renderToken pref) . tokenise
+
+renderToken :: ColourPrefs -> (TokenType,String) -> String
+renderToken pref (t,s) = fontify (colourise pref t) s
+
+
+-- mIRC stuff
+fontify hs =
+    mircColours (joinColours hs)
+    . highlight (filter (`elem`[Normal,Bold,Underscore,ReverseVideo]) hs)
+  where
+    highlight [] s     = s
+    highlight (h:hs) s = font h (highlight hs s)
+
+    font Normal         s = s
+    font Bold           s = '\^B':s++"\^B"
+    font Underscore     s = '\^_':s++"\^_"
+    font ReverseVideo   s = '\^V':s++"\^V"
+
+-- mIRC combines colour codes in a non-modular way
+data MircColour = Mirc { fg::Colour, dim::Bool, bg::Maybe Colour, blink::Bool}
+
+joinColours :: [Highlight] -> MircColour
+joinColours = foldr join (Mirc {fg=Black, dim=False, bg=Nothing, blink=False})
+  where
+    join Blink           mirc = mirc {blink=True}
+    join Dim             mirc = mirc {dim=True}
+    join (Foreground fg) mirc = mirc {fg=fg}
+    join (Background bg) mirc = mirc {bg=Just bg}
+    join Concealed       mirc = mirc {fg=Black, bg=Just Black}
+    join _               mirc = mirc
+
+mircColours :: MircColour -> String -> String
+mircColours (Mirc fg dim Nothing   blink) s = '\^C': code fg dim++s++"\^O"
+mircColours (Mirc fg dim (Just bg) blink) s = '\^C': code fg dim++','
+                                                   : code bg blink++s++"\^O"
+
+code :: Colour -> Bool -> String
+code Black   False = "1"
+code Red     False = "5"
+code Green   False = "3"
+code Yellow  False = "7"
+code Blue    False = "2"
+code Magenta False = "6"
+code Cyan    False = "10"
+code White   False = "0"
+code Black   True  = "14"
+code Red     True  = "4"
+code Green   True  = "9"
+code Yellow  True  = "8"
+code Blue    True  = "12"
+code Magenta True  = "13"
+code Cyan    True  = "11"
+code White   True  = "15"
+

+
+
diff --git a/docs/hscolour/Language/Haskell/HsColour/TTY.html b/docs/hscolour/Language/Haskell/HsColour/TTY.html
--- a/docs/hscolour/Language/Haskell/HsColour/TTY.html
+++ b/docs/hscolour/Language/Haskell/HsColour/TTY.html
@@ -1,16 +1,25 @@
-
-- | Highlights Haskell code with ANSI terminal codes.
-module Language.Haskell.HsColour.TTY (hscolour) where
-
-import Language.Haskell.HsColour.ANSI as ANSI
-import Language.Haskell.HsColour.Classify
-import Language.Haskell.HsColour.Colourise
-
--- | Highlights Haskell code with ANSI terminal codes.
-hscolour :: ColourPrefs -- ^ Colour preferences.
-         -> String      -- ^ Haskell source code.
-         -> String      -- ^ Coloured Haskell source code.
-hscolour pref = concatMap (renderToken pref) . tokenise
-
-renderToken :: ColourPrefs -> (TokenType,String) -> String
-renderToken pref (t,s) = ANSI.highlight (colourise pref t) s
+
+
+
+
+Language/Haskell/HsColour/TTY.hs
+
+
+
-- | Highlights Haskell code with ANSI terminal codes.
+module Language.Haskell.HsColour.TTY (hscolour) where
+
+import Language.Haskell.HsColour.ANSI as ANSI
+import Language.Haskell.HsColour.Classify
+import Language.Haskell.HsColour.Colourise
+
+-- | Highlights Haskell code with ANSI terminal codes.
+hscolour :: ColourPrefs -- ^ Colour preferences.
+         -> String      -- ^ Haskell source code.
+         -> String      -- ^ Coloured Haskell source code.
+hscolour pref = concatMap (renderToken pref) . tokenise
+
+renderToken :: ColourPrefs -> (TokenType,String) -> String
+renderToken pref (t,s) = ANSI.highlight (colourise pref t) s
 

+
+
diff --git a/docs/hscolour/doc-index-C.html b/docs/hscolour/doc-index-C.html
--- a/docs/hscolour/doc-index-C.html
+++ b/docs/hscolour/doc-index-C.html
@@ -211,6 +211,14 @@
 >CppLanguage.Haskell.HsColour.ClassifyCyanLanguage.Haskell.HsColour.Colourise, Language.Haskell.HsColourcppLanguage.Haskell.HsColour.Colourise, Language.Haskell.HsColour
DefinitionLanguage.Haskell.HsColour.Classify
DimLanguage.Haskell.HsColour.ColourHighlight, Language.Haskell.HsColour.Colourise, Language.Haskell.HsColour.ANSI
definitionLanguage.Haskell.HsColour.Colourise, Language.Haskell.HsColour
dropFirstLanguage.Haskell.HsColour.General
dropLastLanguage.Haskell.HsColour.General
5 (Function)Language.Haskell.HsColour.TTYhscolourFragment1 (Function)Language.Haskell.HsColour.CSSLanguage.Haskell.HsColour.MIRC2 (Function)6 (Function)Language.Haskell.HsColour.LaTeXLanguage.Haskell.HsColour.TTY tags, HTML 4.01 with CSS, and LaTeX.
+  has five output formats: 
+  ANSI terminal codes,
+  HTML 3.2 with  tags,
+  HTML 4.01 with CSS,
+  LaTeX,
+  and mIRC chat codes.
+Category: Language
 Exposed-Modules: 
   Language.Haskell.HsColour,
   Language.Haskell.HsColour.ANSI,
@@ -27,7 +32,8 @@
   Language.Haskell.HsColour.MIRC,
   Language.Haskell.HsColour.CSS
 data-files: hscolour.css
-ghc-options: -O -W
+--ghc-options: -O -W
+Build-Type: Simple
 
 Executable: HsColour
 Main-is: HsColour.hs
diff --git a/index.html b/index.html
--- a/index.html
+++ b/index.html
@@ -163,7 +163,7 @@
 
 

 
Copyright and licence

-hscolour is © Malcolm Wallace 2003-2007.  It is distributed
+hscolour is © Malcolm Wallace 2003-2008.  It is distributed
 under the Gnu GPL, which can be found in the file
 LICENCE-GPL.
 
@@ -187,6 +187,7 @@
 
History

 

 

+
1.10
 the title of HTML output is now the filename

 
1.9
 added the -mirc and -lit options, and -print-css

 
1.8
 added highlights for cpp lines
                  
tuple constructors now treated as ConIds
@@ -203,7 +204,7 @@
 

 
 

-This page last modified: 8th Jan 2008

+This page last modified: 22nd July 2008

 Malcolm Wallace

 
 
MIRCLanguage.Haskell.HsColour
Magenta
renderNewLinesAnchorsLanguage.Haskell.HsColour.HTML
restorePosition
Language.Haskell.HsColour.General
Language.Haskell.HsColour.HTMLLanguage.Haskell.HsColour.LaTeX
Language.Haskell.HsColour.MIRC