[commit: haskeline] master: Attempt to fix #81 on Windows. (95ff8e6)

[Ian Lynagh]

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 <judah.jacobson at gmail.com>
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