diff --git a/src/lib/uTop.ml b/src/lib/uTop.ml index 37d00f5..8e3d1f8 100644 --- a/src/lib/uTop.ml +++ b/src/lib/uTop.ml @@ -27,6 +27,11 @@ let history = LTerm_history.create [] let history_file_name = ref (Some (Filename.concat LTerm_resources.home ".utop-history")) let history_file_max_size = ref None let history_file_max_entries = ref None +let stashable_session_history = + (LTerm_history.create + ~max_size:max_int + ~max_entries:max_int + []) (* +-----------------------------------------------------------------+ | Hooks | @@ -537,6 +542,7 @@ utop defines the following directives: #help : list all directives #utop_bindings : list all the current key bindings #utop_macro : display the currently recorded macro +#utop_stash : store all the valid commands from your current session in a file #topfind_log : display messages recorded from findlib since the beginning of the session #topfind_verbose : enable/disable topfind verbosity @@ -629,6 +635,34 @@ let () = (Toploop.Directive_none (fun () -> print_endline (Sys.getcwd ()))) +let () = + Hashtbl.add Toploop.directive_table "utop_stash" + (Toploop.Directive_string + (fun fname -> + let _ :: entries = LTerm_history.contents stashable_session_history in + (* getting and then reversing the entries instead of using + [LTerm_history.save] because the latter escapes newline characters *) + let () = + Printf.printf + "Stashing %d entries in %s... " + (List.length entries / 2) (* because half are comments *) + fname + in + let entries = List.rev entries in + try + let oc = open_out fname in + try + List.iter + (fun e -> + output_string oc (e ^ "\n")) + entries; + close_out oc; + Printf.printf "Done.\n"; + with exn -> + close_out oc; + Printf.printf "Done.\n"; + with exn -> Printf.printf "Error with file %s.\n" fname)) + (* +-----------------------------------------------------------------+ | Camlp4 | +-----------------------------------------------------------------+ *) diff --git a/src/lib/uTop.mli b/src/lib/uTop.mli index e77f9de..3e7f5cd 100644 --- a/src/lib/uTop.mli +++ b/src/lib/uTop.mli @@ -210,6 +210,15 @@ val history_file_max_entries : int option ref default) the maximum number of entries if [history] will be used. *) +val stashable_session_history : LTerm_history.t + (** A history consisting only of expressions successfully evaluated + during the current session. Because stashing is supposed to + produce a valid OCaml file which will behave roughly the same as + the console, it is best if this history never gets truncated, so + its maximum size is set at [max_int]. While this will certainly + lead to a slight memory leaking problem, UTop sessions are + rarely long enough to make it a serious issue. *) + (** {6 Console specific configuration} *) type profile = Dark | Light diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 5b4b923..0ebb0c9 100644 --- a/src/lib/uTop_main.ml +++ b/src/lib/uTop_main.ml @@ -111,7 +111,8 @@ let parse_and_check input eos_is_error = UTop.Value (Parsetree.Ptop_def pstr) with Pparse.Error error -> Pparse.report_error Format.str_formatter error; - UTop.Error ([], Format.flush_str_formatter ()) + let err_string = Format.flush_str_formatter () in + UTop.Error ([], err_string) end #endif | _ -> input @@ -121,7 +122,8 @@ let parse_and_check input eos_is_error = (fun () -> match preprocess (!UTop.parse_toplevel_phrase input eos_is_error) with | UTop.Error (locs, msg) -> - UTop.Error (convert_locs input locs, "Error: " ^ msg ^ "\n") + let msg = "Error: " ^ msg in + UTop.Error (convert_locs input locs, msg ^ "\n") | UTop.Value phrase -> match UTop.check_phrase phrase with | None -> @@ -189,6 +191,15 @@ class read_phrase ~term = object(self) let result = parse_and_check input eos_is_error in return_value <- Some result; LTerm_history.add UTop.history input; + ignore( + match result with + | UTop.Value _, _ -> + LTerm_history.add UTop.stashable_session_history input + | (UTop.Error (_, msg)), _ -> + let input = "(* " ^ (String.trim input) ^ " *)" in + LTerm_history.add UTop.stashable_session_history input; + let stash_msg = "(* " ^ (String.trim msg) ^ " *)\n" in + LTerm_history.add UTop.stashable_session_history stash_msg); return result with UTop.Need_more -> (* Input not finished, continue. *) @@ -649,13 +660,12 @@ let rec loop term = match result with | UTop.Value phrase -> return (Some phrase) - | UTop.Error (_, msg) -> + | UTop.Error (locs, msg) -> print_error term msg >>= fun () -> return None) (fun () -> LTerm.flush term) ) in - match phrase_opt with | Some phrase -> (* Rewrite toplevel expressions. *) @@ -680,6 +690,8 @@ let rec loop term = (* Get the string printed. *) Format.pp_print_flush pp (); let string = Buffer.contents buffer in + let string' = "(* " ^ (String.trim string) ^ " *)\n" in + let _ = LTerm_history.add UTop.stashable_session_history string' in match phrase with | Parsetree.Ptop_def _ -> (* The string is an output phrase, colorize it. *)