From e54e17e43b4a0c7df2a5fe2d18b26886f60df73d Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Thu, 5 Jun 2008 11:29:08 +0000 Subject: [PATCH] complete word completion in the shell. works for commands, flags, options, abstract syntax identifiers and NL strings --- src-3.0/GF/Command/Abstract.hs | 20 +++++++ src-3.0/GF/Command/Commands.hs | 20 ------- src-3.0/GF/Command/Parse.hs | 2 +- src-3.0/GF/System/UseReadline.hs | 2 + src-3.0/GFI.hs | 98 +++++++++++++++++++++++++++++++- 5 files changed, 120 insertions(+), 22 deletions(-) diff --git a/src-3.0/GF/Command/Abstract.hs b/src-3.0/GF/Command/Abstract.hs index 127cbf6e0..1f72688a0 100644 --- a/src-3.0/GF/Command/Abstract.hs +++ b/src-3.0/GF/Command/Abstract.hs @@ -26,3 +26,23 @@ data Argument = AExp Exp | ANoArg deriving (Eq,Ord,Show) + +valIdOpts :: String -> String -> [Option] -> String +valIdOpts flag def opts = case valOpts flag (VId def) opts of + VId v -> v + _ -> def + +valIntOpts :: String -> Integer -> [Option] -> Int +valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of + VInt v -> v + _ -> def + +valOpts :: String -> Value -> [Option] -> Value +valOpts flag def opts = case lookup flag flags of + Just v -> v + _ -> def + where + flags = [(f,v) | OFlag f v <- opts] + +isOpt :: String -> [Option] -> Bool +isOpt o opts = elem o [x | OOpt x <- opts] diff --git a/src-3.0/GF/Command/Commands.hs b/src-3.0/GF/Command/Commands.hs index ceabbde7b..e97c54861 100644 --- a/src-3.0/GF/Command/Commands.hs +++ b/src-3.0/GF/Command/Commands.hs @@ -64,26 +64,6 @@ commandHelp full (co,info) = unlines $ [ "flags: " ++ unwords (flags info) ] else [] -valIdOpts :: String -> String -> [Option] -> String -valIdOpts flag def opts = case valOpts flag (VId def) opts of - VId v -> v - _ -> def - -valIntOpts :: String -> Integer -> [Option] -> Int -valIntOpts flag def opts = fromInteger $ case valOpts flag (VInt def) opts of - VInt v -> v - _ -> def - -valOpts :: String -> Value -> [Option] -> Value -valOpts flag def opts = case lookup flag flags of - Just v -> v - _ -> def - where - flags = [(f,v) | OFlag f v <- opts] - -isOpt :: String -> [Option] -> Bool -isOpt o opts = elem o [x | OOpt x <- opts] - -- this list must be kept sorted by the command name! allCommands :: PGF -> Map.Map String CommandInfo allCommands pgf = Map.fromAscList [ diff --git a/src-3.0/GF/Command/Parse.hs b/src-3.0/GF/Command/Parse.hs index e3cc21cca..dfab70128 100644 --- a/src-3.0/GF/Command/Parse.hs +++ b/src-3.0/GF/Command/Parse.hs @@ -1,4 +1,4 @@ -module GF.Command.Parse(readCommandLine) where +module GF.Command.Parse(readCommandLine, pCommand) where import PGF.ExprSyntax import GF.Command.Abstract diff --git a/src-3.0/GF/System/UseReadline.hs b/src-3.0/GF/System/UseReadline.hs index c4a8f9239..7a4999850 100644 --- a/src-3.0/GF/System/UseReadline.hs +++ b/src-3.0/GF/System/UseReadline.hs @@ -18,6 +18,8 @@ import System.Console.Readline fetchCommand :: String -> IO (String) fetchCommand s = do + setCompletionAppendCharacter Nothing + setBasicQuoteCharacters "" res <- readline s case res of Nothing -> return "q" diff --git a/src-3.0/GFI.hs b/src-3.0/GFI.hs index 92c835123..74ebaf90b 100644 --- a/src-3.0/GFI.hs +++ b/src-3.0/GFI.hs @@ -3,15 +3,24 @@ module GFI (mainGFI) where import GF.Command.Interpreter import GF.Command.Importing import GF.Command.Commands +import GF.Command.Abstract +import GF.Command.Parse import GF.Data.ErrM import GF.Grammar.API -- for cc command import GF.Infra.UseIO import GF.Infra.Option -import GF.System.Readline (fetchCommand) +import GF.System.Readline + import PGF import PGF.Data +import PGF.Macros +import Data.Char +import Data.List(isPrefixOf) +import qualified Data.Map as Map +import qualified Text.ParserCombinators.ReadP as RP import System.CPUTime +import Control.Exception import Data.Version import Paths_gf @@ -28,6 +37,7 @@ loop :: Options -> GFEnv -> IO GFEnv loop opts gfenv0 = do let env = commandenv gfenv0 let sgr = sourcegrammar gfenv0 + setCompletionFunction (Just (wordCompletion (commandenv gfenv0))) s <- fetchCommand (prompt env) let gfenv = gfenv0 {history = s : history gfenv0} let loopNewCPU gfenv' = do cpu' <- getCPUTime @@ -102,3 +112,89 @@ data GFEnv = GFEnv { emptyGFEnv :: GFEnv emptyGFEnv = GFEnv emptyGrammar (mkCommandEnv emptyPGF) [] 0 + + +wordCompletion cmdEnv line prefix p = do + case wc_type (take p line) of + CmplCmd pref + -> ret ' ' [name | name <- Map.keys (commands cmdEnv), isPrefixOf pref name] + CmplStr (Just (Command _ opts _)) s + -> do mb_state0 <- try (evaluate (initState pgf (optLang opts) (optCat opts))) + case mb_state0 of + Right state0 -> let ws = words (take (length s - length prefix) s) + state = foldl nextState state0 ws + compls = getCompletions state prefix + in ret ' ' (Map.keys compls) + Left _ -> ret ' ' [] + 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 '=') + (flg_compls++opt_compls) + Nothing -> ret ' ' [] + CmplIdent _ pref + -> ret ' ' [name | cid <- Map.keys (funs (abstract pgf)), let name = prCId cid, isPrefixOf pref name] + _ -> ret ' ' [] + where + pgf = multigrammar cmdEnv + optLang opts = valIdOpts "lang" (head (languages pgf)) opts + optCat opts = valIdOpts "cat" (lookStartCat pgf) opts + + ret c [x] = return [x++[c]] + ret _ xs = return xs + + +data CompletionType + = CmplCmd Ident + | CmplStr (Maybe Command) String + | CmplOpt (Maybe Command) Ident + | CmplIdent (Maybe Command) Ident + deriving Show + +wc_type :: String -> CompletionType +wc_type = cmd_name + where + cmd_name cs = + let cs1 = dropWhile isSpace cs + in go cs1 cs1 + where + go x [] = CmplCmd x + go x (c:cs) + | isIdent c = go x cs + | otherwise = cmd x cs + + cmd x [] = ret CmplIdent x "" 0 + cmd _ ('|':cs) = cmd_name cs + cmd _ (';':cs) = cmd_name cs + cmd x ('"':cs) = str x cs cs + cmd x ('-':cs) = option x cs cs + cmd x (c :cs) + | isIdent c = ident x (c:cs) cs + | otherwise = cmd x cs + + option x y [] = ret CmplOpt x y 1 + option x y (c:cs) + | isIdent c = option x y cs + | otherwise = cmd x cs + + ident x y [] = ret CmplIdent x y 0 + ident x y (c:cs) + | isIdent c = ident x y cs + | otherwise = cmd x cs + + str x y [] = ret CmplStr x y 1 + str x y ('\"':cs) = cmd x cs + str x y ('\\':c:cs) = str x y cs + str x y (c:cs) = str x y cs + + ret f x y d = f cmd y + where + x1 = take (length x - length y - d) x + x2 = takeWhile (\c -> isIdent c || isSpace c || c == '-' || c == '=') x1 + + cmd = case [x | (x,cs) <- RP.readP_to_S pCommand x2, all isSpace cs] of + [x] -> Just x + _ -> Nothing + + isIdent c = c == '_' || c == '\'' || isAlphaNum c