diff --git a/HsColour.hs b/HsColour.hs --- a/HsColour.hs +++ b/HsColour.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Main where import Language.Haskell.HsColour @@ -6,12 +7,19 @@ import Language.Haskell.HsColour.Options import System import IO +import System.IO (withFile) import Monad (when) import List (intersperse, isSuffixOf) import Debug.Trace -version = "1.15" +-- Deal with UTF-8 I/O. +#if __GLASGOW_HASKELL__ > 611 +-- possibly if MIN_VERSION_base(4,2,0) +import System.IO (hSetEncoding, utf8) +#endif +version = "1.16" + optionTable :: [(String,Option)] optionTable = [ ("help", Help) , ("version", Version) @@ -69,28 +77,30 @@ where writeResult outF s = do if null outF then putStr s - else writeFile (last outF) s + else writeUTF8File (last outF) s exitSuccess fileInteract out inFs u = do h <- case out of [] -> return stdout - [outF] -> openFile outF WriteMode + [outF] -> openFile outF WriteMode >>= + set_utf8_io_enc mapM_ (\ (f,lit)-> - readFile f >>= hPutStr h . u lit) + readUTF8File f >>= hPutStr h . u lit) inFs hClose h ttyInteract [] lit u = do hSetBuffering stdout NoBuffering Prelude.interact (u lit) ttyInteract [outF] lit u = do c <- hGetContents stdin - writeFile outF (u lit c) + writeUTF8File outF (u lit c) exitSuccess = exitWith ExitSuccess - errorOut s = hPutStrLn stderr s >> hFlush stderr >> exitFailure - usage prog = "Usage: "++prog - ++" options [file.hs]\n where\n options = [ " - ++ (indent 15 . unwords . width 58 58 . intersperse "|" + errorOut s = hPutStrLn stderr s >> hFlush stderr >> exitFailure + usage prog = "Usage: "++prog + ++" options [file.hs]\n where\n options = [ " + ++ (indent 15 . unwords . width 58 58 . intersperse "|" . ("-oOUTPUT":) - . map (('-':) . fst)) optionTable ++ " ]" - useDefault d f list | null list = d - | otherwise = f (head list) + . map (('-':) . fst)) optionTable + ++ " ]\n" + useDefault d f list | null list = d + | otherwise = f (head list) useDefaults d f list | null list = d | otherwise = f list guessLiterate Nothing f = ".lhs" `isSuffixOf` f || ".ly" `isSuffixOf` f @@ -108,11 +118,41 @@ indent n (c:s) = c: indent n s -- Rather than have a separate .css file, define some reasonable defaults here. -cssDefaults = "\ -\.hs-keyglyph, .hs-layout {color: red;}\n\ -\.hs-keyword {color: blue;}\n\ -\.hs-comment, .hs-comment a {color: green;}\n\ -\.hs-str, .hs-chr {color: teal;}\n\ -\.hs-keyword, .hs-conid, .hs-varid, .hs-conop, .hs-varop, .hs-num, \ -\.hs-cpp, .hs-sel, .hs-definition {}\n\ -\" +cssDefaults = concat + [ ".hs-keyglyph, .hs-layout {color: red;}\n" + , ".hs-keyword {color: blue;}\n" + , ".hs-comment, .hs-comment a {color: green;}\n" + , ".hs-str, .hs-chr {color: teal;}\n" + , ".hs-keyword, .hs-conid, .hs-varid, .hs-conop, .hs-varop, .hs-num, " + , ".hs-cpp, .hs-sel, .hs-definition {}\n" + ] + +-- Deal with UTF-8 input and output. +set_utf8_io_enc :: Handle -> IO Handle +#if __GLASGOW_HASKELL__ > 611 +-- possibly if MIN_VERSION_base(4,2,0) +set_utf8_io_enc h = do hSetEncoding h utf8; return h +#else +set_utf8_io_enc h = return h +#endif + +-- FILE I(unput) / O(utput) is in UTF8 +-- TTY I(unput) / O(utput) is in locale +-- ( may have problems with HsColour IFILE >OFILE +-- , as it differs from HsColour IFILE -oOFILE) +-- TTY stderr is always in locale (always used for user interaction) +-- +-- Some common use cases: +-- File I / FILE O (HsColour -css -anchor -oOFILE IFILE) +-- : are both always done in UTF8 mode (cabal hscolour mode) +-- File I / TTY O (HsColour IFILE) +-- : file is read in UTF-8 written in locale +-- TTY I / TTY O (HsColour) +-- : stdin/stdout are both in locale + +-- fully mimic Prelude analogues +writeUTF8File f txt = withFile f WriteMode (\hdl -> do set_utf8_io_enc hdl + hPutStr hdl txt) +readUTF8File name = openFile name ReadMode >>= + set_utf8_io_enc >>= + hGetContents diff --git a/Makefile b/Makefile --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ LIBRARY = hscolour -VERSION = 1.15 +VERSION = 1.16 DIRS = Language/Haskell/HsColour diff --git a/README b/README --- a/README +++ b/README @@ -1,6 +1,6 @@ HsColour: A Haskell source-code colouriser. ------------------------------------------- -Copyright: 2003-2009, Malcolm Wallace, University of York +Copyright: 2003-2010, Malcolm Wallace, University of York Licence: GPL Building: diff --git a/hscolour.cabal b/hscolour.cabal --- a/hscolour.cabal +++ b/hscolour.cabal @@ -1,6 +1,6 @@ Name: hscolour -Version: 1.15 -Copyright: 2003-2009 Malcolm Wallace, University of York; 2006 Bjorn Bringert +Version: 1.16 +Copyright: 2003-2010 Malcolm Wallace, University of York; 2006 Bjorn Bringert Maintainer: Malcolm Wallace Author: Malcolm Wallace Homepage: http://www.cs.york.ac.uk/fp/darcs/hscolour/ diff --git a/index.html b/index.html --- a/index.html +++ b/index.html @@ -36,10 +36,10 @@
  • Download a tarfile package from: ftp://ftp.cs.york.ac.uk/pub/haskell/contrib/ - - http://www.cs.york.ac.uk/fp/darcs/hscolour/hscolour-1.15.tar.gz - - http://www.cs.york.ac.uk/fp/darcs/hscolour/hscolour-1.15.zip + + http://www.cs.york.ac.uk/fp/darcs/hscolour/hscolour-1.16.tar.gz + + http://www.cs.york.ac.uk/fp/darcs/hscolour/hscolour-1.16.zip
  • Or use the darcs repository at
    darcs get http://www.cs.york.ac.uk/fp/darcs/hscolour
  • Sources and history are browsable on-line through @@ -200,6 +200,7 @@

    History

    +
    1.16
    deal with UTF-8 sources in ghc-6.12.x
    1.15
    makes -nopartial the default for literate files
    1.14
    merges the -lit and -lit-tex options, adds -lit guessing, and permits multiple input files
    @@ -225,7 +226,7 @@

    -This page last modified: 24th August 2009
    +This page last modified: 1st February 2010
    Malcolm Wallace