The R13B03 release.OTP_R13B03

1 files changed, 689 insertions, 0 deletions

diff --git a/lib/kernel/src/group.erl b/lib/kernel/src/group.erl
new file mode 100644
index 0000000000..a45ba34eae
--- /dev/null
+++ b/lib/kernel/src/group.erl
@@ -0,0 +1,689 @@
+%%
+%% %CopyrightBegin%
+%% 
+%% Copyright Ericsson AB 1996-2009. All Rights Reserved.
+%% 
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%% 
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%% 
+%% %CopyrightEnd%
+%%
+-module(group).
+
+%% A group leader process for user io.
+
+-export([start/2, start/3, server/3]).
+-export([interfaces/1]).
+
+start(Drv, Shell) ->
+    start(Drv, Shell, []).
+
+start(Drv, Shell, Options) ->
+    spawn_link(group, server, [Drv, Shell, Options]).
+
+server(Drv, Shell, Options) ->
+    process_flag(trap_exit, true),
+    edlin:init(),
+    put(line_buffer, proplists:get_value(line_buffer, Options, [])),
+    put(read_mode, list),
+    put(user_drv, Drv),
+    put(expand_fun,
+	proplists:get_value(expand_fun, Options,
+			    fun(B) -> edlin_expand:expand(B) end)),
+    put(echo, proplists:get_value(echo, Options, true)),
+    
+    start_shell(Shell),
+    server_loop(Drv, get(shell), []).
+
+%% Return the pid of user_drv and the shell process.
+%% Note: We can't ask the group process for this info since it
+%% may be busy waiting for data from the driver.
+interfaces(Group) ->
+    case process_info(Group, dictionary) of
+	{dictionary,Dict} ->
+	    get_pids(Dict, [], false);
+	_ ->
+	    []
+    end.
+
+get_pids([Drv = {user_drv,_} | Rest], Found, _) ->
+    get_pids(Rest, [Drv | Found], true);
+get_pids([Sh = {shell,_} | Rest], Found, Active) ->
+    get_pids(Rest, [Sh | Found], Active);
+get_pids([_ | Rest], Found, Active) ->
+    get_pids(Rest, Found, Active);
+get_pids([], Found, true) ->
+    Found;
+get_pids([], _Found, false) ->
+    [].
+
+%% start_shell(Shell)
+%%  Spawn a shell with its group_leader from the beginning set to ourselves.
+%%  If Shell a pid the set its group_leader.
+
+start_shell({Mod,Func,Args}) ->
+    start_shell1(Mod, Func, Args);
+start_shell({Node,Mod,Func,Args}) ->
+    start_shell1(net, call, [Node,Mod,Func,Args]);
+start_shell(Shell) when is_atom(Shell) ->
+    start_shell1(Shell, start, []);
+start_shell(Shell) when is_function(Shell) ->
+    start_shell1(Shell);
+start_shell(Shell) when is_pid(Shell) ->
+    group_leader(self(), Shell),		% we are the shells group leader
+    link(Shell),				% we're linked to it.
+    put(shell, Shell);
+start_shell(_Shell) ->
+    ok.
+
+start_shell1(M, F, Args) ->
+    G = group_leader(),
+    group_leader(self(), self()),
+    case catch apply(M, F, Args) of
+	Shell when is_pid(Shell) ->
+	    group_leader(G, self()),
+	    link(Shell),			% we're linked to it.
+	    put(shell, Shell);
+	Error ->				% start failure
+	    exit(Error)				% let the group process crash
+    end.
+
+start_shell1(Fun) ->
+    G = group_leader(),
+    group_leader(self(), self()),
+    case catch Fun() of
+	Shell when is_pid(Shell) ->
+	    group_leader(G, self()),
+	    link(Shell),			% we're linked to it.
+	    put(shell, Shell);
+	Error ->				% start failure
+	    exit(Error)				% let the group process crash
+    end.
+
+server_loop(Drv, Shell, Buf0) ->
+    receive
+	{io_request,From,ReplyAs,Req} when is_pid(From) ->
+	    Buf = io_request(Req, From, ReplyAs, Drv, Buf0),
+	    server_loop(Drv, Shell, Buf);
+	{driver_id,ReplyTo} ->
+	    ReplyTo ! {self(),driver_id,Drv},
+	    server_loop(Drv, Shell, Buf0);
+	{Drv, echo, Bool} ->
+	    put(echo, Bool),
+	    server_loop(Drv, Shell, Buf0);
+	{'EXIT',Drv,interrupt} ->
+	    %% Send interrupt to the shell.
+	    exit_shell(interrupt),
+	    server_loop(Drv, Shell, Buf0);
+	{'EXIT',Drv,R} ->
+	    exit(R);
+	{'EXIT',Shell,R} ->
+	    exit(R);
+	%% We want to throw away any term that we don't handle (standard
+	%% practice in receive loops), but not any {Drv,_} tuples which are
+	%% handled in io_request/5.
+	NotDrvTuple when (not is_tuple(NotDrvTuple)) orelse
+			 (tuple_size(NotDrvTuple) =/= 2) orelse
+			 (element(1, NotDrvTuple) =/= Drv) ->
+	    %% Ignore this unknown message.
+	    server_loop(Drv, Shell, Buf0)
+    end.
+
+exit_shell(Reason) ->
+    case get(shell) of
+	undefined -> true;
+	Pid -> exit(Pid, Reason)
+    end.
+
+get_tty_geometry(Drv) ->
+    Drv ! {self(),tty_geometry},
+    receive
+	{Drv,tty_geometry,Geometry} ->
+	    Geometry
+    after 2000 ->
+	    timeout
+    end.
+get_unicode_state(Drv) ->
+    Drv ! {self(),get_unicode_state},
+    receive
+	{Drv,get_unicode_state,UniState} ->
+	    UniState;
+	{Drv,get_unicode_state,error} ->
+	    {error, internal}
+    after 2000 ->
+	    {error,timeout}
+    end.
+set_unicode_state(Drv,Bool) ->
+    Drv ! {self(),set_unicode_state,Bool},
+    receive
+	{Drv,set_unicode_state,_OldUniState} ->
+	    ok
+    after 2000 ->
+	    timeout
+    end.
+			   
+
+io_request(Req, From, ReplyAs, Drv, Buf0) ->
+    case io_request(Req, Drv, Buf0) of
+	{ok,Reply,Buf} ->
+	    io_reply(From, ReplyAs, Reply),
+	    Buf;
+	{error,Reply,Buf} ->
+	    io_reply(From, ReplyAs, Reply),
+	    Buf;
+	{exit,R} ->
+	    %% 'kill' instead of R, since the shell is not always in
+	    %% a state where it is ready to handle a termination
+	    %% message.
+	    exit_shell(kill),
+	    exit(R)
+    end.
+
+
+%% Put_chars, unicode is the normal message, characters are always in 
+%%standard unicode
+%% format.
+%% You might be tempted to send binaries unchecked, but the driver 
+%% expects unicode, so that is what we should send...
+%% io_request({put_chars,unicode,Binary}, Drv, Buf) when is_binary(Binary) -> 
+%%     send_drv(Drv, {put_chars,Binary}),
+%%     {ok,ok,Buf};
+io_request({put_chars,unicode,Chars}, Drv, Buf) ->
+    case catch unicode:characters_to_binary(Chars,utf8) of
+	Binary when is_binary(Binary) ->
+	    send_drv(Drv, {put_chars, unicode, Binary}),
+	    {ok,ok,Buf};
+	_ ->
+	    {error,{error,{put_chars, unicode,Chars}},Buf}
+    end;
+io_request({put_chars,unicode,M,F,As}, Drv, Buf) ->
+    case catch apply(M, F, As) of
+	Binary when is_binary(Binary) ->
+	    send_drv(Drv, {put_chars, unicode,Binary}),
+	    {ok,ok,Buf};
+	Chars ->
+	    case catch unicode:characters_to_binary(Chars,utf8) of
+		B when is_binary(B) ->
+		    send_drv(Drv, {put_chars, unicode,B}),
+		    {ok,ok,Buf};
+		_ ->
+		    {error,{error,F},Buf}
+	    end
+    end;
+io_request({put_chars,latin1,Binary}, Drv, Buf) when is_binary(Binary) -> 
+    send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}),
+    {ok,ok,Buf};
+io_request({put_chars,latin1,Chars}, Drv, Buf) ->
+    case catch unicode:characters_to_binary(Chars,latin1) of
+	Binary when is_binary(Binary) ->
+	    send_drv(Drv, {put_chars, unicode,Binary}),
+	    {ok,ok,Buf};
+	_ ->
+	    {error,{error,{put_chars,Chars}},Buf}
+    end;
+io_request({put_chars,latin1,M,F,As}, Drv, Buf) ->
+    case catch apply(M, F, As) of
+	Binary when is_binary(Binary) ->
+	    send_drv(Drv, {put_chars, unicode,unicode:characters_to_binary(Binary,latin1)}),
+	    {ok,ok,Buf};
+	Chars ->
+	    case catch unicode:characters_to_binary(Chars,latin1) of
+		B when is_binary(B) ->
+		    send_drv(Drv, {put_chars, unicode,B}),
+		    {ok,ok,Buf};
+		_ ->
+		    {error,{error,F},Buf}
+	    end
+    end;
+
+io_request({get_chars,Encoding,Prompt,N}, Drv, Buf) ->
+    get_chars(Prompt, io_lib, collect_chars, N, Drv, Buf, Encoding);
+io_request({get_line,Encoding,Prompt}, Drv, Buf) ->
+    get_chars(Prompt, io_lib, collect_line, [], Drv, Buf, Encoding);
+io_request({get_until,Encoding, Prompt,M,F,As}, Drv, Buf) ->
+    get_chars(Prompt, io_lib, get_until, {M,F,As}, Drv, Buf, Encoding);
+io_request({get_password,_Encoding},Drv,Buf) ->
+    get_password_chars(Drv, Buf);
+io_request({setopts,Opts}, Drv, Buf) when is_list(Opts) ->
+    setopts(Opts, Drv, Buf);
+io_request(getopts, Drv, Buf) ->
+    getopts(Drv, Buf);
+io_request({requests,Reqs}, Drv, Buf) ->
+    io_requests(Reqs, {ok,ok,Buf}, Drv);
+
+%% New in R12
+io_request({get_geometry,columns},Drv,Buf) ->
+    case get_tty_geometry(Drv) of
+	{W,_H} ->
+	    {ok,W,Buf};
+	_ ->
+	    {error,{error,enotsup},Buf}
+    end;
+io_request({get_geometry,rows},Drv,Buf) ->
+    case get_tty_geometry(Drv) of
+	{_W,H} ->
+	    {ok,H,Buf};
+	_ ->
+	    {error,{error,enotsup},Buf}
+    end;
+
+%% BC with pre-R13
+io_request({put_chars,Chars}, Drv, Buf) ->
+    io_request({put_chars,latin1,Chars}, Drv, Buf);
+io_request({put_chars,M,F,As}, Drv, Buf) ->
+    io_request({put_chars,latin1,M,F,As}, Drv, Buf);
+io_request({get_chars,Prompt,N}, Drv, Buf) ->
+    io_request({get_chars,latin1,Prompt,N}, Drv, Buf);
+io_request({get_line,Prompt}, Drv, Buf) ->
+    io_request({get_line,latin1,Prompt}, Drv, Buf);
+io_request({get_until, Prompt,M,F,As}, Drv, Buf) ->
+    io_request({get_until,latin1, Prompt,M,F,As}, Drv, Buf);
+io_request(get_password,Drv,Buf) ->
+    io_request({get_password,latin1},Drv,Buf);
+
+
+
+io_request(_, _Drv, Buf) ->
+    {error,{error,request},Buf}.
+
+%% Status = io_requests(RequestList, PrevStat, Drv)
+%%  Process a list of output requests as long as the previous status is 'ok'.
+
+io_requests([R|Rs], {ok,ok,Buf}, Drv) ->
+    io_requests(Rs, io_request(R, Drv, Buf), Drv);
+io_requests([_|_], Error, _Drv) ->
+    Error;
+io_requests([], Stat, _) ->
+    Stat.
+
+%% io_reply(From, ReplyAs, Reply)
+%%  The function for sending i/o command acknowledgement.
+%%  The ACK contains the return value.
+
+io_reply(From, ReplyAs, Reply) ->
+    From ! {io_reply,ReplyAs,Reply}.
+
+%% send_drv(Drv, Message)
+%% send_drv_reqs(Drv, Requests)
+
+send_drv(Drv, Msg) ->
+    Drv ! {self(),Msg}.
+
+send_drv_reqs(_Drv, []) -> [];
+send_drv_reqs(Drv, Rs) ->
+    send_drv(Drv, {requests,Rs}).
+
+expand_encoding([]) ->
+    [];
+expand_encoding([latin1 | T]) ->
+    [{encoding,latin1} | expand_encoding(T)];
+expand_encoding([unicode | T]) ->
+    [{encoding,unicode} | expand_encoding(T)];
+expand_encoding([H|T]) ->
+    [H|expand_encoding(T)].
+%% setopts
+setopts(Opts0,Drv,Buf) ->
+    Opts = proplists:unfold(
+	     proplists:substitute_negations(
+	       [{list,binary}], 
+	       expand_encoding(Opts0))),
+    case check_valid_opts(Opts) of
+	true ->
+	    do_setopts(Opts,Drv,Buf);
+	false ->
+	    {error,{error,enotsup},Buf}
+    end.
+check_valid_opts([]) ->
+    true;
+check_valid_opts([{binary,_}|T]) ->
+    check_valid_opts(T);
+check_valid_opts([{encoding,Valid}|T]) when Valid =:= unicode; Valid =:= utf8; Valid =:= latin1 ->
+    check_valid_opts(T);
+check_valid_opts([{echo,_}|T]) ->
+    check_valid_opts(T);
+check_valid_opts([{expand_fun,_}|T]) ->
+    check_valid_opts(T);
+check_valid_opts(_) ->
+    false.
+
+do_setopts(Opts, Drv, Buf) ->
+    put(expand_fun, proplists:get_value(expand_fun, Opts, get(expand_fun))),
+    put(echo, proplists:get_value(echo, Opts, get(echo))),
+    case proplists:get_value(encoding,Opts) of
+	Valid when Valid =:= unicode; Valid =:= utf8 ->
+	    set_unicode_state(Drv,true);
+	latin1 ->
+	    set_unicode_state(Drv,false);
+	_ ->
+	    ok
+    end,
+    case proplists:get_value(binary, Opts, case get(read_mode) of
+					      binary -> true;
+					      _ -> false
+					   end) of
+	true ->
+	    put(read_mode, binary),
+	    {ok,ok,Buf};
+	false ->
+	    put(read_mode, list),
+	    {ok,ok,Buf};
+	_ ->
+	    {ok,ok,Buf}
+    end.
+
+getopts(Drv,Buf) ->
+    Exp = {expand_fun, case get(expand_fun) of
+			   Func when is_function(Func) ->
+			       Func;
+			   _ ->
+			       false
+		       end},
+    Echo = {echo, case get(echo) of
+		     Bool when Bool =:= true; Bool =:= false ->
+			 Bool;
+		     _ ->
+			 false
+		  end},
+    Bin = {binary, case get(read_mode) of
+		       binary ->
+			   true;
+		       _ ->
+			   false
+		   end},
+    Uni = {encoding, case get_unicode_state(Drv) of
+			true -> unicode;
+			_ -> latin1
+		     end},
+    {ok,[Exp,Echo,Bin,Uni],Buf}.
+    
+
+%% get_chars(Prompt, Module, Function, XtraArgument, Drv, Buffer)
+%%  Gets characters from the input Drv until as the applied function
+%%  returns {stop,Result,Rest}. Does not block output until input has been
+%%  received.
+%%  Returns:
+%%	{Result,NewSaveBuffer}
+%%	{error,What,NewSaveBuffer}
+
+get_password_chars(Drv,Buf) ->
+    case get_password_line(Buf, Drv) of
+	{done, Line, Buf1} ->
+	    {ok, Line, Buf1};
+	interrupted ->
+	    {error, {error, interrupted}, []};
+	terminated ->
+	    {exit, terminated}
+    end.
+
+get_chars(Prompt, M, F, Xa, Drv, Buf, Encoding) ->
+    Pbs = prompt_bytes(Prompt),
+    get_chars_loop(Pbs, M, F, Xa, Drv, Buf, start, Encoding).
+
+get_chars_loop(Pbs, M, F, Xa, Drv, Buf0, State, Encoding) ->
+    Result = case get(echo) of 
+		 true ->
+		     get_line(Buf0, Pbs, Drv, Encoding);
+		 false ->
+		     % get_line_echo_off only deals with lists
+		     % and does not need encoding...
+		     get_line_echo_off(Buf0, Pbs, Drv)
+	     end,
+    case Result of
+	{done,Line,Buf1} ->
+	    get_chars_apply(Pbs, M, F, Xa, Drv, Buf1, State, Line, Encoding);
+	interrupted ->
+	    {error,{error,interrupted},[]};
+	terminated ->
+	    {exit,terminated}
+    end.
+
+get_chars_apply(Pbs, M, F, Xa, Drv, Buf, State0, Line, Encoding) ->
+    id(M,F),
+    case catch M:F(State0, cast(Line,get(read_mode), Encoding), Encoding, Xa) of
+	{stop,Result,Rest} ->
+	    {ok,Result,append(Rest, Buf, Encoding)};
+	{'EXIT',_} ->
+	    {error,{error,err_func(M, F, Xa)},[]};
+	State1 ->
+	    get_chars_loop(Pbs, M, F, Xa, Drv, Buf, State1, Encoding)
+    end.
+
+id(M,F) ->
+    {M,F}.
+%% Convert error code to make it look as before
+err_func(io_lib, get_until, {_,F,_}) ->
+    F;
+err_func(_, F, _) ->
+    F.
+
+%% get_line(Chars, PromptBytes, Drv)
+%%  Get a line with eventual line editing. Handle other io requests
+%%  while getting line.
+%%  Returns:
+%%	{done,LineChars,RestChars}
+%%	interrupted
+
+get_line(Chars, Pbs, Drv, Encoding) ->
+    {more_chars,Cont,Rs} = edlin:start(Pbs),
+    send_drv_reqs(Drv, Rs),
+    get_line1(edlin:edit_line(Chars, Cont), Drv, new_stack(get(line_buffer)), 
+	      Encoding).
+
+get_line1({done,Line,Rest,Rs}, Drv, _Ls, _Encoding) ->
+    send_drv_reqs(Drv, Rs),
+    put(line_buffer, [Line|lists:delete(Line, get(line_buffer))]),
+    {done,Line,Rest};
+get_line1({undefined,{_A,Mode,Char},Cs,Cont,Rs}, Drv, Ls0, Encoding) 
+  when ((Mode =:= none) and (Char =:= $\^P))
+       or ((Mode =:= meta_left_sq_bracket) and (Char =:= $A)) ->
+    send_drv_reqs(Drv, Rs),
+    case up_stack(Ls0) of
+	{none,_Ls} ->
+	    send_drv(Drv, beep),
+	    get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding);
+	{Lcs,Ls} ->
+	    send_drv_reqs(Drv, edlin:erase_line(Cont)),
+	    {more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)),
+	    send_drv_reqs(Drv, Nrs),
+	    get_line1(edlin:edit_line1(lists:sublist(Lcs, 1, length(Lcs)-1),
+				      Ncont),
+		      Drv,
+		      Ls, Encoding)
+    end;
+get_line1({undefined,{_A,Mode,Char},_Cs,Cont,Rs}, Drv, Ls0, Encoding) 
+  when ((Mode =:= none) and (Char =:= $\^N))
+       or ((Mode =:= meta_left_sq_bracket) and (Char =:= $B)) ->
+    send_drv_reqs(Drv, Rs),
+    case down_stack(Ls0) of
+	{none,Ls} ->
+	    send_drv_reqs(Drv, edlin:erase_line(Cont)),
+	    get_line1(edlin:start(edlin:prompt(Cont)), Drv, Ls, Encoding);
+	{Lcs,Ls} ->
+	    send_drv_reqs(Drv, edlin:erase_line(Cont)),
+	    {more_chars,Ncont,Nrs} = edlin:start(edlin:prompt(Cont)),
+	    send_drv_reqs(Drv, Nrs),
+	    get_line1(edlin:edit_line1(lists:sublist(Lcs, 1, length(Lcs)-1),
+				      Ncont),
+		      Drv,
+		      Ls, Encoding)
+    end;
+get_line1({expand, Before, Cs0, Cont,Rs}, Drv, Ls0, Encoding) ->
+    send_drv_reqs(Drv, Rs),
+    ExpandFun = get(expand_fun),
+    {Found, Add, Matches} = ExpandFun(Before),
+    case Found of
+	no -> send_drv(Drv, beep);
+	yes -> ok
+    end,
+    Cs1 = append(Add, Cs0, Encoding), %%XXX:PaN should this always be unicode?
+    Cs = case Matches of
+	     [] -> Cs1;
+	     _ -> MatchStr = edlin_expand:format_matches(Matches),
+		  send_drv(Drv, {put_chars, unicode, unicode:characters_to_binary(MatchStr,unicode)}),
+		  [$\^L | Cs1]
+	 end,
+    get_line1(edlin:edit_line(Cs, Cont), Drv, Ls0, Encoding);
+get_line1({undefined,_Char,Cs,Cont,Rs}, Drv, Ls, Encoding) ->
+    send_drv_reqs(Drv, Rs),
+    send_drv(Drv, beep),
+    get_line1(edlin:edit_line(Cs, Cont), Drv, Ls, Encoding);
+get_line1({What,Cont0,Rs}, Drv, Ls, Encoding) ->
+    send_drv_reqs(Drv, Rs),
+    receive
+	{Drv,{data,Cs}} ->
+	    get_line1(edlin:edit_line(Cs, Cont0), Drv, Ls, Encoding);
+	{Drv,eof} ->
+	    get_line1(edlin:edit_line(eof, Cont0), Drv, Ls, Encoding);
+	{io_request,From,ReplyAs,Req} when is_pid(From) ->
+	    {more_chars,Cont,_More} = edlin:edit_line([], Cont0),
+	    send_drv_reqs(Drv, edlin:erase_line(Cont)),
+	    io_request(Req, From, ReplyAs, Drv, []), %WRONG!!!
+	    send_drv_reqs(Drv, edlin:redraw_line(Cont)),
+	    get_line1({more_chars,Cont,[]}, Drv, Ls, Encoding);
+	{'EXIT',Drv,interrupt} ->
+	    interrupted;
+	{'EXIT',Drv,_} ->
+	    terminated
+    after
+	get_line_timeout(What)->
+	    get_line1(edlin:edit_line([], Cont0), Drv, Ls, Encoding)
+    end.
+
+
+get_line_echo_off(Chars, Pbs, Drv) ->
+    send_drv_reqs(Drv, [{put_chars, unicode,Pbs}]),
+    get_line_echo_off1(edit_line(Chars,[]), Drv).
+
+get_line_echo_off1({Chars,[]}, Drv) ->
+    receive
+	{Drv,{data,Cs}} ->
+	    get_line_echo_off1(edit_line(Cs, Chars), Drv);
+	{Drv,eof} ->
+	    get_line_echo_off1(edit_line(eof, Chars), Drv);
+	{io_request,From,ReplyAs,Req} when is_pid(From) ->
+	    io_request(Req, From, ReplyAs, Drv, []),
+	    get_line_echo_off1({Chars,[]}, Drv);
+	{'EXIT',Drv,interrupt} ->
+	    interrupted;
+	{'EXIT',Drv,_} ->
+	    terminated
+    end;
+get_line_echo_off1({Chars,Rest}, _Drv) ->
+    {done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}.
+
+%% We support line editing for the ICANON mode except the following
+%% line editing characters, which already has another meaning in
+%% echo-on mode (See Advanced Programming in the Unix Environment, 2nd ed,
+%% Stevens, page 638):
+%% - ^u in posix/icanon mode: erase-line, prefix-arg in edlin
+%% - ^t in posix/icanon mode: status, transpose-char in edlin
+%% - ^d in posix/icanon mode: eof, delete-forward in edlin
+%% - ^r in posix/icanon mode: reprint (silly in echo-off mode :-))
+%% - ^w in posix/icanon mode: word-erase (produces a beep in edlin)
+edit_line(eof, Chars) ->
+    {Chars,done};
+edit_line([],Chars) ->
+    {Chars,[]};
+edit_line([$\r,$\n|Cs],Chars) ->
+    {[$\n | Chars], remainder_after_nl(Cs)};
+edit_line([NL|Cs],Chars) when NL =:= $\r; NL =:= $\n ->
+    {[$\n | Chars], remainder_after_nl(Cs)};
+edit_line([Erase|Cs],[]) when Erase =:= $\177; Erase =:= $\^H ->
+    edit_line(Cs,[]);
+edit_line([Erase|Cs],[_|Chars]) when Erase =:= $\177; Erase =:= $\^H ->
+    edit_line(Cs,Chars);
+edit_line([Char|Cs],Chars) ->
+    edit_line(Cs,[Char|Chars]).
+
+remainder_after_nl("") -> done;
+remainder_after_nl(Cs) -> Cs.
+    
+
+
+get_line_timeout(blink) -> 1000;
+get_line_timeout(more_chars) -> infinity.
+
+new_stack(Ls) -> {stack,Ls,{},[]}.
+
+up_stack({stack,[L|U],{},D}) ->
+    {L,{stack,U,L,D}};
+up_stack({stack,[],{},D}) ->
+    {none,{stack,[],{},D}};
+up_stack({stack,U,C,D}) ->
+    up_stack({stack,U,{},[C|D]}).
+
+down_stack({stack,U,{},[L|D]}) ->
+    {L,{stack,U,L,D}};
+down_stack({stack,U,{},[]}) ->
+    {none,{stack,U,{},[]}};
+down_stack({stack,U,C,D}) ->
+    down_stack({stack,[C|U],{},D}).
+
+%% This is get_line without line editing (except for backspace) and
+%% without echo.
+get_password_line(Chars, Drv) ->
+    get_password1(edit_password(Chars,[]),Drv).
+
+get_password1({Chars,[]}, Drv) ->
+    receive
+	{Drv,{data,Cs}} ->
+	    get_password1(edit_password(Cs,Chars),Drv);
+	{io_request,From,ReplyAs,Req} when is_pid(From) ->
+	    %send_drv_reqs(Drv, [{delete_chars, -length(Pbs)}]),
+	    io_request(Req, From, ReplyAs, Drv, []), %WRONG!!!
+	    %% I guess the reason the above line is wrong is that Buf is
+	    %% set to []. But do we expect anything but plain output?
+
+	    get_password1({Chars, []}, Drv);
+	{'EXIT',Drv,interrupt} ->
+	    interrupted;
+	{'EXIT',Drv,_} ->
+	    terminated
+    end;
+get_password1({Chars,Rest},Drv) ->
+    send_drv_reqs(Drv,[{put_chars, unicode, "\n"}]),
+    {done,lists:reverse(Chars),case Rest of done -> []; _ -> Rest end}.
+
+edit_password([],Chars) ->
+    {Chars,[]};
+edit_password([$\r],Chars) ->
+    {Chars,done};
+edit_password([$\r|Cs],Chars) ->
+    {Chars,Cs};
+edit_password([$\177|Cs],[]) ->       %% Being able to erase characters is
+    edit_password(Cs,[]);             %% the least we should offer, but
+edit_password([$\177|Cs],[_|Chars]) ->%% is backspace enough?
+    edit_password(Cs,Chars);
+edit_password([Char|Cs],Chars) ->
+    edit_password(Cs,[Char|Chars]).
+
+%% prompt_bytes(Prompt)
+%%  Return a flat list of bytes for the Prompt.
+prompt_bytes(Prompt) ->
+    lists:flatten(io_lib:format_prompt(Prompt)).
+
+cast(L, binary,latin1) when is_list(L) ->
+    list_to_binary(L);
+cast(L, list, latin1) when is_list(L) ->
+    binary_to_list(list_to_binary(L)); %% Exception if not bytes
+cast(L, binary,unicode) when is_list(L) ->
+    unicode:characters_to_binary(L,utf8);
+cast(Other, _, _) ->
+    Other.
+
+append(B, L, latin1) when is_binary(B) ->
+    binary_to_list(B)++L;
+append(B, L, unicode) when is_binary(B) ->
+    unicode:characters_to_list(B,utf8)++L;
+append(L1, L2, _) when is_list(L1) ->
+    L1++L2;
+append(_Eof, L, _) ->
+    L.