don't display blank regions once done
This commit is contained in:
parent
340208f86b
commit
e620073936
1 changed files with 12 additions and 9 deletions
|
@ -18,8 +18,8 @@ import Types.Messages
|
||||||
#ifdef WITH_CONCURRENTOUTPUT
|
#ifdef WITH_CONCURRENTOUTPUT
|
||||||
import qualified System.Console.Concurrent as Console
|
import qualified System.Console.Concurrent as Console
|
||||||
import qualified System.Console.Regions as Regions
|
import qualified System.Console.Regions as Regions
|
||||||
import Data.String
|
|
||||||
import Control.Concurrent.STM
|
import Control.Concurrent.STM
|
||||||
|
import qualified Data.Text as T
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
withOutputType :: (OutputType -> Annex a) -> Annex a
|
withOutputType :: (OutputType -> Annex a) -> Annex a
|
||||||
|
@ -95,16 +95,18 @@ allowConcurrentOutput = id
|
||||||
- the value of the region is displayed in the scrolling area above
|
- the value of the region is displayed in the scrolling area above
|
||||||
- any other active regions.
|
- any other active regions.
|
||||||
-
|
-
|
||||||
- When not at a console, a region is not displayed until the end.
|
- When not at a console, a region is not displayed until the action is
|
||||||
|
- complete.
|
||||||
-}
|
-}
|
||||||
inOwnConsoleRegion :: Annex a -> Annex a
|
inOwnConsoleRegion :: Annex a -> Annex a
|
||||||
#ifdef WITH_CONCURRENTOUTPUT
|
#ifdef WITH_CONCURRENTOUTPUT
|
||||||
inOwnConsoleRegion a = Regions.withConsoleRegion Regions.Linear $ \r -> do
|
inOwnConsoleRegion a = bracket mkregion rmregion go
|
||||||
setregion (Just r)
|
|
||||||
a `finally` removeregion r
|
|
||||||
where
|
where
|
||||||
setregion r = Annex.changeState $ \s -> s { Annex.output = (Annex.output s) { consoleRegion = r } }
|
go r = do
|
||||||
removeregion r = do
|
setregion (Just r)
|
||||||
|
a
|
||||||
|
mkregion = Regions.openConsoleRegion Regions.Linear
|
||||||
|
rmregion r = do
|
||||||
errflag <- consoleRegionErrFlag <$> Annex.getState Annex.output
|
errflag <- consoleRegionErrFlag <$> Annex.getState Annex.output
|
||||||
let h = if errflag then Console.StdErr else Console.StdOut
|
let h = if errflag then Console.StdErr else Console.StdOut
|
||||||
Annex.changeState $ \s ->
|
Annex.changeState $ \s ->
|
||||||
|
@ -112,9 +114,10 @@ inOwnConsoleRegion a = Regions.withConsoleRegion Regions.Linear $ \r -> do
|
||||||
setregion Nothing
|
setregion Nothing
|
||||||
liftIO $ atomically $ do
|
liftIO $ atomically $ do
|
||||||
t <- Regions.getConsoleRegion r
|
t <- Regions.getConsoleRegion r
|
||||||
|
unless (T.null t) $
|
||||||
|
Console.bufferOutputSTM h t
|
||||||
Regions.closeConsoleRegion r
|
Regions.closeConsoleRegion r
|
||||||
Console.bufferOutputSTM h $
|
setregion r = Annex.changeState $ \s -> s { Annex.output = (Annex.output s) { consoleRegion = r } }
|
||||||
Console.toOutput (t <> fromString "\n")
|
|
||||||
#else
|
#else
|
||||||
inOwnConsoleRegion = id
|
inOwnConsoleRegion = id
|
||||||
#endif
|
#endif
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue