affiche numeros de caracteres ET soulignement pour dumb
git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@4698 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
parent
87f8871ef6
commit
59d5d16cf3
|
@ -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) =
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue