From: Simon Marlow <simonmar@microsoft.com>
Date: Wed, 1 Mar 2006 13:19:48 +0000 (+0000)
Subject: add ':set prompt' command
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=fcd3864f6d56ad122b48d14093a0f01fe1a90ab8;hp=8e59ba46e26979cc11fa71e3f67aebbe6da4e8d6

add ':set prompt' command

contributed by Neil Mitchell <ndmitchell@gmail.com>, with docs by me.
---

diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs
index f8ee7bf..0424f6a 100644
--- a/ghc/compiler/ghci/InteractiveUI.hs
+++ b/ghc/compiler/ghci/InteractiveUI.hs
@@ -153,6 +153,7 @@ helpText =
  "   :set <option> ...           set options\n" ++
  "   :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" ++
  "\n" ++
  "   :show modules               show the currently loaded modules\n" ++
  "   :show bindings              show the current bindings made at the prompt\n" ++
@@ -220,6 +221,7 @@ interactiveUI session srcs maybe_expr = do
    startGHCi (runGHCi srcs maybe_expr)
 	GHCiState{ progname = "<interactive>",
 		   args = [],
+                   prompt = "%s> ",
 		   session = session,
 		   options = [] }
 
@@ -357,10 +359,11 @@ checkPerms name =
 #endif
 
 fileLoop :: Handle -> Bool -> GHCi ()
-fileLoop hdl prompt = do
+fileLoop hdl show_prompt = do
    session <- getSession
    (mod,imports) <- io (GHC.getContext session)
-   when prompt (io (putStr (mkPrompt mod imports)))
+   st <- getGHCiState
+   when show_prompt (io (putStr (mkPrompt mod imports (prompt st))))
    l <- io (IO.try (hGetLine hdl))
    case l of
 	Left e | isEOFError e		   -> return ()
@@ -373,9 +376,9 @@ fileLoop hdl prompt = do
 		-- EOF.
 	Right l -> 
 	  case removeSpaces l of
-	    "" -> fileLoop hdl prompt
+            "" -> fileLoop hdl show_prompt
 	    l  -> do quit <- runCommand l
-          	     if quit then return () else fileLoop hdl prompt
+                     if quit then return () else fileLoop hdl show_prompt
 
 stringLoop :: [String] -> GHCi ()
 stringLoop [] = return ()
@@ -385,10 +388,17 @@ stringLoop (s:ss) = do
 	l  -> do quit <- runCommand l
                  if quit then return () else stringLoop ss
 
-mkPrompt toplevs exports
-  = showSDoc (hsep (map (\m -> char '*' <> pprModule m) toplevs)
-	     <+> hsep (map pprModule exports)
-	     <> text "> ")
+mkPrompt toplevs exports prompt
+  = showSDoc $ f prompt
+    where
+        f ('%':'s':xs) = perc_s <> f xs
+        f ('%':'%':xs) = char '%' <> f xs
+        f (x:xs) = char x <> f xs
+        f [] = empty
+    
+        perc_s = hsep (map (\m -> char '*' <> pprModule m) toplevs) <+>
+                 hsep (map pprModule exports)
+             
 
 #ifdef USE_READLINE
 readlineLoop :: GHCi ()
@@ -397,7 +407,8 @@ readlineLoop = do
    (mod,imports) <- io (GHC.getContext session)
    io yield
    saveSession -- for use by completion
-   l <- io (readline (mkPrompt mod imports)
+   st <- getGHCiState
+   l <- io (readline (mkPrompt mod imports (prompt st))
 	  	`finally` setNonBlockingFD 0)
 		-- readline sometimes puts stdin into blocking mode,
 		-- so we need to put it back for the IO library
@@ -1055,6 +1066,7 @@ setCmd str
   = case words str of
 	("args":args) -> setArgs args
 	("prog":prog) -> setProg prog
+        ("prompt":prompt) -> setPrompt (dropWhile isSpace $ drop 6 $ dropWhile isSpace str)
 	wds -> setOptions wds
 
 setArgs args = do
@@ -1067,6 +1079,15 @@ setProg [prog] = do
 setProg _ = do
   io (hPutStrLn stderr "syntax: :set prog <progname>")
 
+setPrompt value = do
+  st <- getGHCiState
+  if null value
+      then io $ hPutStrLn stderr $ "syntax: :set prompt <prompt>, currently \"" ++ prompt st ++ "\""
+      else setGHCiState st{ prompt = remQuotes value }
+  where
+     remQuotes ('\"':xs) | not (null xs) && last xs == '\"' = init xs
+     remQuotes x = x
+
 setOptions wds =
    do -- first, deal with the GHCi opts (+s, +t, etc.)
       let (plus_opts, minus_opts)  = partition isPlus wds
@@ -1306,6 +1327,7 @@ data GHCiState = GHCiState
      { 
 	progname       :: String,
 	args	       :: [String],
+        prompt         :: String,
 	session        :: GHC.Session,
 	options        :: [GHCiOption]
      }
diff --git a/ghc/docs/users_guide/ghci.xml b/ghc/docs/users_guide/ghci.xml
index f4ae5a3..786815d 100644
--- a/ghc/docs/users_guide/ghci.xml
+++ b/ghc/docs/users_guide/ghci.xml
@@ -59,7 +59,8 @@ Prelude>
    :set &lt;option&gt; ...          set options
    :set args &lt;arg&gt; ...        set the arguments returned by System.getArgs
    :set prog &lt;progname&gt;       set the value returned by System.getProgName
-
+   :set prompt &lt;prompt&gt;       set the prompt used in GHCi
+ 
    :show modules              show the currently loaded modules
    :show bindings             show the current bindings made at the prompt
 
@@ -1096,7 +1097,7 @@ Prelude> :. cmds.ghci
       <varlistentry>
 	<term>
           <literal>:set</literal> <literal>args</literal> <replaceable>arg</replaceable> ...
-          <indexterm><primary><literal>:set</literal></primary></indexterm>
+          <indexterm><primary><literal>:set args</literal></primary></indexterm>
         </term>
 	<listitem>
 	  <para>Sets the list of arguments which are returned when the
@@ -1108,7 +1109,7 @@ Prelude> :. cmds.ghci
       <varlistentry>
 	<term>
            <literal>:set</literal> <literal>prog</literal> <replaceable>prog</replaceable>
-           <indexterm><primary><literal>:set</literal></primary></indexterm>
+           <indexterm><primary><literal>:set prog</literal></primary></indexterm>
         </term>
 	<listitem>
 	  <para>Sets the string to be returned when the program calls
@@ -1119,6 +1120,19 @@ Prelude> :. cmds.ghci
 
       <varlistentry>
 	<term>
+           <literal>:set</literal> <literal>prompt</literal> <replaceable>prompt</replaceable>
+        </term>
+	<listitem>
+	  <para>Sets the string to be used as the prompt in GHCi.
+	  Inside <replaceable>prompt</replaceable>, the sequence
+	  <literal>%s</literal> is replaced by the names of the
+	  modules currently in scope, and <literal>%%</literal> is
+	  replaced by <literal>%</literal>.</para>
+        </listitem>
+      </varlistentry>
+
+      <varlistentry>
+	<term>
           <literal>:show bindings</literal>
           <indexterm><primary><literal>:show bindings</literal></primary></indexterm>
         </term>