diff --git a/GF.cabal b/GF.cabal index 7a4c990fc..8fc01e382 100644 --- a/GF.cabal +++ b/GF.cabal @@ -6,18 +6,6 @@ license: GPL license-file: LICENSE synopsis: Grammatical Framework -flag haskeline - Description: Enable Haskeline in the shell - Default: True - -flag readline - Description: Enable Readline in the shell - Default: True - -flag editline - Description: Enable Editline in the shell - Default: True - flag interrupt Description: Enable Ctrl+Break in the shell Default: True @@ -74,7 +62,8 @@ executable gf old-time, process, pretty, - mtl + mtl, + haskeline build-tools: happy, alex if os(windows) build-depends: Win32 @@ -142,7 +131,6 @@ executable gf GF.Compile.PGFtoProlog GF.Compile.PGFtoJS GF.Compile - GF.System.Readline GF.Quiz PGF PGF.CId @@ -161,23 +149,6 @@ executable gf GFC GFI - if flag(haskeline) - build-depends: haskeline - cpp-options: -DUSE_HASKELINE - other-modules: GF.System.UseHaskeline - else - if flag(readline) - build-depends: readline - cpp-options: -DUSE_READLINE - other-modules: GF.System.UseReadline - else - if flag(editline) - build-depends: editline - cpp-options: -DUSE_EDITLINE - other-modules: GF.System.UseEditline - else - other-modules: GF.System.NoReadline - if flag(interrupt) cpp-options: -DUSE_INTERRUPT other-modules: GF.System.UseSignal diff --git a/src/compiler/GF/System/NoReadline.hs b/src/compiler/GF/System/NoReadline.hs deleted file mode 100644 index 1f1050e8c..000000000 --- a/src/compiler/GF/System/NoReadline.hs +++ /dev/null @@ -1,33 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.NoReadline --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ --- --- Do not use readline. ------------------------------------------------------------------------------ - -module GF.System.NoReadline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where - -import System.IO.Error (try) -import System.IO (stdout,hFlush) - -fetchCommand :: String -> IO (String) -fetchCommand s = do - putStr s - hFlush stdout - res <- try getLine - case res of - Left e -> return "q" - Right l -> return l - -setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO () -setCompletionFunction _ = return () - -filenameCompletionFunction :: String -> IO [String] -filenameCompletionFunction _ = return [] diff --git a/src/compiler/GF/System/Readline.hs b/src/compiler/GF/System/Readline.hs deleted file mode 100644 index ee38cdc0b..000000000 --- a/src/compiler/GF/System/Readline.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# OPTIONS -cpp #-} - ----------------------------------------------------------------------- --- | --- Module : GF.System.Readline --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.2 $ --- --- Uses the right readline library to read user input. ------------------------------------------------------------------------------ - -module GF.System.Readline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where - -#ifdef USE_HASKELINE - -import GF.System.UseHaskeline - -#elif USE_READLINE - -import GF.System.UseReadline - -#elif USE_EDITLINE - -import GF.System.UseEditline - -#else - -import GF.System.NoReadline - -#endif diff --git a/src/compiler/GF/System/UseEditline.hs b/src/compiler/GF/System/UseEditline.hs deleted file mode 100644 index 6d51a1be3..000000000 --- a/src/compiler/GF/System/UseEditline.hs +++ /dev/null @@ -1,36 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.UseReadline --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ --- --- Use GNU readline ------------------------------------------------------------------------------ - -module GF.System.UseEditline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where - -import System.Console.Editline.Readline - -fetchCommand :: String -> IO (String) -fetchCommand s = do - setCompletionAppendCharacter Nothing - --setBasicQuoteCharacters "" - res <- readline s - case res of - Nothing -> return "q" - Just s -> do addHistory s - return s - -setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO () -setCompletionFunction Nothing = setCompletionEntryFunction Nothing -setCompletionFunction (Just fn) = setCompletionEntryFunction (Just my_fn) - where - my_fn prefix = do - s <- getLineBuffer - p <- getPoint - fn s prefix p diff --git a/src/compiler/GF/System/UseHaskeline.hs b/src/compiler/GF/System/UseHaskeline.hs deleted file mode 100644 index 140407439..000000000 --- a/src/compiler/GF/System/UseHaskeline.hs +++ /dev/null @@ -1,43 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.UseReadline --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ --- --- Use GNU readline ------------------------------------------------------------------------------ - -module GF.System.UseHaskeline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where - -import System.Console.Haskeline -import System.Directory - -fetchCommand :: String -> IO (String) -fetchCommand s = do - settings <- getGFSettings - res <- runInputT settings (getInputLine s) - case res of - Nothing -> return "q" - Just s -> return s - -getGFSettings :: IO (Settings IO) -getGFSettings = do - path <- getAppUserDataDirectory "gf_history" - return $ - Settings { - complete = completeFilename, - historyFile = Just path, - autoAddHistory = True - } - - -setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO () -setCompletionFunction _ = return () - -filenameCompletionFunction :: String -> IO [String] -filenameCompletionFunction _ = return [] diff --git a/src/compiler/GF/System/UseReadline.hs b/src/compiler/GF/System/UseReadline.hs deleted file mode 100644 index a0e051601..000000000 --- a/src/compiler/GF/System/UseReadline.hs +++ /dev/null @@ -1,36 +0,0 @@ ----------------------------------------------------------------------- --- | --- Module : GF.System.UseReadline --- Maintainer : BB --- Stability : (stable) --- Portability : (portable) --- --- > CVS $Date: 2005/05/10 15:04:01 $ --- > CVS $Author: bringert $ --- > CVS $Revision: 1.1 $ --- --- Use GNU readline ------------------------------------------------------------------------------ - -module GF.System.UseReadline (fetchCommand, setCompletionFunction, filenameCompletionFunction) where - -import System.Console.Readline - -fetchCommand :: String -> IO (String) -fetchCommand s = do - setCompletionAppendCharacter Nothing - setBasicQuoteCharacters "" - res <- readline s - case res of - Nothing -> return "q" - Just s -> do addHistory s - return s - -setCompletionFunction :: Maybe (String -> String -> Int -> IO [String]) -> IO () -setCompletionFunction Nothing = setCompletionEntryFunction Nothing -setCompletionFunction (Just fn) = setCompletionEntryFunction (Just my_fn) - where - my_fn prefix = do - s <- getLineBuffer - p <- getPoint - fn s prefix p diff --git a/src/compiler/GFI.hs b/src/compiler/GFI.hs index a0806ce94..faa47faeb 100644 --- a/src/compiler/GFI.hs +++ b/src/compiler/GFI.hs @@ -19,7 +19,7 @@ import GF.Infra.CheckM import GF.Infra.UseIO import GF.Infra.Option import GF.Infra.Modules (greatestResource, modules, emptyModInfo) -import GF.System.Readline +import qualified System.Console.Haskeline as Haskeline import GF.Compile.Coding @@ -79,11 +79,9 @@ loop opts gfenv0 = do let ifv act = if isv then act else return () let env = commandenv gfenv0 let sgr = sourcegrammar gfenv0 - setCompletionFunction (Just (wordCompletion gfenv0)) - let fetch = case flag optMode opts of - ModeRun -> tryGetLine - _ -> fetchCommand (prompt env) - s0 <- fetch + s0 <- case flag optMode opts of + ModeRun -> tryGetLine + _ -> fetchCommand gfenv0 let gfenv = gfenv0 {history = s0 : history gfenv0} let pwords = case words s0 of @@ -204,6 +202,20 @@ loop opts gfenv0 = do gfenv' <- either (\e -> (print e >> return gfenv)) return r loop opts gfenv' +fetchCommand :: GFEnv -> IO String +fetchCommand gfenv = do + path <- getAppUserDataDirectory "gf_history" + let settings = + Haskeline.Settings { + Haskeline.complete = wordCompletion gfenv, + Haskeline.historyFile = Just path, + Haskeline.autoAddHistory = True + } + res <- Haskeline.runInputT settings (Haskeline.getInputLine (prompt (commandenv gfenv))) + case res of + Nothing -> return "q" + Just s -> return s + importInEnv :: GFEnv -> Options -> [FilePath] -> IO GFEnv importInEnv gfenv opts files | flag optRetainResource opts = @@ -262,34 +274,37 @@ emptyGFEnv = do decode _ = id -- decodeUnicode . coding -wordCompletion gfenv line prefix p = - case wc_type (take p line) of +wordCompletion gfenv (left,right) = do + case wc_type (reverse left) of CmplCmd pref - -> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name] - CmplStr (Just (Command _ opts _)) s + -> ret (length pref) [Haskeline.simpleCompletion name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name] + CmplStr (Just (Command _ opts _)) s0 -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optType opts))) case mb_state0 of - Right state0 -> let ws = words (take (length s - length prefix) s) + Right state0 -> let (rprefix,rs) = break isSpace (reverse s0) + s = reverse rs + prefix = reverse rprefix + ws = words s in case loop state0 ws of - Nothing -> ret ' ' [] + Nothing -> ret 0 [] Just state -> let compls = getCompletions state prefix - in ret ' ' (Map.keys compls) - Left (_ :: SomeException) -> ret ' ' [] + in ret (length prefix) (map (\x -> Haskeline.simpleCompletion x) (Map.keys compls)) + Left (_ :: SomeException) -> ret 0 [] CmplOpt (Just (Command n _ _)) pref -> case Map.lookup n (commands cmdEnv) of - Just inf -> do let flg_compls = ['-':flg | (flg,_) <- flags inf, isPrefixOf pref flg] - opt_compls = ['-':opt | (opt,_) <- options inf, isPrefixOf pref opt] - ret (if null flg_compls then ' ' else '=') + Just inf -> do let flg_compls = [Haskeline.Completion ('-':flg++"=") ('-':flg) False | (flg,_) <- flags inf, isPrefixOf pref flg] + opt_compls = [Haskeline.Completion ('-':opt) ('-':opt) True | (opt,_) <- options inf, isPrefixOf pref opt] + ret (length pref+1) (flg_compls++opt_compls) - Nothing -> ret ' ' [] + Nothing -> ret (length pref) [] CmplIdent (Just (Command "i" _ _)) _ -- HACK: file name completion for command i - -> filenameCompletionFunction prefix + -> Haskeline.completeFilename (left,right) CmplIdent _ pref -> do mb_abs <- try (evaluate (abstract pgf)) case mb_abs of - Right abs -> ret ' ' [name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name] - Left (_ :: SomeException) -> ret ' ' [] - _ -> ret ' ' [] + Right abs -> ret (length pref) [Haskeline.simpleCompletion name | cid <- Map.keys (funs abs), let name = showCId cid, isPrefixOf pref name] + Left (_ :: SomeException) -> ret (length pref) [] + _ -> ret 0 [] where pgf = multigrammar cmdEnv cmdEnv = commandenv gfenv @@ -305,8 +320,7 @@ wordCompletion gfenv line prefix p = Left es -> Nothing Right ps -> loop ps ts - ret c [x] = return [x++[c]] - ret _ xs = return xs + ret len xs = return (drop len left,xs) data CompletionType