Add the ability to customize the continuation prompt.

- Remove unused property `def_prompt`.

2 files changed, 34 insertions, 19 deletions

diff --git a/ghc/GhciMonad.hs b/ghc/GhciMonad.hs
index e61e1409de..a3fe632493 100644
--- a/ghc/GhciMonad.hs
+++ b/ghc/GhciMonad.hs
@@ -64,7 +64,7 @@ data GHCiState = GHCiState
         progname       :: String,
         args           :: [String],
         prompt         :: String,
-        def_prompt     :: String,
+        prompt2        :: String,
         editor         :: String,
         stop           :: String,
         options        :: [GHCiOption],
diff --git a/ghc/InteractiveUI.hs b/ghc/InteractiveUI.hs
index 9c7104fb43..a6b08ead5a 100644
--- a/ghc/InteractiveUI.hs
+++ b/ghc/InteractiveUI.hs
@@ -109,7 +109,8 @@ data GhciSettings = GhciSettings {
         availableCommands :: [Command],
         shortHelpText     :: String,
         fullHelpText      :: String,
-        defPrompt         :: String
+        defPrompt         :: String,
+        defPrompt2        :: String
     }
 
 defaultGhciSettings :: GhciSettings
@@ -118,7 +119,8 @@ defaultGhciSettings =
         availableCommands = ghciCommands,
         shortHelpText     = defShortHelpText,
         fullHelpText      = defFullHelpText,
-        defPrompt         = default_prompt
+        defPrompt         = default_prompt,
+        defPrompt2        = default_prompt2
     }
 
 ghciWelcomeMsg :: String
@@ -285,6 +287,7 @@ defFullHelpText =
   "   :set args <arg> ...         set the arguments returned by System.getArgs\n" ++
   "   :set prog <progname>        set the value returned by System.getProgName\n" ++
   "   :set prompt <prompt>        set the prompt used in GHCi\n" ++
+  "   :set prompt2 <prompt>       set the continuation prompt used in GHCi\n" ++
   "   :set editor <cmd>           set the command used for :edit\n" ++
   "   :set stop [<n>] <cmd>       set the command to run when a breakpoint is hit\n" ++
   "   :unset <option> ...         unset options\n" ++
@@ -327,9 +330,10 @@ findEditor = do
 
 foreign import ccall unsafe "rts_isProfiled" isProfiled :: IO CInt
 
-default_progname, default_prompt, default_stop :: String
+default_progname, default_prompt, default_prompt2, default_stop :: String
 default_progname = "<interactive>"
 default_prompt = "%s> "
+default_prompt2 = "%s| "
 default_stop = ""
 
 default_args :: [String]
@@ -393,7 +397,7 @@ interactiveUI config srcs maybe_exprs = do
         GHCiState{ progname       = default_progname,
                    GhciMonad.args = default_args,
                    prompt         = defPrompt config,
-                   def_prompt     = defPrompt config,
+                   prompt2        = defPrompt2 config,
                    stop           = default_stop,
                    editor         = default_editor,
                    options        = [],
@@ -704,7 +708,7 @@ runOneCommand eh gCmd = do
     multiLineCmd q = do
       st <- lift getGHCiState
       let p = prompt st
-      lift $ setGHCiState st{ prompt = "%s| " }
+      lift $ setGHCiState st{ prompt = prompt2 st }
       mb_cmd <- collectCommand q ""
       lift $ getGHCiState >>= \st' -> setGHCiState st'{ prompt = p }
       return mb_cmd
@@ -1880,7 +1884,8 @@ setCmd str
         case toArgs rest of
             Right [prog] -> setProg prog
             _ -> liftIO (hPutStrLn stderr "syntax: :set prog <progname>")
-    Right ("prompt", rest) -> setPrompt $ Just $ dropWhile isSpace rest
+    Right ("prompt", rest) -> setPrompt $ dropWhile isSpace rest
+    Right ("prompt2", rest) -> setPrompt2 $ dropWhile isSpace rest
     Right ("editor", rest) -> setEditor $ dropWhile isSpace rest
     Right ("stop",   rest) -> setStop   $ dropWhile isSpace rest
     _ -> case toArgs str of
@@ -1975,22 +1980,30 @@ setStop cmd = do
   st <- getGHCiState
   setGHCiState st{ stop = cmd }
 
-setPrompt :: Maybe String -> GHCi ()
-setPrompt Nothing = do
-    st <- getGHCiState
-    setGHCiState ( st { prompt = def_prompt st } )
+setPrompt :: String -> GHCi ()
+setPrompt = setPrompt_ f err
+  where
+    f v st = st { prompt = v }
+    err st = "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
+
+setPrompt2 :: String -> GHCi ()
+setPrompt2 = setPrompt_ f err
+  where
+    f v st = st { prompt2 = v }
+    err st = "syntax: :set prompt2 <prompt>, currently \"" ++ prompt2 st ++ "\""
 
-setPrompt (Just value) = do
+setPrompt_ :: (String -> GHCiState -> GHCiState) -> (GHCiState -> String) -> String -> GHCi ()
+setPrompt_ f err value = do
   st <- getGHCiState
   if null value
-      then liftIO $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
+      then liftIO $ hPutStrLn stderr $ err st
       else case value of
            '\"' : _ -> case reads value of
                        [(value', xs)] | all isSpace xs ->
-                           setGHCiState (st { prompt = value' })
+                           setGHCiState $ f value' st
                        _ ->
                            liftIO $ hPutStrLn stderr "Can't parse prompt string. Use Haskell syntax."
-           _ -> setGHCiState (st { prompt = value })
+           _ -> setGHCiState $ f value st
 
 setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
@@ -2056,7 +2069,8 @@ unsetOptions str
          defaulters =
            [ ("args"  , setArgs default_args)
            , ("prog"  , setProg default_progname)
-           , ("prompt", setPrompt Nothing)
+           , ("prompt", setPrompt default_prompt)
+           , ("prompt2", setPrompt2 default_prompt2)
            , ("editor", liftIO findEditor >>= setEditor)
            , ("stop"  , setStop default_stop)
            ]
@@ -2120,6 +2134,7 @@ showCmd str = do
         ["args"]     -> liftIO $ putStrLn (show (GhciMonad.args st))
         ["prog"]     -> liftIO $ putStrLn (show (progname st))
         ["prompt"]   -> liftIO $ putStrLn (show (prompt st))
+        ["prompt2"]  -> liftIO $ putStrLn (show (prompt2 st))
         ["editor"]   -> liftIO $ putStrLn (show (editor st))
         ["stop"]     -> liftIO $ putStrLn (show (stop st))
         ["imports"]  -> showImports
@@ -2134,7 +2149,7 @@ showCmd str = do
         ["languages"] -> showLanguages -- backwards compat
         ["language"]  -> showLanguages
         ["lang"]      -> showLanguages -- useful abbreviation
-        _ -> throwGhcException (CmdLineError ("syntax:  :show [ args | prog | prompt | editor | stop | modules | bindings\n"++
+        _ -> throwGhcException (CmdLineError ("syntax:  :show [ args | prog | prompt | prompt2 | editor | stop | modules | bindings\n"++
                                      "               | breaks | context | packages | language ]"))
 
 showiCmd :: String -> GHCi ()
@@ -2346,7 +2361,7 @@ listHomeModules w = do
 
 completeSetOptions = wrapCompleter flagWordBreakChars $ \w -> do
   return (filter (w `isPrefixOf`) opts)
-    where opts = "args":"prog":"prompt":"editor":"stop":flagList
+    where opts = "args":"prog":"prompt":"prompt2":"editor":"stop":flagList
           flagList = map head $ group $ sort allFlags
 
 completeSeti = wrapCompleter flagWordBreakChars $ \w -> do
@@ -2355,7 +2370,7 @@ completeSeti = wrapCompleter flagWordBreakChars $ \w -> do
 
 completeShowOptions = wrapCompleter flagWordBreakChars $ \w -> do
   return (filter (w `isPrefixOf`) opts)
-    where opts = ["args", "prog", "prompt", "editor", "stop",
+    where opts = ["args", "prog", "prompt", "prompt2", "editor", "stop",
                      "modules", "bindings", "linker", "breaks",
                      "context", "packages", "language"]