diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2017-05-16 15:28:06 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2017-05-16 15:50:11 -0400 |
| commit | 5f2ce9e7dfd19a387b79334bb3e1c496221663aa (patch) | |
| tree | 92f9e9c34186884f7c8f920375b1afcded731a7e /Messages.hs | |
| parent | 68b490cd2863ef39b9c478a9da566802f3cccb1d (diff) | |
clear regions before ssh prompt
When built with concurrent-output 1.9, ssh password prompts will no longer
interfere with the -J display.
To avoid flicker, only done when ssh actually does need to prompt;
ssh is first run in batch mode and if that succeeds the connection is up
and no need to clear regions.
This commit was supported by the NSF-funded DataLad project.
Diffstat (limited to 'Messages.hs')
| -rw-r--r-- | Messages.hs | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/Messages.hs b/Messages.hs index 83ea91dbc..ff13b31ee 100644 --- a/Messages.hs +++ b/Messages.hs @@ -56,6 +56,7 @@ import Types.Messages import Types.ActionItem import Types.Concurrency import Messages.Internal +import Messages.Concurrent import qualified Messages.JSON as JSON import qualified Annex @@ -227,10 +228,13 @@ implicitMessage = whenM (implicitMessages <$> Annex.getState Annex.output) - that the action is the only thing using the console, and can eg prompt - the user. -} -prompt :: (Concurrency -> Annex a) -> Annex a +prompt :: Annex a -> Annex a prompt a = go =<< Annex.getState Annex.concurrency where - go NonConcurrent = a NonConcurrent - go c@(Concurrent {}) = withMessageState $ \s -> do + go NonConcurrent = a + go (Concurrent {}) = withMessageState $ \s -> do let l = promptLock s - bracketIO (takeMVar l) (putMVar l) (const (a c)) + bracketIO + (takeMVar l) + (putMVar l) + (const $ hideRegionsWhile a) |