(***********************************************************************)
(*                                                                     *)
(*                               Ledit                                 *)
(*                                                                     *)
(*       Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt      *)
(*                                                                     *)
(*  Copyright 2001 Institut National de Recherche en Informatique et   *)
(*  Automatique.  Distributed only by permission.                      *)
(*                                                                     *)
(***********************************************************************)

(* $Id: go.ml,v 1.21 2002/04/03 07:37:07 ddr Exp $ *)

open Ledit
open Sys

let version = "1.11"

let usage () =
  prerr_string "Usage: ";
  prerr_string argv.(0);
  prerr_endline " [options] [comm [args]]";
  prerr_endline " -h file : history file";
  prerr_endline " -x  : don't remove old contents of history";
  prerr_endline " -l len : line max length";
  prerr_endline " -v : prints ledit version and exit";
  prerr_endline "Exec comm [args] as child process";
  exit 1

let get_arg i = if i >= Array.length argv then usage () else argv.(i)

let histfile = ref ""
let trunc = ref true
let comm = ref "cat"
let args = ref [| "cat" |]

let _ =
  let rec arg_loop i =
    if i < Array.length argv then
      arg_loop
        (match argv.(i) with
           "-h" -> histfile := get_arg (i + 1); i + 2
         | "-l" ->
             let x = get_arg (i + 1) in
             begin try set_max_len (int_of_string x) with
               _ -> usage ()
             end;
             i + 2
         | "-x" -> trunc := false; i + 1
         | "-v" ->
             Printf.printf "Ledit version %s\n" version; flush stdout; exit 0
         | _ ->
             let i = if argv.(i) = "-c" then i + 1 else i in
             if i < Array.length argv then
               begin
                 comm := argv.(i);
                 args := Array.sub argv i (Array.length argv - i);
                 Array.length argv
               end
             else Array.length argv)
  in
  arg_loop 1

let string_of_signal =
  function
    2 -> "Interrupted"
  | 3 -> "Quit"
  | 10 -> "Bus error"
  | 11 -> "Segmentation fault"
  | x -> "Signal " ^ string_of_int x

let rec read_loop () =
  begin try
    match input_char stdin with
      '\n' -> print_newline ()
    | x -> print_char x
  with
    Break -> ()
  end;
  read_loop ()

let stupid_hack_to_avoid_sys_error_at_exit () =
  Unix.dup2 (Unix.openfile "/dev/null" [Unix.O_WRONLY] 0) Unix.stdout

let go () =
  let (id, od) = Unix.pipe () in
  let pid = Unix.fork () in
  if pid < 0 then failwith "fork"
  else if pid > 0 then
    begin
      Unix.dup2 od Unix.stdout;
      Unix.close id;
      Unix.close od;
      set_son pid;
      let _ =
        (signal sigchld
           (Signal_handle
              (fun _ ->
                 match snd (Unix.waitpid [Unix.WNOHANG] pid) with
                   Unix.WSIGNALED sign ->
                     prerr_endline (string_of_signal sign);
                     flush stderr;
                     raise End_of_file
                 | _ -> raise End_of_file)) :
         signal_behavior)
      in
      try
        if !histfile <> "" then open_histfile !trunc !histfile;
        catch_break true;
        read_loop ();
        if !histfile <> "" then close_histfile ()
      with
        x ->
          let _ = (signal sigchld Signal_ignore : signal_behavior) in
          begin try Unix.close Unix.stdout; let _ = Unix.wait () in () with
            Unix.Unix_error (_, _, _) -> ()
          end;
          stupid_hack_to_avoid_sys_error_at_exit ();
          match x with
            End_of_file -> ()
          | _ -> prerr_string "(ledit) "; flush stderr; raise x
    end
  else
    begin
      Unix.dup2 id Unix.stdin;
      Unix.close id;
      Unix.close od;
      Unix.execvp !comm !args;
      failwith "execv"
    end

let handle f a =
  try f a with
    Unix.Unix_error (code, fname, param) ->
      Printf.eprintf "Unix error: %s\nOn function %s %s\n"
        (Unix.error_message code) fname param;
      flush stderr;
      exit 2
  | e -> Printexc.catch raise e

let _ = handle go ()
