save history before killing the emacs buffer

Ignore-this: 165539f1b3cc25e7bbfe51c29c378798

darcs-hash:20120213145725-c41ad-5c47d1977067310ba024249b47b8251ff1b10ee9

src/lib/uTop_main.ml

@@ -22,18 +22,19 @@ module String_set = Set.Make(String)
    | History                                                         |
    +-----------------------------------------------------------------+ *)
 
+let save_history () =
+  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)
+
 let init_history () =
   (* Save history on exit. *)
-  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));
+  Lwt_main.at_exit save_history;
   (* Load history. *)
   match !UTop.history_file_name with
     | None ->
@@ -569,6 +570,9 @@ module Emacs(M : sig end) = struct
         end
       | Some ("exit", code) ->
           exit (int_of_string code)
+      | Some ("save-history", code) ->
+          Lwt_main.run (save_history ());
+          loop_commands history_prev history_next
       | Some (command, _) ->
           Printf.ksprintf (send "stderr") "unrecognized command %S!" command;
           exit 1

src/top/utop.el

@@ -302,6 +302,13 @@ to add the newline character if it is not accepted).")
       (setq utop-pending-entry nil)
       (utop-send-data "history-next:\n"))))
 
+(defun utop-save-history ()
+  "Save history to the history file."
+  (interactive)
+  (with-current-buffer utop-buffer-name
+    (unless (eq utop-state 'done)
+      (process-send-string utop-process "save-history:\n"))))
+
 ;; +-----------------------------------------------------------------+
 ;; | Receiving input from the utop sub-process                     |
 ;; +-----------------------------------------------------------------+
@@ -677,10 +684,12 @@ To automatically do that just add these lines to your .emacs:
 (defun utop-exit (&optional exit-code)
   "Try to gracefully exit utop.
 
-EXIT-CODE is the exit code that shoud be used. It defaults to 0."
+EXIT-CODE is the exit code that shoud be returned by utop. It
+defaults to 0."
   (interactive)
   (with-current-buffer utop-buffer-name
-    (process-send-string utop-process (format "exit:%d\n" (or exit-code 0)))))
+    (unless (eq utop-state 'done)
+      (process-send-string utop-process (format "exit:%d\n" (or exit-code 0))))))
 
 (defun utop-sentinel (process msg)
   "Callback for process' state change."
@@ -865,6 +874,9 @@ EXIT-CODE is the exit code that shoud be used. It defaults to 0."
   ;; Register the exit hook
   (add-hook 'kill-buffer-hook (lambda () (run-hooks 'utop-exit-hook)) t t)
 
+  ;; Save history before killing the buffer
+  (add-hook 'kill-buffer-query-functions (lambda () (utop-save-history) t) nil t)
+
   ;; Start utop
   (utop-start arguments)