%% ``The contents of this file are subject to the Erlang Public License,
%% Version 1.0, (the "License"); you may not use this file except in
%% compliance with the License. You may obtain a copy of the License at
%% http://www.erlang.org/EPL1_0.txt
%% 
%% 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.
%% 
%% The Original Code is Erlang-4.7.3, December, 1998.
%% 
%% The Initial Developer of the Original Code is Ericsson Telecom
%% AB. Portions created by Ericsson are Copyright (C), 1998, Ericsson
%% Telecom AB. All Rights Reserved.
%% 
%% Contributor(s): ______________________________________.''
%%
%% Copyright (C) 1993, Ellemtel Telecommunications Systems Laboratories
%% File    : edlin.erl
%% Author  : Robert Virding
%% Purpose : A simple Emacs-like line editor.

%% Changes: 5/11 - 93
%% Anders and klacke added support for the META-key
%% Changes: 25/4 - 95
%% Joe added completion when you hit TAB
%% Robert extended completion to work anywhere.
%% Changes: 6/8 - 97
%% Don exported expand/1 for use in winshell

-module(edlin).
-copyright('Copyright (c) 1991-97 Ericsson Telecom AB').
-vsn('$Revision: /main/release/free/1').

-export([init/0,start/1,edit_line/2,prefix_arg/1]).
-export([erase_line/1,erase_inp/1,redraw_line/1]).
-export([length_before/1,length_after/1,prompt/1]).
-export([expand/1]).

-import(lists, [append/2, reverse/1, reverse/2,
		nthtail/2, keysearch/3, prefix/2]).

%% A Continuation has the structure:
%%	{line,Prompt,CurrentLine,EditPrefix}

%% init()
%%  Initialise the line editor. This must be done once per process using
%%  the editor.

init() ->
    put(kill_buffer, []).

%% start(Prompt)
%% edit(Characters, Continuation)
%%  Return
%%	{done,Line,Rest,Requests}
%%	{more_chars,Cont,Requests}
%%	{blink,Cont,Requests}
%%	{undefined,Char,Rest,Cont,Requests}

start(Pbs) ->
    {more_chars,{line,Pbs,{[],[]},none},[{put_chars,Pbs}]}.

edit_line(Cs, {line,P,L,{blink,N}}) ->
    edit(Cs, P, L, none, [{move_rel,N}]);
edit_line(Cs, {line,P,L,M}) ->
    edit(Cs, P, L, M, []).

edit([C|Cs], P, Line, {blink,N}, [R|Rs]) ->	%Remove blink here
    edit([C|Cs], P, Line, none, Rs);
edit([C|Cs], P, {Bef,Aft}, Prefix, Rs0) ->
    case key_map(C, Prefix) of
	meta ->
	    edit(Cs, P, {Bef,Aft}, meta, Rs0);
	ctlx ->
	    edit(Cs, P, {Bef,Aft}, ctlx, Rs0);
	new_line ->
	    {done,reverse(Bef, append(Aft, "\n")),Cs,
	     reverse(Rs0, [{move_rel,length(Aft)},{put_chars,"\n"}])};
	redraw_line ->
	    Rs1 = erase(P, Bef, Aft, Rs0),
	    Rs = redraw(P, Bef, Aft, Rs1),
	    edit(Cs, P, {Bef,Aft}, none, Rs);
	tab ->
	    case expand(Bef) of
		{yes,Str} ->
		    edit(append(Str, Cs), P, {Bef,Aft}, none, Rs0);
		no ->
		    %% don't beep if there's only whitespace before
		    %% us - user may have pasted in a lot of indented stuff.
		    case whitespace_only(Bef) of
			false ->
			    edit(Cs, P, {Bef,Aft}, none, [beep|Rs0]);
			true ->
			    edit(Cs, P, {Bef,Aft}, none, [Rs0])
		    end
	    end;
	{undefined,C} ->
	    {undefined,{none,Prefix,C},Cs,{line,P,{Bef,Aft},none},
	     reverse(Rs0)};
	Op ->
	    case do_op(Op, Bef, Aft, Rs0) of
		{blink,N,Line,Rs} ->
		    edit(Cs, P, Line, {blink,N}, Rs);
		{Line,Rs} ->
		    edit(Cs, P, Line, none, Rs)
	    end
    end;
edit([], P, L, {blink,N}, Rs) ->
    {blink,{line,P,L,{blink,N}},reverse(Rs)};
edit([], P, L, Prefix, Rs) ->
    {more_chars,{line,P,L,Prefix},reverse(Rs)};
edit(eof, P, {Bef,Aft}, Mode, Rs) ->
    {done,reverse(Bef, Aft),[],reverse(Rs, [{move_rel,length(Aft)}])}.

%% Assumes that arg is a string
%% Horizontal whitespace only.
whitespace_only([]) ->
    true;
whitespace_only([C|Rest]) ->
    case C of
	$  ->
	    whitespace_only(Rest);
	$\t ->
	    whitespace_only(Rest);
	_ ->
	    false
    end.

%% prefix_arg(Argument)
%%  Take a prefix argument and return its numeric value.

prefix_arg(none) -> 1;
prefix_arg({ctlu,N}) -> N;
prefix_arg(N) -> N.

%% key_map(Char, Prefix)
%%  Map a character and a prefix to an action.

key_map($\^A, none) -> beginning_of_line;
key_map($\^B, none) -> backward_char;
key_map($\^D, none) -> forward_delete_char;
key_map($\^E, none) -> end_of_line;
key_map($\^F, none) -> forward_char;
key_map($\^H, none) -> backward_delete_char;
key_map($\t, none) -> tab;
key_map($\^L, none) -> redraw_line;
key_map($\n, none) -> new_line;
key_map($\^K, none) -> kill_line;
key_map($\r, none) -> new_line;
key_map($\^T, none) -> transpose_char;
key_map($\^U, none) -> ctlu;
key_map($\^X, none) -> ctlx;
key_map($\^Y, none) -> yank;
key_map($\e, none) -> meta;
key_map($), Prefix) when Prefix /= meta -> {blink,$),$(};
key_map($}, Prefix) when Prefix /= meta -> {blink,$},${};
key_map($], Prefix) when Prefix /= meta -> {blink,$],$[};
key_map($B, meta) -> backward_word;
key_map($D, meta) -> kill_word;
key_map($F, meta) -> forward_word;
key_map($T, meta) -> transpose_word;
key_map($Y, meta) -> yank_pop;
key_map($b, meta) -> backward_word;
key_map($d, meta) -> kill_word;
key_map($f, meta) -> forward_word;
key_map($t, meta) -> transpose_word;
key_map($y, meta) -> yank_pop;
key_map($\177, none) -> backward_delete_char;
key_map($\177, meta) -> backward_kill_word;
%% To enable the Meta key (and disable international characters),
%% uncomment the following line:
%% key_map(C, none) when C > 128 -> key_map(C-128, meta);
key_map(C, none) when C >= $  ->
    {insert,C};
key_map(C, M) -> {undefined,C}.

%% do_op(Action, Before, After, Requests)

do_op({insert,C}, Bef, [], Rs) ->
    {{[C|Bef],[]},[{put_chars,[C]}|Rs]};
do_op({insert,C}, Bef, Aft, Rs) ->
    {{[C|Bef],Aft},[{insert_chars, [C]}|Rs]};
do_op({blink,C,M}, Bef, [], Rs) ->
    N = over_paren(Bef, C, M),
    {blink,N+1,{[C|Bef],[]},[{move_rel,-(N+1)},{put_chars,[C]}|Rs]};
do_op({blink,C,M}, Bef, Aft, Rs) ->
    N = over_paren(Bef, C, M),
    {blink,N+1,{[C|Bef],Aft},[{move_rel,-(N+1)},{insert_chars,[C]}|Rs]};
do_op(forward_delete_char, Bef, [C|Aft], Rs) ->
    {{Bef,Aft},[{delete_chars,1}|Rs]};
do_op(backward_delete_char, [C|Bef], Aft, Rs) ->
    {{Bef,Aft},[{delete_chars,-1}|Rs]};
do_op(transpose_char, [C1,C2|Bef], [], Rs) ->
    {{[C2,C1|Bef],[]},[{put_chars,[C1,C2]},{move_rel,-2}|Rs]};
do_op(transpose_char, [C2|Bef], [C1|Aft], Rs) ->
    {{[C2,C1|Bef],Aft},[{put_chars,[C1,C2]},{move_rel,-1}|Rs]};
do_op(kill_word, Bef, Aft0, Rs) ->
    {Aft1,Kill0,N0} = over_non_word(Aft0, [], 0),
    {Aft,Kill,N} = over_word(Aft1, Kill0, N0),
    put(kill_buffer, reverse(Kill)),
    {{Bef,Aft},[{delete_chars,N}|Rs]};
do_op(backward_kill_word, Bef0, Aft, Rs) ->
    {Bef1,Kill0,N0} = over_non_word(Bef0, [], 0),
    {Bef,Kill,N} = over_word(Bef1, Kill0, N0),
    put(kill_buffer, Kill),
    {{Bef,Aft},[{delete_chars,-N}|Rs]};
do_op(kill_line, Bef, Aft, Rs) ->
    put(kill_buffer, Aft),
    {{Bef,[]},[{delete_chars,length(Aft)}|Rs]};
do_op(yank, Bef, [], Rs) ->
    Kill = get(kill_buffer),
    {{reverse(Kill, Bef),[]},[{put_chars,Kill}|Rs]};
do_op(yank, Bef, Aft, Rs) ->
    Kill = get(kill_buffer),
    {{reverse(Kill, Bef),Aft},[{insert_chars,Kill}|Rs]};
do_op(forward_char, Bef, [C|Aft], Rs) ->
    {{[C|Bef],Aft},[{move_rel,1}|Rs]};
do_op(backward_char, [C|Bef], Aft, Rs) ->
    {{Bef,[C|Aft]},[{move_rel,-1}|Rs]};
do_op(forward_word, Bef0, Aft0, Rs) ->
    {Aft1,Bef1,N0} = over_non_word(Aft0, Bef0, 0),
    {Aft,Bef,N} = over_word(Aft1, Bef1, N0),
    {{Bef,Aft},[{move_rel,N}|Rs]};
do_op(backward_word, Bef0, Aft0, Rs) ->
    {Bef1,Aft1,N0} = over_non_word(Bef0, Aft0, 0),
    {Bef,Aft,N} = over_word(Bef1, Aft1, N0),
    {{Bef,Aft},[{move_rel,-N}|Rs]};
do_op(beginning_of_line, [C|Bef], Aft, Rs) ->
    {{[],reverse(Bef, [C|Aft])},[{move_rel,-(length(Bef)+1)}|Rs]};
do_op(beginning_of_line, [], Aft, Rs) ->
    {{[],Aft},Rs};
do_op(end_of_line, Bef, [C|Aft], Rs) ->
    {{reverse(Aft, [C|Bef]),[]},[{move_rel,length(Aft)+1}|Rs]};
do_op(end_of_line, Bef, [], Rs) ->
    {{Bef,[]},Rs};
do_op(beep, Bef, Aft, Rs) ->
    {{Bef,Aft},[beep|Rs]};
do_op(Other, Bef, Aft, Rs) ->
    {{Bef,Aft},[beep|Rs]}.

%% over_word(Chars, InitialStack, InitialCount) ->
%%	{RemainingChars,CharStack,Count}
%% over_non_word(Chars, InitialStack, InitialCount) ->
%%	{RemainingChars,CharStack,Count}
%%  Step over word/non-word characters pushing the stepped over ones on
%%  the stack.

over_word([C|Cs], Stack, N) ->
    case word_char(C) of
	true -> over_word(Cs, [C|Stack], N+1);
	false -> {[C|Cs],Stack,N}
    end;
over_word([], Stack, N) ->
    {[],Stack,N}.

over_non_word([C|Cs], Stack, N) ->
    case word_char(C) of
	true -> {[C|Cs],Stack,N};
	false -> over_non_word(Cs, [C|Stack], N+1)
    end;
over_non_word([], Stack, N) ->
    {[],Stack,N}.

word_char(C) when C >= $A, C =< $Z -> true;
word_char(C) when C >= $a, C =< $z -> true;
word_char(C) when C >= $0, C =< $9 -> true;
word_char(C) when C == $_ -> true;
word_char(C) -> false.

%% over_white(Chars, InitialStack, InitialCount) ->
%%	{RemainingChars,CharStack,Count}

over_white([$ |Cs], Stack, N) ->
    over_white(Cs, [$ |Stack], N+1);
over_white([$\t|Cs], Stack, N) ->
    over_white(Cs, [$\t|Stack], N+1);
over_white(Cs, Stack, N) ->
    {Cs,Stack,N}.

%% over_paren(Chars, Paren, Match)
%% over_paren(Chars, Paren, Match, Depth, N)
%%  Step over parentheses until matching Paren is found at depth 0. Don't
%%  do proper parentheses matching check. Paren has NOT been added.

over_paren(Chars, Paren, Match) ->
    over_paren(Chars, Paren, Match, 1, 1).

over_paren([Match|Cs], Paren, Match, 1, N) ->
    N;
over_paren([Match|Cs], Paren, Match, D, N) ->
    over_paren(Cs, Paren, Match, D-1, N+1);
over_paren([Paren|Cs], Paren, Match, D, N) ->
    over_paren(Cs, Paren, Match, D+1, N+1);
over_paren([C|Cs], Paren, Match, D, N)  ->
    over_paren(Cs, Paren, Match, D, N+1);
over_paren([], Paren, Match, D, N) ->
    0.

%% erase_line(Line)
%% erase_inp(Line)
%% redraw_line(Line)
%% length_before(Line)
%% length_after(Line)
%% prompt(Line)
%%  Various functions for accessing bits of a line.

erase_line({line,Pbs,{Bef,Aft},M}) ->
    reverse(erase(Pbs, Bef, Aft, [])).

erase_inp({line,Pbs,{Bef,Aft},M}) ->
    reverse(erase([], Bef, Aft, [])).

erase(Pbs, Bef, Aft, Rs) ->
    [{delete_chars,-length(Pbs)-length(Bef)},{delete_chars,length(Aft)}|Rs].

redraw_line({line,Pbs,{Bef,Aft},M}) ->
    reverse(redraw(Pbs, Bef, Aft, [])).

redraw(Pbs, Bef, Aft, Rs) ->
    [{move_rel,-length(Aft)},{put_chars,reverse(Bef, Aft)},{put_chars,Pbs}|Rs].

length_before({line,Pbs,{Bef,Aft},M}) ->
    length(Pbs) + length(Bef).

length_after({line,Pbs,{Bef,Aft},M}) ->
    length(Aft).

prompt({line,Pbs,L,M}) ->
    Pbs.

%% expand(CurrentBefore) ->
%%	{yes,Expansion} | no
%%  Try to expand the word before as either a module name or a function
%%  name. We can handle white space around the seperating ':' but the
%%  function name must be on the same line. CurrentBefore is reversed
%%  and over_word/3 reverses the characters it finds.

expand(Bef0) ->
    {Bef1,Word,Nw} = over_word(Bef0, [], 0),
    case over_white(Bef1, [], 0) of
	{[$:|Bef2],White,Nwh} ->
	    {Bef3,White1,Nwh1} = over_white(Bef2, [], 0),
	    {Bef,Mod,Nm} = over_word(Bef3, [], 0),
	    expand_function_name(Mod, Word);
	{Bef2,White,Nwh} ->
	    expand_module_name(Word)
    end.

expand_module_name(Prefix) ->
    match(Prefix, code:all_loaded(), $:).

expand_function_name(ModStr, FuncPrefix) ->
    Mod = list_to_atom(ModStr),
    case erlang:module_loaded(Mod) of
	true ->
	    L = apply(Mod, module_info, []),
	    case keysearch(exports, 1, L) of
		{value, {_, Exports}} ->
		    match(FuncPrefix, Exports, $();
		_ ->
		    no
	    end;
	false ->
	    no
    end.

match(Prefix, Alts, Extra) ->
    case match1(Prefix, Alts, []) of
	[Str] ->
	    {yes, append(nthtail(length(Prefix), Str),[Extra])};
	Matches ->
	    case longest_common_head(Matches) of
		{yes, []} ->
		    no;
		{yes, Str} ->
		    {yes, nthtail(length(Prefix), Str)};
		no ->
		    no
	    end
    end.

match1(Prefix, [{H,_}|T], L) ->
    case prefix(Prefix, Str = atom_to_list(H)) of
	true ->
	    match1(Prefix, T, [Str|L]);
	false ->
	    match1(Prefix, T, L)
    end;
match1(_, [], L) ->
    L.

longest_common_head([]) ->
    no;
longest_common_head(LL) ->
    longest_common_head(LL, []).

longest_common_head([[]|_], L) ->
    {yes, reverse(L)};
longest_common_head(LL, L) ->
    case same_head(LL) of
	true ->
	    [[H|_]|_] = LL,
	    LL1 = all_tails(LL),
	    longest_common_head(LL1, [H|L]);
	false ->
	    {yes, reverse(L)}
    end.

same_head([[H|T]|T1]) -> same_head(H, T1).

same_head(H, [[H|_]|T]) -> same_head(H, T);
same_head(H, [])        -> true;
same_head(H, _)         -> false.

all_tails(LL) -> all_tails(LL, []).

all_tails([[_|T]|T1], L) -> all_tails(T1, [T|L]);
all_tails([], L)         -> L.
