diff options
Diffstat (limited to 'lib/kernel/src/group.erl')
| -rw-r--r-- | lib/kernel/src/group.erl | 689 |
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. |