Repository : ssh://darcs.haskell.org//srv/darcs/packages/haskeline On branch : master
http://hackage.haskell.org/trac/ghc/changeset/95ff8e6330f411f40fe56fe54d587cc6bd1f2b26 >--------------------------------------------------------------- commit 95ff8e6330f411f40fe56fe54d587cc6bd1f2b26 Author: Judah Jacobson <[email protected]> Date: Mon Dec 6 21:55:48 2010 +0000 Attempt to fix #81 on Windows. >--------------------------------------------------------------- System/Console/Haskeline/Backend/Win32.hsc | 52 ++++++++++++++++++++++------ haskeline.cabal | 4 +- 2 files changed, 43 insertions(+), 13 deletions(-) diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc index d4d98b3..b4303cb 100644 --- a/System/Console/Haskeline/Backend/Win32.hsc +++ b/System/Console/Haskeline/Backend/Win32.hsc @@ -20,6 +20,7 @@ import System.Console.Haskeline.Key import System.Console.Haskeline.Monads import System.Console.Haskeline.LineState import System.Console.Haskeline.Term as Term +import System.Console.Haskeline.Backend.WCWidth import Data.ByteString.Internal (createAndTrim) import qualified Data.ByteString as B @@ -265,27 +266,56 @@ printText txt = do printAfter :: String -> DrawM () printAfter str = do + p <- getPos printText str - movePos $ negate $ length str + setPos p drawLineDiffWin :: LineChars -> LineChars -> DrawM () drawLineDiffWin (xs1,ys1) (xs2,ys2) = case matchInit xs1 xs2 of ([],[]) | ys1 == ys2 -> return () - (xs1',[]) | xs1' ++ ys1 == ys2 -> movePos $ negate $ length xs1' - ([],xs2') | ys1 == xs2' ++ ys2 -> movePos $ length xs2' + (xs1',[]) | xs1' ++ ys1 == ys2 -> movePosLeft xs1' + ([],xs2') | ys1 == xs2' ++ ys2 -> movePosRight xs2' (xs1',xs2') -> do - movePos (negate $ length xs1') - let m = length xs1' + length ys1 - (length xs2' + length ys2) + movePosLeft xs1' + let m = gsWidth xs1' + gsWidth ys1 - (gsWidth xs2' + gsWidth ys2) let deadText = replicate m ' ' printText (graphemesToString xs2') printAfter (graphemesToString ys2 ++ deadText) -movePos :: Int -> DrawM () -movePos n = do - Coord {coordX = x, coordY = y} <- getPos +movePosRight, movePosLeft :: [Grapheme] -> DrawM () +movePosRight str = do + p <- getPos w <- asks width - let (h,x') = divMod (x+n) w - setPos Coord {coordX = x', coordY = y+h} + setPos $ moveCoord w p str + where + moveCoord _ p [] = p + moveCoord w p cs = case splitAtWidth (w - coordX p) cs of + (_,[],len) | len < w -- stayed on same line + -> Coord { coordY = coordY p + 1, + coordX = coordX p + len + } + (_,cs',_) -- moved to next line + -> moveCoord w Coord { + coordY = coordY p + 1, + coordX = 0 + } cs' + +movePosLeft str = do + p <- getPos + w <- asks width + setPos $ moveCoord w p str + where + moveCoord _ p [] = p + moveCoord w p cs = case splitAtWidth (coordX p) cs of + (_,[],len) -- stayed on same line + -> Coord { coordY = coordY p, + coordX = coordX p - len + } + (_,cs',_) -- moved to previous line + -> moveCoord w Coord { + coordY = coordY p - 1, + coordX = w-1 + } cs' crlf :: String crlf = "\r\n" @@ -309,7 +339,7 @@ instance (MonadException m, MonadReader Layout m) => Term (Draw m) where setPos (Coord 0 0) moveToNextLine s = do - movePos (lengthToEnd s) + movePosRight (snd s) printText "\r\n" -- make the console take care of creating a new line ringBell True = liftIO messageBeep diff --git a/haskeline.cabal b/haskeline.cabal index 415b2d2..99f1d6b 100644 --- a/haskeline.cabal +++ b/haskeline.cabal @@ -80,6 +80,7 @@ Library System.Console.Haskeline.IO Other-Modules: System.Console.Haskeline.Backend + System.Console.Haskeline.Backend.WCWidth System.Console.Haskeline.Command System.Console.Haskeline.Command.Completion System.Console.Haskeline.Command.History @@ -96,6 +97,7 @@ Library System.Console.Haskeline.Command.Undo System.Console.Haskeline.Vi include-dirs: includes + c-sources: cbits/h_wcwidth.c if os(windows) { Build-depends: Win32>=2.0 Other-modules: System.Console.Haskeline.Backend.Win32 @@ -107,11 +109,9 @@ Library Build-depends: unix>=2.0 && < 2.5 -- unix-2.3 doesn't build on ghc-6.8.1 or earlier c-sources: cbits/h_iconv.c - cbits/h_wcwidth.c includes: h_iconv.h install-includes: h_iconv.h Other-modules: - System.Console.Haskeline.Backend.WCWidth System.Console.Haskeline.Backend.Posix System.Console.Haskeline.Backend.IConv System.Console.Haskeline.Backend.DumbTerm _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
