diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml index 60c57e9..a15abdb 100644 --- a/src/lib/uTop_main.ml +++ b/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 diff --git a/src/top/utop.el b/src/top/utop.el index 32fb439..491e85d 100644 --- a/src/top/utop.el +++ b/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)