prompt: added reverse-i-search

src/BC/Config.hs

@@ -6,6 +6,8 @@ promptStr = "> "
 
 returnStr = "=> "
 
+reversePromptStr = "bck-i-search: "
+
 historyFile = ".bc_history"
 
 historyLen = 1000::Int

src/BC/Prompt.hs

@@ -78,6 +78,41 @@ printStatus state str =
         truncLen s = if length s > 20 then take 20 s ++ "..." else s
 
 
+reverseSearch :: Prompt -> String -> IO (Maybe String)
+reverseSearch (PState _ his) old = do
+    putStrLn $ replace (length old)
+    read' []
+  where maybeLength (Just n) = length n
+        maybeLength Nothing = 0
+        replace n = concat $ replicate n "\b \b"
+        findFromHistory acc = findFromHistory' his acc
+        findFromHistory acc = findFromHistory' his acc
+        findFromHistory' _ "" = ""
+        findFromHistory' [] acc = ""
+        findFromHistory' (x:xy) acc =
+          if isInfixOf acc x then x else findFromHistory' xy acc
+        read' acc = do -- annoyed grunt
+          cleanPrompt
+          putStr "\x1b[1A"
+          cleanPrompt
+          let h = findFromHistory acc
+          putStr (promptStr ++ h ++ "\n" ++ reversePromptStr ++ acc)
+          c <- getChar
+          case c of
+            '\EOT' -> return Nothing
+            '\n'   -> return (Just h)
+            '\DEL' ->
+              if null acc
+              then read' acc
+              else do
+                putStr "\b \b"
+                read' (take (length acc - 1) acc)
+            c      ->
+              if isPrint c
+                then read' (acc ++ [c])
+                else return Nothing
+
+
 tabComplete :: String -> Int -> State -> IO (String, Int)
 tabComplete str pos state =
   let tokens = words $ take pos str
@@ -176,7 +211,16 @@ readline state = read' "" 0
                 then do
                   putStr [c]
                   read' (take pos acc ++ [c] ++ drop pos acc) (pos+1) pstate
-                else read' acc pos pstate
+                else
+                  if ord c == 18 -- 18 == Ctrl+R
+                    then do
+                       mnacc <- reverseSearch pstate acc
+                       case mnacc of
+                        Just nacc -> do
+                          putStr nacc
+                          return (Just nacc)
+                        _         -> read' acc pos pstate
+                    else read' acc pos pstate
         clamp n min max
             | n < min = min
             | n > max = max