haskeline 0.6.2.2 → 0.6.2.3
raw patch · 19 files changed
+729/−183 lines, 19 filesdep ~basedep ~filepathdep ~terminfoPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: base, filepath, terminfo
API changes (from Hackage documentation)
- System.Console.Haskeline.MonadException: instance [overlap ok] (MonadException m) => MonadException (StateT s m)
Files
- CHANGES +22/−0
- LICENSE +2/−2
- System/Console/Haskeline/Backend/DumbTerm.hs +17/−16
- System/Console/Haskeline/Backend/Posix.hsc +22/−2
- System/Console/Haskeline/Backend/Terminfo.hs +176/−107
- System/Console/Haskeline/Backend/WCWidth.hs +51/−0
- System/Console/Haskeline/Backend/Win32.hsc +1/−1
- System/Console/Haskeline/Command/Completion.hs +1/−0
- System/Console/Haskeline/Completion.hs +3/−9
- System/Console/Haskeline/Emacs.hs +2/−0
- System/Console/Haskeline/Key.hs +4/−0
- System/Console/Haskeline/MonadException.hs +0/−6
- System/Console/Haskeline/Monads.hs +43/−12
- System/Console/Haskeline/RunCommand.hs +38/−19
- System/Console/Haskeline/Term.hs +1/−1
- System/Console/Haskeline/Vi.hs +16/−3
- cbits/h_iconv.c +4/−1
- cbits/h_wcwidth.c +309/−0
- haskeline.cabal +17/−4
CHANGES view
@@ -1,3 +1,25 @@+Changed in version 0.6.2.3:+ * #110: Recognize the enter key in xterm.++ * #108: Fix behavior after a paste of long, non-ASCII text.++ * #106: Ignore input immediately following an unrecognized control sequence.++ * #104: In vi-mode, allow, e.g., "d2w" as well as "2dw"++ * #103: Fix vi-mode 'c' command with movements.++ * #81: Correctly handle characters with a width > 1.++ * Compatibility updates from the GHC folks for Solaris and for ghc-6.14.++ * Optimization: if several key presses are input all at once (e.g. from a+ paste), only display the last change. This can also make Haskeline more+ responsive when editing long lines.++ * Hard-code some defaults for ctrl-left and ctrl-right, and provide the+ corresponding Emacs bindings to skip words.+ Changed in version 0.6.2.2: * Raise dependency to utf8-string>=0.3.6 (fixes a bug when decoding invalid input)
LICENSE view
@@ -5,10 +5,10 @@ modification, are permitted provided that the following conditions are met: - Redistribution of source code must retain the above copyright notice,-this list of conditions and the following disclamer.+this list of conditions and the following disclaimer. - Redistribution in binary form must reproduce the above copyright notice,-this list of conditions and the following disclamer in the documentation+this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS "AS IS" AND ANY
System/Console/Haskeline/Backend/DumbTerm.hs view
@@ -1,6 +1,7 @@ module System.Console.Haskeline.Backend.DumbTerm where import System.Console.Haskeline.Backend.Posix+import System.Console.Haskeline.Backend.WCWidth import System.Console.Haskeline.Term import System.Console.Haskeline.LineState import System.Console.Haskeline.Monads as Monads@@ -82,40 +83,40 @@ Window {pos=p} <- get w <- maxWidth let (xs1',xs2') = matchInit xs1 xs2- let newP = p + length xs2' - length xs1'- let ys2' = take (w-newP) ys2- if length xs1' > p || newP >= w+ let (xw1, xw2) = (gsWidth xs1', gsWidth xs2')+ let newP = p + xw2 - xw1+ let (ys2', yw2) = takeWidth (w-newP) ys2+ if xw1 > p || newP >= w then refitLine (xs2,ys2) else do -- we haven't moved outside the margins put Window {pos=newP} case (xs1',xs2') of ([],[]) | ys1 == ys2 -> return () -- no change (_,[]) | xs1' ++ ys1 == ys2 -> -- moved left- printText $ backs (length xs1')+ printText $ backs xw1 ([],_) | ys1 == xs2' ++ ys2 -> -- moved right printText (graphemesToString xs2')- _ -> let- extraLength = length xs1' + length ys1- - length xs2' - length ys2- in printText $ backs (length xs1')+ _ -> let extraLength = xw1 + snd (takeWidth (w-p) ys1)+ - xw2 - yw2+ in printText $ backs xw1 ++ graphemesToString (xs2' ++ ys2') ++ clearDeadText extraLength- ++ backs (length ys2')+ ++ backs yw2 refitLine :: ([Grapheme],[Grapheme]) -> DumbTermM () refitLine (xs,ys) = do w <- maxWidth- let xs' = dropFrames w xs- let p = length xs' + let (xs',p) = dropFrames w xs put Window {pos=p}- let ys' = take (w - p) ys- let k = length ys'+ let (ys',k) = takeWidth (w - p) ys printText $ cr ++ graphemesToString (xs' ++ ys') ++ spaces (w-k-p) ++ backs (w-p) where- dropFrames w zs = case splitAt w zs of- (_,[]) -> zs- (_,zs') -> dropFrames w zs'+ -- returns the width of the returned characters.+ dropFrames w zs = case splitAtWidth w zs of+ (_,[],l) -> (zs,l)+ (_,zs',_) -> dropFrames w zs'+ clearDeadText :: Int -> String clearDeadText n | n > 0 = spaces n ++ backs n
System/Console/Haskeline/Backend/Posix.hsc view
@@ -123,7 +123,23 @@ ,("\ESC[C", simpleKey RightKey) ,("\ESC[A", simpleKey UpKey) ,("\ESC[B", simpleKey DownKey)- ,("\b", simpleKey Backspace)]+ ,("\b", simpleKey Backspace)+ -- ctrl-left/right aren't a standard+ -- part of terminfo, but enough people have complained+ -- that I've decided to hard-code them in.+ -- (Note they will be overridden by terminfo or .haskeline.)+ -- These appear to be the most common bindings:+ -- xterm:+ ,("\ESC[1;5D", ctrlKey $ simpleKey LeftKey)+ ,("\ESC[1;5C", ctrlKey $ simpleKey RightKey)+ -- Terminal.app:+ ,("\ESC[5D", ctrlKey $ simpleKey LeftKey)+ ,("\ESC[5C", ctrlKey $ simpleKey RightKey)+ -- rxvt: (Note: these will be superceded by e.g. xterm-color,+ -- which uses them as regular arrow keys.)+ ,("\ESC[OD", ctrlKey $ simpleKey LeftKey)+ ,("\ESC[OC", ctrlKey $ simpleKey RightKey)+ ] sttyKeys :: IO [(String, Key)]@@ -217,7 +233,7 @@ blockUntilInput bs <- B.hGetNonBlocking stdin bufferSize cs <- convert (localeToUnicode enc) bs- return $ map KeyInput $ lexKeys baseMap cs+ return [KeyInput $ lexKeys baseMap cs] -- Different versions of ghc work better using different functions. blockUntilInput :: IO ()@@ -319,8 +335,12 @@ wrapTerminalOps:: MonadException m => Handle -> m a -> m a wrapTerminalOps outH = bracketSet (hGetBuffering stdin) (hSetBuffering stdin) NoBuffering+ -- TODO: block buffering? Certain \r and \n's are causing flicker...+ -- - moving to the right+ -- - breaking line after offset widechar? . bracketSet (hGetBuffering outH) (hSetBuffering outH) LineBuffering . bracketSet (hGetEcho stdin) (hSetEcho stdin) False+ . hWithBinaryMode stdin bracketSet :: (Eq a, MonadException m) => IO a -> (a -> IO ()) -> a -> m b -> m b bracketSet getState set newState f = bracket (liftIO getState)
System/Console/Haskeline/Backend/Terminfo.hs view
@@ -6,19 +6,24 @@ import System.Console.Terminfo import Control.Monad-import Data.List(intersperse)+import Data.List(intersperse, foldl') import System.IO import qualified Control.Exception.Extensible as Exception import qualified Data.ByteString.Char8 as B import Data.Maybe (fromMaybe, mapMaybe) import Control.Concurrent.Chan+import qualified Data.IntMap as Map import System.Console.Haskeline.Monads as Monads import System.Console.Haskeline.LineState import System.Console.Haskeline.Term import System.Console.Haskeline.Backend.Posix+import System.Console.Haskeline.Backend.WCWidth import System.Console.Haskeline.Key +----------------------------------------------------------------+-- Low-level terminal output+ -- | Keep track of all of the output capabilities we can use. -- -- We'll be frequently using the (automatic) 'Monoid' instance for @@ -32,6 +37,10 @@ getActions :: Capability Actions getActions = do+ -- This capability is not strictly necessary, but is very widely supported+ -- and assuming it makes for a much simpler implementation of printText.+ autoRightMargin >>= guard+ leftA' <- moveLeft rightA' <- moveRight upA' <- moveUp@@ -42,29 +51,26 @@ -- Don't require the bell capabilities bellAudible' <- bell `mplus` return mempty bellVisual' <- visualBell `mplus` return mempty- wrapLine' <- getWrapLine nl' (leftA' 1)+ wrapLine' <- getWrapLine (leftA' 1) return Actions{leftA = leftA', rightA = rightA',upA = upA', clearToLineEnd = clearToLineEnd', nl = nl',cr = cr', bellAudible = bellAudible', bellVisual = bellVisual', clearAllA = clearAll', wrapLine = wrapLine'} -text :: B.ByteString -> Actions -> TermOutput-text str _ = termText $ B.unpack str--getWrapLine :: TermOutput -> TermOutput -> Capability TermOutput-getWrapLine nl' left1 = (autoRightMargin >>= guard >> withAutoMargin)- `mplus` return nl'- where - -- If the wraparound glitch is in effect, force a wrap by printing a space.- -- Otherwise, it'll wrap automatically.- withAutoMargin = (do- wraparoundGlitch >>= guard- return (termText " " <#> left1)- )`mplus` return mempty+-- If the wraparound glitch is in effect, force a wrap by printing a space.+-- Otherwise, it'll wrap automatically.+getWrapLine :: TermOutput -> Capability TermOutput+getWrapLine left1 = (do+ wraparoundGlitch >>= guard+ return (termText " " <#> left1)+ ) `mplus` return mempty type TermAction = Actions -> TermOutput +text :: B.ByteString -> TermAction+text str _ = termText $ B.unpack str+ left,right,up :: Int -> TermAction left = flip leftA right = flip rightA@@ -73,44 +79,70 @@ clearAll :: LinesAffected -> TermAction clearAll = flip clearAllA ----------- mreplicate :: Monoid m => Int -> m -> m mreplicate n m | n <= 0 = mempty | otherwise = m `mappend` mreplicate (n-1) m +-- We don't need to bother encoding the spaces.+spaces :: Int -> TermAction+spaces 0 = mempty+spaces 1 = const $ termText " " -- share when possible+spaces n = const $ termText $ replicate n ' '++----------------------------------------------------------------+-- The Draw monad+ -- denote in modular arithmetic; -- in particular, 0 <= termCol < width-data TermPos = TermPos {termRow,termCol :: Int}+data TermPos = TermPos {termRow,termCol :: !Int} deriving Show initTermPos :: TermPos initTermPos = TermPos {termRow = 0, termCol = 0} +data TermRows = TermRows {+ rowLengths :: !(Map.IntMap Int),+ -- ^ The length of each nonempty row+ lastRow :: !Int+ -- ^ The last nonempty row, or zero if the entire line+ -- is empty. Note that when the cursor wraps to the first+ -- column of the next line, termRow > lastRow.+ }+ deriving Show ---------------+initTermRows :: TermRows+initTermRows = TermRows {rowLengths = Map.empty, lastRow=0} +setRow :: Int -> Int -> TermRows -> TermRows+setRow r len rs = TermRows {rowLengths = Map.insert r len (rowLengths rs),+ lastRow=r}++lookupCells :: TermRows -> Int -> Int+lookupCells (TermRows rc _) r = Map.findWithDefault 0 r rc++sum' :: [Int] -> Int+ newtype Draw m a = Draw {unDraw :: (ReaderT Actions- (ReaderT Terminal (StateT TermPos- (PosixT m)))) a}+ (ReaderT Terminal+ (StateT TermRows+ (StateT TermPos+ (PosixT m))))) a} deriving (Monad, MonadIO, MonadException, MonadReader Actions, MonadReader Terminal, MonadState TermPos,+ MonadState TermRows, MonadReader Handle, MonadReader Encoders) type DrawM a = forall m . (MonadReader Layout m, MonadIO m) => Draw m a instance MonadTrans Draw where- lift = Draw . lift . lift . lift . lift . lift+ lift = Draw . lift . lift . lift . lift . lift . lift runTerminfoDraw :: IO (Maybe RunTerm) runTerminfoDraw = do mterm <- Exception.try setupTermFromEnv ch <- newChan case mterm of- -- XXX narrow this: either an ioexception (from getenv) or a - -- usererror. Left (_::SetupTermError) -> return Nothing Right term -> case getCapability term getActions of Nothing -> return Nothing@@ -124,6 +156,7 @@ , runTerm = \(RunTermType f) -> runPosixT enc h $ evalStateT' initTermPos+ $ evalStateT' initTermRows $ runReaderT' term $ runReaderT' actions $ unDraw f@@ -160,6 +193,7 @@ ,(keyEnd, simpleKey End) ,(keyPageDown, simpleKey PageDown) ,(keyPageUp, simpleKey PageUp)+ ,(keyEnter, simpleKey $ KeyChar '\n') ] @@ -171,93 +205,127 @@ liftIO $ hRunTermOutput ttyh term toutput +----------------------------------------------------------------+-- Movement actions +changePos :: TermPos -> TermPos -> TermAction+changePos TermPos {termRow=r1, termCol=c1} TermPos {termRow=r2, termCol=c2}+ | r1 == r2 = if c1 < c2 then right (c2-c1) else left (c1-c2)+ | r1 > r2 = cr <#> up (r1-r2) <#> right c2+ | otherwise = cr <#> mreplicate (r2-r1) nl <#> right c2++-- TODO: when drawLineDiffT calls this, shouldn't move if same.+moveToPos :: TermPos -> DrawM TermAction+moveToPos p = do+ oldP <- get+ put p+ return $ changePos oldP p++moveRelative :: Int -> DrawM ()+moveRelative n = liftM3 (advancePos n) ask get get+ >>= moveToPos >>= output++-- Note that these move by a certain number of cells, not graphemes. changeRight, changeLeft :: Int -> DrawM ()-changeRight n = do- w <- asks width- TermPos {termRow=r,termCol=c} <- get- if c+n < w - then do- put TermPos {termRow=r,termCol=c+n}- output (right n)- else do- let m = c+n- let linesDown = m `div` w- let newCol = m `rem` w- put TermPos {termRow=r+linesDown, termCol=newCol}- output $ cr <#> mreplicate linesDown nl <#> right newCol- -changeLeft n = do- w <- asks width- TermPos {termRow=r,termCol=c} <- get- if c - n >= 0 - then do - put TermPos {termRow = r,termCol = c-n}- output (left n)- else do - let m = n - c- let linesUp = 1 + ((m-1) `div` w)- let newCol = (-m) `mod` w -- mod returns positive #- put TermPos {termRow = r - linesUp, termCol=newCol}- output $ cr <#> up linesUp <#> right newCol- --- TODO: I think if we wrap this all up in one call to output, it'll be faster...-printText :: [Grapheme] -> DrawM ()-printText [] = return ()-printText xs = fillLine xs >>= printText+changeRight n | n <= 0 = return ()+ | otherwise = moveRelative n+changeLeft n | n <= 0 = return ()+ | otherwise = moveRelative (negate n) --- Draws as much of the string as possible in the line, and returns the rest.--- If we fill up the line completely, wrap to the next row.-fillLine :: [Grapheme] -> DrawM [Grapheme]-fillLine str = do+-- TODO: this could be more efficient by only checking intermediate rows.+-- TODO: this is worth handling with QuickCheck.+advancePos :: Int -> Layout -> TermRows -> TermPos -> TermPos+advancePos k Layout {width=w} rs p = indexToPos $ k + posIndex+ where+ posIndex = termCol p + sum' (map (lookupCells rs)+ [0..termRow p-1])+ indexToPos n = loopFindRow 0 n+ loopFindRow r m = r `seq` m `seq` let+ thisRowSize = lookupCells rs r+ in if m < thisRowSize+ || (m == thisRowSize && m < w)+ || thisRowSize <= 0 -- This shouldn't happen in practice,+ -- but double-check to prevent an infinite loop+ then TermPos {termRow=r, termCol=m}+ else loopFindRow (r+1) (m-thisRowSize)++sum' = foldl' (+) 0++----------------------------------------------------------------+-- Text printing actions++encodeGraphemes :: MonadIO m => [Grapheme] -> Draw m TermAction+encodeGraphemes = liftM text . posixEncode . graphemesToString++printText :: [Grapheme] -> DrawM TermAction+printText = textAction mempty++textAction :: TermAction -> [Grapheme] -> DrawM TermAction+textAction prevOutput [] = return prevOutput+textAction prevOutput gs = do+ -- First, get the monadic parameters: w <- asks width- TermPos {termRow=r,termCol=c} <- get- let roomLeft = w - c- if length str < roomLeft- then do- posixEncode (graphemesToString str) >>= output . text- put TermPos{termRow=r, termCol=c+length str}- return []- else do- let (thisLine,rest) = splitAt roomLeft str- bstr <- posixEncode (graphemesToString thisLine)- output (text bstr <#> wrapLine)- put TermPos {termRow=r+1,termCol=0}- return rest+ TermPos {termRow=r, termCol=c} <- get+ -- Now, split off as much as will fit on the rest of this row:+ let (thisLine,rest,thisWidth) = splitAtWidth (w-c) gs+ let lineWidth = c + thisWidth+ ts <- encodeGraphemes thisLine+ -- Finally, actually print out the relevant text.+ modify $ setRow r lineWidth+ if null rest && lineWidth < w+ then do -- everything fits on one line without wrapping+ put TermPos {termRow=r, termCol=lineWidth}+ return (prevOutput <#> ts)+ else do -- Must wrap to the next line+ put TermPos {termRow=r+1,termCol=0}+ let wrap = if lineWidth == w then wrapLine else spaces (w-lineWidth)+ textAction (prevOutput <#> ts <#> wrap) rest +----------------------------------------------------------------+-- High-level Term implementation+--+-- To prevent flicker, we combine all of the drawing commands into one big+-- TermAction, and output them all at once.+ 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 (gsWidth xs1')+ ([],xs2') | ys1 == xs2' ++ ys2 -> changeRight (gsWidth xs2') (xs1',xs2') -> do- changeLeft (length xs1')- printText (xs2' ++ ys2)- let m = length xs1' + length ys1 - (length xs2' + length ys2)- clearDeadText m- changeLeft (length ys2)--linesLeft :: Layout -> TermPos -> Int -> Int-linesLeft Layout {width=w} TermPos {termCol = c} n- | c + n < w = 1- | otherwise = 1 + div (c+n) w+ oldRS <- get+ -- TODO: this changeLeft could be merged with the rest of the output.+ -- For now, we'll leave it separate since xs1' is often empty+ -- (e.g. when typing new characters).+ changeLeft (gsWidth xs1')+ xsOut <- printText xs2'+ p <- get+ restOut <- liftM mconcat $ sequence+ [ printText ys2+ , clearDeadText oldRS+ , moveToPos p+ ]+ output (xsOut <#> restOut) -lsLinesLeft :: Layout -> TermPos -> LineChars -> Int-lsLinesLeft layout pos = linesLeft layout pos . lengthToEnd+-- The number of nonempty lines after the current row position.+getLinesLeft :: DrawM Int+getLinesLeft = do+ p <- get+ rc <- get+ return $ max 0 (lastRow rc - termRow p) -clearDeadText :: Int -> DrawM ()-clearDeadText n- | n <= 0 = return ()- | otherwise = do- layout <- ask- pos <- get- let numLinesToClear = linesLeft layout pos n- output clearToLineEnd- when (numLinesToClear > 1) $ output $ mconcat [- mreplicate (numLinesToClear - 1) - $ nl <#> clearToLineEnd- , up (numLinesToClear - 1)- , right (termCol pos)]+clearDeadText :: TermRows -> DrawM TermAction+clearDeadText oldRS = do+ TermPos {termRow = r, termCol = c} <- get+ let extraRows = lastRow oldRS - r+ if extraRows < 0+ || (extraRows == 0 && lookupCells oldRS r <= c)+ then return mempty+ else do+ modify $ setRow r c+ when (extraRows /= 0)+ $ put TermPos {termRow = r + extraRows, termCol=0}+ return $ clearToLineEnd <#> mreplicate extraRows (nl <#> clearToLineEnd) clearLayoutT :: DrawM () clearLayoutT = do@@ -266,19 +334,20 @@ put initTermPos moveToNextLineT :: LineChars -> DrawM ()-moveToNextLineT s = do- pos <- get- layout <- ask- output $ mreplicate (lsLinesLeft layout pos s) nl+moveToNextLineT _ = do+ lleft <- getLinesLeft+ output $ mreplicate (lleft+1) nl put initTermPos+ put initTermRows repositionT :: Layout -> LineChars -> DrawM ()-repositionT oldLayout s = do+repositionT _ s = do oldPos <- get- let l = lsLinesLeft oldLayout oldPos s - 1+ l <- getLinesLeft output $ cr <#> mreplicate l nl <#> mreplicate (l + termRow oldPos) (clearToLineEnd <#> up 1) put initTermPos+ put initTermRows drawLineDiffT ([],[]) s instance (MonadException m, MonadReader Layout m) => Term (Draw m) where
+ System/Console/Haskeline/Backend/WCWidth.hs view
@@ -0,0 +1,51 @@+module System.Console.Haskeline.Backend.WCWidth(+ gsWidth,+ splitAtWidth,+ takeWidth,+ ) where++-- Certain characters are "wide", i.e. take up two spaces in the terminal.+-- This module wraps the necessary foreign routines, and also provides some convenience+-- functions for width-breaking code.++import System.Console.Haskeline.LineState++import Data.Char+import Data.List+import Foreign.C.Types++foreign import ccall unsafe mk_wcwidth :: CWchar -> Int++wcwidth :: Char -> Int+wcwidth c = case mk_wcwidth $ toEnum $ fromEnum c of+ -1 -> 0 -- shouldn't happen, since control characters+ -- aren't turned into graphemes; but better to be safe.+ w -> w++gWidth :: Grapheme -> Int+gWidth g = wcwidth (baseChar g)++gsWidth :: [Grapheme] -> Int+gsWidth = foldl' (+) 0 . map gWidth++-- | Split off the maximal list which is no more than the given width.+-- returns the width of that list.+splitAtWidth :: Int -> [Grapheme] -> ([Grapheme],[Grapheme],Int)+splitAtWidth n xs = case splitAtWidth' n xs of+ (this,rest,remaining) -> (this,rest,n-remaining)++-- Returns the amount of unused space in the line.+splitAtWidth' :: Int -> [Grapheme] -> ([Grapheme],[Grapheme],Int)+splitAtWidth' w [] = ([],[],w)+splitAtWidth' w (g:gs)+ | gw > w = ([],g:gs,w)+ | otherwise = (g:gs',gs'',r)+ where+ gw = gWidth g+ (gs',gs'',r) = splitAtWidth' (w-gw) gs++-- Returns the longest prefix less than or equal to the given width+-- plus the width of that list.+takeWidth :: Int -> [Grapheme] -> ([Grapheme],Int)+takeWidth n gs = case splitAtWidth n gs of+ (gs',_,len) -> (gs',len)
System/Console/Haskeline/Backend/Win32.hsc view
@@ -63,7 +63,7 @@ processEvent :: InputEvent -> Maybe Event processEvent KeyEvent {keyDown = True, unicodeChar = c, virtualKeyCode = vc, controlKeyState = cstate} - = fmap (KeyInput . Key modifier') $ keyFromCode vc `mplus` simpleKeyChar + = fmap (\e -> KeyInput [Key modifier' e]) $ keyFromCode vc `mplus` simpleKeyChar where simpleKeyChar = guard (c /= '\NUL') >> return (KeyChar c) testMod ck = (cstate .&. ck) /= 0
System/Console/Haskeline/Command/Completion.hs view
@@ -28,6 +28,7 @@ graphemesToString ys) return (IMode (withRev stringToGraphemes rest) ys, completions) where+ withRev :: ([a] -> [b]) -> [a] -> [b] withRev f = reverse . f . reverse -- | Create a 'Command' for word completion.
System/Console/Haskeline/Completion.hs view
@@ -100,7 +100,7 @@ --------- -- Quoted completion completeQuotedWord :: Monad m => Maybe Char -- ^ An optional escape character- -> String -- List of characters which set off quotes+ -> String -- ^ List of characters which set off quotes -> (String -> m [Completion]) -- ^ Function to produce a list of possible completions -> CompletionFunc m -- ^ Alternate completion to perform if the -- cursor is not at a quoted word@@ -161,19 +161,13 @@ alterIfDir False c = c alterIfDir True c = c {replacement = addTrailingPathSeparator (replacement c), isFinished = False}- -- NOTE In order for completion to work properly, all of the alternatives- -- must have the exact same prefix. As a result, </> is a little too clever;- -- for example, it doesn't prepend the directory if the file looks like- -- an absolute path (strange, but it can happen).- -- The FilePath docs state that (++) is an exact inverse of splitFileName, so- -- that's the right function to user here.- fullName = (dir ++)+ fullName = replaceFileName path -- turn a user-visible path into an internal version useable by System.FilePath. fixPath :: String -> IO String+-- For versions of filepath < 1.2 fixPath "" = return "." fixPath ('~':c:path) | isPathSeparator c = do home <- getHomeDirectory return (home </> path) fixPath path = return path-
System/Console/Haskeline/Emacs.hs view
@@ -53,6 +53,8 @@ , ctrlChar 'l' +> clearScreenCmd , metaChar 'f' +> change wordRight , metaChar 'b' +> change wordLeft+ , ctrlKey (simpleKey LeftKey) +> change wordLeft+ , ctrlKey (simpleKey RightKey) +> change wordRight , metaChar 'c' +> change (modifyWord capitalize) , metaChar 'l' +> change (modifyWord (mapBaseChars toLower)) , metaChar 'u' +> change (modifyWord (mapBaseChars toUpper))
System/Console/Haskeline/Key.hs view
@@ -7,6 +7,7 @@ metaChar, ctrlChar, metaKey,+ ctrlKey, parseKey ) where @@ -45,6 +46,9 @@ metaKey :: Key -> Key metaKey (Key m bc) = Key m {hasMeta = True} bc++ctrlKey :: Key -> Key+ctrlKey (Key m bc) = Key m {hasControl = True} bc simpleChar, metaChar, ctrlChar :: Char -> Key simpleChar = simpleKey . KeyChar
System/Console/Haskeline/MonadException.hs view
@@ -74,9 +74,3 @@ (\e -> runReaderT (h e) r) block = mapReaderT block unblock = mapReaderT unblock--instance MonadException m => MonadException (StateT s m) where- catch f h = StateT $ \s -> catch (runStateT f s)- (\e -> runStateT (h e) s)- block = mapStateT block- unblock = mapStateT unblock
System/Console/Haskeline/Monads.hs view
@@ -4,8 +4,10 @@ ReaderT(..), runReaderT', asks,- StateT(..),+ StateT,+ runStateT, evalStateT',+ gets, modify, update, MonadReader(..),@@ -14,11 +16,10 @@ import Control.Monad.Trans import System.Console.Haskeline.MonadException+import Prelude hiding (catch) import Control.Monad.Reader hiding (MonadReader,ask,asks,local) import qualified Control.Monad.Reader as Reader-import Control.Monad.State hiding (MonadState,get,put,modify)-import qualified Control.Monad.State as State class Monad m => MonadReader r m where ask :: m r@@ -39,14 +40,8 @@ get :: m s put :: s -> m () -instance Monad m => MonadState s (StateT s m) where- get = State.get- put = State.put--instance (MonadState s m, MonadTrans t, Monad (t m)) => MonadState s (t m) where- get = lift get- put = lift . put-+gets :: MonadState s m => (s -> a) -> m a+gets f = liftM f get modify :: MonadState s m => (s -> s) -> m () modify f = get >>= put . f@@ -61,5 +56,41 @@ runReaderT' :: Monad m => r -> ReaderT r m a -> m a runReaderT' = flip runReaderT +newtype StateT s m a = StateT { getStateTFunc + :: forall r . s -> m ((a -> s -> r) -> r)}++instance Monad m => Monad (StateT s m) where+ return x = StateT $ \s -> return $ \f -> f x s+ StateT f >>= g = StateT $ \s -> do+ useX <- f s+ useX $ \x s' -> getStateTFunc (g x) s'++instance MonadTrans (StateT s) where+ lift m = StateT $ \s -> do+ x <- m+ return $ \f -> f x s++instance MonadIO m => MonadIO (StateT s m) where+ liftIO = lift . liftIO++runStateT :: Monad m => StateT s m a -> s -> m (a, s)+runStateT f s = do+ useXS <- getStateTFunc f s+ return $ useXS $ \x s' -> (x,s')++instance Monad m => MonadState s (StateT s m) where+ get = StateT $ \s -> return $ \f -> f s s+ put s = s `seq` StateT $ \_ -> return $ \f -> f () s++instance (MonadState s m, MonadTrans t, Monad (t m)) => MonadState s (t m) where+ get = lift get+ put = lift . put+ evalStateT' :: Monad m => s -> StateT s m a -> m a-evalStateT' = flip evalStateT+evalStateT' s f = liftM fst $ runStateT f s++instance MonadException m => MonadException (StateT s m) where+ block m = StateT $ \s -> block $ getStateTFunc m s+ unblock m = StateT $ \s -> unblock $ getStateTFunc m s+ catch f h = StateT $ \s -> catch (getStateTFunc f s)+ $ \e -> getStateTFunc (h e) s
System/Console/Haskeline/RunCommand.hs view
@@ -20,32 +20,34 @@ runCommandLoop' tops prefix cmds getEvent = do let s = lineChars prefix emptyIM drawLine s- loopKeys [] s (fmap ($ emptyIM) cmds)- where - loopKeys :: [Key] -> LineChars -> KeyMap (CmdM m a) -> t m a- loopKeys [] s processor = do -- no keys left, so read some more+ readMoreKeys s (fmap ($ emptyIM) cmds)+ where+ readMoreKeys :: LineChars -> KeyMap (CmdM m a) -> t m a+ readMoreKeys s next = do event <- handle (\(e::SomeException) -> moveToNextLine s >> throwIO e) getEvent case event of ErrorEvent e -> moveToNextLine s >> throwIO e WindowResize -> drawReposition tops s- >> loopKeys [] s processor- KeyInput k -> do- ks <- lift $ asks $ lookupKeyBinding k- loopKeys ks s processor- loopKeys (k:ks) s processor = case lookupKM processor k of- Nothing -> actBell >> loopKeys [] s processor- Just (Consumed cmd) -> loopCmd ks s cmd- Just (NotConsumed cmd) -> loopCmd (k:ks) s cmd+ >> readMoreKeys s next+ KeyInput ks -> do+ bound_ks <- mapM (lift . asks . lookupKeyBinding) ks+ loopCmd s $ applyKeysToMap (concat bound_ks) next - loopCmd :: [Key] -> LineChars -> CmdM m a -> t m a- loopCmd ks s (GetKey next) = loopKeys ks s next- loopCmd ks s (DoEffect e next) = do- t <- drawEffect prefix s e- loopCmd ks t next- loopCmd ks s (CmdM next) = lift next >>= loopCmd ks s- loopCmd _ s (Result x) = moveToNextLine s >> return x+ loopCmd :: LineChars -> CmdM m a -> t m a+ loopCmd s (GetKey next) = readMoreKeys s next+ -- If there are multiple consecutive LineChanges, only render the diff+ -- to the last one, and skip the rest. This greatly improves speed when+ -- a large amount of text is pasted in at once.+ loopCmd s (DoEffect (LineChange _)+ e@(DoEffect (LineChange _) _)) = loopCmd s e+ loopCmd s (DoEffect e next) = do+ t <- drawEffect prefix s e+ loopCmd t next+ loopCmd s (CmdM next) = lift next >>= loopCmd s+ loopCmd s (Result x) = moveToNextLine s >> return x + drawEffect :: (MonadTrans t, Term (t m), MonadReader Prefs m) => String -> LineChars -> Effect -> t m LineChars drawEffect prefix s (LineChange ch) = do@@ -82,3 +84,20 @@ reposition oldLayout s +---------------+-- Traverse through the tree of keybindings, using the given keys.+-- Remove as many GetKeys as possible.+applyKeysToMap :: Monad m => [Key] -> KeyMap (CmdM m a)+ -> CmdM m a+applyKeysToMap [] next = GetKey next+applyKeysToMap (k:ks) next = case lookupKM next k of+ Nothing -> DoEffect RingBell $ GetKey next+ Just (Consumed cmd) -> applyKeysToCmd ks cmd+ Just (NotConsumed cmd) -> applyKeysToCmd (k:ks) cmd++applyKeysToCmd :: Monad m => [Key] -> CmdM m a+ -> CmdM m a+applyKeysToCmd ks (GetKey next) = applyKeysToMap ks next+applyKeysToCmd ks (DoEffect e next) = DoEffect e (applyKeysToCmd ks next)+applyKeysToCmd ks (CmdM next) = CmdM $ liftM (applyKeysToCmd ks) next+applyKeysToCmd _ (Result x) = Result x
System/Console/Haskeline/Term.hs view
@@ -68,7 +68,7 @@ matchInit (x:xs) (y:ys) | x == y = matchInit xs ys matchInit xs ys = (xs,ys) -data Event = WindowResize | KeyInput Key | ErrorEvent SomeException+data Event = WindowResize | KeyInput [Key] | ErrorEvent SomeException deriving Show keyEventLoop :: IO [Event] -> Chan Event -> IO Event
System/Console/Haskeline/Vi.hs view
@@ -205,30 +205,43 @@ deletionCmd :: InputCmd (ArgMode CommandMode) CommandMode deletionCmd = keyChoiceCmd- [simpleChar 'd' +> killAndStoreCmd killAll+ [ reinputArg >+> deletionCmd+ , simpleChar 'd' +> killAndStoreCmd killAll , useMovementsForKill (change argState) killAndStoreCmd , withoutConsuming (change argState) ] deletionToInsertCmd :: InputCmd (ArgMode CommandMode) EitherMode deletionToInsertCmd = keyChoiceCmd- [simpleChar 'c' +> killAndStoreIE killAll+ [ reinputArg >+> deletionToInsertCmd+ , simpleChar 'c' +> killAndStoreIE killAll -- vim, for whatever reason, treats cw same as ce and cW same as cE. -- readline does this too, so we should also. , simpleChar 'w' +> killAndStoreIE (SimpleMove goToWordDelEnd) , simpleChar 'W' +> killAndStoreIE (SimpleMove goToBigWordDelEnd)+ , useMovementsForKill (liftM Left . change argState) killAndStoreIE , withoutConsuming (return . Left . argState) ] yankCommand :: InputCmd (ArgMode CommandMode) CommandMode yankCommand = keyChoiceCmd- [simpleChar 'y' +> copyAndStore killAll+ [ reinputArg >+> yankCommand+ , simpleChar 'y' +> copyAndStore killAll , useMovementsForKill (change argState) copyAndStore , withoutConsuming (change argState) ] where copyAndStore = storedCmdAction . copyFromArgHelper++reinputArg :: LineState s => InputKeyCmd (ArgMode s) (ArgMode s)+reinputArg = foreachDigit restartArg ['1'..'9'] >+> loop+ where+ restartArg n = startArg n . argState+ loop = keyChoiceCmd+ [ foreachDigit addNum ['0'..'9'] >+> loop+ , withoutConsuming return+ ] goToWordDelEnd, goToBigWordDelEnd :: InsertMode -> InsertMode goToWordDelEnd = goRightUntil $ atStart (not . isWordChar)
cbits/h_iconv.c view
@@ -11,5 +11,8 @@ size_t h_iconv(iconv_t cd, char **inbuf, size_t *inbytesleft, char **outbuf, size_t *outbytesleft) {- return iconv(cd, inbuf, inbytesleft, outbuf, outbytesleft);+ // Cast inbuf to (void*) so that it works both on Solaris, which expects+ // a (const char**), and on other platforms (e.g. Linux), which expect+ // a (char **).+ return iconv(cd, (void*)inbuf, inbytesleft, outbuf, outbytesleft); }
+ cbits/h_wcwidth.c view
@@ -0,0 +1,309 @@+/*+ * This is an implementation of wcwidth() and wcswidth() (defined in+ * IEEE Std 1002.1-2001) for Unicode.+ *+ * http://www.opengroup.org/onlinepubs/007904975/functions/wcwidth.html+ * http://www.opengroup.org/onlinepubs/007904975/functions/wcswidth.html+ *+ * In fixed-width output devices, Latin characters all occupy a single+ * "cell" position of equal width, whereas ideographic CJK characters+ * occupy two such cells. Interoperability between terminal-line+ * applications and (teletype-style) character terminals using the+ * UTF-8 encoding requires agreement on which character should advance+ * the cursor by how many cell positions. No established formal+ * standards exist at present on which Unicode character shall occupy+ * how many cell positions on character terminals. These routines are+ * a first attempt of defining such behavior based on simple rules+ * applied to data provided by the Unicode Consortium.+ *+ * For some graphical characters, the Unicode standard explicitly+ * defines a character-cell width via the definition of the East Asian+ * FullWidth (F), Wide (W), Half-width (H), and Narrow (Na) classes.+ * In all these cases, there is no ambiguity about which width a+ * terminal shall use. For characters in the East Asian Ambiguous (A)+ * class, the width choice depends purely on a preference of backward+ * compatibility with either historic CJK or Western practice.+ * Choosing single-width for these characters is easy to justify as+ * the appropriate long-term solution, as the CJK practice of+ * displaying these characters as double-width comes from historic+ * implementation simplicity (8-bit encoded characters were displayed+ * single-width and 16-bit ones double-width, even for Greek,+ * Cyrillic, etc.) and not any typographic considerations.+ *+ * Much less clear is the choice of width for the Not East Asian+ * (Neutral) class. Existing practice does not dictate a width for any+ * of these characters. It would nevertheless make sense+ * typographically to allocate two character cells to characters such+ * as for instance EM SPACE or VOLUME INTEGRAL, which cannot be+ * represented adequately with a single-width glyph. The following+ * routines at present merely assign a single-cell width to all+ * neutral characters, in the interest of simplicity. This is not+ * entirely satisfactory and should be reconsidered before+ * establishing a formal standard in this area. At the moment, the+ * decision which Not East Asian (Neutral) characters should be+ * represented by double-width glyphs cannot yet be answered by+ * applying a simple rule from the Unicode database content. Setting+ * up a proper standard for the behavior of UTF-8 character terminals+ * will require a careful analysis not only of each Unicode character,+ * but also of each presentation form, something the author of these+ * routines has avoided to do so far.+ *+ * http://www.unicode.org/unicode/reports/tr11/+ *+ * Markus Kuhn -- 2007-05-26 (Unicode 5.0)+ *+ * Permission to use, copy, modify, and distribute this software+ * for any purpose and without fee is hereby granted. The author+ * disclaims all warranties with regard to this software.+ *+ * Latest version: http://www.cl.cam.ac.uk/~mgk25/ucs/wcwidth.c+ */++#include <wchar.h>++struct interval {+ int first;+ int last;+};++/* auxiliary function for binary search in interval table */+static int bisearch(wchar_t ucs, const struct interval *table, int max) {+ int min = 0;+ int mid;++ if (ucs < table[0].first || ucs > table[max].last)+ return 0;+ while (max >= min) {+ mid = (min + max) / 2;+ if (ucs > table[mid].last)+ min = mid + 1;+ else if (ucs < table[mid].first)+ max = mid - 1;+ else+ return 1;+ }++ return 0;+}+++/* The following two functions define the column width of an ISO 10646+ * character as follows:+ *+ * - The null character (U+0000) has a column width of 0.+ *+ * - Other C0/C1 control characters and DEL will lead to a return+ * value of -1.+ *+ * - Non-spacing and enclosing combining characters (general+ * category code Mn or Me in the Unicode database) have a+ * column width of 0.+ *+ * - SOFT HYPHEN (U+00AD) has a column width of 1.+ *+ * - Other format characters (general category code Cf in the Unicode+ * database) and ZERO WIDTH SPACE (U+200B) have a column width of 0.+ *+ * - Hangul Jamo medial vowels and final consonants (U+1160-U+11FF)+ * have a column width of 0.+ *+ * - Spacing characters in the East Asian Wide (W) or East Asian+ * Full-width (F) category as defined in Unicode Technical+ * Report #11 have a column width of 2.+ *+ * - All remaining characters (including all printable+ * ISO 8859-1 and WGL4 characters, Unicode control characters,+ * etc.) have a column width of 1.+ *+ * This implementation assumes that wchar_t characters are encoded+ * in ISO 10646.+ */++int mk_wcwidth(wchar_t ucs)+{+ /* sorted list of non-overlapping intervals of non-spacing characters */+ /* generated by "uniset +cat=Me +cat=Mn +cat=Cf -00AD +1160-11FF +200B c" */+ static const struct interval combining[] = {+ { 0x0300, 0x036F }, { 0x0483, 0x0486 }, { 0x0488, 0x0489 },+ { 0x0591, 0x05BD }, { 0x05BF, 0x05BF }, { 0x05C1, 0x05C2 },+ { 0x05C4, 0x05C5 }, { 0x05C7, 0x05C7 }, { 0x0600, 0x0603 },+ { 0x0610, 0x0615 }, { 0x064B, 0x065E }, { 0x0670, 0x0670 },+ { 0x06D6, 0x06E4 }, { 0x06E7, 0x06E8 }, { 0x06EA, 0x06ED },+ { 0x070F, 0x070F }, { 0x0711, 0x0711 }, { 0x0730, 0x074A },+ { 0x07A6, 0x07B0 }, { 0x07EB, 0x07F3 }, { 0x0901, 0x0902 },+ { 0x093C, 0x093C }, { 0x0941, 0x0948 }, { 0x094D, 0x094D },+ { 0x0951, 0x0954 }, { 0x0962, 0x0963 }, { 0x0981, 0x0981 },+ { 0x09BC, 0x09BC }, { 0x09C1, 0x09C4 }, { 0x09CD, 0x09CD },+ { 0x09E2, 0x09E3 }, { 0x0A01, 0x0A02 }, { 0x0A3C, 0x0A3C },+ { 0x0A41, 0x0A42 }, { 0x0A47, 0x0A48 }, { 0x0A4B, 0x0A4D },+ { 0x0A70, 0x0A71 }, { 0x0A81, 0x0A82 }, { 0x0ABC, 0x0ABC },+ { 0x0AC1, 0x0AC5 }, { 0x0AC7, 0x0AC8 }, { 0x0ACD, 0x0ACD },+ { 0x0AE2, 0x0AE3 }, { 0x0B01, 0x0B01 }, { 0x0B3C, 0x0B3C },+ { 0x0B3F, 0x0B3F }, { 0x0B41, 0x0B43 }, { 0x0B4D, 0x0B4D },+ { 0x0B56, 0x0B56 }, { 0x0B82, 0x0B82 }, { 0x0BC0, 0x0BC0 },+ { 0x0BCD, 0x0BCD }, { 0x0C3E, 0x0C40 }, { 0x0C46, 0x0C48 },+ { 0x0C4A, 0x0C4D }, { 0x0C55, 0x0C56 }, { 0x0CBC, 0x0CBC },+ { 0x0CBF, 0x0CBF }, { 0x0CC6, 0x0CC6 }, { 0x0CCC, 0x0CCD },+ { 0x0CE2, 0x0CE3 }, { 0x0D41, 0x0D43 }, { 0x0D4D, 0x0D4D },+ { 0x0DCA, 0x0DCA }, { 0x0DD2, 0x0DD4 }, { 0x0DD6, 0x0DD6 },+ { 0x0E31, 0x0E31 }, { 0x0E34, 0x0E3A }, { 0x0E47, 0x0E4E },+ { 0x0EB1, 0x0EB1 }, { 0x0EB4, 0x0EB9 }, { 0x0EBB, 0x0EBC },+ { 0x0EC8, 0x0ECD }, { 0x0F18, 0x0F19 }, { 0x0F35, 0x0F35 },+ { 0x0F37, 0x0F37 }, { 0x0F39, 0x0F39 }, { 0x0F71, 0x0F7E },+ { 0x0F80, 0x0F84 }, { 0x0F86, 0x0F87 }, { 0x0F90, 0x0F97 },+ { 0x0F99, 0x0FBC }, { 0x0FC6, 0x0FC6 }, { 0x102D, 0x1030 },+ { 0x1032, 0x1032 }, { 0x1036, 0x1037 }, { 0x1039, 0x1039 },+ { 0x1058, 0x1059 }, { 0x1160, 0x11FF }, { 0x135F, 0x135F },+ { 0x1712, 0x1714 }, { 0x1732, 0x1734 }, { 0x1752, 0x1753 },+ { 0x1772, 0x1773 }, { 0x17B4, 0x17B5 }, { 0x17B7, 0x17BD },+ { 0x17C6, 0x17C6 }, { 0x17C9, 0x17D3 }, { 0x17DD, 0x17DD },+ { 0x180B, 0x180D }, { 0x18A9, 0x18A9 }, { 0x1920, 0x1922 },+ { 0x1927, 0x1928 }, { 0x1932, 0x1932 }, { 0x1939, 0x193B },+ { 0x1A17, 0x1A18 }, { 0x1B00, 0x1B03 }, { 0x1B34, 0x1B34 },+ { 0x1B36, 0x1B3A }, { 0x1B3C, 0x1B3C }, { 0x1B42, 0x1B42 },+ { 0x1B6B, 0x1B73 }, { 0x1DC0, 0x1DCA }, { 0x1DFE, 0x1DFF },+ { 0x200B, 0x200F }, { 0x202A, 0x202E }, { 0x2060, 0x2063 },+ { 0x206A, 0x206F }, { 0x20D0, 0x20EF }, { 0x302A, 0x302F },+ { 0x3099, 0x309A }, { 0xA806, 0xA806 }, { 0xA80B, 0xA80B },+ { 0xA825, 0xA826 }, { 0xFB1E, 0xFB1E }, { 0xFE00, 0xFE0F },+ { 0xFE20, 0xFE23 }, { 0xFEFF, 0xFEFF }, { 0xFFF9, 0xFFFB },+ { 0x10A01, 0x10A03 }, { 0x10A05, 0x10A06 }, { 0x10A0C, 0x10A0F },+ { 0x10A38, 0x10A3A }, { 0x10A3F, 0x10A3F }, { 0x1D167, 0x1D169 },+ { 0x1D173, 0x1D182 }, { 0x1D185, 0x1D18B }, { 0x1D1AA, 0x1D1AD },+ { 0x1D242, 0x1D244 }, { 0xE0001, 0xE0001 }, { 0xE0020, 0xE007F },+ { 0xE0100, 0xE01EF }+ };++ /* test for 8-bit control characters */+ if (ucs == 0)+ return 0;+ if (ucs < 32 || (ucs >= 0x7f && ucs < 0xa0))+ return -1;++ /* binary search in table of non-spacing characters */+ if (bisearch(ucs, combining,+ sizeof(combining) / sizeof(struct interval) - 1))+ return 0;++ /* if we arrive here, ucs is not a combining or C0/C1 control character */++ return 1 + + (ucs >= 0x1100 &&+ (ucs <= 0x115f || /* Hangul Jamo init. consonants */+ ucs == 0x2329 || ucs == 0x232a ||+ (ucs >= 0x2e80 && ucs <= 0xa4cf &&+ ucs != 0x303f) || /* CJK ... Yi */+ (ucs >= 0xac00 && ucs <= 0xd7a3) || /* Hangul Syllables */+ (ucs >= 0xf900 && ucs <= 0xfaff) || /* CJK Compatibility Ideographs */+ (ucs >= 0xfe10 && ucs <= 0xfe19) || /* Vertical forms */+ (ucs >= 0xfe30 && ucs <= 0xfe6f) || /* CJK Compatibility Forms */+ (ucs >= 0xff00 && ucs <= 0xff60) || /* Fullwidth Forms */+ (ucs >= 0xffe0 && ucs <= 0xffe6) ||+ (ucs >= 0x20000 && ucs <= 0x2fffd) ||+ (ucs >= 0x30000 && ucs <= 0x3fffd)));+}+++int mk_wcswidth(const wchar_t *pwcs, size_t n)+{+ int w, width = 0;++ for (;*pwcs && n-- > 0; pwcs++)+ if ((w = mk_wcwidth(*pwcs)) < 0)+ return -1;+ else+ width += w;++ return width;+}+++/*+ * The following functions are the same as mk_wcwidth() and+ * mk_wcswidth(), except that spacing characters in the East Asian+ * Ambiguous (A) category as defined in Unicode Technical Report #11+ * have a column width of 2. This variant might be useful for users of+ * CJK legacy encodings who want to migrate to UCS without changing+ * the traditional terminal character-width behaviour. It is not+ * otherwise recommended for general use.+ */+int mk_wcwidth_cjk(wchar_t ucs)+{+ /* sorted list of non-overlapping intervals of East Asian Ambiguous+ * characters, generated by "uniset +WIDTH-A -cat=Me -cat=Mn -cat=Cf c" */+ static const struct interval ambiguous[] = {+ { 0x00A1, 0x00A1 }, { 0x00A4, 0x00A4 }, { 0x00A7, 0x00A8 },+ { 0x00AA, 0x00AA }, { 0x00AE, 0x00AE }, { 0x00B0, 0x00B4 },+ { 0x00B6, 0x00BA }, { 0x00BC, 0x00BF }, { 0x00C6, 0x00C6 },+ { 0x00D0, 0x00D0 }, { 0x00D7, 0x00D8 }, { 0x00DE, 0x00E1 },+ { 0x00E6, 0x00E6 }, { 0x00E8, 0x00EA }, { 0x00EC, 0x00ED },+ { 0x00F0, 0x00F0 }, { 0x00F2, 0x00F3 }, { 0x00F7, 0x00FA },+ { 0x00FC, 0x00FC }, { 0x00FE, 0x00FE }, { 0x0101, 0x0101 },+ { 0x0111, 0x0111 }, { 0x0113, 0x0113 }, { 0x011B, 0x011B },+ { 0x0126, 0x0127 }, { 0x012B, 0x012B }, { 0x0131, 0x0133 },+ { 0x0138, 0x0138 }, { 0x013F, 0x0142 }, { 0x0144, 0x0144 },+ { 0x0148, 0x014B }, { 0x014D, 0x014D }, { 0x0152, 0x0153 },+ { 0x0166, 0x0167 }, { 0x016B, 0x016B }, { 0x01CE, 0x01CE },+ { 0x01D0, 0x01D0 }, { 0x01D2, 0x01D2 }, { 0x01D4, 0x01D4 },+ { 0x01D6, 0x01D6 }, { 0x01D8, 0x01D8 }, { 0x01DA, 0x01DA },+ { 0x01DC, 0x01DC }, { 0x0251, 0x0251 }, { 0x0261, 0x0261 },+ { 0x02C4, 0x02C4 }, { 0x02C7, 0x02C7 }, { 0x02C9, 0x02CB },+ { 0x02CD, 0x02CD }, { 0x02D0, 0x02D0 }, { 0x02D8, 0x02DB },+ { 0x02DD, 0x02DD }, { 0x02DF, 0x02DF }, { 0x0391, 0x03A1 },+ { 0x03A3, 0x03A9 }, { 0x03B1, 0x03C1 }, { 0x03C3, 0x03C9 },+ { 0x0401, 0x0401 }, { 0x0410, 0x044F }, { 0x0451, 0x0451 },+ { 0x2010, 0x2010 }, { 0x2013, 0x2016 }, { 0x2018, 0x2019 },+ { 0x201C, 0x201D }, { 0x2020, 0x2022 }, { 0x2024, 0x2027 },+ { 0x2030, 0x2030 }, { 0x2032, 0x2033 }, { 0x2035, 0x2035 },+ { 0x203B, 0x203B }, { 0x203E, 0x203E }, { 0x2074, 0x2074 },+ { 0x207F, 0x207F }, { 0x2081, 0x2084 }, { 0x20AC, 0x20AC },+ { 0x2103, 0x2103 }, { 0x2105, 0x2105 }, { 0x2109, 0x2109 },+ { 0x2113, 0x2113 }, { 0x2116, 0x2116 }, { 0x2121, 0x2122 },+ { 0x2126, 0x2126 }, { 0x212B, 0x212B }, { 0x2153, 0x2154 },+ { 0x215B, 0x215E }, { 0x2160, 0x216B }, { 0x2170, 0x2179 },+ { 0x2190, 0x2199 }, { 0x21B8, 0x21B9 }, { 0x21D2, 0x21D2 },+ { 0x21D4, 0x21D4 }, { 0x21E7, 0x21E7 }, { 0x2200, 0x2200 },+ { 0x2202, 0x2203 }, { 0x2207, 0x2208 }, { 0x220B, 0x220B },+ { 0x220F, 0x220F }, { 0x2211, 0x2211 }, { 0x2215, 0x2215 },+ { 0x221A, 0x221A }, { 0x221D, 0x2220 }, { 0x2223, 0x2223 },+ { 0x2225, 0x2225 }, { 0x2227, 0x222C }, { 0x222E, 0x222E },+ { 0x2234, 0x2237 }, { 0x223C, 0x223D }, { 0x2248, 0x2248 },+ { 0x224C, 0x224C }, { 0x2252, 0x2252 }, { 0x2260, 0x2261 },+ { 0x2264, 0x2267 }, { 0x226A, 0x226B }, { 0x226E, 0x226F },+ { 0x2282, 0x2283 }, { 0x2286, 0x2287 }, { 0x2295, 0x2295 },+ { 0x2299, 0x2299 }, { 0x22A5, 0x22A5 }, { 0x22BF, 0x22BF },+ { 0x2312, 0x2312 }, { 0x2460, 0x24E9 }, { 0x24EB, 0x254B },+ { 0x2550, 0x2573 }, { 0x2580, 0x258F }, { 0x2592, 0x2595 },+ { 0x25A0, 0x25A1 }, { 0x25A3, 0x25A9 }, { 0x25B2, 0x25B3 },+ { 0x25B6, 0x25B7 }, { 0x25BC, 0x25BD }, { 0x25C0, 0x25C1 },+ { 0x25C6, 0x25C8 }, { 0x25CB, 0x25CB }, { 0x25CE, 0x25D1 },+ { 0x25E2, 0x25E5 }, { 0x25EF, 0x25EF }, { 0x2605, 0x2606 },+ { 0x2609, 0x2609 }, { 0x260E, 0x260F }, { 0x2614, 0x2615 },+ { 0x261C, 0x261C }, { 0x261E, 0x261E }, { 0x2640, 0x2640 },+ { 0x2642, 0x2642 }, { 0x2660, 0x2661 }, { 0x2663, 0x2665 },+ { 0x2667, 0x266A }, { 0x266C, 0x266D }, { 0x266F, 0x266F },+ { 0x273D, 0x273D }, { 0x2776, 0x277F }, { 0xE000, 0xF8FF },+ { 0xFFFD, 0xFFFD }, { 0xF0000, 0xFFFFD }, { 0x100000, 0x10FFFD }+ };++ /* binary search in table of non-spacing characters */+ if (bisearch(ucs, ambiguous,+ sizeof(ambiguous) / sizeof(struct interval) - 1))+ return 2;++ return mk_wcwidth(ucs);+}+++int mk_wcswidth_cjk(const wchar_t *pwcs, size_t n)+{+ int w, width = 0;++ for (;*pwcs && n-- > 0; pwcs++)+ if ((w = mk_wcwidth_cjk(*pwcs)) < 0)+ return -1;+ else+ width += w;++ return width;+}
haskeline.cabal view
@@ -1,6 +1,6 @@ Name: haskeline Cabal-Version: >=1.6-Version: 0.6.2.2+Version: 0.6.2.3 Category: User Interfaces License: BSD3 License-File: LICENSE@@ -24,10 +24,21 @@ flag base2 Description: Use the base packages from before version 6.8 +-- There are three main advantages to the terminfo backend over the portable,+-- "dumb" alternative. First, it enables more efficient control sequences+-- when redrawing the input. Second, and more importantly, it enables us+-- to draw on multiple lines, so we can wrap long input strings. And third,+-- the backend adds some extra key sequences such as forwards delete.+--+-- (The "dumb" terminal also allows editing of long input strings, but is+-- restricted to only one line and thus only shows part of the input at once.) flag terminfo Description: Use the terminfo package for POSIX consoles. Default: True +-- Note that the Setup script checks whether -liconv is necessary. This flag+-- lets us override that decision. When it is True, we use -liconv. When it+-- is False, we run tests to decide. flag libiconv Description: Explicitly link against the libiconv library. Default: False@@ -39,7 +50,7 @@ } else { if impl(ghc>=6.11) {- Build-depends: base >=4.1 && < 4.3, containers>=0.1 && < 0.4, directory==1.0.*,+ Build-depends: base >=4.1 && < 4.4, containers>=0.1 && < 0.4, directory==1.0.*, bytestring==0.9.* } else {@@ -47,7 +58,7 @@ bytestring==0.9.* } }- Build-depends: filepath==1.1.*, mtl==1.1.*,+ Build-depends: filepath >= 1.1 && < 1.3, mtl==1.1.*, utf8-string==0.3.* && >=0.3.6, extensible-exceptions==0.1.* && >=0.1.1.0 Extensions: ForeignFunctionInterface, Rank2Types, FlexibleInstances,@@ -94,14 +105,16 @@ 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 if flag(terminfo) {- Build-depends: terminfo>=0.3.1.1 && <0.4+ Build-depends: terminfo>=0.3.1.3 && <0.4 Other-modules: System.Console.Haskeline.Backend.Terminfo cpp-options: -DTERMINFO }