Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Initial commit/release. See README.

  • Loading branch information...
commit c8eac58be3658eb1c229dc59171bee8418093124 0 parents
@ferd ferd authored
2  Emakefile
@@ -0,0 +1,2 @@
+{["src/*"], [{outdir, "ebin"}]}.
+
88 README.markdown
@@ -0,0 +1,88 @@
+# erlang-history #
+
+erlang-history (eh) is a tiny pair of files that can be used to patch an Erlang-OTP system to add support for history in the Erlang shell.
+
+The history supported is the one available through up/down arrows on the keyboard.
+
+## How to install ##
+
+1. Compile the two files (`erl -make`).
+2. Take the `.beam` files in `ebin/` and move them to `$ROOT/lib/kernel-$VSN/ebin/` for the OTP release of your choice.
+3. Start the Erlang shell associated with this version of the Erlang/OTP kernel to gain shell history.
+4. In case you want to remove the patch, just recompile `$ROOT$/lib/kernel-$VSN/src/group.erl`, and move the resulting `.beam` back into the `ebin/` directory. Alternatively, make a backup beforehand.
+
+## Configuration Options & Features ##
+
+By default, the shell history will be enabled. To disable it, the kernel application variable `hist` can be set to `false` to disable history.
+
+Options include:
+
+- `hist` - `true | false`: enables or disables shell history. Default value is `true`
+- `hist_file` - `string()`: gives the path to where the history should be saved. By default, the file sits in your home directory as `.erlang-history.$NODENAME`. The node name will *always* be appended to the file name as a way to manage conflicts and accounts.
+- `hist_size` - `1..N`: how many input lines the shell should remember. By default, the value is set to 500.
+- `hist_drop` - `["some", "string", ...]`: lines you do not want to be saved in the history. As an example, setting `hist_drop` to `["q().","init:stop().","halt()."]` will avoid saving most manual ways of shutting down a shell. By default, no terms are dropped.
+
+If you are not familiar with Erlang application variables, there are two principal ways to handle them. The first one is to pass the arguments manually to `erl` as follows:
+
+ erl -kernel hist_size 120 -kernel hist_drop '["q().","init:stop()."]'
+
+The other way is to create a configuration file, looking a bit as follows:
+
+ [{kernel,[
+ {hist_size, 120},
+ {hist_drop, ["q().", "init:stop()."]}
+ ]}].
+
+Then start the Erlang shell by doing:
+
+ erl -config hist.config
+
+that is, if we assume `hist.config` is the name of your configuration file. If you're in a unix-like system, you can then alias the 'erl' command to run whatever you need:
+
+ alias erl='erl -config hist.config'
+
+And then use it everywhere. Last but not least, if you feel dirty, you can directly find the `.app` file of the kernel application (in its `ebin/` directory) and write the values in there.
+
+## FAQ (or planned FAQs) ##
+
+### Is this going to be in OTP? ###
+
+So far I haven't planned to push this into OTP. I have no idea how reliable the code is, wrote pretty much no tests (testing this shit is hard, although unit tests would be possible) outside of trying stuff for myself.
+
+I also feel the whole thing is a bit too hackish and I do not believe it would be up to the OTP team's standard, but if it were to be, why not? I could commit that stuff inside OTP for sure.
+
+### How do you store history? ###
+
+I've used DETS tables at this point in time, as it was (at first) easy to store stuff that way. The old requests are injected into the shell when it first starts up (and it does so for all instances of the shell on a given node. Every time a new line is typed in (as the existing shell sees it fit -- I just tied myself into the existing code), it is saved into the database.
+
+Yes, this means there is a 2GB hard limit on how much history you can store per Erlang node. I hope you won't need that, but oh well. Hopefully you don't need that much stuff.
+
+### What's the license? ###
+
+I don't know yet! I'm hesitating between MIT and BSD, although if this were to make it into Erlang/OTP, I'd go with the Erlang Public License to fit with the rest. We'll see how it goes and what people want.
+
+### I'm a man with the head of a horse, the torso of a wasp and the legs of a spider ###
+
+Congratulations, I guess.
+
+### Does this handle more advanced history functionality than just up/down arrows? ###
+
+No, it doesn't.
+
+It would be nice to support backwards search with ^R, but I didn't go this far into implementing things.
+
+Users of the shell history functions (`h()` and `v(N)`) will be disappointed to know I haven't added history support for that. Although it is possible (and I have some demo code to do so), I decided it was not worth including because of all the weird problems created. These commands save the function called as Erlang term tokens (after parsing, before evaluation) and the full results of the calls. This means that a lot of data or state could be carried over sessions while no longer making sense; things like pids, sockets, etc. Rather than dealing with that, I decided it would be simpler for people to just replay the previous functions.
+
+If you want the demo code that handled these things, let me know.
+
+### What if the database gets corrupted? ###
+
+DETS repairing of tables should be properly supported. In case of a database corrupted beyond repair, removing the DB file and starting over again will work fine.
+
+## Author ##
+
+- Fred Hebert (ferd, MononcQc).
+
+## Thanks ##
+
+Thanks to Robert Virding & Felix Lange for the guidance through Erlang's IO system and the fun discussions at the 2011 EUC's hackathon. It was a pretty fun day and that's where I first prototyped this.
0  ebin/.this-file-intentionally-left-blank
No changes.
712 src/group.erl
@@ -0,0 +1,712 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1996-2010. 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, history:load())),
+ 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),
+ save_line_buffer(Line, get_lines(Ls)),
+ {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(save_line(Ls0, edlin:current_line(Cont))) 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(save_line(Ls0, edlin:current_line(Cont))) 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({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}).
+
+save_line({stack, U, {}, []}, Line) ->
+ {stack, U, {}, [Line]};
+save_line({stack, U, _L, D}, Line) ->
+ {stack, U, Line, D}.
+
+get_lines({stack, U, {}, []}) ->
+ U;
+get_lines({stack, U, {}, D}) ->
+ tl(lists:reverse(D, U));
+get_lines({stack, U, L, D}) ->
+ get_lines({stack, U, {}, [L|D]}).
+
+save_line_buffer("\n", Lines) ->
+ save_line_buffer(Lines);
+save_line_buffer(Line, [Line|_Lines]=Lines) ->
+ save_line_buffer(Lines);
+save_line_buffer(Line, Lines) ->
+ history:add(Line),
+ save_line_buffer([Line|Lines]).
+
+save_line_buffer(Lines) ->
+ put(line_buffer, Lines).
+
+%% 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.
184 src/history.erl
@@ -0,0 +1,184 @@
+-module(history).
+-export([load/0, add/1]).
+
+-define(DEFAULT_HIST_FILE, ".erlang-hist").
+-define(DEFAULT_HIST_SIZE, 500).
+-define(TABLE, shell_group_hist).
+-define(DEFAULT_AUTOSAVE, 500).
+-define(DEFAULT_DROP, []).
+
+%% History is node-based, but history of many jobs on a single node
+%% are mixed in together.
+-record(opts, {hist=true, hist_file, hist_size}).
+
+%%% PUBLIC
+%% Loads the shell history from memory. This function should only be
+%% called from group:server/3 to inject itself in the previous commands
+%% stack.
+load() ->
+ case opts() of
+ #opts{hist=false} ->
+ [];
+ #opts{hist_file=F, hist_size=S} ->
+ wait_for_kernel_safe_sup(),
+ %% We cannot repair the table automatically. The current process
+ %% is handling output and dets repairing a table outputs a message.
+ %% Due to how the IO protocol works, this leads to a deadlock where
+ %% we wait to reply to ourselves in some circumstances.
+ case dets:open_file(?TABLE, [{file,F}, {auto_save, opt(hist_auto_save)}, {repair, false}]) of
+ {ok, ?TABLE} -> load_history(S);
+ {error, {needs_repair, F}} -> repair_table(F)
+ end
+ end.
+
+load_history(S) ->
+ Ct = case dets:lookup(?TABLE, ct) of
+ [] -> % 1st run
+ dets:insert(?TABLE, {ct,1}),
+ 1;
+ [{ct,OldCt}] -> OldCt
+ end,
+ load(Ct, Ct-S).
+
+%% Repairing the table means we need to spawn a new process to do it for us.
+%% That process will then try to message the current group leader with mentions
+%% of trying to repair the table. We need to absorb these, let the process
+%% repair, then close the table in order for us to open it again and finally
+%% be free!
+repair_table(F) ->
+ %% Start a process to open and close the table to repair it, different
+ %% from the current shell process.
+ R = make_ref(),
+ S = self(),
+ spawn(fun() ->
+ {ok, ?TABLE} = dets:open_file(?TABLE, [{file,F},{repair,force}]),
+ dets:close(?TABLE),
+ S ! R
+ end),
+ %% Messages from the IO protocol will only need to be received if we
+ %% currently are the group leader (in this case, the 'user' process).
+ %% if this is not 'user', we can move on.
+ case process_info(self(), registered_name) of
+ {registered_name, user} ->
+ receive
+ {io_request,From,ReplyAs,
+ {put_chars,_Encoding,io_lib,format,
+ ["dets:"++_, [F, [_|_]]]}} -> From ! {io_reply, ReplyAs, ok}
+ end;
+ _ -> ok
+ end,
+ %% now we wait for the worker to close the table, telling us it's safe
+ %% to load it on our own.
+ receive
+ R -> ok
+ end,
+ load().
+
+%% Adds a given line to the history,
+add(Line) -> add(Line, opt(hist)).
+
+%% only add lines that do not match something to drop from history. The behaviour
+%% to avoid storing empty or duplicate lines is in fact implemented within
+%% group:save_line_buffer/2.
+add(Line, true) ->
+ case lists:member(Line, opt(hist_drop)) of
+ false ->
+ [{ct, Ct}] = dets:lookup(?TABLE, ct),
+ dets:insert(?TABLE, {Ct, Line}),
+ dets:delete(?TABLE, Ct-opt(hist_size)),
+ dets:update_counter(?TABLE, ct, {2,1});
+ true ->
+ ok
+ end;
+add(_, false) -> ok.
+
+%%% PRIVATE
+%% Gets a short record of vital options when setting things up.
+opts() ->
+ #opts{hist=opt(hist),
+ hist_file=opt(hist_file),
+ hist_size=opt(hist_size)}.
+
+%% Defines whether history should be allowed at all.
+opt(hist) ->
+ case application:get_env(kernel, hist) of
+ {ok, true} -> true;
+ {ok, false} -> false;
+ _Default -> true
+ end;
+%% Defines what the base name and path of the history file will be.
+%% By default, the file sits in the user's home directory as
+%% '.erlang-history.'. All filenames get the node name apended
+%% to them.
+opt(hist_file) ->
+ case {opt(hist), application:get_env(kernel, hist_file)} of
+ {true, undefined} ->
+ case init:get_argument(home) of
+ {ok, [[Home]]} ->
+ Name = filename:join([Home, ?DEFAULT_HIST_FILE]),
+ application:set_env(kernel, hist_file, Name),
+ opt(hist_file);
+ _ ->
+ error_logger:error_msg("No place found to save shell history"),
+ erlang:error(badarg)
+ end;
+ {true, {ok, Val}} -> Val++"."++atom_to_list(node());
+ {false, _} -> undefined
+ end;
+%% Defines how many commands should be kept in memory. Default is 500.
+opt(hist_size) ->
+ case {opt(hist), application:get_env(kernel, hist_size)} of
+ {true, undefined} ->
+ application:set_env(kernel, hist_size, ?DEFAULT_HIST_SIZE),
+ ?DEFAULT_HIST_SIZE;
+ {true, {ok,Val}} -> Val;
+ {false, _} -> undefined
+ end;
+%% This handles the delay of auto-saving of DETS. This isn't public
+%% and the value is currently very short so that shell crashes do not
+%% corrupt the file history.
+opt(hist_auto_save) ->
+ case application:get_env(kernel, hist_auto_save) of
+ undefined ->
+ application:set_env(kernel, hist_auto_save, ?DEFAULT_AUTOSAVE),
+ ?DEFAULT_AUTOSAVE;
+ {ok, V} -> V
+ end;
+%% Allows to define a list of strings that should not be kept in history.
+%% one example would be ["q().","init:stop().","halt()."] if you do not
+%% want to keep ways to shut down the shell.
+opt(hist_drop) ->
+ case application:get_env(kernel, hist_drop) of
+ undefined ->
+ application:set_env(kernel, hist_drop, ?DEFAULT_DROP),
+ ?DEFAULT_DROP;
+ {ok, V} when is_list(V) -> [Ln++"\n" || Ln <- V];
+ {ok, _} -> ?DEFAULT_DROP
+ end.
+
+%% Because loading the shell happens really damn early, processes we depend on
+%% might not be there yet. Luckily, the load function is called from the shell
+%% after a new process has been spawned, so we can block in here
+wait_for_kernel_safe_sup() ->
+ case whereis(kernel_safe_sup) of
+ undefined ->
+ timer:sleep(50),
+ wait_for_kernel_safe_sup();
+ _ -> ok
+ end.
+
+%% Load all the elements previously saved in history
+load(N, _) when N =< 0 -> [];
+load(N, M) when N =< M -> truncate(M), [];
+load(N, M) ->
+ case dets:lookup(?TABLE, N-1) of
+ [] -> []; % nothing in history
+ [{_,Entry}] -> [Entry | load(N-1,M)]
+ end.
+
+%% If the history size was changed between two shell sessions, we have to
+%% truncate the old history.
+truncate(N) when N =< 0 -> ok;
+truncate(N) ->
+ dets:delete(?TABLE, N),
+ truncate(N-1).
Please sign in to comment.
Something went wrong with that request. Please try again.