Add UTop.end_and_accept_current_phrase

Closes #131

src/lib/uTop.cppo.ml

@@ -76,6 +76,10 @@ let auto_run_lwt, get_auto_run_lwt, set_auto_run_lwt = make_variable true
 let auto_run_async, get_auto_run_async, set_auto_run_async = make_variable true
 let topfind_verbose, get_topfind_verbose, set_topfind_verbose = make_variable false
 
+(* Ugly hack until the action system of lambda-term is improved *)
+let end_and_accept_current_phrase : LTerm_read_line.action =
+  Edit (Custom (fun () -> assert false))
+
 (* +-----------------------------------------------------------------+
    | Keywords                                                        |
    +-----------------------------------------------------------------+ *)
@@ -499,6 +503,18 @@ let () =
 module Bindings = Zed_input.Make (LTerm_key)
 module Keys_map = Map.Make (struct type t = LTerm_key.t list let compare = compare end)
 
+let name_of_action action =
+  if action == end_and_accept_current_phrase then
+    "end-and-accept-current-phrase"
+  else
+    LTerm_read_line.name_of_action action
+
+let doc_of_action action =
+  if action == end_and_accept_current_phrase then
+    "end the current phrase with the phrase terminator (;;) and evaluate it"
+  else
+    LTerm_read_line.doc_of_action action
+
 let () =
   Hashtbl.add Toploop.directive_table "utop_help"
     (Toploop.Directive_none
@@ -533,20 +549,29 @@ For a complete description of utop, look at the utop(1) manual page."));
                           loop
                             actions
                             (("",
-                              LTerm_read_line.name_of_action action,
-                              LTerm_read_line.doc_of_action action)
+                              name_of_action action,
+                              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)
+                      name_of_action action,
+                      doc_of_action action)
                      :: acc)
           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
+              (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 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) ->
@@ -582,7 +607,7 @@ For a complete description of utop, look at the utop(1) manual page."));
           let macro = Zed_macro.contents LTerm_read_line.macro in
           List.iter
             (fun action ->
-               output_string stdout (LTerm_read_line.name_of_action action);
+               output_string stdout (name_of_action action);
                output_char stdout '\n')
             macro;
           flush stdout))

src/lib/uTop.mli

@@ -154,6 +154,19 @@ val get_auto_run_async : unit -> bool
 val set_auto_run_async : bool -> unit
   (** Modifies {!auto_run_async}. *)
 
+val end_and_accept_current_phrase : LTerm_read_line.action
+ (** Action that add the phrase terminator at the end of the current phrase
+     and accepts it. For instance to avoid typing [;;], add this to your
+     ~/.ocamlinit:
+
+     {[
+       #require "lambda-term";;
+       LTerm_read_line.bind
+         [ { control = false; meta = false; shift = false; code = Enter } ]
+         [ UTop.end_and_accept_current_phrase ]
+     ]}
+ *)
+
 (** {6 History} *)
 
 val history : LTerm_history.t
@@ -234,7 +247,6 @@ type 'a result =
 exception Need_more
   (** Exception raised by a parser when it need more data. *)
 
-(*val parse_use_file : (string -> bool -> ((Camlp4.PreCast.Syntax.Ast.str_item list * Camlp4.PreCast.Syntax.Loc.t option) Camlp4.PreCast.Syntax.Gram.Entry.t) result) ref*)
 val parse_use_file : (string -> bool -> Parsetree.toplevel_phrase list result) ref
 
 val parse_use_file_default : string -> bool -> Parsetree.toplevel_phrase list result

src/lib/uTop_main.cppo.ml

@@ -125,6 +125,17 @@ let parse_and_check input eos_is_error =
   in
   (result, Buffer.contents buf)
 
+let add_terminator s =
+  let terminator = UTop.get_phrase_terminator () in
+  if Zed_utf8.ends_with s terminator then
+    s
+  else
+    s ^ terminator
+
+let is_accept : LTerm_read_line.action -> bool = function
+  | Accept -> true
+  | action -> action == UTop.end_and_accept_current_phrase
+
 (* Read a phrase. If the result is a value, it is guaranteed to by a
    valid phrase (i.e. typable and compilable). It also returns
    warnings printed parsing. *)
@@ -138,18 +149,24 @@ class read_phrase ~term = object(self)
     match return_value with
     | Some x ->
       x
-      | None ->
-          assert false
+    | None -> assert false
 
   method exec = function
-    | LTerm_read_line.Accept :: actions when !UTop.smart_accept && S.value self#mode = LTerm_read_line.Edition -> begin
-        Zed_macro.add self#macro LTerm_read_line.Accept;
-        (* Try to parse the input. *)
+    | action :: actions when S.value self#mode = LTerm_read_line.Edition &&
+                             is_accept action  -> begin
+        Zed_macro.add self#macro action;
         let input = Zed_rope.to_string (Zed_edit.text self#edit) in
+        let input =
+          if action == UTop.end_and_accept_current_phrase then
+            add_terminator input
+          else
+            input
+        in
         (* Toploop does that: *)
         Location.reset ();
+        let eos_is_error = not !UTop.smart_accept in
         try
-          let result = parse_and_check input false in
+          let result = parse_and_check input eos_is_error in
           return_value <- Some result;
           LTerm_history.add UTop.history input;
           return result