From dcdab7ac0fe43f7c558a00ac8c724e3a953b80e8 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Fri, 17 Feb 2012 11:51:27 +0100
Subject: [PATCH] handle directive errors

Ignore-this: f9d34b11616ac661ed173d247b41cfe1

darcs-hash:20120217105127-c41ad-c23ea68992ece18a620ae19947307497935c7fef
---
 src/lib/uTop_main.ml | 35 ++++++++++++++++++++++++++++++-----
 1 file changed, 30 insertions(+), 5 deletions(-)

diff --git a/src/lib/uTop_main.ml b/src/lib/uTop_main.ml
index 1bd857c..8abdf4c 100644
--- a/src/lib/uTop_main.ml
+++ b/src/lib/uTop_main.ml
@@ -328,8 +328,20 @@ let rec loop term =
         let cols = (LTerm.size term).cols in
         update_margin Format.std_formatter cols;
         update_margin Format.err_formatter cols;
-        (* No exception can be raised at this stage. *)
-        ignore (Toploop.execute_phrase true Format.std_formatter phrase);
+        (try
+           ignore (Toploop.execute_phrase true Format.std_formatter phrase)
+         with exn ->
+           (* The only possible errors are directive errors. *)
+           let msg = UTop.get_message Errors.report_error exn in
+           (* Skip the dumb location. *)
+           let msg =
+             try
+               let idx = String.index msg '\n' + 1 in
+               String.sub msg idx (String.length msg - idx)
+             with Not_found ->
+               msg
+           in
+           Lwt_main.run (print_error msg));
         loop term
     | None ->
         loop term
@@ -505,13 +517,26 @@ module Emacs(M : sig end) = struct
   let process_input add_to_history eos_is_error =
     let input = read_data () in
     match parse_and_check input eos_is_error with
-      | UTop.Value phrase ->
+      | UTop.Value phrase -> begin
           send "accept" "";
           if add_to_history then LTerm_history.add UTop.history input;
           (* Add Lwt_main.run to toplevel evals. *)
           let phrase = if UTop.get_auto_run_lwt () then insert_lwt_main_run phrase else phrase in
-          (* No exception can be raised at this stage. *)
-          ignore (Toploop.execute_phrase true Format.std_formatter phrase)
+          try
+            ignore (Toploop.execute_phrase true Format.std_formatter phrase)
+          with exn ->
+            (* The only possible errors are directive errors. *)
+            let msg = UTop.get_message Errors.report_error exn in
+            (* Skip the dumb location. *)
+            let msg =
+              try
+                let idx = String.index msg '\n' + 1 in
+                String.sub msg idx (String.length msg - idx)
+              with Not_found ->
+                msg
+            in
+            List.iter (send "stderr") (split_at ~trim:true '\n' msg)
+        end
       | UTop.Error (locs, msg) ->
           send "accept" (String.concat "," (List.map (fun (a, b) -> Printf.sprintf "%d,%d" a b) locs));
           if add_to_history then LTerm_history.add UTop.history input;