+-- -----------------------------------------------------------------------------
+-- Completion
+
+completeNone :: String -> IO [String]
+completeNone w = return []
+
+#ifdef USE_READLINE
+completeWord :: String -> Int -> Int -> IO (Maybe (String, [String]))
+completeWord w start end = do
+ line <- Readline.getLineBuffer
+ case w of
+ ':':_ | all isSpace (take (start-1) line) -> wrapCompleter completeCmd w
+ _other
+ | Just c <- is_cmd line -> do
+ maybe_cmd <- lookupCommand c
+ let (n,w') = selectWord (words' 0 line)
+ case maybe_cmd of
+ Nothing -> return Nothing
+ Just (_,_,False,complete) -> wrapCompleter complete w
+ Just (_,_,True,complete) -> let complete' w = do rets <- complete w
+ return (map (drop n) rets)
+ in wrapCompleter complete' w'
+ | otherwise -> do
+ --printf "complete %s, start = %d, end = %d\n" w start end
+ wrapCompleter completeIdentifier w
+ where words' _ [] = []
+ words' n str = let (w,r) = break isSpace str
+ (s,r') = span isSpace r
+ in (n,w):words' (n+length w+length s) r'
+ -- In a Haskell expression we want to parse 'a-b' as three words
+ -- where a compiler flag (ie. -fno-monomorphism-restriction) should
+ -- only be a single word.
+ selectWord [] = (0,w)
+ selectWord ((offset,x):xs)
+ | offset+length x >= start = (start-offset,take (end-offset) x)
+ | otherwise = selectWord xs
+
+is_cmd line
+ | ((':':w) : _) <- words (dropWhile isSpace line) = Just w
+ | otherwise = Nothing
+
+completeCmd w = do
+ cmds <- readIORef commands
+ return (filter (w `isPrefixOf`) (map (':':) (map cmdName cmds)))
+
+completeMacro w = do
+ cmds <- readIORef commands
+ let cmds' = [ cmd | cmd <- map cmdName cmds, cmd `elem` map cmdName builtin_commands ]
+ return (filter (w `isPrefixOf`) cmds')
+
+completeIdentifier w = do
+ s <- restoreSession
+ rdrs <- GHC.getRdrNamesInScope s
+ return (filter (w `isPrefixOf`) (map (showSDoc.ppr) rdrs))
+
+completeModule w = do
+ s <- restoreSession
+ dflags <- GHC.getSessionDynFlags s
+ let pkg_mods = allExposedModules dflags
+ return (filter (w `isPrefixOf`) (map (showSDoc.ppr) pkg_mods))
+
+completeHomeModule w = do
+ s <- restoreSession
+ g <- GHC.getModuleGraph s
+ let home_mods = map GHC.ms_mod g
+ return (filter (w `isPrefixOf`) (map (showSDoc.ppr) home_mods))
+
+completeSetOptions w = do
+ return (filter (w `isPrefixOf`) options)
+ where options = "args":"prog":allFlags
+
+completeFilename = Readline.filenameCompletionFunction
+
+completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
+
+unionComplete :: (String -> IO [String]) -> (String -> IO [String]) -> String -> IO [String]
+unionComplete f1 f2 w = do
+ s1 <- f1 w
+ s2 <- f2 w
+ return (s1 ++ s2)
+
+wrapCompleter :: (String -> IO [String]) -> String -> IO (Maybe (String,[String]))
+wrapCompleter fun w = do
+ strs <- fun w
+ case strs of
+ [] -> return Nothing
+ [x] -> return (Just (x,[]))
+ xs -> case getCommonPrefix xs of
+ "" -> return (Just ("",xs))
+ pref -> return (Just (pref,xs))
+
+getCommonPrefix :: [String] -> String
+getCommonPrefix [] = ""
+getCommonPrefix (s:ss) = foldl common s ss
+ where common s "" = s
+ common "" s = ""
+ common (c:cs) (d:ds)
+ | c == d = c : common cs ds
+ | otherwise = ""
+
+allExposedModules :: DynFlags -> [Module]
+allExposedModules dflags
+ = map GHC.mkModule (concat (map exposedModules (filter exposed (eltsUFM pkg_db))))
+ where
+ pkg_db = pkgIdMap (pkgState dflags)
+#else
+completeCmd = completeNone
+completeMacro = completeNone
+completeIdentifier = completeNone
+completeModule = completeNone
+completeHomeModule = completeNone
+completeSetOptions = completeNone
+completeFilename = completeNone
+completeHomeModuleOrFile=completeNone
+#endif
+