Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
Software
COOL
Commits
5a2c1338
Commit
5a2c1338
authored
Jan 22, 2015
by
Thorsten Wißmann
🐧
Browse files
TODO: Recheck and Recommit this! Don't merge to master!
parent
69a71d22
Changes
3
Hide whitespace changes
Inline
Side-by-side
src/ncurses/Repl.ml
View file @
5a2c1338
open
Readline
type
binding
=
string
*
(
unit
->
unit
)
(* name, callback, shortdescription, long description *)
type
binding
=
string
*
(
string
list
->
unit
)
*
string
*
string
type
settings
=
{
prompt
:
string
;
...
...
@@ -10,7 +11,7 @@ type settings = {
let
session
:
settings
option
ref
=
ref
(
None
)
let
bind
a
b
=
(
a
,
b
)
let
bind
a
b
c
d
=
(
a
,
b
,
c
,
d
)
(* (* for debugging purposes... *)
let cmp a b =
...
...
@@ -21,10 +22,32 @@ let cmp a b =
print_endline ("a<>b -> >"^(string_of_bool (a <> b))^"<")
*)
let
helpCommand
bindings
args
=
(*
let maxCommandLen = ref 0 in
List.iter (fun (n,_) => maxCommandLen := Pervasives.max (Str.length n) !maxCommandLen) bindings
*)
let
printBinding
(
name
,_,
shortdesc
,
_
)
=
Printf
.
printf
" %-10s %s
\n
"
name
shortdesc
in
List
.
iter
printBinding
bindings
;
flush
stdout
let
addHelpBinding
bindings
=
(* do some workaround for this kind of recursive structure *)
let
rec
newBinds
withFunction
=
let
d
=
"Prints this help"
in
List
.
append
(
if
withFunction
then
[
bind
"help"
(
helpCommand
(
newBinds
false
))
d
""
]
else
[
bind
"help"
(
fun
_
->
()
)
d
""
]
)
bindings
in
newBinds
true
let
start
(
settings
:
settings
)
:
unit
=
session
:=
Some
(
settings
);
let
findBinding
(
name
:
string
)
:
binding
=
let
checkname
(
n
,_
)
=
(
name
=
n
)
in
let
checkname
(
n
,_
,_,_
)
=
(
name
=
n
)
in
List
.
find
checkname
(
settings
.
bindings
)
in
let
rec
loop
()
=
...
...
@@ -39,8 +62,8 @@ let start (settings: settings): unit =
|
(
v
::_
)
when
v
=
""
->
()
|
(
name
::
args
)
->
try
let
(
_
,
callback
)
=
findBinding
name
in
callback
()
let
(
_
,
callback
,_,_
)
=
findBinding
name
in
callback
[]
with
Not_found
->
begin
let
msg
=
"Command »"
^
name
^
"« not found."
in
print_endline
msg
...
...
@@ -55,3 +78,6 @@ let start (settings: settings): unit =
let
stop
()
=
session
:=
None
let
exitBinding
:
binding
=
bind
"exit"
(
fun
_
->
stop
()
)
"exits this tool"
""
src/ncurses/Repl.mli
View file @
5a2c1338
type
binding
=
string
*
(
unit
->
unit
)
(* name, callback, shortdescription, long description *)
type
binding
=
string
*
(
string
list
->
unit
)
*
string
*
string
type
settings
=
{
prompt
:
string
;
bindings
:
binding
list
;
}
val
bind
:
string
->
(
unit
->
unit
)
->
binding
val
helpCommand
:
binding
list
->
(
string
list
->
unit
)
val
addHelpBinding
:
binding
list
->
binding
list
val
bind
:
string
->
(
string
list
->
unit
)
->
string
->
string
->
binding
val
start
:
settings
->
unit
val
stop
:
unit
->
unit
val
exitBinding
:
binding
src/repl-example/repl-example.ml
View file @
5a2c1338
...
...
@@ -31,8 +31,8 @@ let main3 () =
let
main4
()
=
let
session
=
{
Repl
.
prompt
=
"> "
;
Repl
.
bindings
=
[
Repl
.
bind
"exit"
(
fun
()
->
Repl
.
stop
()
)
Repl
.
bindings
=
Repl
.
addHelpBinding
[
Repl
.
exitBinding
];
}
in
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment