1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
|
(***********************************************************************)
(* *)
(* Ledit *)
(* *)
(* Daniel de Rauglaudre, INRIA Rocquencourt *)
(* *)
(* Copyright 2001-2008 Institut National de Recherche en Informatique *)
(* et Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id: go.ml,v 1.47 2008/01/23 09:54:05 deraugla Exp $ *)
open Ledit;
open Sys;
value version = "2.01-exp";
value usage () = do {
prerr_string "Usage: ";
prerr_string argv.(0);
prerr_endline " [options] [comm [args]]";
prerr_endline " -a : ascii encoding";
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 " -t : trace sequences (for debugging)";
prerr_endline " -u : utf-8 encoding";
prerr_endline " -v : prints ledit version and exit";
prerr_endline "Exec comm [args] as child process";
};
value get_arg i =
if i >= Array.length argv then do { usage (); exit 1 } else argv.(i);
value histfile = ref "";
value trunc = ref True;
value comm = ref "cat";
value args = ref [| "cat" |];
arg_loop 1 where rec arg_loop i =
if i < Array.length argv then
arg_loop
(match argv.(i) with
[ "-a" -> do { set_ascii (); i + 1 }
| "-h" -> do { histfile.val := get_arg (i + 1); i + 2 }
| "-help" -> do { usage (); exit 0 }
| "-l" -> do {
let x = get_arg (i + 1) in
try set_max_len (int_of_string x) with _ -> do {
usage ();
exit 1
};
i + 2
}
| "-x" -> do { trunc.val := False; i + 1 }
| "-t" -> do { trace_sequences.val := True; i + 1 }
| "-u" -> do { set_utf8 (); unset_meta_as_escape (); i + 1 }
| "-v" -> do {
Printf.printf "Ledit version %s\n" version;
flush stdout;
exit 0
}
| _ ->
if i < Array.length argv then do {
if argv.(i).[0] = '-' then do {
prerr_endline ("Illegal option " ^ argv.(i));
prerr_endline "Use option -help for usage";
exit 1
}
else do {
comm.val := argv.(i);
args.val := Array.sub argv i (Array.length argv - i);
Array.length argv
}
}
else Array.length argv ])
else ()
;
value string_of_signal =
fun
[ 2 -> "Interrupted"
| 3 -> "Quit"
| 10 -> "Bus error"
| 11 -> "Segmentation fault"
| x -> "Signal " ^ string_of_int x ]
;
value rec read_loop () = do {
try
let c = input_char stdin in
if c = "\n" then print_newline () else print_string c
with
[ Break -> () ];
read_loop ()
};
value stupid_hack_to_avoid_sys_error_at_exit () =
Unix.dup2 (Unix.openfile "/dev/null" [Unix.O_WRONLY] 0) Unix.stdout
;
value go () =
let (id, od) = Unix.pipe () in
let pid = Unix.fork () in
if pid < 0 then failwith "fork"
else if pid > 0 then do {
Unix.dup2 od Unix.stdout;
Unix.close id;
Unix.close od;
set_son_pid pid;
let _ =
(signal sigchld
(Signal_handle
(fun _ ->
match snd (Unix.waitpid [Unix.WNOHANG] pid) with
[ Unix.WSIGNALED sign -> do {
prerr_endline (string_of_signal sign);
flush stderr;
raise End_of_file
}
| _ -> raise End_of_file ])) :
signal_behavior)
in
try do {
if histfile.val <> "" then open_histfile trunc.val histfile.val
else ();
catch_break True;
read_loop ()
}
with x -> do {
let _ = (signal sigchld Signal_ignore : signal_behavior) in
try do {
Unix.close Unix.stdout;
let _ = Unix.wait () in
()
}
with
[ Unix.Unix_error _ _ _ -> () ];
stupid_hack_to_avoid_sys_error_at_exit ();
match x with
[ End_of_file -> ()
| _ -> do { prerr_string "(ledit) "; flush stderr; raise x } ]
}
}
else do {
Unix.dup2 id Unix.stdin;
Unix.close id;
Unix.close od;
Unix.execvp comm.val args.val
}
;
value handle f a =
try f a with
[ Unix.Unix_error code fname param -> do {
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 ]
;
handle go ();
|