TODO: Recheck and Recommit this! Don't merge to master!

src/ncurses/Repl.ml

 
 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

 
 
-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

@@ -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