[haskeline] #78: control characters in prompt mess up width calculations

haskeline haskeline at projects.haskell.org
Sat Aug 21 08:22:36 EDT 2010


#78: control characters in prompt mess up width calculations
-------------------+--------------------------------------------------------
Reporter:  judah   |        Owner:     
    Type:  defect  |       Status:  new
Priority:  minor   |    Milestone:     
 Version:  0.6     |   Resolution:     
Keywords:          |  
-------------------+--------------------------------------------------------
Comment (by phercek):

 Heh, I used a different hack to get it working with ghci. One part of it
 is the patch to ghc itself I posted in my previous comment. The second
 part is a patch to haskeline itself. The patch is here:

 {{{
 ---
 ghc-6.12.org/libraries/haskeline/System/Console/Haskeline/Backend/Terminfo.hs
 2009-09-24 00:35:18.000000000 +0200
 +++
 ghc-6.12/libraries/haskeline/System/Console/Haskeline/Backend/Terminfo.hs
 2009-10-12 14:26:57.000000000 +0200
 @@ -213,10 +213,10 @@
      w <- asks width
      TermPos {termRow=r,termCol=c} <- get
      let roomLeft = w - c
 -    if length str < roomLeft
 +    if visibleLen str < roomLeft
          then do
                  posixEncode (graphemesToString str) >>= output . text
 -                put TermPos{termRow=r, termCol=c+length str}
 +                put TermPos{termRow=r, termCol=c+visibleLen str}
                  return []
          else do
                  let (thisLine,rest) = splitAt roomLeft str
 @@ -228,14 +228,24 @@
  drawLineDiffT :: LineChars -> LineChars -> DrawM ()
  drawLineDiffT (xs1,ys1) (xs2,ys2) = case matchInit xs1 xs2 of
      ([],[])     | ys1 == ys2            -> return ()
 -    (xs1',[])   | xs1' ++ ys1 == ys2    -> changeLeft (length xs1')
 -    ([],xs2')   | ys1 == xs2' ++ ys2    -> changeRight (length xs2')
 +    (xs1',[])   | xs1' ++ ys1 == ys2    -> changeLeft (visibleLen xs1')
 +    ([],xs2')   | ys1 == xs2' ++ ys2    -> changeRight (visibleLen xs2')
      (xs1',xs2')                         -> do
 -        changeLeft (length xs1')
 +        changeLeft (visibleLen xs1')
          printText (xs2' ++ ys2)
 -        let m = length xs1' + length ys1 - (length xs2' + length ys2)
 +        let m = visibleLen xs1' + visibleLen ys1 - (visibleLen xs2' +
 visibleLen ys2)
          clearDeadText m
 -        changeLeft (length ys2)
 +        changeLeft (visibleLen ys2)
 +
 +visibleLen :: [Grapheme] -> Int
 +visibleLen str = countVisibleChars (map baseChar str) 0
 +  where
 +    countVisibleChars ( '\SOH' : rest ) cnt = countInvisibleChars rest
 cnt
 +    countVisibleChars ( _ : rest ) cnt = countVisibleChars rest (cnt+1)
 +    countVisibleChars [] cnt = cnt
 +    countInvisibleChars ( '\STX' : rest ) cnt = countVisibleChars rest
 cnt
 +    countInvisibleChars ( _ : rest ) cnt = countInvisibleChars rest cnt
 +    countInvisibleChars [] cnt = cnt

  linesLeft :: Layout -> TermPos -> Int -> Int
  linesLeft Layout {width=w} TermPos {termCol = c} n
 }}}

 My ghci prompt is[[BR]]
 {{{:set prompt "\SOH\ESC[1;32m\STX%s>\SOH\ESC[0m\STX "}}}

 Together these two patches work pretty well. I'm not even sure whether
 they ever misbehave. I think they do misbehave but it is so rare that I do
 not care (and even do not remember when it does happen).

 Both patches are probably just ugly hacks. Definitely so for the ghci
 prompt patch. The haskeline patch is possibly not so ugly but I do not
 know since I do not know haskeline design. I did whatever I could to get
 it kind of working in the least amount of time. I was not bothering to get
 good solution, I only wanted mostly working solution.

 I'll probably will not mess with this till I'll be upgrading to ghc 6.14.
 In such a case, if this ticket is not resolved by then, I'll just port my
 patches forward. I would hate to return back to non-colored ghci prompt.

-- 
Ticket URL: <http://trac.haskell.org/haskeline/ticket/78#comment:7>
haskeline <http://example.org/>
My example project


More information about the Haskeline mailing list