haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

use the new input system 

Ignore-this: d474c7d33d21321167507d1ce45eda55

darcs-hash:20110801204429-c41ad-5be3e7c40dfdd9cb2c22f97c600d7ea13fa52980
This commit is contained in:
Jeremie Dimino 2011-08-01 22:44:29 +02:00
parent 2d4b4ec919
commit 5c9d0a1a88
1 changed files with 31 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/uTop.ml
View File

@ -68,7 +68,8 @@ let prompt_comment = ref (S.const [|(UChar.of_char '*', { none with foreground =
| Help |
+-----------------------------------------------------------------+ *)
module Key_map = Map.Make(struct type t = LTerm_key.t let compare = compare end)
module Bindings = Zed_input.Make (LTerm_key)
module Keys_map = Map.Make (struct type t = LTerm_key.t list let compare = compare end)
let () =
Hashtbl.add Toploop.directive_table "utop_help"
@ -82,14 +83,36 @@ let () =
Hashtbl.add Toploop.directive_table "utop_bindings"
(Toploop.Directive_none
(fun () ->
let make_line key action =
(LTerm_key.to_string_compact key,
LTerm_read_line.name_of_action action,
LTerm_read_line.doc_of_action action)
let make_lines keys actions acc =
match actions with
| [] ->
(String.concat " " (List.map LTerm_key.to_string_compact keys),
"",
"does nothing")
:: acc
| action :: actions ->
let rec loop actions acc =
match actions with
| [] ->
acc
| action :: actions ->
loop
actions
(("",
LTerm_read_line.name_of_action action,
LTerm_read_line.doc_of_action action)
:: acc)
in
loop
actions
((String.concat " " (List.map LTerm_key.to_string_compact keys),
LTerm_read_line.name_of_action action,
LTerm_read_line.doc_of_action action)
:: acc)
in
let bindings = Hashtbl.fold (fun key action map -> Key_map.add key (LTerm_read_line.Edit action) map) LTerm_edit.bindings Key_map.empty in
let bindings = Hashtbl.fold Key_map.add LTerm_read_line.bindings bindings in
let table = Key_map.fold (fun key action acc -> make_line key action :: acc) bindings [] in
let bindings = Bindings.fold (fun key actions map -> Keys_map.add key (List.map (fun action -> (LTerm_read_line.Edit action)) actions) map) !LTerm_edit.bindings Keys_map.empty in
let bindings = Bindings.fold Keys_map.add !LTerm_read_line.bindings bindings in
let table = List.rev (Keys_map.fold (fun keys action acc -> make_lines keys action acc) bindings []) in
let size_key, size_name, size_doc =
List.fold_left
(fun (size_key, size_name, size_doc) (key, name, doc) ->