unbreak :edit patch on Windows

[ghc-hetmet.git] / compiler / ghci / InteractiveUI.hs

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index f7ff7ae..909eaec 100644 (file)
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -26,7 +26,7 @@ import TcType           ( tidyTopType )
 import qualified Id     ( setIdType )
 import IdInfo           ( GlobalIdDetails(..) )
 import Linker           ( HValue, extendLinkEnv, withExtendedLinkEnv,
 import qualified Id     ( setIdType )
 import IdInfo           ( GlobalIdDetails(..) )
 import Linker           ( HValue, extendLinkEnv, withExtendedLinkEnv,

-                          initDynLinker, linkPackages )
+                          initDynLinker )

 import PrelNames        ( breakpointJumpName, breakpointCondJumpName )
 #endif
 
 import PrelNames        ( breakpointJumpName, breakpointCondJumpName )
 #endif
 

@@ -56,7 +56,7 @@ import BasicTypes     ( failed, successIf )
 import Panic           ( panic, installSignalHandlers )
 import Config
 import StaticFlags     ( opt_IgnoreDotGhci )
 import Panic           ( panic, installSignalHandlers )
 import Config
 import StaticFlags     ( opt_IgnoreDotGhci )

-import Linker          ( showLinkerState )
+import Linker          ( showLinkerState, linkPackages )

 import Util            ( removeSpaces, handle, global, toArgs,
                          looksLikeModuleName, prefixMatch, sortLe )
 
 import Util            ( removeSpaces, handle, global, toArgs,
                          looksLikeModuleName, prefixMatch, sortLe )
 

@@ -84,7 +84,7 @@ import Data.Dynamic
 import Numeric
 import Data.List
 import Data.Int                ( Int64 )
 import Numeric
 import Data.List
 import Data.Int                ( Int64 )

-import Data.Maybe      ( isJust, fromMaybe, catMaybes )
+import Data.Maybe      ( isJust, isNothing, fromMaybe, catMaybes )

 import System.Cmd
 import System.CPUTime
 import System.Environment
 import System.Cmd
 import System.CPUTime
 import System.Environment

@@ -123,6 +123,9 @@ builtin_commands = [
   ("browse",    keepGoing browseCmd,           False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),
   ("browse",    keepGoing browseCmd,           False, completeModule),
   ("cd",       keepGoing changeDirectory,      False, completeFilename),
   ("def",      keepGoing defineMacro,          False, completeIdentifier),

+  ("e",        keepGoing editFile,             False, completeFilename),
+       -- Hugs users are accustomed to :e, so make sure it doesn't overlap
+  ("edit",     keepGoing editFile,             False, completeFilename),

   ("help",     keepGoing help,                 False, completeNone),
   ("?",                keepGoing help,                 False, completeNone),
   ("info",      keepGoing info,                        False, completeIdentifier),
   ("help",     keepGoing help,                 False, completeNone),
   ("?",                keepGoing help,                 False, completeNone),
   ("info",      keepGoing info,                        False, completeIdentifier),

@@ -159,6 +162,8 @@ helpText =
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++
  "   :browse [*]<module>         display the names defined by <module>\n" ++
  "   :cd <dir>                   change directory to <dir>\n" ++
  "   :def <cmd> <expr>           define a command :<cmd>\n" ++

+ "   :edit <file>                edit file\n" ++
+ "   :edit                       edit last module\n" ++

  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++
  "   :help, :?                   display this list of commands\n" ++
  "   :info [<name> ...]          display information about the given names\n" ++
  "   :load <filename> ...        load module(s) and their dependents\n" ++

@@ -170,6 +175,7 @@ helpText =
  "   :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 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 editor <cmd>           set the comand used for :edit\n" ++

  "\n" ++
  "   :show modules               show the currently loaded modules\n" ++
  "   :show bindings              show the current bindings made at the prompt\n" ++
  "\n" ++
  "   :show modules               show the currently loaded modules\n" ++
  "   :show bindings              show the current bindings made at the prompt\n" ++

@@ -242,11 +248,13 @@ jumpFunction session@(Session ref) (I# idsPtr) hValues location b
          writeIORef ref (hsc_env { hsc_IC = new_ic })
          is_tty <- hIsTerminalDevice stdin
          prel_mod <- GHC.findModule session prel_name Nothing
          writeIORef ref (hsc_env { hsc_IC = new_ic })
          is_tty <- hIsTerminalDevice stdin
          prel_mod <- GHC.findModule session prel_name Nothing

+        default_editor <- findEditor

          withExtendedLinkEnv (zip names hValues) $
            startGHCi (interactiveLoop is_tty True)
                      GHCiState{ progname = "<interactive>",
                                 args = [],
                                 prompt = location++"> ",
          withExtendedLinkEnv (zip names hValues) $
            startGHCi (interactiveLoop is_tty True)
                      GHCiState{ progname = "<interactive>",
                                 args = [],
                                 prompt = location++"> ",

+                               editor = default_editor,

                                 session = session,
                                 options = [],
                                 prelude =  prel_mod }
                                 session = session,
                                 options = [],
                                 prelude =  prel_mod }

@@ -255,6 +263,17 @@ jumpFunction session@(Session ref) (I# idsPtr) hValues location b
          return b
 #endif
 
          return b
 #endif
 

+findEditor = do
+  getEnv "EDITOR" 
+    `IO.catch` \_ -> do
+#if 0
+       -- ToDo: mingw32_HOST_OS
+       win <- getWindowsDirectory
+       return (win `joinFileName` "notepad.exe")
+#else
+       return ""
+#endif
+

 interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
 interactiveUI session srcs maybe_expr = do
 #if defined(GHCI) && defined(BREAKPOINT)
 interactiveUI :: Session -> [(FilePath, Maybe Phase)] -> Maybe String -> IO ()
 interactiveUI session srcs maybe_expr = do
 #if defined(GHCI) && defined(BREAKPOINT)

@@ -274,15 +293,19 @@ interactiveUI session srcs maybe_expr = do
    newStablePtr stdout
    newStablePtr stderr
 
    newStablePtr stdout
    newStablePtr stderr
 

-   hFlush stdout
-   hSetBuffering stdout NoBuffering
-

        -- Initialise buffering for the *interpreted* I/O system
    initInterpBuffering session
 
        -- Initialise buffering for the *interpreted* I/O system
    initInterpBuffering session
 

+   when (isNothing maybe_expr) $ do
+       -- Only for GHCi (not runghc and ghc -e):
+       -- Turn buffering off for the compiled program's stdout/stderr
+       turnOffBuffering
+       -- Turn buffering off for GHCi's stdout
+       hFlush stdout
+       hSetBuffering stdout NoBuffering

        -- We don't want the cmd line to buffer any input that might be
        -- intended for the program, so unbuffer stdin.
        -- We don't want the cmd line to buffer any input that might be
        -- intended for the program, so unbuffer stdin.

-   hSetBuffering stdin NoBuffering
+       hSetBuffering stdin NoBuffering

 
        -- initial context is just the Prelude
    prel_mod <- GHC.findModule session prel_name Nothing
 
        -- initial context is just the Prelude
    prel_mod <- GHC.findModule session prel_name Nothing

@@ -302,10 +325,13 @@ interactiveUI session srcs maybe_expr = do
    Readline.setCompleterWordBreakCharacters word_break_chars
 #endif
 
    Readline.setCompleterWordBreakCharacters word_break_chars
 #endif
 

+   default_editor <- findEditor
+

    startGHCi (runGHCi srcs maybe_expr)
        GHCiState{ progname = "<interactive>",
                   args = [],
                    prompt = "%s> ",
    startGHCi (runGHCi srcs maybe_expr)
        GHCiState{ progname = "<interactive>",
                   args = [],
                    prompt = "%s> ",

+                  editor = default_editor,

                   session = session,
                   options = [],
                    prelude = prel_mod }
                   session = session,
                   options = [],
                    prelude = prel_mod }

@@ -649,8 +675,6 @@ initInterpBuffering session
        Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
        _         -> panic "interactiveUI:flush"
 
        Just hval -> writeIORef flush_interp (unsafeCoerce# hval :: IO ())
        _         -> panic "interactiveUI:flush"
 

-      turnOffBuffering -- Turn it off right now
-

       return ()
 
 
       return ()
 
 

@@ -737,6 +761,27 @@ changeDirectory dir = do
   dir <- expandPath dir
   io (setCurrentDirectory dir)
 
   dir <- expandPath dir
   io (setCurrentDirectory dir)
 

+editFile :: String -> GHCi ()
+editFile str
+  | null str  = do
+       -- find the name of the "topmost" file loaded
+     session <- getSession
+     graph0 <- io (GHC.getModuleGraph session)
+     graph1 <- filterM (io . GHC.isLoaded session . GHC.ms_mod_name) graph0
+     let graph2 = flattenSCCs (GHC.topSortModuleGraph True graph1 Nothing)
+     case GHC.ml_hs_file (GHC.ms_location (last graph2)) of
+       Just file -> do_edit file
+       Nothing   -> throwDyn (CmdLineError "unknown file name")
+  | otherwise = do_edit str
+  where
+       do_edit file = do
+          st <- getGHCiState
+          let cmd = editor st
+          when (null cmd) $ 
+               throwDyn (CmdLineError "editor not set, use :set editor")
+          io $ system (cmd ++ ' ':file)
+           return ()
+

 defineMacro :: String -> GHCi ()
 defineMacro s = do
   let (macro_name, definition) = break isSpace s
 defineMacro :: String -> GHCi ()
 defineMacro s = do
   let (macro_name, definition) = break isSpace s

@@ -1167,11 +1212,13 @@ setCmd ""
                   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
           ))
 setCmd str
                   else hsep (map (\o -> char '+' <> text (optToStr o)) opts)
           ))
 setCmd str

-  = case words str of
+  = case toArgs str of

        ("args":args) -> setArgs args
        ("prog":prog) -> setProg prog
        ("args":args) -> setArgs args
        ("prog":prog) -> setProg prog

-        ("prompt":prompt) -> setPrompt (dropWhile isSpace $ drop 6 $ dropWhile isSpace str)
+        ("prompt":prompt) -> setPrompt (after 6)
+        ("editor":cmd) -> setEditor (after 6)

        wds -> setOptions wds
        wds -> setOptions wds

+   where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str

 
 setArgs args = do
   st <- getGHCiState
 
 setArgs args = do
   st <- getGHCiState

@@ -1183,6 +1230,10 @@ setProg [prog] = do
 setProg _ = do
   io (hPutStrLn stderr "syntax: :set prog <progname>")
 
 setProg _ = do
   io (hPutStrLn stderr "syntax: :set prog <progname>")
 

+setEditor cmd = do
+  st <- getGHCiState
+  setGHCiState st{ editor = cmd }
+

 setPrompt value = do
   st <- getGHCiState
   if null value
 setPrompt value = do
   st <- getGHCiState
   if null value

@@ -1429,6 +1480,7 @@ data GHCiState = GHCiState
        progname       :: String,
        args           :: [String],
         prompt         :: String,
        progname       :: String,
        args           :: [String],
         prompt         :: String,

+       editor         :: String,

        session        :: GHC.Session,
        options        :: [GHCiOption],
         prelude        :: Module
        session        :: GHC.Session,
        options        :: [GHCiOption],
         prelude        :: Module