From mboxrd@z Thu Jan 1 00:00:00 1970 Received: by margaux.inria.fr, Mon, 4 Jan 93 11:19:55 +0100 Received: from peray.inria.fr by margaux.inria.fr, Mon, 4 Jan 93 11:02:34 +0100 Received: by peray.inria.fr; Mon, 4 Jan 93 11:00:36 +0100 From: Daniel de Rauglaudre Message-Id: <9301041000.AA19707@peray.inria.fr> Subject: ledit (fep like) To: caml-list@margaux Date: Mon, 4 Jan 1993 11:00:35 +0900 (MET) X-Mailer: ELM [version 2.4 PL13] Content-Type: text/plain Sender: weis@margaux Dear friends, Happy new year. Here is the program "ledit", written in Caml-Light, to run interactive commands (e.g. the toplevel of Caml-Light), with a line editing. Have fun! Chers amis, Bonne anne'e. Voici le programme "ledit", e'crit en Chamau-Le'ger, pour exe'cuter des commandes inte'ractives (par exemple le toplevel de Caml-Light), avec une e'dition de lignes. Daniel de Rauglaudre #!/bin/sh # This is a shell archive (produced by shar 3.49) # To extract the files from this archive, save it to a file, remove # everything above the "!/bin/sh" line above, and type "sh file_name". # # made 01/02/1993 14:21 UTC by ddr@margaux # Source directory /home/margaux/formel1/ddr/scratch/ledit # # existing files will NOT be overwritten unless -c is specified # # This shar contains: # length mode name # ------ ---------- ------------------------------------------ # 328 -rw-r--r-- Makefile # 2432 -rw-r--r-- README # 1718 -rw-r--r-- go.ml # 302 -rwxr-xr-x ledit # 15851 -rw-r--r-- ledit.ml # 314 -rw-r--r-- ledit.mli # # ============= Makefile ============== if test -f 'Makefile' -a X"$1" != X"-c"; then echo 'x - skipping Makefile (File already exists)' else echo 'x - extracting Makefile (Text)' sed 's/^X//' << 'SHAR_EOF' > 'Makefile' && # $Id: Makefile,v 1.7 93/01/02 14:16:49 ddr Exp $ X ZC=camlc ZOFILES=ledit.zo go.zo TARGET=ledit.out X all: $(TARGET) X clean: X rm -f *.zo *.zi *.log *.logi $(TARGET) X $(TARGET): $(ZOFILES) X $(ZC) $(ZOFILES) -o $(TARGET) X .ml.zo: X $(ZC) -c $< .mli.zi: X $(ZC) -c $< X .SUFFIXES: .ml .zo .mli .zi X go.zo: ledit.zo ledit.zo: ledit.zi X SHAR_EOF chmod 0644 Makefile || echo 'restore of Makefile failed' Wc_c="`wc -c < 'Makefile'`" test 328 -eq "$Wc_c" || echo 'Makefile: original size 328, current size' "$Wc_c" fi # ============= README ============== if test -f 'README' -a X"$1" != X"-c"; then echo 'x - skipping README (File already exists)' else echo 'x - extracting README (Text)' sed 's/^X//' << 'SHAR_EOF' > 'README' && This is "ledit", line editor, version 1.0, written in Caml-Light. X X OVERVIEW: X This can be used as a shell command "ledit" or as a library function with the input files "ledit.ml" and "ledit.mli". X As a command, "ledit" can run an interactive command; the input lines can be edited, using some keys binding a` la gnu-emacs. With some (explicit) options, ledit can use a history file to make the history commands work. X As a library file, it is possible to open "ledit" in a Caml-Light source file. The function "input_char" (of "io"), is then hidden by the one of ledit. If nothing else is added, "input_char std_in" works like the one of "io". To make the line editing fully work, there are 2 things more to do: first, write a shell script setting special options for line input (so called "cbreak" and "no echo") before the call of your program (see the shell script file "ledit"), and add at the beginning of the program a call to the ledit function "set_echo false"; to make the history command work (ctrl-p, ctrl-n, for examples), add a call to the function "open_histfile". X X CONTENTS: X Makefile to compile the files README this file ledit.mli ledit interface ledit.ml ledit implementation go.ml main program for the command "ledit" ledit shell script running "ledit.out", result of make X X INSTALLATION: X Run "make". X X DOCUMENTATION: X Sorry, no doc for the moment. Try the following examples: X type: ./ledit -h history -c camllight you have the Caml-Light toplevel with a line editing, all input lines being saved in the file "history". To keep the previous history file, if already existing, add the option -x after -h history. X your command can have options, the ledit option -c having to be the last option of ledit: ./ledit -h history -x -c ed foo X to see the available input commands, the simplest method is to have a look to the source file ledit.ml X X PROBLEMS: X In case of possible manipulation error, after the return of the command "ledit", your shell script may have lost the echo. Just type the interrupt command (depending of your installation: often ctrl-c of delete): this suppress the possible characters input. Then type (without echo: so don't make mistakes): "stty -cbreak echo" and return. X X REMARK: X This is a prototype, given without warranty. X X CREATOR: X Daniel de Rauglaudre, at INRIA, France. ddr@margaux.inria.fr SHAR_EOF chmod 0644 README || echo 'restore of README failed' Wc_c="`wc -c < 'README'`" test 2432 -eq "$Wc_c" || echo 'README: original size 2432, current size' "$Wc_c" fi # ============= go.ml ============== if test -f 'go.ml' -a X"$1" != X"-c"; then echo 'x - skipping go.ml (File already exists)' else echo 'x - extracting go.ml (Text)' sed 's/^X//' << 'SHAR_EOF' > 'go.ml' && (* $Id: go.ml,v 1.9 93/01/02 14:47:15 ddr Exp $ *) X #open "ledit";; #open "sys";; X let usage() = prerr_string "Usage: "; prerr_string command_line.(0); prerr_endline " [options] [-c comm [args]]"; prerr_endline " -h file : history file"; prerr_endline " -x : don't remove old contents of history"; prerr_endline " -ne : shell set no echo"; prerr_endline " -l len : line max length"; prerr_endline "If -c present, exec comm [args] as child process"; sys__exit 1 ;; X let get_arg i = if i >= vect_length command_line then usage() else command_line.(i) ;; X let histfile = ref "";; let trunc = ref true;; X arg_loop 1 where rec arg_loop i = if i < vect_length command_line then ( arg_loop ( match command_line.(i) with "-h" -> histfile := get_arg(i+1); i+2 | "-l" -> let x = get_arg(i+1) in (try set_max_len (int_of_string x) with _ -> usage()); i+2 | "-ne" -> set_echo false; i+1 | "-x" -> trunc := false; i+1 | _ -> if i == 1 & command_line.(1) = command_line.(0) then (* weird *) i+1 else usage() ) ) ;; X let rec read_loop() = begin try match input_char std_in with `\n` -> print_newline() | x -> print_char x with Break -> () end; read_loop() ;; X try if !histfile <> "" then open_histfile !trunc !histfile; catch_break true; read_loop(); if !histfile <> "" then close_histfile () with End_of_file -> () | Failure x -> prerr_string "(ledit) Failed: "; prerr_endline x | Invalid_argument x -> prerr_string "(ledit) Invalid argument: "; prerr_endline x | _ -> prerr_endline "(ledit) Uncaught exception" ;; SHAR_EOF chmod 0644 go.ml || echo 'restore of go.ml failed' Wc_c="`wc -c < 'go.ml'`" test 1718 -eq "$Wc_c" || echo 'go.ml: original size 1718, current size' "$Wc_c" fi # ============= ledit ============== if test -f 'ledit' -a X"$1" != X"-c"; then echo 'x - skipping ledit (File already exists)' else echo 'x - extracting ledit (Text)' sed 's/^X//' << 'SHAR_EOF' > 'ledit' && #!/bin/sh # $Id: ledit,v 1.6 93/01/02 14:16:50 ddr Exp $ X LEDIT=$0 OPTS= COMM=cat while test "$*" <> ""; do X i=$1 X case $i in X -c) shift; COMM=$*; break;; X *) OPTS="$OPTS $i";; X esac; X shift done X stty cbreak old -echo trap "stty -cbreak new echo" 0 trap "exit" 2 3 exec $LEDIT.out -ne $OPTS | $COMM SHAR_EOF chmod 0755 ledit || echo 'restore of ledit failed' Wc_c="`wc -c < 'ledit'`" test 302 -eq "$Wc_c" || echo 'ledit: original size 302, current size' "$Wc_c" fi # ============= ledit.ml ============== if test -f 'ledit.ml' -a X"$1" != X"-c"; then echo 'x - skipping ledit.ml (File already exists)' else echo 'x - extracting ledit.ml (Text)' sed 's/^X//' << 'SHAR_EOF' > 'ledit.ml' && (* $Id: ledit.ml,v 1.16 93/01/02 14:16:51 ddr Exp $ *) X #open "sys";; X let l_set = 0;; let l_incr = 1;; let l_xtnd = 2;; X let read ic buf beg len = input ic buf beg len;; let write oc buf beg len = output oc buf beg len; flush oc;; let lseek fd pos mode = seek_in fd ( if mode == l_set then pos else if mode == l_incr then (pos_in fd + pos) else if mode == l_xtnd then (in_channel_length fd + pos) else failwith "lseek" ) ;; X type 'a nref = {mutable v : 'a};; let nref x = {v = x};; X let max_len = nref 70;; let set_max_len x = max_len.v <- if x > 3 then x else failwith "set_max_len" ;; X type command = Accept_line | Backward_char | Backward_delete_char | Beginning_of_history | Beginning_of_line | Call_shell | Delete_char | End_of_history | End_of_line | Forward_char | Kill_line | Next_history | Operate_and_get_next | Previous_history | Refresh_line | Reverse_search_history | Self_insert | Unix_line_discard | Yank ;; X let (command_of_char, set_char_command) = let command_vect = make_vect 256 Self_insert in (* command_of_char *) (fun c -> command_vect.(int_of_char c)), (* set_char_command *) (fun c comm -> command_vect.(int_of_char c) <- comm) ;; X for i = 32 to 126 do set_char_command (char_of_int i) Self_insert done; set_char_command `\001` (* ^a *) Beginning_of_line; set_char_command `\005` (* ^e *) End_of_line; set_char_command `\006` (* ^f *) Forward_char; set_char_command `\002` (* ^b *) Backward_char; set_char_command `\n` Accept_line; set_char_command `\016` (* ^p *) Previous_history; set_char_command `\014` (* ^n *) Next_history; set_char_command `\188` (* M-< *) Beginning_of_history; set_char_command `\190` (* M-> *) End_of_history; set_char_command `\018` (* ^r *) Reverse_search_history; set_char_command `\004` (* ^d *) Delete_char; set_char_command `\008` (* ^h *) Backward_delete_char; set_char_command `\011` (* ^k *) Kill_line; set_char_command `\015` (* ^o *) Operate_and_get_next; set_char_command `\021` (* ^u *) Unix_line_discard; set_char_command `\025` (* ^y *) Yank; set_char_command `\012` (* ^l *) Refresh_line; set_char_command `\025` (* ^z *) Call_shell; ();; X type 'a option = None | Some of 'a;; X type line = { mutable buf : string; mutable cur : int; mutable len : int };; X type state = { od : line; nd : line; line : line; mutable shift : int; mutable cut : string; mutable last_comm : command; mutable histfile : (in_channel * out_channel) option; mutable histlen : int; mutable histcur : int; mutable forward : bool; mutable echo : bool };; X let bs = `\b`;; X let put_char st c = if not st.echo then output_char std_err c;; let put_newline st = if not st.echo then prerr_endline "";; let flush_out st = if not st.echo then flush std_err;; X let read_char = let buff = " " in function fd -> if read fd buff 0 1 < 0 then failwith "eof in history" else nth_char buff 0 ;; X let line_set_nth_char line i c = if i == string_length line.buf then line.buf <- line.buf ^ (make_string 1 c) else set_nth_char line.buf i c ;; X let line_to_nd st = st.nd.len <- 0; line_rec 0 where rec line_rec i = if i == st.line.cur then st.nd.cur <- st.nd.len; if i < st.line.len then ( let c = nth_char st.line.buf i in let ic = int_of_char c in if ic < 32 or ic == 127 then ( line_set_nth_char st.nd st.nd.len `^`; line_set_nth_char st.nd (st.nd.len + 1) (char_of_int(127 land (ic+64))); st.nd.len <- st.nd.len + 2 ) else if ic >= 128 then ( line_set_nth_char st.nd st.nd.len `\\`; line_set_nth_char st.nd (st.nd.len + 1) (char_of_int(ic / 64+int_of_char `0`)); line_set_nth_char st.nd (st.nd.len + 2) (char_of_int(ic mod 64 / 8+int_of_char `0`)); line_set_nth_char st.nd (st.nd.len + 3) (char_of_int(ic mod 8+int_of_char `0`)); st.nd.len <- st.nd.len + 4 ) else ( line_set_nth_char st.nd st.nd.len c; st.nd.len <- st.nd.len + 1 ); line_rec(i+1) ) else ( if st.nd.len > max_len.v then ( let shift = if st.nd.cur - st.shift >= 0 & st.nd.cur - st.shift < max_len.v - 2 then st.shift else if st.nd.cur < max_len.v - 3 then 0 else st.nd.cur - (max_len.v / 2) in for i = 0 to max_len.v - 3 do let ni = i + shift in set_nth_char st.nd.buf i (if ni < st.nd.len then nth_char st.nd.buf ni else ` `) done; set_nth_char st.nd.buf (max_len.v - 2) ` `; set_nth_char st.nd.buf (max_len.v - 1) ( if shift = 0 then `>` else if st.nd.len - shift < max_len.v - 2 then `<` else `*` ); st.nd.cur <- st.nd.cur - shift; st.nd.len <- max_len.v; st.shift <- shift ) else st.shift <- 0 ) ;; X let display st = disp_rec 0 where rec disp_rec i = if i < st.nd.len then ( if i >= st.od.len or nth_char st.od.buf i <> nth_char st.nd.buf i then ( 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 = nth_char st.nd.buf st.od.cur in st.od.cur <- st.od.cur + 1; put_char st c done; let c = nth_char st.nd.buf i in line_set_nth_char st.od i c; st.od.cur <- st.od.cur + 1; put_char st c ); disp_rec(i+1) ) else ( (* delete all old possible ending chars *) if st.od.len > st.nd.len then ( while st.od.cur < st.od.len do let c = if st.od.cur < st.nd.len then nth_char 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 ); st.od.len <- st.nd.len; (* update cursor position *) while st.od.cur < st.nd.cur do put_char st (nth_char 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 ) ;; X let update_output st = line_to_nd st; display st ;; X let balance_paren st = function `)` | `]` | `}` as c -> let i = find_lparen c (st.line.cur - 2) where rec find_lparen r i = if i < 0 then i else match nth_char 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 | `"` -> find_lparen r (skip_string (i-1)) where rec skip_string i = if i < 0 then i else if nth_char st.line.buf i == `"` then i-1 else skip_string (i-1) | _ -> find_lparen r (i-1) in if i >= 0 then ( let c = st.line.cur in st.line.cur <- i; update_output st; st.line.cur <- c; for i = 0 to 60000 do () done ) | _ -> () ;; X let delete_char st = st.line.len <- st.line.len - 1; for i = st.line.cur to st.line.len - 1 do set_nth_char st.line.buf i (nth_char st.line.buf (i+1)) done ;; X let insert_char st x = for i = st.line.len downto st.line.cur + 1 do line_set_nth_char st.line i (nth_char st.line.buf (i-1)) done; st.line.len <- st.line.len + 1; line_set_nth_char st.line st.line.cur x ;; X let previous_history st = match st.histfile with Some (fd, _) -> if st.forward then ( let rec skip_back_until_bol() = if st.histcur > 1 then ( st.forward <- false; st.histcur <- st.histcur - 1; lseek fd (st.histcur - 1) l_set; if read_char fd <> `\n` then skip_back_until_bol() ) in skip_back_until_bol() ); if st.histcur > 1 then ( st.line.len <- 0; st.line.cur <- 0; let rec back_read_loop() = let c = if st.histcur == 1 then `\n` else ( st.histcur <- st.histcur - 1; lseek fd (st.histcur - 1) l_set; read_char fd ) in if c <> `\n` then ( insert_char st c; back_read_loop() ) in back_read_loop(); st.line.cur <- st.line.len ) | None -> () ;; X let next_history st = match st.histfile with Some (fd, _) -> if not st.forward then ( let rec skip_until_eol() = st.forward <- true; let c = read_char fd in st.histcur <- st.histcur + 1; if c <> `\n` then skip_until_eol() in skip_until_eol() ); if st.histcur < st.histlen then ( st.line.len <- 0; st.line.cur <- 0; let rec read_loop() = let c = read_char fd in st.histcur <- st.histcur + 1; if c <> `\n` then ( insert_char st c; st.line.cur <- st.line.cur + 1; read_loop() ) in read_loop(); st.line.cur <- st.line.len ) | None -> () ;; X let beginning_of_history st = match st.histfile with Some (fd, _) -> if st.histlen > 0 then ( st.histcur <- 0; lseek fd 0 l_set; st.forward <- true; next_history st ) | None -> () ;; X let end_of_history st = match st.histfile with Some (fd, _) -> if st.histlen > 0 then ( st.histcur <- st.histlen + 1; lseek fd 0 l_xtnd; st.forward <- true; previous_history st ) | None -> () ;; X let rec update_line st c = match command_of_char c with X (* commands for Moving *) Beginning_of_line -> if st.line.cur > 0 then ( st.line.cur <- 0; update_output st ) | End_of_line -> if st.line.cur < st.line.len then ( st.line.cur <- st.line.len; update_output st ) | Forward_char -> if st.line.cur < st.line.len then ( st.line.cur <- st.line.cur + 1; update_output st ) | Backward_char -> if st.line.cur > 0 then ( st.line.cur <- st.line.cur - 1; update_output st ) X (* commands for manipulating the history *) | 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 -> let s = "(reverse-i-search)`': " in let len = string_length s in for i = 0 to len - 1 do line_set_nth_char st.line i (nth_char s i) done; st.line.cur <- len-3; st.line.len <- len; update_output st; let rec incr_search() = let c = input_char std_in in match command_of_char c with Self_insert -> insert_char st c; st.line.cur <- st.line.cur + 1; update_output st; incr_search () | _ -> c in let c = incr_search() in let len = st.line.len - st.line.cur - 3 in for i = 0 to len do set_nth_char st.line.buf i (nth_char st.line.buf (i+st.line.cur+2)) done; st.line.cur <- len; st.line.len <- len; update_output st; update_line st c X (* command for changing text *) | Delete_char -> if st.line.len = 0 then raise End_of_file; if st.line.cur < st.line.len then ( delete_char st; update_output st ) | Backward_delete_char -> if st.line.cur > 0 then ( st.line.cur <- st.line.cur - 1; delete_char st; update_output st ) | Self_insert -> insert_char st c; st.line.cur <- st.line.cur + 1; balance_paren st c; update_output st X (* killing and yanking *) | Kill_line -> st.cut <- sub_string st.line.buf st.line.cur (st.line.len-st.line.cur); if st.line.len > st.line.cur then ( st.line.len <- st.line.cur; update_output st ) | Unix_line_discard -> if st.line.cur > 0 then ( while st.line.cur > 0 do st.line.cur <- st.line.cur - 1; delete_char st done; update_output st ) | Yank -> if string_length st.cut > 0 then ( for i = 0 to string_length st.cut - 1 do insert_char st (nth_char st.cut i); st.line.cur <- st.line.cur + 1 done; update_output st ) X | _ -> () ;; X let last_line = ref "";; let save_history st line = match st.histfile with Some (fdi, fdo) -> if st.histcur < st.histlen then lseek fdi 0 l_xtnd; if line <> !last_line & line <> "" then ( last_line := line; let line = line ^ "\n" in write_loop 0 (string_length line) where rec write_loop beg len = write fdo line beg len; st.histlen <- st.histlen + len (* if len > 0 then ( let wlen = write fdo line beg len in st.histlen <- st.histlen + wlen; write_loop (beg+wlen) (len-wlen) ) *) ) | None -> () ;; X let (edit_line, open_histfile, close_histfile, set_echo) = let st = { od={buf="";cur=0;len=0}; nd={buf="";cur=0;len=0}; line={buf="";cur=0;len=0}; shift=0; cut=""; last_comm=Accept_line; histfile=None; histlen=0; histcur=0; forward=true; echo=true } in (fun () -> (* edit_line *) let rec edit_loop() = let c = match input_char std_in with `\027` (* esc *) -> char_of_int(int_of_char(input_char std_in)+128) | c -> c in st.last_comm <- command_of_char c; match st.last_comm with Accept_line | Operate_and_get_next -> let v_max_len = max_len.v in max_len.v <- 10000; update_output st; max_len.v <- v_max_len; put_newline st; let line = sub_string st.line.buf 0 st.line.len in save_history st line; line | Refresh_line -> put_newline st; "" | _ -> update_line st c; edit_loop() in st.od.len <- 0; st.od.cur <- 0; if st.last_comm == Refresh_line then update_output st else ( st.line.len <- 0; st.line.cur <- 0; if st.last_comm == Operate_and_get_next then ( match st.histfile with Some (fd, _) -> lseek fd st.histcur l_set; next_history st; update_output st | None -> () ) else ( st.histcur <- st.histlen + 1; st.forward <- true ) ); edit_loop() ), (fun trunc file -> (* open_histfile *) let fd = open file ([ O_RDWR; O_CREAT ] @ (if trunc then [ O_TRUNC ] else [])) (s_irall + s_iwall) in let fdi = open_descriptor_in fd and fdo = open_descriptor_out fd in if not trunc then ( lseek fdi 0 l_xtnd; st.histlen <- in_channel_length fdi; st.histcur <- st.histlen + 1; st.forward <- true ); st.histfile <- Some (fdi, fdo) ), (fun () -> (* close_histfile *) match st.histfile with Some (fd, _) -> close_in fd | None -> () ), (fun e -> (* set_echo *) st.echo <- e ) ;; X let (set_prompt, get_prompt, input_char) = let prompt = nref "" and buff = nref "" and ind = nref 1 in X (* set_prompt *) (function x -> prompt.v <- x ), (* get_prompt *) (function () -> prompt.v ), (* input_char *) (function ic -> if ic != std_in then io__input_char ic else ( if ind.v > string_length buff.v then ( prerr_string prompt.v; flush std_err; buff.v <- edit_line(); ind.v <- 0 ); let c = if ind.v == string_length buff.v then `\n` else nth_char buff.v ind.v in ind.v <- ind.v + 1; c ) ) ;; SHAR_EOF chmod 0644 ledit.ml || echo 'restore of ledit.ml failed' Wc_c="`wc -c < 'ledit.ml'`" test 15851 -eq "$Wc_c" || echo 'ledit.ml: original size 15851, current size' "$Wc_c" fi # ============= ledit.mli ============== if test -f 'ledit.mli' -a X"$1" != X"-c"; then echo 'x - skipping ledit.mli (File already exists)' else echo 'x - extracting ledit.mli (Text)' sed 's/^X//' << 'SHAR_EOF' > 'ledit.mli' && (* $Id: ledit.mli,v 1.3 93/01/02 14:16:52 ddr Exp $ *) X value input_char : in_channel -> char and set_prompt : string -> unit and get_prompt : unit -> string and open_histfile : bool -> string -> unit and close_histfile : unit -> unit and set_max_len : int -> unit and set_echo : bool -> unit ;; SHAR_EOF chmod 0644 ledit.mli || echo 'restore of ledit.mli failed' Wc_c="`wc -c < 'ledit.mli'`" test 314 -eq "$Wc_c" || echo 'ledit.mli: original size 314, current size' "$Wc_c" fi exit 0