Skip to content

Instantly share code, notes, and snippets.

@wildart

wildart/console.fsx

Last active Dec 8, 2020
Embed
What would you like to do?
// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information.
// namespace FSI
open System
open System.Text
open System.Collections.Generic
/// System.Console.ReadKey appears to return an ANSI character (not the expected the unicode character).
/// When this fix flag is true, this byte is converted to a char using the System.Console.InputEncoding.
/// This is a code-around for bug://1345.
/// Fixes to System.Console.ReadKey may break this code around, hence the option here.
module ConsoleOptions =
let readKeyFixup (c:char) =
// Assumes the c:char is actually a byte in the System.Console.InputEncoding.
// Convert it to a Unicode char through the encoding.
if 0 <= int c && int c <= 255 then
let chars = System.Console.InputEncoding.GetChars [| byte c |]
if chars.Length = 1 then
chars.[0] // fixed up char
else
assert("readKeyFixHook: InputEncoding.GetChars(single-byte) returned multiple chars" = "")
c // no fix up
else
assert("readKeyFixHook: given char is outside the 0..255 byte range" = "")
c
type Style = Prompt | Out | Error
/// Class managing the command History.
type History() =
let list = new List<string>()
let mutable current = 0
member x.Count = list.Count
member x.Current =
if current >= 0 && current < list.Count then list.[current] else String.Empty
member x.Clear() = list.Clear(); current <- -1
member x.Add line =
match line with
| null | "" -> ()
| _ -> list.Add(line)
member x.AddLast line =
match line with
| null | "" -> ()
| _ -> list.Add(line); current <- list.Count
// Dead code
// member x.First() = current <- 0; x.Current
// member x.Last() = current <- list.Count - 1; x.Current
member x.Previous() =
if (list.Count > 0) then
current <- ((current - 1) + list.Count) % list.Count
x.Current
member x.Next() =
if (list.Count > 0) then
current <- (current + 1) % list.Count
x.Current
/// List of available optionsCache
type Options() =
inherit History()
let mutable root = ""
member x.Root with get() = root and set(v) = (root <- v)
/// Cursor position management
module Utils =
open System
open System.Reflection
open Microsoft.FSharp.Core
open Microsoft.FSharp.Collections
let guard(f) =
try f()
with e ->
failwithf "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" e.Message e.StackTrace
// Quick and dirty dirty method lookup for inlined IL
// In some situations, we can't use ldtoken to obtain a RuntimeMethodHandle, since the method
// in question's token may contain typars from an external type environment. Such a token would
// cause the PE file to be flagged as invalid.
// In such a situation, we'll want to search out the MethodRef in a similar fashion to bindMethodBySearch
// but since we can't use ldtoken to obtain System.Type objects, we'll need to do everything with strings.
// This is the least fool-proof method for resolving the binding, but since the scenarios it's used in are
// so constrained, (fsi 2.0, methods with generic multi-dimensional arrays in their signatures), it's
// acceptable
let findMethod (parentT:Type,nm,marity,argtys : string [],rty : string) =
let staticOrInstanceBindingFlags = BindingFlags.Instance ||| BindingFlags.Static ||| BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.DeclaredOnly
let methInfos = parentT.GetMethods(staticOrInstanceBindingFlags) |> Array.toList
let methInfos = methInfos |> List.filter (fun methInfo -> methInfo.Name = nm)
match methInfos with
| [methInfo] ->
methInfo
| _ ->
let select (methInfo:MethodInfo) =
let mtyargTIs = if methInfo.IsGenericMethod then methInfo.GetGenericArguments() else [| |]
if mtyargTIs.Length <> marity then false else
let haveArgTs =
let parameters = Array.toList (methInfo.GetParameters())
parameters |> List.map (fun param -> param.ParameterType)
let haveResT = methInfo.ReturnType
if argtys.Length <> haveArgTs.Length then false else
let res = rty :: (Array.toList argtys) = (List.map (fun (t : System.Type) -> t.Name) (haveResT :: haveArgTs))
res
match List.tryFind select methInfos with
| None -> failwith "Internal Error: cannot bind to method"
| Some methInfo -> methInfo
let rec previousWordFromIdx (line: string) (idx, isInWord) =
if idx < 0 then 0 else
match line.Chars(idx), isInWord with
| ' ', true -> idx + 1
| ' ', false -> previousWordFromIdx line (idx - 1, false)
| _, _ -> previousWordFromIdx line (idx - 1, true)
let rec nextWordFromIdx (line: string) (idx, isInWord) =
if idx >= line.Length then line.Length - 1 else
match line.Chars(idx), isInWord with
| ' ', true -> idx
| ' ', false -> nextWordFromIdx line (idx + 1, false)
| _, _ -> nextWordFromIdx line (idx + 1, true)
[<Sealed>]
type Cursor =
static member ResetTo(top,left) =
Utils.guard(fun () ->
Console.CursorTop <- min top (Console.BufferHeight - 1)
Console.CursorLeft <- left)
static member Move(inset, delta) =
let position = Console.CursorTop * (Console.BufferWidth - inset) + (Console.CursorLeft - inset) + delta
let top = position / (Console.BufferWidth - inset)
let left = inset + position % (Console.BufferWidth - inset)
Cursor.ResetTo(top,left)
type Anchor =
{top:int; left:int}
static member Current(inset) = {top=Console.CursorTop;left= max inset Console.CursorLeft}
static member Top(inset) = {top = 0; left = inset}
member p.PlaceAt(inset, index) =
//printf "p.top = %d, p.left = %d, inset = %d, index = %d\n" p.top p.left inset index
let left = inset + (( (p.left - inset) + index) % (Console.BufferWidth - inset))
let top = p.top + ( (p.left - inset) + index) / (Console.BufferWidth - inset)
Cursor.ResetTo(top,left)
type ReadLineConsole() =
let history = new History()
let mutable complete : (string option * string -> seq<string>) = fun (_s1,_s2) -> Seq.empty
member x.SetCompletionFunction f = complete <- f
/// Inset all inputs by this amount
member x.Prompt = "> "
member x.Prompt2 = "- "
member x.Inset = x.Prompt.Length
member x.GetOptions(input:string) =
/// Tab optionsCache available in current context
let optionsCache = new Options()
let rec look parenCount i =
if i <= 0 then i else
match input.Chars(i - 1) with
| c when Char.IsLetterOrDigit(c) (* or Char.IsWhiteSpace(c) *) -> look parenCount (i-1)
| '.' | '_' -> look parenCount (i-1)
| '}' | ')' | ']' -> look (parenCount+1) (i-1)
| '(' | '{' | '[' -> look (parenCount-1) (i-1)
| _ when parenCount > 0 -> look parenCount (i-1)
| _ -> i
let start = look 0 input.Length
let name = input.Substring(start, input.Length - start)
if (name.Trim().Length > 0) then
let lastDot = name.LastIndexOf('.')
let attr, pref, root =
if (lastDot < 0) then
None, name, input.Substring(0, start)
else
Some(name.Substring(0, lastDot)),
name.Substring(lastDot + 1),
input.Substring(0, start + lastDot + 1)
//printf "attr, pref, root = %s\n" (any_to_string (attr, pref, root))
try
complete(attr,pref)
|> Seq.filter(fun option -> option.StartsWith(pref,StringComparison.Ordinal))
|> Seq.iter (fun option -> optionsCache.Add(option))
// engine.Evaluate(String.Format("dir({0})", attr)) as IEnumerable
optionsCache.Root <-root
with e ->
optionsCache.Clear()
optionsCache,true
else
optionsCache,false
member x.MapCharacter(c) : string =
match c with
| '\x1A'-> "^Z"
| _ -> "^?"
member x.GetCharacterSize(c) =
if (Char.IsControl(c))
then x.MapCharacter(c).Length
else 1
static member TabSize = 4
member x.ReadLine() =
let checkLeftEdge(prompt) =
let currLeft = Console.CursorLeft
if currLeft < x.Inset then
if currLeft = 0 then Console.Write (if prompt then x.Prompt2 else String(' ',x.Inset))
Utils.guard(fun () ->
Console.CursorTop <- min Console.CursorTop (Console.BufferHeight - 1)
Console.CursorLeft <- x.Inset)
// The caller writes the primary prompt. If we are reading the 2nd and subsequent lines of the
// input we're responsible for writing the secondary prompt.
checkLeftEdge true
/// Cursor anchor - position of !anchor when the routine was called
let mutable anchor = Anchor.Current x.Inset
/// Length of the output currently rendered on screen.
let mutable rendered = 0
/// Input has changed, therefore options cache is invalidated.
let mutable changed = false
/// Cache of optionsCache
let mutable optionsCache = Options()
let writeBlank() =
Console.Write(' ')
checkLeftEdge false
let writeChar(c) =
if Console.CursorTop = Console.BufferHeight - 1 && Console.CursorLeft = Console.BufferWidth - 1 then
//printf "bottom right!\n"
anchor <- { anchor with top = (anchor).top - 1 }
checkLeftEdge true
if (Char.IsControl(c)) then
let s = x.MapCharacter(c)
Console.Write(s)
rendered <- rendered + s.Length
else
Console.Write(c)
rendered <- rendered + 1
checkLeftEdge true
/// The console input buffer.
let input = new StringBuilder()
/// Current position - index into the input buffer
let mutable current = 0
let render() =
//printf "render\n"
let curr = current
anchor.PlaceAt(x.Inset,0)
let output = new StringBuilder()
let mutable position = -1
for i = 0 to input.Length - 1 do
if (i = curr) then
position <- output.Length
let c = input.Chars(i)
if (Char.IsControl(c)) then
output.Append(x.MapCharacter(c)) |> ignore
else
output.Append(c) |> ignore
if (curr = input.Length) then
position <- output.Length
// render the current text, computing a new value for "rendered"
let old_rendered = rendered
rendered <- 0
for i = 0 to input.Length - 1 do
writeChar(input.Chars(i))
// blank out any dangling old text
for i = rendered to old_rendered - 1 do
writeBlank()
anchor.PlaceAt(x.Inset,position)
render()
let insertChar(c:char) =
if (current = input.Length) then
current <- current + 1
input.Append(c) |> ignore
writeChar(c)
else
input.Insert(current, c) |> ignore
current <- current + 1
render()
let insertTab() =
for i = ReadLineConsole.TabSize - (current % ReadLineConsole.TabSize) downto 1 do
insertChar(' ')
let moveLeft() =
if (current > 0 && (current - 1 < input.Length)) then
current <- current - 1
let c = input.Chars(current)
Cursor.Move(x.Inset, - x.GetCharacterSize(c))
let moveRight() =
if (current < input.Length) then
let c = input.Chars(current)
current <- current + 1
Cursor.Move(x.Inset, x.GetCharacterSize(c))
let moveWordLeft() =
if (current > 0 && (current - 1 < input.Length)) then
let line = input.ToString()
current <- Utils.previousWordFromIdx line (current - 1, false)
anchor.PlaceAt(x.Inset, current)
let moveWordRight() =
if (current < input.Length) then
let line = input.ToString()
let idxToMoveTo = Utils.nextWordFromIdx line (current + 1, false)
// if has reached end of the last word
if idxToMoveTo = current && current < line.Length
then current <- line.Length
else current <- idxToMoveTo
anchor.PlaceAt(x.Inset, current)
let setInput(line:string) =
input.Length <- 0
input.Append(line) |> ignore
current <- input.Length
render()
let tabPress(shift) =
let opts,prefix =
if changed then
changed <- false
x.GetOptions(input.ToString())
else
optionsCache,false
optionsCache <- opts
if (opts.Count > 0) then
let part =
if shift
then opts.Previous()
else opts.Next()
setInput(opts.Root + part)
else
if (prefix) then
Console.Beep()
else
insertTab()
let delete() =
if (input.Length > 0 && current < input.Length) then
input.Remove(current, 1) |> ignore
render()
let deleteFromStartOfLineToCursor() =
if (input.Length > 0 && current > 0) then
input.Remove (0, current) |> ignore
current <- 0
render()
let deleteWordLeadingToCursor() =
if (input.Length > 0 && current > 0) then
let line = input.ToString()
let idx = Utils.previousWordFromIdx line (current - 1, false)
input.Remove(idx, current - idx) |> ignore
current <- idx
render()
let deleteToEndOfLine() =
if (current < input.Length) then
input.Remove (current, input.Length - current) |> ignore
render()
let insert(key: ConsoleKeyInfo) =
// REVIEW: is this F6 rewrite required? 0x1A looks like Ctrl-Z.
// REVIEW: the Ctrl-Z code is not recognised as EOF by the lexer.
// REVIEW: looks like a relic of the port of readline, which is currently removable.
let c = if (key.Key = ConsoleKey.F6) then '\x1A' else key.KeyChar
let c = ConsoleOptions.readKeyFixup c
insertChar(c)
let backspace() =
if (input.Length > 0 && current > 0) then
input.Remove(current - 1, 1) |> ignore
current <- current - 1
render()
let enter() =
Console.Write("\n")
let line = input.ToString()
if (line = "\x1A") then null
else
if (line.Length > 0) then
history.AddLast(line)
line
let clear() =
current <- input.Length
let setPrompt prompt =
if prompt then // We only allow clearing if prompt is ">"
Console.Clear()
Console.Write (x.Prompt)
Console.Write(input.ToString())
anchor <- Anchor.Top(x.Inset)
let previous = history.Previous()
history.Next() |> ignore
if previous = "" then
setPrompt true
else
setPrompt (previous.EndsWith(";;"))
let writeCharCode(c:char) =
let ci = int c
if ci > 65530 then
Console.Write('[')
Console.Write(ci)
Console.Write(']')
let home() =
current <- 0
anchor.PlaceAt(x.Inset,0)
let rec read() =
let key = Console.ReadKey true
writeCharCode(key.KeyChar)
match key.Key with
| ConsoleKey.Backspace ->
backspace()
change()
| ConsoleKey.Delete ->
delete()
change()
| ConsoleKey.Enter ->
enter()
| ConsoleKey.Tab ->
tabPress(key.Modifiers &&& ConsoleModifiers.Shift <> enum 0)
Console.Write('t')
read()
| ConsoleKey.UpArrow ->
setInput(history.Previous())
change()
| ConsoleKey.DownArrow ->
setInput(history.Next())
change()
| ConsoleKey.RightArrow when key.Modifiers &&& ConsoleModifiers.Control = enum 0 ->
moveRight()
change()
| ConsoleKey.LeftArrow when key.Modifiers &&& ConsoleModifiers.Control = enum 0 ->
moveLeft()
change()
| ConsoleKey.Escape ->
setInput String.Empty
change()
| ConsoleKey.Home ->
home()
change()
| ConsoleKey.End ->
current <- input.Length
anchor.PlaceAt(x.Inset,rendered)
change()
| _ ->
match (key.Modifiers, key.Key) with
| (ConsoleModifiers.Control, ConsoleKey.A) ->
home()
change ()
| (ConsoleModifiers.Control, ConsoleKey.E) ->
current <- input.Length
anchor.PlaceAt(x.Inset, rendered)
change ()
| (ConsoleModifiers.Control, ConsoleKey.B) ->
moveLeft()
change ()
| (ConsoleModifiers.Control, ConsoleKey.F) ->
moveRight()
change ()
| (ConsoleModifiers.Control, ConsoleKey.LeftArrow)
| (ConsoleModifiers.Alt, ConsoleKey.B) ->
moveWordLeft()
change ()
| (ConsoleModifiers.Control, ConsoleKey.RightArrow)
| (ConsoleModifiers.Alt, ConsoleKey.F) ->
moveWordRight()
change ()
| (ConsoleModifiers.Control, ConsoleKey.K) ->
deleteToEndOfLine()
change()
| (ConsoleModifiers.Control,ConsoleKey.P) ->
setInput(history.Previous())
change()
| (ConsoleModifiers.Control, ConsoleKey.N) ->
setInput(history.Next())
change()
| (ConsoleModifiers.Control, ConsoleKey.D) ->
if (input.Length = 0) then
exit 0 //quit
else
delete()
change()
| (ConsoleModifiers.Control, ConsoleKey.L) ->
clear()
change()
| (ConsoleModifiers.Control, ConsoleKey.U) ->
deleteFromStartOfLineToCursor()
change()
| (ConsoleModifiers.Control, ConsoleKey.W) ->
deleteWordLeadingToCursor()
change()
| _ ->
// Note: If KeyChar=0, the not a proper char, e.g. it could be part of a multi key-press character,
// e.g. e-acute is ' and e with the French (Belgium) IME and US Intl KB.
// Here: skip KeyChar=0 (except for F6 which maps to 0x1A (ctrl-Z?)).
if key.KeyChar <> '\000' || key.Key = ConsoleKey.F6 then
insert(key)
change()
else
// Skip and read again.
read()
and change() =
changed <- true
read()
read()
let console = new ReadLineConsole()
console.ReadLine()
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment