[commit: haskeline] master: Fix #73, again. (Pasting multiple lines might drop some characters.) (441b414)
Ian Lynagh
igloo at earth.li
Wed Oct 19 16:12:03 CEST 2011
Repository : ssh://darcs.haskell.org//srv/darcs/packages/haskeline
On branch : master
http://hackage.haskell.org/trac/ghc/changeset/441b41485bd89a7a99f047b1aa38094a8cd00ef5
>---------------------------------------------------------------
commit 441b41485bd89a7a99f047b1aa38094a8cd00ef5
Author: Judah Jacobson <judah.jacobson at gmail.com>
Date: Sun Oct 16 23:38:24 2011 +0000
Fix #73, again. (Pasting multiple lines might drop some characters.)
I think the regression occured when I fixed #106.
>---------------------------------------------------------------
System/Console/Haskeline/Backend/DumbTerm.hs | 1 +
System/Console/Haskeline/Backend/Terminfo.hs | 1 +
System/Console/Haskeline/Backend/Win32.hsc | 1 +
System/Console/Haskeline/RunCommand.hs | 22 +++++++++++++---------
System/Console/Haskeline/Term.hs | 3 +++
5 files changed, 19 insertions(+), 9 deletions(-)
diff --git a/System/Console/Haskeline/Backend/DumbTerm.hs b/System/Console/Haskeline/Backend/DumbTerm.hs
index 47cd138..f92301e 100644
--- a/System/Console/Haskeline/Backend/DumbTerm.hs
+++ b/System/Console/Haskeline/Backend/DumbTerm.hs
@@ -38,6 +38,7 @@ runDumbTerm h = do
TermOps {
getLayout = tryGetLayouts (posixLayouts h)
, withGetEvent = withPosixGetEvent ch h enc []
+ , saveUnusedKeys = saveKeys ch
, runTerm = \(RunTermType f) ->
runPosixT enc h
$ evalStateT' initWindow
diff --git a/System/Console/Haskeline/Backend/Terminfo.hs b/System/Console/Haskeline/Backend/Terminfo.hs
index 0e9582a..20eeac3 100644
--- a/System/Console/Haskeline/Backend/Terminfo.hs
+++ b/System/Console/Haskeline/Backend/Terminfo.hs
@@ -153,6 +153,7 @@ runTerminfoDraw h = do
, withGetEvent = wrapKeypad (hOut h) term
. withPosixGetEvent ch h enc
(terminfoKeys term)
+ , saveUnusedKeys = saveKeys ch
, runTerm = \(RunTermType f) ->
runPosixT enc h
$ evalStateT' initTermPos
diff --git a/System/Console/Haskeline/Backend/Win32.hsc b/System/Console/Haskeline/Backend/Win32.hsc
index bdc7bab..d66a805 100644
--- a/System/Console/Haskeline/Backend/Win32.hsc
+++ b/System/Console/Haskeline/Backend/Win32.hsc
@@ -360,6 +360,7 @@ win32Term = do
getLayout = getBufferSize (hOut hs)
, withGetEvent = withWindowMode hs
. win32WithEvent hs ch
+ , saveUnusedKeys = saveKeys ch
, runTerm = \(RunTermType f) ->
runReaderT' hs $ runDraw f
},
diff --git a/System/Console/Haskeline/RunCommand.hs b/System/Console/Haskeline/RunCommand.hs
index 6a81f8d..d499bbd 100644
--- a/System/Console/Haskeline/RunCommand.hs
+++ b/System/Console/Haskeline/RunCommand.hs
@@ -22,9 +22,9 @@ runCommandLoop' :: forall t m s a . (MonadTrans t, Term (t m), CommandMonad (t m
runCommandLoop' tops prefix initState cmds getEvent = do
let s = lineChars prefix initState
drawLine s
- readMoreKeys s (fmap ($ initState) cmds)
+ readMoreKeys s (fmap (liftM (\x -> (x,[])) . ($ initState)) cmds)
where
- readMoreKeys :: LineChars -> KeyMap (CmdM m a) -> t m a
+ readMoreKeys :: LineChars -> KeyMap (CmdM m (a,[Key])) -> t m a
readMoreKeys s next = do
event <- handle (\(e::SomeException) -> moveToNextLine s
>> throwIO e) getEvent
@@ -36,7 +36,7 @@ runCommandLoop' tops prefix initState cmds getEvent = do
bound_ks <- mapM (lift . asks . lookupKeyBinding) ks
loopCmd s $ applyKeysToMap (concat bound_ks) next
- loopCmd :: LineChars -> CmdM m a -> t m a
+ loopCmd :: LineChars -> CmdM m (a,[Key]) -> 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
@@ -47,7 +47,10 @@ runCommandLoop' tops prefix initState cmds getEvent = 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
+ loopCmd s (Result (x,ks)) = do
+ liftIO (saveUnusedKeys tops ks)
+ moveToNextLine s
+ return x
drawEffect :: (MonadTrans t, Term (t m), MonadReader Prefs m)
@@ -89,17 +92,18 @@ drawReposition tops s = do
---------------
-- 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
+-- Returns any unused keys (so that they can be applied at the next getInputLine).
+applyKeysToMap :: Monad m => [Key] -> KeyMap (CmdM m (a,[Key]))
+ -> CmdM m (a,[Key])
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 :: Monad m => [Key] -> CmdM m (a,[Key])
+ -> CmdM m (a,[Key])
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
+applyKeysToCmd ks (Result (x,ys)) = Result (x,ys++ks) -- use in the next input line
diff --git a/System/Console/Haskeline/Term.hs b/System/Console/Haskeline/Term.hs
index 0387878..3ba6ef5 100644
--- a/System/Console/Haskeline/Term.hs
+++ b/System/Console/Haskeline/Term.hs
@@ -45,6 +45,7 @@ data TermOps = TermOps {
, withGetEvent :: (MonadException m, CommandMonad m)
=> (m Event -> m a) -> m a
, runTerm :: (MonadException m, CommandMonad m) => RunTermType m a -> m a
+ , saveUnusedKeys :: [Key] -> IO ()
}
-- | Operations needed for file-style interaction.
@@ -112,6 +113,8 @@ keyEventLoop readEvents eventChan = do
Just ThreadKilled -> return ()
_ -> writeChan eventChan (ErrorEvent e)
+saveKeys :: Chan Event -> [Key] -> IO ()
+saveKeys ch = writeChan ch . KeyInput
data Interrupt = Interrupt
deriving (Show,Typeable,Eq)
More information about the Cvs-libraries
mailing list