X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fghci%2FInteractiveUI.hs;h=b4c1f6ee5e5fc2bd8e4faf793da08bfc0faffedf;hb=2423c249f5ca7785d0ec89eb33e72662da7561c1;hp=485e329d3975cfa012457da27a187ae7b062ed3e;hpb=bd6cfcc12e3a047b1fd6d62cf79ea2cc2bd010b9;p=ghc-hetmet.git diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs index 485e329..b4c1f6e 100644 --- a/compiler/ghci/InteractiveUI.hs +++ b/compiler/ghci/InteractiveUI.hs @@ -3,7 +3,7 @@ -- -- GHC Interactive User Interface -- --- (c) The GHC Team 2005 +-- (c) The GHC Team 2005-2006 -- ----------------------------------------------------------------------------- module InteractiveUI ( @@ -17,48 +17,40 @@ module InteractiveUI ( import GHC.Exts ( Int(..), Ptr(..), int2Addr# ) import Foreign.StablePtr ( deRefStablePtr, castPtrToStablePtr ) import System.IO.Unsafe ( unsafePerformIO ) -import Var ( Id, globaliseId, idName, idType ) -import HscTypes ( Session(..), InteractiveContext(..), HscEnv(..) - , extendTypeEnvWithIds ) -import RdrName ( extendLocalRdrEnv, mkRdrUnqual, lookupLocalRdrEnv ) -import NameEnv ( delListFromNameEnv ) -import TcType ( tidyTopType ) -import qualified Id ( setIdType ) -import IdInfo ( GlobalIdDetails(..) ) -import Linker ( HValue, extendLinkEnv, withExtendedLinkEnv, - initDynLinker ) -import PrelNames ( breakpointJumpName, breakpointCondJumpName ) +import Var +import HscTypes +import RdrName +import NameEnv +import TcType +import qualified Id +import IdInfo +import PrelNames #endif -- The GHC interface import qualified GHC -import GHC ( Session, dopt, DynFlag(..), Target(..), - TargetId(..), DynFlags(..), - pprModule, Type, Module, ModuleName, SuccessFlag(..), - TyThing(..), Name, LoadHowMuch(..), Phase, - GhcException(..), showGhcException, - CheckedModule(..), SrcLoc ) -import DynFlags ( allFlags ) -import Packages ( PackageState(..) ) -import PackageConfig ( InstalledPackageInfo(..) ) -import UniqFM ( eltsUFM ) +import GHC ( Session, LoadHowMuch(..), Target(..), TargetId(..), + Type, Module, ModuleName, TyThing(..), Phase ) +import DynFlags +import Packages +import PackageConfig +import UniqFM import PprTyThing import Outputable --- for createtags (should these come via GHC?) -import Name ( nameSrcLoc, nameModule, nameOccName ) -import OccName ( pprOccName ) -import SrcLoc ( isGoodSrcLoc, srcLocFile, srcLocLine, srcLocCol ) +-- for createtags +import Name +import OccName +import SrcLoc -- Other random utilities -import Digraph ( flattenSCCs ) -import BasicTypes ( failed, successIf ) -import Panic ( panic, installSignalHandlers ) +import Digraph +import BasicTypes +import Panic hiding (showException) import Config -import StaticFlags ( opt_IgnoreDotGhci ) -import Linker ( showLinkerState, linkPackages ) -import Util ( removeSpaces, handle, global, toArgs, - looksLikeModuleName, prefixMatch, sortLe ) +import StaticFlags +import Linker +import Util #ifndef mingw32_HOST_OS import System.Posix @@ -68,6 +60,7 @@ import System.Posix #else import GHC.ConsoleHandler ( flushConsole ) import System.Win32 ( setConsoleCP, setConsoleOutputCP ) +import qualified System.Win32 #endif #ifdef USE_READLINE @@ -123,6 +116,9 @@ builtin_commands = [ ("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), @@ -159,6 +155,8 @@ helpText = " :browse [*] display the names defined by \n" ++ " :cd change directory to \n" ++ " :def define a command :\n" ++ + " :edit edit file\n" ++ + " :edit edit last module\n" ++ " :help, :? display this list of commands\n" ++ " :info [ ...] display information about the given names\n" ++ " :load ... load module(s) and their dependents\n" ++ @@ -170,12 +168,13 @@ helpText = " :set args ... set the arguments returned by System.getArgs\n" ++ " :set prog set the value returned by System.getProgName\n" ++ " :set prompt set the prompt used in GHCi\n" ++ + " :set editor set the command 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" ++ " :ctags [] create tags file for Vi (default: \"tags\")\n" ++ - " :etags [] create tags file for Emacs (defauilt: \"TAGS\")\n" ++ + " :etags [] create tags file for Emacs (default: \"TAGS\")\n" ++ " :type show the type of \n" ++ " :kind show the kind of \n" ++ " :undef undefine user-defined command :\n" ++ @@ -242,11 +241,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 + default_editor <- findEditor withExtendedLinkEnv (zip names hValues) $ startGHCi (interactiveLoop is_tty True) GHCiState{ progname = "", args = [], prompt = location++"> ", + editor = default_editor, session = session, options = [], prelude = prel_mod } @@ -255,6 +256,16 @@ jumpFunction session@(Session ref) (I# idsPtr) hValues location b return b #endif +findEditor = do + getEnv "EDITOR" + `IO.catch` \_ -> do +#if mingw32_HOST_OS + win <- System.Win32.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) @@ -306,10 +317,13 @@ interactiveUI session srcs maybe_expr = do Readline.setCompleterWordBreakCharacters word_break_chars #endif + default_editor <- findEditor + startGHCi (runGHCi srcs maybe_expr) GHCiState{ progname = "", args = [], prompt = "%s> ", + editor = default_editor, session = session, options = [], prelude = prel_mod } @@ -638,7 +652,7 @@ GLOBAL_VAR(turn_off_buffering, error "no flush_stdout", IO ()) no_buf_cmd = "System.IO.hSetBuffering System.IO.stdout System.IO.NoBuffering" ++ " Prelude.>> System.IO.hSetBuffering System.IO.stderr System.IO.NoBuffering" -flush_cmd = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush IO.stderr" +flush_cmd = "System.IO.hFlush System.IO.stdout Prelude.>> System.IO.hFlush System.IO.stderr" initInterpBuffering :: Session -> IO () initInterpBuffering session @@ -695,7 +709,8 @@ info s = do { let names = words s filterOutChildren :: [Name] -> [Name] filterOutChildren names = filter (not . parent_is_there) names where parent_is_there n - | Just p <- GHC.nameParent_maybe n = p `elem` names +-- | Just p <- GHC.nameParent_maybe n = p `elem` names +-- ToDo!! | otherwise = False pprInfo exts (thing, fixity, insts) @@ -739,6 +754,27 @@ changeDirectory dir = do 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 @@ -820,7 +856,7 @@ checkModule m = do case result of Nothing -> io $ putStrLn "Nothing" Just r -> io $ putStrLn (showSDoc ( - case checkedModuleInfo r of + case GHC.checkedModuleInfo r of Just cm | Just scope <- GHC.modInfoTopLevelScope cm -> let (local,global) = partition ((== modl) . GHC.moduleName . GHC.nameModule) scope @@ -1169,11 +1205,13 @@ setCmd "" 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 - ("prompt":prompt) -> setPrompt (dropWhile isSpace $ drop 6 $ dropWhile isSpace str) + ("prompt":prompt) -> setPrompt (after 6) + ("editor":cmd) -> setEditor (after 6) wds -> setOptions wds + where after n = dropWhile isSpace $ drop n $ dropWhile isSpace str setArgs args = do st <- getGHCiState @@ -1185,6 +1223,10 @@ setProg [prog] = do setProg _ = do io (hPutStrLn stderr "syntax: :set prog ") +setEditor cmd = do + st <- getGHCiState + setGHCiState st{ editor = cmd } + setPrompt value = do st <- getGHCiState if null value @@ -1431,6 +1473,7 @@ data GHCiState = GHCiState progname :: String, args :: [String], prompt :: String, + editor :: String, session :: GHC.Session, options :: [GHCiOption], prelude :: Module