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

(* $Id: ledit.ml,v 1.21 2001/07/03 11:38:53 ddr Exp $ *)

open Sys

let max_len = ref 70
let set_max_len x = max_len := if x > 3 then x else failwith "set_max_len"
let prompt = ref ""

let son = ref None
let set_son pid = son := Some pid

type command =
    Abort
  | Accept_line
  | Backward_char
  | Backward_delete_char
  | Backward_kill_word
  | Backward_word
  | Beginning_of_history
  | Beginning_of_line
  | Capitalize_word
  | Delete_char
  | Downcase_word
  | End_of_history
  | End_of_line
  | Expand_abbrev
  | Forward_char
  | Forward_word
  | Interrupt
  | Kill_line
  | Kill_word
  | Next_history
  | Operate_and_get_next
  | Previous_history
  | Quit
  | Quoted_insert
  | Refresh_line
  | Reverse_search_history
  | Self_insert
  | Start_digit_sequence of int
  | Start_csi_sequence
  | Start_escape_sequence
  | Start_o_sequence
  | Suspend
  | Transpose_chars
  | Unix_line_discard
  | Upcase_word
  | Yank

type istate =
    Normal
  | Quote
  | Escape
  | CSI
  | Oseq
  | Digitseq of int

let (command_of_char, set_char_command) =
  let command_vect = Array.create 256 Self_insert in
  (fun c -> command_vect.(Char.code c)),
  (fun c comm -> command_vect.(Char.code c) <- comm)

let (escape_command_of_char, set_escape_command) =
  let command_vect = Array.create 256 Abort in
  (fun c -> command_vect.(Char.code c)),
  (fun c comm -> command_vect.(Char.code c) <- comm)

let (csi_command_of_char, set_csi_command) =
  let command_vect = Array.create 256 Abort in
  (fun c -> command_vect.(Char.code c)),
  (fun c comm -> command_vect.(Char.code c) <- comm)

let (o_command_of_char, set_o_command) =
  let command_vect = Array.create 256 Abort in
  (fun c -> command_vect.(Char.code c)),
  (fun c comm -> command_vect.(Char.code c) <- comm)

let (digit_command_of_char, set_digit_command) =
  let command_vect = Array.init 10 (fun i -> Array.create 256 Abort) in
  (fun x c -> command_vect.(x).(Char.code c)),
  (fun x c comm -> command_vect.(x).(Char.code c) <- comm)

let _ =
  set_char_command '\001' Beginning_of_line;
  set_char_command '\005' End_of_line;
  set_char_command '\006' Forward_char;
  set_char_command '\002' Backward_char;
  set_char_command '\230' Forward_word;
  set_char_command '\226' Backward_word;
  set_char_command '\016' Previous_history;
  set_char_command '\014' Next_history;
  set_char_command '\188' Beginning_of_history;
  set_char_command '\190' End_of_history;
  set_char_command '\018' Reverse_search_history;
  set_char_command '\004' Delete_char;
  set_char_command '\008' Backward_delete_char;
  set_char_command '\127' Backward_delete_char;
  set_char_command '\020' Transpose_chars;
  set_char_command '\227' Capitalize_word;
  set_char_command '\245' Upcase_word;
  set_char_command '\236' Downcase_word;
  set_char_command '\228' Kill_word;
  set_char_command '\136' Backward_kill_word;
  set_char_command '\255' Backward_kill_word;
  set_char_command '\017' Quoted_insert;
  set_char_command '\011' Kill_line;
  set_char_command '\025' Yank;
  set_char_command '\021' Unix_line_discard;
  set_char_command '\012' Refresh_line;
  set_char_command '\007' Abort;
  set_char_command '\003' Interrupt;
  set_char_command '\026' Suspend;
  set_char_command '\028' Quit;
  set_char_command '\n' Accept_line;
  set_char_command '\024' Operate_and_get_next;
  set_char_command '\027' Start_escape_sequence;
  set_char_command '\175' Expand_abbrev;
  set_escape_command 'f' Forward_word;
  set_escape_command 'b' Backward_word;
  set_escape_command 'c' Capitalize_word;
  set_escape_command 'u' Upcase_word;
  set_escape_command 'l' Downcase_word;
  set_escape_command '<' Beginning_of_history;
  set_escape_command '>' End_of_history;
  set_escape_command 'd' Kill_word;
  set_escape_command '\008' Backward_kill_word;
  set_escape_command '\127' Backward_kill_word;
  set_escape_command '[' Start_csi_sequence;
  set_escape_command 'O' Start_o_sequence;
  set_escape_command '/' Expand_abbrev;
  set_csi_command 'A' Previous_history;
  set_csi_command 'B' Next_history;
  set_csi_command 'C' Forward_char;
  set_csi_command 'D' Backward_char;
  set_csi_command 'H' Beginning_of_line;
  set_csi_command 'F' End_of_line;
  set_csi_command '1' (Start_digit_sequence 1);
  set_csi_command '3' (Start_digit_sequence 3);
  set_csi_command '4' (Start_digit_sequence 4);
  set_csi_command '5' (Start_digit_sequence 5);
  set_csi_command '6' (Start_digit_sequence 6);
  set_o_command 'A' Previous_history;
  set_o_command 'B' Next_history;
  set_o_command 'C' Forward_char;
  set_o_command 'D' Backward_char;
  set_digit_command 1 '~' Beginning_of_line;
  set_digit_command 3 '~' Delete_char;
  set_digit_command 4 '~' End_of_line;
  set_digit_command 5 '~' Backward_word;
  set_digit_command 6 '~' Forward_word

type line = { mutable buf : string; mutable cur : int; mutable len : int }
type abbrev_data =
  { hist : string list;
    rpos : int;
    clen : int;
    abbr : string;
    found : string list }

type state =
  { od : line;
    nd : line;
    line : line;
    mutable last_line : string;
    iso_8859_1 : bool;
    mutable istate : istate;
    mutable shift : int;
    mutable cut : string;
    mutable last_comm : command;
    mutable histfile : out_channel option;
    mutable history : string Cursor.t;
    mutable abbrev : abbrev_data option }

let bs = '\b'

let put_char st c = output_char stderr c
let put_newline st = prerr_endline ""
let flush_out st = flush stderr
let bell () = prerr_string "\007"; flush stderr
let clear_screen () = prerr_string "\027c"

let saved_tcio = ref None

let init () =
  saved_tcio := Some(
  try Unix.tcgetattr Unix.stdin with
    Unix.Unix_error (_, _, _) ->
      Printf.eprintf "Error: standard input is not a terminal\n";
      flush stderr;
      exit 1)

let edit_tcio = ref None

let set_edit () =
  let tcio =
    match !edit_tcio with
      Some e -> e
    | None ->
        let tcio = Unix.tcgetattr Unix.stdin in
        tcio.Unix.c_echo <- false;
        tcio.Unix.c_icanon <- false;
        tcio.Unix.c_vmin <- 1;
        tcio.Unix.c_isig <- false;
        tcio.Unix.c_ixon <- false;
        edit_tcio := Some tcio;
        tcio
  in
  Unix.tcsetattr Unix.stdin Unix.TCSADRAIN tcio
and unset_edit () =
  match !saved_tcio with
  | Some x -> Unix.tcsetattr Unix.stdin Unix.TCSADRAIN x
  | None -> invalid_arg "ledit: empty saved_tcio."

let line_set_nth_char line i c =
  if i == String.length line.buf then line.buf <- line.buf ^ String.make 1 c
  else line.buf.[i] <- c

let line_to_nd st =
  let rec line_rec i =
    if i == st.line.cur then st.nd.cur <- st.nd.len;
    if i < st.line.len then
      let c = st.line.buf.[i] in
      let ic = Char.code c in
      if c = '\t' then
        for i = st.nd.len + 1 to (st.nd.len + 8) / 8 * 8 do
          line_set_nth_char st.nd st.nd.len ' '; st.nd.len <- st.nd.len + 1
        done
      else if ic < 32 || ic == 127 then
        begin
          line_set_nth_char st.nd st.nd.len '^';
          line_set_nth_char st.nd (st.nd.len + 1)
            (Char.chr (127 land (ic + 64)));
          st.nd.len <- st.nd.len + 2
        end
      else if ic >= 128 && not st.iso_8859_1 then
        begin
          line_set_nth_char st.nd st.nd.len '\\';
          line_set_nth_char st.nd (st.nd.len + 1)
            (Char.chr (ic / 100 + Char.code '0'));
          line_set_nth_char st.nd (st.nd.len + 2)
            (Char.chr (ic mod 100 / 10 + Char.code '0'));
          line_set_nth_char st.nd (st.nd.len + 3)
            (Char.chr (ic mod 10 + Char.code '0'));
          st.nd.len <- st.nd.len + 4
        end
      else if ic >= 128 && ic < 160 then
        begin
          line_set_nth_char st.nd st.nd.len 'M';
          line_set_nth_char st.nd (st.nd.len + 1) '-';
          line_set_nth_char st.nd (st.nd.len + 2) '^';
          line_set_nth_char st.nd (st.nd.len + 3)
            (Char.chr (127 land (ic + 64)));
          st.nd.len <- st.nd.len + 4
        end
      else
        begin
          line_set_nth_char st.nd st.nd.len c; st.nd.len <- st.nd.len + 1
        end;
      line_rec (i + 1)
    else if st.nd.len > !max_len then
      let shift =
        if st.nd.cur - st.shift >= 0 && st.nd.cur - st.shift < !max_len - 2
        then
          st.shift
        else if st.nd.cur < !max_len - 3 then 0
        else st.nd.cur - !max_len / 2
      in
      for i = 0 to !max_len - 3 do
        let ni = i + shift in
        st.nd.buf.[i] <- if ni < st.nd.len then st.nd.buf.[ni] else ' '
      done;
      st.nd.buf.[!max_len - 2] <- ' ';
      st.nd.buf.[!max_len - 1] <-
        if shift = 0 then '>'
        else if st.nd.len - shift < !max_len - 2 then '<'
        else '*';
      st.nd.cur <- st.nd.cur - shift;
      st.nd.len <- !max_len;
      st.shift <- shift
    else st.shift <- 0
  in
  st.nd.len <- 0; line_rec 0

let display st =
  let rec disp_rec i =
    if i < st.nd.len then
      begin
        if i >= st.od.len || st.od.buf.[i] <> st.nd.buf.[i] then
          begin
            while i < st.od.cur do
              st.od.cur <- st.od.cur - 1; put_char st bs
            done;
            while st.od.cur < i do
              let c = st.nd.buf.[st.od.cur] in
              st.od.cur <- st.od.cur + 1; put_char st c
            done;
            let c = st.nd.buf.[i] in
            line_set_nth_char st.od i c;
            st.od.cur <- st.od.cur + 1;
            put_char st c
          end;
        disp_rec (i + 1)
      end
    else
      begin
        if st.od.len > st.nd.len then
          begin
            while st.od.cur < st.od.len do
              let c =
                if st.od.cur < st.nd.len then st.nd.buf.[st.od.cur] else ' '
              in
              put_char st c; st.od.cur <- st.od.cur + 1
            done;
            while st.od.cur > st.nd.len do
              put_char st bs;
              put_char st ' ';
              put_char st bs;
              st.od.cur <- st.od.cur - 1
            done
          end;
        st.od.len <- st.nd.len;
        while st.od.cur < st.nd.cur do
          put_char st st.nd.buf.[st.od.cur]; st.od.cur <- st.od.cur + 1
        done;
        while st.od.cur > st.nd.cur do
          put_char st bs; st.od.cur <- st.od.cur - 1
        done;
        flush_out st
      end
  in
  disp_rec 0

let update_output st = line_to_nd st; display st

let balance_paren st =
  function
    ')' | ']' | '}' as c ->
      let i =
        let rec find_lparen r i =
          if i < 0 then i
          else
            match st.line.buf.[i] with
              ')' | ']' | '}' as c ->
                find_lparen r (find_lparen c (i - 1) - 1)
            | '(' -> if r == ')' then i else -1
            | '[' -> if r == ']' then i else -1
            | '{' -> if r == '}' then i else -1
            | '\"' ->
                let rec skip_string i =
                  if i < 0 then i
                  else if st.line.buf.[i] == '\"' then i - 1
                  else skip_string (i - 1)
                in
                find_lparen r (skip_string (i - 1))
            | _ -> find_lparen r (i - 1)
        in
        find_lparen c (st.line.cur - 2)
      in
      if i >= 0 then
        let c = st.line.cur in
        st.line.cur <- i;
        update_output st;
        st.line.cur <- c;
        let _ = Unix.select [Unix.stdin] [] [] 1.0 in ()
  | _ -> ()

let delete_char st =
  st.line.len <- st.line.len - 1;
  for i = st.line.cur to st.line.len - 1 do
    st.line.buf.[i] <- st.line.buf.[i + 1]
  done

let insert_char st x =
  for i = st.line.len downto st.line.cur + 1 do
    line_set_nth_char st.line i st.line.buf.[i - 1]
  done;
  st.line.len <- st.line.len + 1;
  line_set_nth_char st.line st.line.cur x

let move_in_word buf e f g =
  let rec move_rec i =
    if e i then i
    else
      match buf.[i] with
        'a'..'z' | 'A'..'Z' | '0'..'9' | '_' -> f move_rec i
      | x -> if Char.code x >= 160 then f move_rec i else g move_rec i
  in
  move_rec

let forward_move line = move_in_word line.buf (fun i -> i == line.len)
let backward_move line = move_in_word line.buf (fun i -> i == -1)

let forward_word line =
  let i = line.cur in
  let i = forward_move line (fun _ i -> i) (fun mv i -> mv (i + 1)) i in
  forward_move line (fun mv i -> mv (i + 1)) (fun _ i -> i) i

let backward_word line =
  let i = line.cur - 1 in
  let i = backward_move line (fun _ i -> i) (fun mv i -> mv (i - 1)) i in
  backward_move line (fun mv i -> mv (i - 1)) (fun _ i -> i) i + 1

let get_word_len st =
  let i = st.line.cur - 1 in
  i - backward_move st.line (fun mv i -> mv (i - 1)) (fun _ i -> i) i

let kill_word st =
  let i = st.line.cur in
  let i =
    forward_move st.line (fun _ i -> i) (fun mv i -> delete_char st; mv i) i
  in
  forward_move st.line (fun mv i -> delete_char st; mv i) (fun _ i -> i) i

let backward_kill_word st =
  let k = backward_word st.line in
  let sh = st.line.cur - k in
  st.line.len <- st.line.len - sh;
  for i = k to st.line.len - 1 do
    st.line.buf.[i] <- st.line.buf.[i + sh]
  done;
  k

let capitalize_word st =
  let i = st.line.cur in
  let i0 = forward_move st.line (fun _ i -> i) (fun mv i -> mv (i + 1)) i in
  forward_move st.line
    (fun mv i ->
       let f = if i == i0 then Char.uppercase else Char.lowercase in
       st.line.buf.[i] <- f st.line.buf.[i]; mv (i + 1))
    (fun _ i -> i) i0

let upcase_word st =
  let i = st.line.cur in
  let i = forward_move st.line (fun _ i -> i) (fun mv i -> mv (i + 1)) i in
  forward_move st.line
    (fun mv i ->
       let f = Char.uppercase in
       st.line.buf.[i] <- f st.line.buf.[i]; mv (i + 1))
    (fun _ i -> i) i

let downcase_word st =
  let i = st.line.cur in
  let i = forward_move st.line (fun _ i -> i) (fun mv i -> mv (i + 1)) i in
  forward_move st.line
    (fun mv i ->
       let f = Char.lowercase in
       st.line.buf.[i] <- f st.line.buf.[i]; mv (i + 1))
    (fun _ i -> i) i

let transpose_chars st =
  if st.line.cur == st.line.len then
    let c = st.line.buf.[st.line.cur - 1] in
    st.line.buf.[st.line.cur - 1] <- st.line.buf.[st.line.cur - 2];
    st.line.buf.[st.line.cur - 2] <- c
  else
    let c = st.line.buf.[st.line.cur] in
    st.line.buf.[st.line.cur] <- st.line.buf.[st.line.cur - 1];
    st.line.buf.[st.line.cur - 1] <- c;
    st.line.cur <- st.line.cur + 1

let set_line st str =
  st.line.len <- 0;
  st.line.cur <- 0;
  for i = 0 to String.length str - 1 do
    insert_char st str.[i]; st.line.cur <- st.line.len
  done

let save_if_last st =
  if Cursor.is_last_line st.history then
    st.last_line <- String.sub st.line.buf 0 st.line.len

let previous_history st =
  try
    save_if_last st;
    Cursor.before st.history;
    set_line st (Cursor.peek st.history)
  with
    Cursor.Failure -> bell ()

let next_history st =
  try Cursor.after st.history; set_line st (Cursor.peek st.history) with
    Cursor.Failure -> set_line st st.last_line

let read_char =
  let buff = " " in
  fun () ->
    let len = Unix.read Unix.stdin buff 0 1 in
    if len == 0 then raise End_of_file else buff.[0]

let reverse_search_history st =
  let question str = "(reverse-i-search)'" ^ str ^ "': " in
  let make_line str fstr =
    st.line.cur <- 0;
    st.line.len <- 0;
    let len = String.length str in
    for i = 0 to len - 1 do
      insert_char st str.[i]; st.line.cur <- st.line.cur + 1
    done;
    let len = String.length fstr in
    for i = 0 to len - 1 do
      insert_char st fstr.[i]; st.line.cur <- st.line.cur + 1
    done
  in
  let initial_str = String.sub st.line.buf 0 st.line.len in
  let rec find_line (cnt, fstr) str =
    let rec find_rec ifstr istr =
      if istr == String.length str then cnt, fstr
      else if ifstr == String.length fstr then
        if try Cursor.before st.history; true with
             Cursor.Failure -> false
        then
          find_line (cnt + 1, Cursor.peek st.history) str
        else begin bell (); cnt, fstr end
      else if str.[istr] != fstr.[ifstr] then find_rec (ifstr + 1) 0
      else find_rec (ifstr + 1) (istr + 1)
    in
    find_rec 0 0
  in
  let rec incr_search (cnt, fstr) str =
    let q = question str in
    make_line q fstr;
    st.line.cur <- String.length q - 3;
    update_output st;
    let c = read_char () in
    match command_of_char c with
      Start_escape_sequence -> fstr
    | Self_insert ->
        let str = str ^ String.make 1 c in
        incr_search (find_line (cnt, fstr) str) str
    | Backward_delete_char ->
        if String.length str == 0 then incr_search (cnt, fstr) str
        else
          let str = String.sub str 0 (String.length str - 1) in
          for i = 1 to cnt do Cursor.after st.history done;
          incr_search (find_line (0, initial_str) str) str
    | Abort ->
        for i = 1 to cnt do Cursor.after st.history done; bell (); initial_str
    | Reverse_search_history ->
        let (cnt, fstr) =
          try
            Cursor.before st.history;
            find_line (cnt + 1, Cursor.peek st.history) str
          with
            Cursor.Failure -> bell (); cnt, initial_str
        in
        incr_search (cnt, fstr) str
    | _ -> fstr
  in
  let fstr = incr_search (0, initial_str) "" in make_line "" fstr

let rec beginning_of_history st =
  save_if_last st;
  Cursor.goto_first st.history;
  try set_line st (Cursor.peek st.history) with
    Cursor.Failure -> bell ()

let rec end_of_history st =
  Cursor.goto_last st.history; set_line st st.last_line

let rec back_search st ad hist rpos =
  match hist with
    [] ->
      for i = 0 to String.length ad.abbr - 1 do
        insert_char st ad.abbr.[i]; st.line.cur <- st.line.cur + 1
      done;
      bell ()
  | l :: ll ->
      let i = String.length l - rpos in
      if i <= 0 then back_search st ad ll 0
      else
        let i = backward_word {buf = l; cur = i; len = String.length l} in
        if String.length l - i < String.length ad.abbr then
          back_search st ad (l :: ll) (String.length l - i)
        else if String.sub l i (String.length ad.abbr) = ad.abbr then
          let i1 = forward_word {buf = l; cur = i; len = String.length l} in
          let f = String.sub l i (i1 - i) in
          if List.mem f ad.found then
            back_search st ad (l :: ll) (String.length l - i)
          else
            let ad =
              {hist = l :: ll; rpos = String.length l - i1; clen = i1 - i;
               abbr = ad.abbr; found = f :: ad.found}
            in
            st.abbrev <- Some ad;
            for i = 0 to String.length f - 1 do
              insert_char st f.[i]; st.line.cur <- st.line.cur + 1
            done
        else back_search st ad (l :: ll) (String.length l - i)

let expand_abbrev st abbrev =
  let ad =
    match abbrev with
      Some x -> x
    | None ->
        let len = get_word_len st in
        let abbr = String.sub st.line.buf (st.line.cur - len) len in
        let line_beg = String.sub st.line.buf 0 (st.line.cur - len) in
        let line_end =
          String.sub st.line.buf st.line.cur (st.line.len - st.line.cur)
        in
        {hist = line_beg :: (Cursor.get_all st.history @ [line_end]);
         rpos = 0; clen = len; abbr = abbr; found = [abbr]}
  in
  for i = 1 to ad.clen do st.line.cur <- st.line.cur - 1; delete_char st done;
  back_search st ad ad.hist ad.rpos;
  update_output st

let rec update_line st comm c =
  let abbrev = st.abbrev in
  st.abbrev <- None;
  match comm with
    Beginning_of_line ->
      if st.line.cur > 0 then begin st.line.cur <- 0; update_output st end
  | End_of_line ->
      if st.line.cur < st.line.len then
        begin st.line.cur <- st.line.len; update_output st end
  | Forward_char ->
      if st.line.cur < st.line.len then
        begin st.line.cur <- st.line.cur + 1; update_output st end
  | Backward_char ->
      if st.line.cur > 0 then
        begin st.line.cur <- st.line.cur - 1; update_output st end
  | Forward_word ->
      if st.line.cur < st.line.len then
        begin st.line.cur <- forward_word st.line; update_output st end
  | Backward_word ->
      if st.line.cur > 0 then
        begin st.line.cur <- backward_word st.line; update_output st end
  | Capitalize_word ->
      if st.line.cur < st.line.len then
        begin st.line.cur <- capitalize_word st; update_output st end
  | Upcase_word ->
      if st.line.cur < st.line.len then
        begin st.line.cur <- upcase_word st; update_output st end
  | Downcase_word ->
      if st.line.cur < st.line.len then
        begin st.line.cur <- downcase_word st; update_output st end
  | Previous_history -> previous_history st; update_output st
  | Next_history -> next_history st; update_output st
  | Beginning_of_history -> beginning_of_history st; update_output st
  | End_of_history -> end_of_history st; update_output st
  | Reverse_search_history -> reverse_search_history st; update_output st
  | Delete_char ->
      if st.line.len = 0 then raise End_of_file;
      if st.line.cur < st.line.len then
        begin delete_char st; update_output st end
  | Backward_delete_char ->
      if st.line.cur > 0 then
        begin
          st.line.cur <- st.line.cur - 1; delete_char st; update_output st
        end
  | Transpose_chars ->
      if st.line.len > 1 && st.line.cur > 0 then
        begin transpose_chars st; update_output st end
  | Kill_word ->
      if st.line.cur < st.line.len then
        begin st.line.cur <- kill_word st; update_output st end
  | Backward_kill_word ->
      if st.line.cur > 0 then
        begin st.line.cur <- backward_kill_word st; update_output st end
  | Quoted_insert -> st.istate <- Quote
  | Start_escape_sequence -> st.istate <- Escape
  | Start_csi_sequence -> st.istate <- CSI
  | Start_digit_sequence x -> st.istate <- Digitseq x
  | Start_o_sequence -> st.istate <- Oseq
  | Self_insert ->
      insert_char st c;
      st.line.cur <- st.line.cur + 1;
      balance_paren st c;
      update_output st
  | Expand_abbrev -> expand_abbrev st abbrev
  | Refresh_line ->
      clear_screen ();
      prerr_string !prompt;
      st.od.cur <- 0; st.od.len <- 0; update_output st
  | Kill_line ->
      st.cut <-
        String.sub st.line.buf st.line.cur (st.line.len - st.line.cur);
      if st.line.len > st.line.cur then
        begin st.line.len <- st.line.cur; update_output st end
  | Unix_line_discard ->
      if st.line.cur > 0 then
        begin st.line.cur <- 0; st.line.len <- 0; update_output st end
  | Yank ->
      if String.length st.cut > 0 then
        begin
          for i = 0 to String.length st.cut - 1 do
            insert_char st st.cut.[i]; st.line.cur <- st.line.cur + 1
          done;
          update_output st
        end
  | Abort -> bell ()
  | Interrupt ->
      if st.line.cur > 0 then
        begin st.line.cur <- 0; st.line.len <- 0; update_output st end;
      begin match !son with
        Some pid -> Unix.kill pid Sys.sigint
      | _ -> ()
      end
  | Suspend ->
      unset_edit ();
      Unix.kill (Unix.getpid ()) Sys.sigtstp;
      set_edit ();
      st.od.cur <- 0;
      st.od.len <- 0;
      update_output st
  | Quit ->
      begin match !son with
        Some pid -> Unix.kill pid Sys.sigquit
      | _ -> ()
      end
  | Operate_and_get_next|Accept_line -> ()

let save_history st line =
  let last_line =
    try Cursor.peek_last st.history with
      Cursor.Failure -> ""
  in
  if line <> last_line && line <> "" then
    begin
      Cursor.insert_last st.history line;
      match st.histfile with
        Some fdo -> output_string fdo line; output_char fdo '\n'; flush fdo
      | None -> ()
    end

let (edit_line, open_histfile, close_histfile) =
  let st =
    {od = {buf = ""; cur = 0; len = 0}; nd = {buf = ""; cur = 0; len = 0};
     line = {buf = ""; cur = 0; len = 0}; last_line = "";
     iso_8859_1 =
       begin try Sys.getenv "LC_CTYPE" <> "" with
         Not_found -> false
       end;
     istate = Normal; shift = 0; cut = ""; last_comm = Accept_line;
     histfile = None; history = Cursor.create (); abbrev = None}
  in
  let edit_line () =
    let rec edit_loop () =
      let c = read_char () in
      let comm =
        match st.istate with
          Quote -> Self_insert
        | Normal -> command_of_char c
        | Escape -> escape_command_of_char c
        | CSI -> csi_command_of_char c
        | Oseq -> o_command_of_char c
        | Digitseq x -> digit_command_of_char x c
      in
      st.istate <- Normal;
      st.last_comm <- comm;
      match comm with
        Accept_line | Operate_and_get_next ->
          let v_max_len = !max_len in
          max_len := 10000;
          update_output st;
          max_len := v_max_len;
          put_newline st;
          let line = String.sub st.line.buf 0 st.line.len in
          st.abbrev <- None; save_history st line; line
      | _ -> update_line st comm c; edit_loop ()
    in
    st.od.len <- 0;
    st.od.cur <- 0;
    st.line.len <- 0;
    st.line.cur <- 0;
    if st.last_comm == Operate_and_get_next then
      try
        Cursor.after st.history;
        set_line st (Cursor.peek st.history);
        update_output st
      with
        Cursor.Failure -> ()
    else Cursor.goto_last st.history;
    edit_loop ()
  and open_histfile trunc file =
    if not trunc then
      begin match
        try Some (open_in file) with
          _ -> None
      with
        Some fi ->
          begin try
            while true do Cursor.insert st.history (input_line fi) done
          with
            End_of_file -> ()
          end;
          close_in fi
      | _ -> ()
      end;
    let fd =
      Unix.openfile file
        ([Unix.O_WRONLY; Unix.O_CREAT] @
           (if trunc then [Unix.O_TRUNC] else []))
        0o666
    in
    let fdo = Unix.out_channel_of_descr fd in
    if not trunc then seek_out fdo (out_channel_length fdo);
    st.histfile <- Some fdo
  and close_histfile () =
    match st.histfile with
      Some fdo -> close_out fdo
    | None -> ()
  in
  edit_line, open_histfile, close_histfile

let (set_prompt, get_prompt, input_char) =
  let buff = ref ""
  and ind = ref 1 in
  let set_prompt x = prompt := x
  and get_prompt () = !prompt
  and input_char ic =
    if ic != stdin then input_char ic
    else
      begin
        if !ind > String.length !buff then
          begin
            prerr_string !prompt;
            flush stderr;
            begin try set_edit (); buff := edit_line (); unset_edit () with
              e -> unset_edit (); raise e
            end;
            ind := 0
          end;
        let c = if !ind == String.length !buff then '\n' else !buff.[!ind] in
        ind := !ind + 1; c
      end
  in
  set_prompt, get_prompt, input_char
;;

let read_line =
  let b = Buffer.create 128 in
  fun () ->
    Buffer.clear b;
    let rec loop () =
      let c = input_char stdin in
      if c = '\n' then
        Buffer.contents b
      else
        begin
          Buffer.add_char b c;
          loop ()
        end
    in
    loop ()
