haskal
/
utop
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

handle directive errors 

Ignore-this: f9d34b11616ac661ed173d247b41cfe1

darcs-hash:20120217105127-c41ad-c23ea68992ece18a620ae19947307497935c7fef
This commit is contained in:
Jeremie Dimino 2012-02-17 11:51:27 +01:00
parent 02e8648628
commit dcdab7ac0f
1 changed files with 30 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/lib/uTop_main.ml
View File

@ -328,8 +328,20 @@ let rec loop term =
let cols = (LTerm.size term).cols in let cols = (LTerm.size term).cols in
update_margin Format.std_formatter cols; update_margin Format.std_formatter cols;
update_margin Format.err_formatter cols; update_margin Format.err_formatter cols;
(* No exception can be raised at this stage. *) (try
ignore (Toploop.execute_phrase true Format.std_formatter phrase); 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 loop term
| None -> | None ->
loop term loop term
@ -505,13 +517,26 @@ module Emacs(M : sig end) = struct
let process_input add_to_history eos_is_error = let process_input add_to_history eos_is_error =
let input = read_data () in let input = read_data () in
match parse_and_check input eos_is_error with match parse_and_check input eos_is_error with
| UTop.Value phrase -> | UTop.Value phrase -> begin
send "accept" ""; send "accept" "";
if add_to_history then LTerm_history.add UTop.history input; if add_to_history then LTerm_history.add UTop.history input;
(* Add Lwt_main.run to toplevel evals. *) (* Add Lwt_main.run to toplevel evals. *)
let phrase = if UTop.get_auto_run_lwt () then insert_lwt_main_run phrase else phrase in 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. *) try
ignore (Toploop.execute_phrase true Format.std_formatter phrase) 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) -> | UTop.Error (locs, msg) ->
send "accept" (String.concat "," (List.map (fun (a, b) -> Printf.sprintf "%d,%d" a b) locs)); 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; if add_to_history then LTerm_history.add UTop.history input;