From b70f35afc1c606dc85e6feb7da74be72411f58c1 Mon Sep 17 00:00:00 2001
From: "judah.jacobson@gmail.com" <unknown>
Date: Thu, 10 Jan 2008 22:19:28 +0000
Subject: [PATCH] Fix filename completion by adding trailing spaces/slashes
 manually.

---
 compiler/ghci/InteractiveUI.hs |   27 ++++++++++++++++++++++-----
 1 file changed, 22 insertions(+), 5 deletions(-)

diff --git a/compiler/ghci/InteractiveUI.hs b/compiler/ghci/InteractiveUI.hs
index 65693b3..a0c76ec 100644
--- a/compiler/ghci/InteractiveUI.hs
+++ b/compiler/ghci/InteractiveUI.hs
@@ -310,6 +310,7 @@ interactiveUI session srcs maybe_expr = do
 
    Readline.setBasicWordBreakCharacters word_break_chars
    Readline.setCompleterWordBreakCharacters word_break_chars
+   Readline.setCompletionAppendCharacter Nothing
 #endif
 
    default_editor <- findEditor
@@ -1699,7 +1700,18 @@ completeSetOptions w = do
   return (filter (w `isPrefixOf`) options)
     where options = "args":"prog":allFlags
 
-completeFilename = Readline.filenameCompletionFunction
+completeFilename w = do
+    ws <- Readline.filenameCompletionFunction w
+    case ws of
+        -- If we only found one result, and it's a directory, 
+        -- add a trailing slash.
+        [file] -> do
+                isDir <- expandPathIO file >>= doesDirectoryExist
+                if isDir && last file /= '/'
+                    then return [file ++ "/"]
+                    else return [file]
+        _ -> return ws
+                
 
 completeHomeModuleOrFile = unionComplete completeHomeModule completeFilename
 
@@ -1713,8 +1725,10 @@ 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,[]))
+    []  -> Readline.setAttemptedCompletionOver True >> return Nothing
+    [x] -> -- Add a trailing space, unless it already has an appended slash.
+           let appended = if last x == '/' then x else x ++ " "
+           in return (Just (appended,[]))
     xs  -> case getCommonPrefix xs of
 		""   -> return (Just ("",xs))
 		pref -> return (Just (pref,xs))
@@ -1795,10 +1809,13 @@ ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s)
 -- Utils
 
 expandPath :: String -> GHCi String
-expandPath path = 
+expandPath path = io (expandPathIO path)
+
+expandPathIO :: String -> IO String
+expandPathIO path = 
   case dropWhile isSpace path of
    ('~':d) -> do
-	tilde <- io getHomeDirectory -- will fail if HOME not defined
+	tilde <- getHomeDirectory -- will fail if HOME not defined
 	return (tilde ++ '/':d)
    other -> 
 	return other
-- 
1.7.10.4