don't display blank regions once done

This commit is contained in:
Joey Hess 2015-11-04 16:57:36 -04:00
parent 340208f86b
commit e620073936
Failed to extract signature

View file

@ -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