update the date in the prompt only at new commands

Ignore-this: e4124f10f7bf14d078d529d688cf1e5

darcs-hash:20110804094320-c41ad-279bb1a2449f896f7b0b368804cc311a8bf85c42

src/uTop.ml

@@ -32,6 +32,15 @@ let default_keywords = [
 let keywords = ref (List.fold_left (fun set kwd -> String_set.add kwd set) String_set.empty default_keywords)
 let add_keyword kwd = keywords := String_set.add kwd !keywords
 
+(* +-----------------------------------------------------------------+
+   | Hooks                                                           |
+   +-----------------------------------------------------------------+ *)
+
+let new_command_hooks = Lwt_sequence.create ()
+let at_new_command f = ignore (Lwt_sequence.add_l f new_command_hooks)
+let new_prompt_hooks = Lwt_sequence.create ()
+let at_new_prompt f = ignore (Lwt_sequence.add_l f new_prompt_hooks)
+
 (* +-----------------------------------------------------------------+
    | Prompts                                                         |
    +-----------------------------------------------------------------+ *)
@@ -46,8 +55,12 @@ let key_sequence = UTop_private.key_sequence
 
 let count = UTop_private.count
 
+let time = ref 0.
+
+let () = at_new_prompt (fun () -> time := Unix.time ())
+
 let make_prompt profile count size key_sequence (recording, macro_count, macro_counter) =
-  let tm = Unix.localtime (Unix.time ()) in
+  let tm = Unix.localtime !time in
   let color dark light =
     match profile with
       | Dark -> dark

src/uTop.mli

@@ -53,3 +53,20 @@ val prompt_comment : LTerm_text.t React.signal ref
 
       For compatibility with ocaml error printing, it must ends with a
       line of length 2. *)
+
+(** {6 Hooks} *)
+
+val new_command_hooks : (unit -> unit) Lwt_sequence.t
+  (** Functions called before each new command. *)
+
+val at_new_command : (unit -> unit) -> unit
+  (** [at_new_command f] adds [f] to the hooks executed before each
+      new commands. *)
+
+val new_prompt_hooks : (unit -> unit) Lwt_sequence.t
+  (** Functions executed before each new prompt, including
+      continuation prompts. *)
+
+val at_new_prompt : (unit -> unit) -> unit
+  (** [at_new_prompt f] adds [f] to the hooks executed before each new
+      prompt. *)

src/uTop_console.ml

@@ -438,7 +438,9 @@ object(self)
     (* Set the source signal for the key sequence. *)
     UTop_private.set_key_sequence self#key_sequence;
     (* Set the prompt. *)
-    self#set_prompt prompt
+    self#set_prompt prompt;
+    (* Call hooks. *)
+    Lwt_sequence.iter_l (fun f -> f ()) UTop.new_prompt_hooks
 end
 
 (* +-----------------------------------------------------------------+
@@ -477,6 +479,9 @@ let rec read_input term prompt buffer len =
                      history := LTerm_read_line.add_entry line !history;
                      pending := None);
 
+              (* Call hooks. *)
+              Lwt_sequence.iter_l (fun f -> f ()) UTop.new_command_hooks;
+
               !UTop.prompt
 
           | "* " ->

src/uTop_emacs.ml

@@ -108,9 +108,18 @@ let rec read_input prompt buffer length =
            (* Increment the command counter. *)
            UTop_private.set_count (React.S.value UTop_private.count + 1);
 
-           send "prompt" ""
+           (* Call hooks. *)
+           Lwt_sequence.iter_l (fun f -> f ()) UTop.new_command_hooks;
+           Lwt_sequence.iter_l (fun f -> f ()) UTop.new_prompt_hooks;
+
+           send "prompt" "";
+
        | "* " | "  " ->
            (* Continuation of the current phrase. *)
+
+           (* Call hooks. *)
+           Lwt_sequence.iter_l (fun f -> f ()) UTop.new_prompt_hooks;
+
            send "continue" ""
        | _ ->
            Printf.ksprintf (send "stderr") "unrecognized prompt %S!" prompt;