affiche numeros de caracteres ET soulignement pour dumb

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4698 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Jacques Garrigue 2002-04-18 08:50:43 +00:00
parent 87f8871ef6
commit 59d5d16cf3
2 changed files with 9 additions and 8 deletions

View File

@ -44,16 +44,16 @@ let status = ref Terminfo.Uninitialised
let num_loc_lines = ref 0 (* number of lines already printed after input *) let num_loc_lines = ref 0 (* number of lines already printed after input *)
let rec highlight_locations loc1 loc2 = let rec highlight_locations ppf loc1 loc2 =
match !status with match !status with
Terminfo.Uninitialised -> Terminfo.Uninitialised ->
status := Terminfo.setup stdout; highlight_locations loc1 loc2 status := Terminfo.setup stdout; highlight_locations ppf loc1 loc2
| Terminfo.Bad_term -> | Terminfo.Bad_term ->
begin match !input_lexbuf with begin match !input_lexbuf with
None -> false None -> false
| Some lb -> | Some lb ->
try try
if Sys.getenv "TERM" = "character" then false else raise Not_found if Sys.getenv "TERM" = "norepeat" then false else raise Not_found
with Not_found -> with Not_found ->
try try
(* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *) (* Char 0 is at offset -lb.lex_abs_pos in lb.lex_buffer. *)
@ -67,7 +67,9 @@ let rec highlight_locations loc1 loc2 =
done; done;
let end_pos = lb.lex_buffer_len - pos0 - 1 in let end_pos = lb.lex_buffer_len - pos0 - 1 in
let pos_at_bol = ref 0 in let pos_at_bol = ref 0 in
print_string "Toplevel input:\n# "; Format.fprintf ppf "Characters %i-%i:@."
loc1.loc_start loc1.loc_end;
print_string " ";
(* Print the input, underlining the location *) (* Print the input, underlining the location *)
for pos = 0 to end_pos do for pos = 0 to end_pos do
let c = lb.lex_buffer.[pos + pos0] in let c = lb.lex_buffer.[pos + pos0] in
@ -86,8 +88,7 @@ let rec highlight_locations loc1 loc2 =
else if !pos_at_bol <= loc1.loc_start && loc1.loc_start < pos else if !pos_at_bol <= loc1.loc_start && loc1.loc_start < pos
then begin then begin
print_char '\r'; print_char '\r';
print_char (if !pos_at_bol = 0 then '#' else ' '); print_string " ";
print_char ' ';
for i = !pos_at_bol to loc1.loc_start - 1 do for i = !pos_at_bol to loc1.loc_start - 1 do
print_char '.' print_char '.'
done; done;
@ -165,7 +166,7 @@ let (msg_file, msg_line, msg_chars, msg_to, msg_colon, msg_head) =
let print ppf loc = let print ppf loc =
if String.length !input_name = 0 then if String.length !input_name = 0 then
if highlight_locations loc none then () else if highlight_locations ppf loc none then () else
fprintf ppf "Characters %i-%i:@." loc.loc_start loc.loc_end fprintf ppf "Characters %i-%i:@." loc.loc_start loc.loc_end
else begin else begin
let (filename, linenum, linebeg) = let (filename, linenum, linebeg) =

View File

@ -26,7 +26,7 @@ exception Escape_error
let report_error ppf = function let report_error ppf = function
| Unclosed(opening_loc, opening, closing_loc, closing) -> | Unclosed(opening_loc, opening, closing_loc, closing) ->
if String.length !Location.input_name = 0 if String.length !Location.input_name = 0
&& Location.highlight_locations opening_loc closing_loc && Location.highlight_locations ppf opening_loc closing_loc
then fprintf ppf "Syntax error: '%s' expected, \ then fprintf ppf "Syntax error: '%s' expected, \
the highlighted '%s' might be unmatched" closing opening the highlighted '%s' might be unmatched" closing opening
else begin else begin