let display_type_annot (v:Ed_sourceview.sourceview) args =
let f = v#file#filename in
try
let annot_file =
try
if Filename.check_suffix f ".ml" then
(Filename.chop_extension f)^".annot"
else
raise Not_found
with _ -> failwith "File has no .ml extension"
in
match Ed_misc.date_of_file f, Ed_misc.date_of_file annot_file with
None, _ -> failwith ("Could not access "^f)
| Some _, None -> failwith ("Could not access "^annot_file)
| Some d1, Some d2 ->
if d1 > d2 then
failwith
(Printf.sprintf "Source was modified since %s was created" annot_file)
else
begin
let loc_start =
let (start,_) = v#file#buffer#selection_bounds in
Cam_misc.utf8_string_length
(v#file#mode_from_display
(v#file#buffer#get_text ~start: v#file#buffer#start_iter ~stop: start ()))
in
let annot_string = Ed_misc.string_of_file annot_file in
match Dtypes.build_tree annot_string with
None -> failwith "No tree built"
| Some t ->
match Dtypes.search_in_tree loc_start t with
None -> failwith "No type annot found"
| Some (left,right,start,stop) ->
let from_display =
v#file#mode_from_display
(v#file#buffer#get_text ())
in
let (left, right) =
let left =
Cam_misc.utf8_string_length
(v#file#mode_to_display
(String.sub from_display 0 left))
in
let right =
Cam_misc.utf8_string_length
(v#file#mode_to_display
(String.sub from_display 0 right))
in
(left, right)
in
let s = String.sub annot_string start (stop-start) in
let start = v#file#buffer#get_iter (`OFFSET left) in
let stop = v#file#buffer#get_iter (`OFFSET right) in
v#file#buffer#select_range start stop;
Ed_misc.set_active_action_message (Ed_misc.to_utf8 s);
end
with
Not_found ->
()
| Failure s
| Sys_error s ->
Ed_misc.set_active_action_message s