diff --git a/src/BC/Prompt.hs b/src/BC/Prompt.hs index c15b166..a82336a 100644 --- a/src/BC/Prompt.hs +++ b/src/BC/Prompt.hs @@ -50,11 +50,13 @@ output state out = let res = parse out in if length res == 1 && isErr (head res) then do + cleanPrompt print (head res) return state else let (ret, newstate) = eval state res - in do putStrLn $ returnStr ++ show ret + in do cleanPrompt + putStrLn $ returnStr ++ show ret return newstate @@ -76,6 +78,37 @@ printStatus state str = truncLen s = if length s > 20 then take 20 s ++ "..." else s +tabComplete :: String -> Int -> State -> IO (String, Int) +tabComplete str pos state = + let tokens = words $ take pos str + completions = if tokens == [] + then [] + else getCompletions (last tokens) state + in case completions of + cs@(_:_:_) -> do + printCompletions cs + putStr $ concat $ replicate (length promptStr + pos) "\x1b[C" + -- ^ shift cursor right to current position + return (str, pos) + x:_ -> let diff = drop (length $ last tokens) x + in do + putStr diff + return (take pos str ++ diff ++ drop pos str, pos + length diff) + _ -> return (str, pos) + + +printCompletions :: [String] -> IO () +printCompletions cs = + let compString = intercalate " " $ take 5 cs -- only list 5 matches + toPrint = "\n" + ++ "\x1b[2K\r" -- clear completion line + ++ "\x1b[32m" -- color to green + ++ replicate (length promptStr) ' ' + ++ compString + ++ "\x1b[0m\r\x1b[A" -- color to white, move to prev line + in putStr toPrint + + cleanPrompt :: IO () cleanPrompt = putStr "\x1b[2K\r" @@ -135,6 +168,9 @@ readline state = read' "" 0 '\x1b' -> do (pos, nacc, newpstate) <- readSpecialKey pos acc pstate read' nacc (clamp pos 0 (length acc)) newpstate + '\t' -> do + (newAcc, newPos) <- tabComplete acc pos state + read' newAcc newPos pstate c -> if isPrint c then do diff --git a/src/BC/State.hs b/src/BC/State.hs index a3e6764..1b31680 100644 --- a/src/BC/State.hs +++ b/src/BC/State.hs @@ -9,3 +9,8 @@ type State = Map String Value newState :: State newState = fromList primitives + +getCompletions :: String -> State -> [String] +getCompletions s = foldWithKey addKey [] + where addKey k _ ks = if isPrefix s k then k:ks else ks + isPrefix s1 s2 = length s2 >= length s1 && (all id $ zipWith (==) s1 s2) \ No newline at end of file diff --git a/src/BC/Types.hs b/src/BC/Types.hs index 9f10a18..1e5197f 100644 --- a/src/BC/Types.hs +++ b/src/BC/Types.hs @@ -103,6 +103,7 @@ precedence "<=" = 2 precedence ">=" = 2 precedence "==" = 2 precedence "!=" = 2 +precedence _ = 6 contains :: Eq a => [a] -> a -> Bool