more history settings

Ignore-this: d048fb6bc7cc235fdc4ea6c75d4525a4

darcs-hash:20120212193712-c41ad-96b5f2057ff55811cdd90a8e8ae2be3e4af3d4d3

src/lib/uTop.ml

@@ -17,7 +17,14 @@ module String_set = Set.Make(String)
 
 let version = UTop_version.version
 
+(* +-----------------------------------------------------------------+
+   | History                                                         |
+   +-----------------------------------------------------------------+ *)
+
 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
 
 (* +-----------------------------------------------------------------+
    | Hooks                                                           |

src/lib/uTop.mli

@@ -14,19 +14,6 @@ open React
 val version : string
   (** Version of utop. *)
 
-val history : LTerm_history.t
-  (** The history used by utop. You can configure limits using the
-      [LTerm_history] module.
-
-      For example if you want to limit the history to 1000 line, add
-      these lines to your ~/.ocamlinit file:
-
-      {[
-        #require "lambda-term";;
-        LTerm_history.set_max_entries UTop.history 1000;;
-      ]}
-  *)
-
 val count : int React.signal
   (** The number of commands already executed. *)
 
@@ -84,6 +71,34 @@ val get_auto_run_lwt : unit -> bool
 val set_auto_run_lwt : bool -> unit
   (** Modifies {!auto_run_lwt}. *)
 
+(** {6 History} *)
+
+val history : LTerm_history.t
+  (** The history used by utop. You can configure limits using the
+      [LTerm_history] module.
+
+      For example if you want to limit the history to 1000 line, add
+      these lines to your ~/.ocamlinit file:
+
+      {[
+        #require "lambda-term";;
+        LTerm_history.set_max_entries UTop.history 1000;;
+      ]}
+  *)
+
+val history_file_name : string option ref
+  (** Name of the history file. If [None], no history will be loaded
+      or saved. *)
+
+val history_file_max_size : int option ref
+  (** Maximum size of the history file. If [None] (the default) the
+      maximum size of [history] will be used. *)
+
+val history_file_max_entries : int option ref
+  (** Maximum entries to store in the history file. If [None] (the
+      default) the maximum number of entries if [history] will be
+      used. *)
+
 (** {6 Console specific configuration} *)
 
 type profile = Dark | Light

src/lib/uTop_main.ml

@@ -23,10 +23,22 @@ module String_set = Set.Make(String)
    +-----------------------------------------------------------------+ *)
 
 let init_history () =
-  let fn = Filename.concat LTerm_resources.home ".utop-history" in
   (* Save history on exit. *)
-  Lwt_main.at_exit (fun () -> LTerm_history.save UTop.history ~append:true fn);
+  Lwt_main.at_exit
+    (fun () ->
+       match !UTop.history_file_name with
+         | None ->
+             return ()
+         | Some fn ->
+             try_lwt
+               LTerm_history.save UTop.history ?max_size:!UTop.history_file_max_size ?max_entries:!UTop.history_file_max_entries fn
+             with Unix.Unix_error (error, func, arg) ->
+               Lwt_log.error_f "cannot save history to %S: %s: %s" fn func (Unix.error_message error));
   (* Load history. *)
+  match !UTop.history_file_name with
+    | None ->
+        return ()
+    | Some fn ->
         try_lwt
           LTerm_history.load UTop.history fn
         with Unix.Unix_error (error, func, arg) ->
@@ -667,11 +679,14 @@ let main_aux () =
       (* Install our out phrase printer. *)
       Toploop.print_out_phrase := print_out_phrase term !Toploop.print_out_phrase;
       (* Load user data. *)
-      Lwt_main.run (join [init_history (); UTop_styles.load (); load_inputrc ()]);
+      Lwt_main.run (join [UTop_styles.load (); load_inputrc ()]);
       (* Display a welcome message. *)
       Lwt_main.run (welcome term);
       (* Common initialization. *)
       common_init ();
+      (* Load history after the initialization file so the user can
+         change the history file name. *)
+      Lwt_main.run (init_history ());
       (* Print help message. *)
       print_string "\nType #utop_help for help about using utop.\n\n";
       flush stdout;