let commands = Hashtbl.create 17;;
let history = Ed_minibuffer.history ();;
let default_build_command file =
let out = Printf.sprintf "%s.byte"
(Filename.chop_extension (Filename.basename file))
in
let wd = Unix.getcwd () in
prerr_endline file;
if Ed_misc.is_prefix wd file then
(
let len_file = String.length file in
let len_wd = String.length wd in
let s = String.sub file (len_wd + 1) (len_file - len_wd - 1) in
let inc = Filename.dirname s in
Printf.sprintf "ocamlbuild -I %s %s"
(Filename.quote inc) (Filename.quote out)
)
else if Filename.is_relative file then
(
let inc = Filename.dirname file in
Printf.sprintf "ocamlbuild -I %s %s"
(Filename.quote inc) (Filename.quote out)
)
else
(
let d = Filename.dirname file in
Printf.sprintf "(cd %s && ocamlbuild %s)"
(Filename.quote d) (Filename.quote out)
)
;;
let output_name = "ocamlbuild";;
let ocamlbuild_output = ref None;;
let ocamlbuild_output () =
match !ocamlbuild_output with
None ->
let o = new Ed_outputs.text_output
~on_destroy: (fun () -> ocamlbuild_output := None)
output_name
in
ocamlbuild_output := Some o ;
o
| Some o -> o
;;
let goto_error file line start stop error =
match !Ed_sourceview.active_sourceview with
None -> ()
| Some v ->
let com = Printf.sprintf "open_file \"%s\" %d,%d" file (line-1) start in
Cam_commands.eval_command com;
v#set_location ((line-1), start);
let mes = Printf.sprintf "Line %d, chars %d-%d: %s" line start stop error in
Ed_misc.error_message (Ed_misc.to_utf8 mes);
let line_offset =
let it = v#file#buffer#get_iter (`LINE (line-1)) in
it#offset
in
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 (line_offset + start)))
in
let right =
Cam_misc.utf8_string_length
(v#file#mode_to_display
(String.sub from_display 0 (line_offset + stop)))
in
(left, right)
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
;;
type problem =
{ pb_file : string ;
pb_line : int ;
pb_start : int ;
pb_stop : int ;
pb_kind : [ `Error of string | `Warning of char * string ] ;
}
;;
let warning_is_error c =
let to_show = Cam_commands.safe_get_global "warn_error" in
let len = String.length to_show in
let res = ref false in
for i = 0 to len - 1 do
if to_show.[i] = c or to_show.[i] = 'A' then
res := true
else if to_show.[i] = Char.lowercase c or to_show.[i] = 'a' then
res := false
done;
!res
;;
let analyze_ocaml_compilation on_problem text =
let lines = Ed_misc.split_string text ['\n'] in
let rec iter = function
[] | [_] -> ()
| line1 :: line2 :: q ->
let f file line start stop =
let kind =
try
let f c =
let line_len = String.length line2 in
let warn_len = String.length "Warning X: " in
let msg = String.sub line2 warn_len (line_len - warn_len) in
`Warning (c, msg)
in
Scanf.sscanf line2 "Warning %c: " f
with _ -> `Error line2
in
let pb =
{ pb_file = file ;
pb_line = line ;
pb_start = start ;
pb_stop = stop ;
pb_kind = kind ;
}
in
if on_problem pb then iter q else ()
in
try Scanf.sscanf line1 "File %S, line %d, characters %d-%d:" f
with Scanf.Scan_failure _ -> iter (line2 :: q)
in
iter lines
;;
let run ?(output=ocamlbuild_output()) command =
let outputs = Ed_outputs.outputs () in
let output' =
try outputs#output_by_name output#name
with Not_found ->
outputs#add_output (output :> Ed_outputs.output);
outputs#output_by_name output#name
in
outputs#show output#name;
let on_end code =
output'#set_label (Printf.sprintf "%s (ret %d)" output#name code);
analyze_ocaml_compilation
(fun pb ->
let error = match pb.pb_kind with
`Error s -> Some s
| `Warning (c, s) ->
if warning_is_error c then
Some s
else
None
in
match error with
None -> true
| Some msg ->
goto_error pb.pb_file pb.pb_line pb.pb_start pb.pb_stop msg;
false
)
output#contents
in
output#run ~reset: true command on_end
;;
let build (v:Ed_sourceview.sourceview) args =
let file = v#file#filename in
let com =
try Hashtbl.find commands file
with Not_found -> default_build_command file
in
let on_ok com =
Hashtbl.replace commands file com;
Ed_mode_ocaml_rc.ocamlbuild_commands#set
(Hashtbl.fold
(fun f com acc -> (f,com)::acc) commands []);
run com
in
Ed_misc.input_string ~history
v#minibuffer
~title: "Command" (Ed_misc.to_utf8 com) on_ok
;;