let _ = Ed_mode_ocaml_rc.read ()
let _ = Ed_mode_ocaml_rc.write ()
let mode_name = Ed_mode_ocaml_rc.mode_name
let remove_first_blanks s =
let len = String.length s in
try
let rec first_no_blank p =
if p < len then
match s.[p] with
' ' | '\t' -> first_no_blank (p+1)
| _ -> p
else
raise Not_found
in
let p = first_no_blank 0 in
String.sub s p (len - p)
with
Not_found -> ""
let indent_line (v : Ed_sourceview.sourceview) args =
let line = v#current_line in
let b = v#file#buffer in
let pos = b#get_iter `INSERT in
let cnum = pos#line_offset in
let bol = b#get_iter (`LINE line) in
let eol = bol#forward_to_line_end in
let code =
v#file#of_utf8
(v#file#mode_from_display
(b#get_text ~start: b#start_iter ~stop: eol ()))
in
let indentations =
match Ed_ocaml_lexer.get_lines_indentation code with
`Failure (e,(start,stop),l) ->
let err = Printf.sprintf "chars %d-%d: %s"
start stop (Ed_ocaml_lexer.report_error e) in
Ed_misc.set_active_action_message (Ed_misc.to_utf8 err);
l
| `Success l ->
l
in
if List.length indentations <= line then
()
else
match List.rev indentations with
[] -> ()
| None :: _ -> ()
| (Some n) :: _ ->
let codeline = v#file#of_utf8
(b#get_text ~start: bol ~stop: eol ())
in
let len = String.length codeline in
let new_codeline = remove_first_blanks codeline in
let len2 = String.length new_codeline in
let user_pos =
let beg = len - len2 in
if cnum < beg then 0 else cnum - beg
in
let new_codeline = Printf.sprintf "%s%s"
(String.make n ' ')
new_codeline
in
if new_codeline <> codeline then
begin
b#delete ~start: bol ~stop: eol;
let pos = b#get_iter (`LINE line) in
v#place_cursor pos;
b#insert (v#file#mode_to_display (v#file#to_utf8 new_codeline));
let pos = b#get_iter (`LINECHAR (line,n+user_pos)) in
v#place_cursor pos
end
else
()
let indent_buffer (v : Ed_sourceview.sourceview) args =
let current_line = v#current_line in
let b = v#file#buffer in
let code = v#file#of_utf8
(v#file#mode_from_display
(b#get_text ~start: b#start_iter ~stop: b#end_iter ()))
in
match Ed_ocaml_lexer.get_lines_indentation code with
`Failure (e,(start,stop),_) ->
let err = Printf.sprintf "chars %d-%d: %s"
start stop (Ed_ocaml_lexer.report_error e) in
Ed_misc.set_active_action_message (Ed_misc.to_utf8 err)
| `Success indentations ->
let lines = Ed_misc.split_string ~keep_empty: true code ['\n'] in
let nb_lines = List.length lines in
let nb_indentations = List.length indentations in
let indentations =
if nb_indentations < nb_lines then
indentations @
(Ed_misc.make_list (nb_lines - nb_indentations) None)
else
indentations
in
b#delete ~start: b#start_iter ~stop: b#end_iter;
v#place_cursor b#start_iter;
List.iter2
(fun line nopt ->
let line =
match nopt with
None -> line^"\n"
| Some n ->
let s = remove_first_blanks line in
Printf.sprintf "%s%s\n" (String.make n ' ') s
in
b#insert (v#file#mode_to_display (v#file#to_utf8 line))
)
lines
indentations;
v#place_cursor (b#get_iter (`LINE current_line));
let message =
Printf.sprintf "%d lines indented / %d lines in buffer"
nb_indentations nb_lines
in
Ed_misc.set_active_action_message (Ed_misc.to_utf8 message)
let switch_file (v:Ed_sourceview.sourceview) args =
let f = v#file#filename in
try
let filename2 =
let ext =
if Filename.check_suffix f ".ml" then
"mli"
else if Filename.check_suffix f ".mli" then
"ml"
else
raise Not_found
in
Printf.sprintf "%s.%s" (Filename.chop_extension f) ext
in
let com = Printf.sprintf "open_file %s" (Filename.quote filename2) in
Cam_commands.eval_command com
with
Not_found -> ()
let __alpha__ = 1;;
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
let coms = [
"indent_line", [| |], None, indent_line ;
"indent_buffer", [| |], None, indent_buffer ;
"switch_file", [| |], None, switch_file ;
"display_type_annot", [| |], None, display_type_annot ;
]
let _ = List.iter
(fun (name, args, more, f) ->
Ed_sourceview.register_com
~prefix: mode_name name args ?more f)
coms
class mode =
object
inherit Ed_sourceview.empty_mode
method name = mode_name
method key_bindings : (Okey.keyhit_state * string) list =
Ed_mode_ocaml_rc.key_bindings#get
method menus : (string * GToolbox.menu_entry list) list =
[
"OCaml",
[ `I ("Switch file", fun () -> Cam_commands.eval_command "ocaml_switch_file") ;
`S ;
`I ("Indent line", fun () -> Cam_commands.eval_command "ocaml_indent_line") ;
`I ("Indent buffer", fun () -> Cam_commands.eval_command "ocaml_indent_buffer") ;
`S ;
`I ("Display type from .annot file", fun () -> Cam_commands.eval_command "ocaml_display_type_annot") ;
]
]
end
let mode = new mode
let _ = Ed_sourceview.register_mode mode