arrange for regional output manager to run when -J is enabled

Commands that want to use it have to run their seek action inside
allowConcurrentOutput. Which seems reasonable; perhaps some future command
will want to support the -J flag but not use regions.

The region state moved from Annex to MessageState. This makes sense
organizationally, and note that some uses of onLocal use a different Annex
state, but pass the MessageState into it, which is what is needed.

2 files changed, 23 insertions, 22 deletions

diff --git a/Messages/Internal.hs b/Messages/Internal.hs
index 8bbb0cfc8..e4651238b 100644
--- a/Messages/Internal.hs
+++ b/Messages/Internal.hs
@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-{- git-annex output messages, including concurrent output
+{- git-annex output messages, including concurrent output to display regions
  -
  - Copyright 2010-2015 Joey Hess <id@joeyh.name>
  -
@@ -58,35 +58,38 @@ flushed a = a >> hFlush stdout
  -}
 concurrentMessage :: Bool -> String -> Annex () -> Annex ()
 #ifdef WITH_CONCURRENTOUTPUT
-concurrentMessage iserror msg _ = go =<< Annex.getState Annex.consoleregion
+concurrentMessage iserror msg _ = go =<< consoleRegion <$> Annex.getState Annex.output
   where
 	go Nothing
 		| iserror = liftIO $ Console.errorConcurrent msg
-		| otherwise = liftIO $ Console.outputConcurrent msg
+		| otherwise = do
+			liftIO $ Console.outputConcurrent ("REGION MESSAGE NO REGION" ++ show msg)
+			liftIO $ Console.outputConcurrent msg
 	go (Just r) = do
+		liftIO $ Console.outputConcurrent ("REGION MESSAGE " ++ show msg)
 		-- Can't display the error to stdout while
 		-- console regions are in use, so set the errflag
 		-- to get it to display to stderr later.
-		when iserror $
-			Annex.changeState $ \s -> s { Annex.consoleregionerrflag = True }
+		when iserror $ do
+			Annex.changeState $ \s ->
+				s { Annex.output = (Annex.output s) { consoleRegionErrFlag = True } }
 		liftIO $ Regions.appendConsoleRegion r msg
 #else
 concurrentMessage _ _ fallback = fallback
 #endif
 
-{- Enable concurrent output when that has been requested.
- -
- - This should only be run once per git-annex lifetime, with
- - everything that might generate messages run inside it.
- -}
-withConcurrentOutput :: Annex a -> Annex a
+{- Do concurrent output when that has been requested. -}
+allowConcurrentOutput :: Annex a -> Annex a
 #ifdef WITH_CONCURRENTOUTPUT
-withConcurrentOutput a = withOutputType go
+allowConcurrentOutput a = go =<< Annex.getState Annex.concurrentjobs
   where
-	go (ConcurrentOutput _) = Console.withConcurrentOutput a
-	go _ = a
+	go (Just n) = Regions.displayConsoleRegions $ bracket_
+		(Annex.setOutput (ConcurrentOutput n))
+		(Annex.setOutput NormalOutput)
+		a
+	go Nothing = a
 #else
-withConcurrentOutput = id
+allowConcurrentOutput = id
 #endif
 
 {- Runs an action in its own dedicated region of the console.
@@ -103,11 +106,12 @@ inOwnConsoleRegion a = Regions.withConsoleRegion Regions.Linear $ \r -> do
 	setregion (Just r)
 	a `finally` removeregion r
   where
-	setregion v = Annex.changeState $ \s -> s { Annex.consoleregion = v }
+	setregion r = Annex.changeState $ \s -> s { Annex.output = (Annex.output s) { consoleRegion = r } }
 	removeregion r = do
-		errflag <- Annex.getState Annex.consoleregionerrflag
+		errflag <- consoleRegionErrFlag <$> Annex.getState Annex.output
 		let h = if errflag then Console.StdErr else Console.StdOut
-		Annex.changeState $ \s -> s { Annex.consoleregionerrflag = False }
+		Annex.changeState $ \s ->
+			s { Annex.output = (Annex.output s) { consoleRegionErrFlag = False } }
 		setregion Nothing
 		liftIO $ atomically $ do
 			t <- Regions.getConsoleRegion r
diff --git a/Messages/Progress.hs b/Messages/Progress.hs
index a20ba098e..89f2f0c8c 100644
--- a/Messages/Progress.hs
+++ b/Messages/Progress.hs
@@ -65,10 +65,7 @@ metered combinemeterupdate key af a = case keySize key of
 		return r
 #else
 	-- Old progress bar code, not suitable for concurrent output.
-	go _ (ConcurrentOutput _) = do
-		r <- nometer
-		liftIO $ putStrLn $ fromMaybe (key2file key) af
-		return r
+	go _ (ConcurrentOutput _) = nometer
 	go size NormalOutput = do
 		showOutput
 		progress <- liftIO $ newProgress "" size