-module(eFmt).

-include("eFmt.hrl").

-export([
   format/2
   , format/3

   , scan_format/2
   , unscan_format/1
   , build_text/1
   , build_text/2


   , print/1
   , print/4
   , indentation/2

   , write/1
   , write/2
   , write/3
   , doWrite/4
   , format_prompt/1
   , format_prompt/2


   , writeAtom/2
   , write_string/1
   , write_string/2
   , write_latin1_string/1
   , write_latin1_string/2
   , write_char/1
   , write_latin1_char/1

   , write_string_as_latin1/1
   , write_string_as_latin1/2
   , write_char_as_latin1/1


   , char_list/1
   , latin1_char_list/1
   , deep_char_list/1
   , deep_latin1_char_list/1
   , printable_list/1
   , printable_latin1_list/1
   , printable_unicode_list/1

%% Utilities for collecting characters.

   , collect_chars/3
   , collect_chars/4
   , collect_line/3
   , collect_line/4
   , get_until/3, get_until/4


%% The following functions were used by Yecc's include-file.

   , write_unicode_string/1
   , write_unicode_char/1
   , deep_unicode_char_list/1

   , limit_term/2

   , charsLen/1
]).

-export_type([
   chars/0
   , latin1_string/0
   , continuation/0
   , fread_error/0
   , fmtSpec/0
   , chars_limit/0
]).

%%----------------------------------------------------------------------

-type chars() :: [char() | chars()].
-type latin1_string() :: [unicode:latin1_char()].
-type depth() :: -1 | non_neg_integer().

-type chars_limit() :: integer().

-opaque continuation() ::
{Format :: string(), Stack :: chars(), Nchars :: non_neg_integer(), Results :: [term()]}.

-type fread_error() ::
'atom'
| 'based'
| 'character'
| 'float'
| 'format'
| 'input'
| 'integer'
| 'string'
| 'unsigned'.

-type fmtSpec() :: #fmtSpec{}.

%%----------------------------------------------------------------------
-spec format(Format :: io:format(), Data :: [term()]) -> chars().
format(Format, Args) ->
   try eFmtFormat:fwrite(Format, Args)
   catch
      C:R:S ->
         test_modules_loaded(C, R, S),
         erlang:error(badarg, [Format, Args, S])
   end.

-spec format(Format :: io:format(), Data :: [term()], Options :: [{'chars_limit', CharsLimit :: chars_limit()}]) -> chars().
format(Format, Args, Options) ->
   try eFmtFormat:fwrite(Format, Args, Options)
   catch
      C:R:S ->
         test_modules_loaded(C, R, S),
         erlang:error(badarg, [Format, Args])
   end.

-spec scan_format(Format, Data) -> FormatList when
   Format :: io:format(),
   Data :: [term()],
   FormatList :: [char() | fmtSpec()].

scan_format(Format, Args) ->
   try eFmtFormat:scan(Format, Args)
   catch
      C:R:S ->
         test_modules_loaded(C, R, S),
         erlang:error(badarg, [Format, Args])
   end.

-spec unscan_format(FormatList) -> {Format, Data} when
   FormatList :: [char() | fmtSpec()],
   Format :: io:format(),
   Data :: [term()].

unscan_format(FormatList) ->
   eFmtFormat:unscan(FormatList).

-spec build_text(FormatList) -> chars() when
   FormatList :: [char() | fmtSpec()].

build_text(FormatList) ->
   try eFmtFormat:build(FormatList)
   catch
      C:R:S ->
         test_modules_loaded(C, R, S),
         erlang:error(badarg, [FormatList])
   end.

-spec build_text(FormatList, Options) -> chars() when
   FormatList :: [char() | fmtSpec()],
   Options :: [Option],
   Option :: {'chars_limit', CharsLimit},
   CharsLimit :: chars_limit().

build_text(FormatList, Options) ->
   try eFmtFormat:build(FormatList, Options)
   catch
      C:R:S ->
         test_modules_loaded(C, R, S),
         erlang:error(badarg, [FormatList, Options])
   end.

%% Failure to load a module must not be labeled as badarg.
%% C, R, and S are included so that the original error, which could be
%% a bug in eFmtFormat, can be found by tracing on
%% test_modules_loaded/3.
test_modules_loaded(_C, _R, _S) ->
   Modules = [eFmtFormat, io_lib_pretty, string, unicode],
   case code:ensure_modules_loaded(Modules) of
      ok -> ok;
      Error -> erlang:error(Error)
   end.

-spec print(Term) -> chars() when
   Term :: term().

print(Term) ->
   io_lib_pretty:print(Term).

-spec print(Term, Column, LineLength, Depth) -> chars() when
   Term :: term(),
   Column :: non_neg_integer(),
   LineLength :: non_neg_integer(),
   Depth :: depth().

print(Term, Column, LineLength, Depth) ->
   io_lib_pretty:print(Term, Column, LineLength, Depth).

-spec indentation(String, StartIndent) -> integer() when
   String :: string(),
   StartIndent :: integer().

indentation(Chars, Current) ->
   eFmtFormat:indentation(Chars, Current).


%% Format an IO-request prompt (handles formatting errors safely).
%% Atoms, binaries, and iolists (or unicode:charlist()) can be used
%% as-is, and will be printed without any additional quotes.

-spec format_prompt(term()) -> chars().

format_prompt(Prompt) ->
   format_prompt(Prompt, latin1).

-spec format_prompt(term(), atom()) -> chars().

format_prompt({format, Format, Args}, _Encoding) ->
   do_format_prompt(Format, Args);
format_prompt(Prompt, Encoding)
   when is_list(Prompt); is_atom(Prompt); is_binary(Prompt) ->
   do_format_prompt(add_modifier(Encoding, "s"), [Prompt]);
format_prompt(Prompt, Encoding) ->
   do_format_prompt(add_modifier(Encoding, "p"), [Prompt]).

do_format_prompt(Format, Args) ->
   case catch format(Format, Args) of
      {'EXIT', _} -> "???";
      List -> List
   end.

add_modifier(latin1, C) ->
   "~" ++ C;
add_modifier(_, C) ->
   "~t" ++ C.

%% write(Term)
%% write(Term, Depth)
%% write(Term, Depth, Pretty)
%%  Return a (non-flattened) list of characters giving a printed
%%  representation of the term. write/3 is for backward compatibility.

-spec write(Term) -> chars() when
   Term :: term().

write(Term) ->
   writeTerm(Term, -1, latin1).

-spec write(term(), depth(), boolean()) -> chars().

write(Term, D, true) ->
   io_lib_pretty:print(Term, 1, 80, D);
write(Term, D, false) ->
   write(Term, D).

-spec write(Term, Depth) -> chars() when
   Term :: term(),
   Depth :: depth();
   (Term, Options) -> chars() when
   Term :: term(),
   Options :: [Option],
   Option :: {'chars_limit', CharsLimit}
   | {'depth', Depth}
   | {'encoding', 'latin1' | 'utf8' | 'unicode'},
   CharsLimit :: chars_limit(),
   Depth :: depth().

write(Term, Options) when is_list(Options) ->
   Depth = get_option(depth, Options, -1),
   Encoding = get_option(encoding, Options, epp:default_encoding()),
   CharsLimit = get_option(chars_limit, Options, -1),
   if
      Depth =:= 0; CharsLimit =:= 0 ->
         "...";
      CharsLimit < 0 ->
         writeTerm(Term, Depth, Encoding);
      CharsLimit > 0 ->
         RecDefFun = fun(_, _) -> no end,
         If = io_lib_pretty:intermediate(Term, Depth, CharsLimit, RecDefFun, Encoding, _Str = false),
         io_lib_pretty:write(If)
   end;
write(Term, Depth) ->
   write(Term, [{depth, Depth}, {encoding, latin1}]).



doWrite(Term, Depth, Encoding, CharsLimit) ->
   if
      Depth =:= 0 orelse CharsLimit =:= 0 ->
         <<"...">>;
      CharsLimit < 0 ->
         writeTerm(Term, Depth, Encoding);
      true ->
         RecDefFun = fun(_, _) -> no end,
         If = io_lib_pretty:intermediate(Term, Depth, CharsLimit, RecDefFun, Encoding, _Str = false),
         io_lib_pretty:write(If)
   end.

-define(writeInt(Int), integer_to_binary(Term)).

-define(writeFloat(Float), eFmtFormat:floatG(Term)).

-define(writeAtom(Atom, Encoding), <<"'", (atom_to_binary(Atom, Encoding))/binary, "'">>).

-define(writePort(Port), list_to_binary(erlang:port_to_list(Port))).

-define(writeRef(Ref), list_to_binary(erlang:ref_to_list(Ref))).

-define(writePid(Ref), list_to_binary(erlang:pid_to_list(Ref))).

-define(writeFun(Fun), list_to_binary(erlang:fun_to_list(Fun))).

writeTerm(_Term, 0, _E) -> <<"...">>;
writeTerm(Term, _D, _E) when is_integer(Term) -> ?writeInt(Term);
writeTerm(Term, _D, _E) when is_float(Term) -> ?writeFloat(Term);
writeTerm(Atom, _D, E) when is_atom(Atom) -> ?writeAtom(Atom, E);
writeTerm(Term, _D, _E) when is_port(Term) -> ?writePort(Term);
writeTerm(Term, _D, _E) when is_pid(Term) -> ?writePid(Term);
writeTerm(Term, _D, _E) when is_reference(Term) -> ?writeRef(Term);
writeTerm(Term, _D, _E) when is_function(Term) -> ?writeFun(Term);
writeTerm(Term, D, _E) when is_binary(Term) -> writeBinary(Term, D);
writeTerm(Term, D, _E) when is_bitstring(Term) -> writeBinary(Term, D);
writeTerm(Term, D, E) when is_list(Term) -> writeList(Term, D, E, <<"[">>);
writeTerm(Term, D, E) when is_map(Term) -> writeMap(Term, D, E, <<"#{">>);
writeTerm(Term, D, E) when is_tuple(Term) -> writeTuple(Term, D, E, 1, tuple_size(Term), <<"{">>).

writeAtom(Atom, Encoding) ->
   <<"'", (atom_to_binary(Atom, Encoding))/binary, "'">>.

writeList([], _D, _E, BinAcc) ->
   <<BinAcc/binary, "]">>;
writeList([One], D, E, BinAcc) ->
   <<BinAcc/binary, (writeTerm(One, D, E))/binary, "]">>;
writeList([One | List], D, E, BinAcc) ->
   if
      D =:= 1 -> <<BinAcc, "|...]">>;
      true ->
         writeList(List, D - 1, E, <<BinAcc/binary, (writeTerm(One, D, E))/binary, ",">>)
   end;
writeList(Other, D, E, BinAcc) ->
   <<BinAcc/binary, "|", (writeTerm(Other, D, E))/binary, "]">>.

writeTuple(Tuple, D, E, Index, TupleSize, BinAcc) ->
   if
      D =:= 1 -> <<BinAcc/binary, "...}">>;
      true ->
         if
            Index < TupleSize ->
               writeTuple(Tuple, D - 1, E, Index + 1, TupleSize, <<BinAcc/binary, (writeTerm(element(Index, Tuple), D - 1, E))/binary, ",">>);
            Index == TupleSize ->
               <<BinAcc/binary, (writeTerm(element(Index, Tuple), D - 1, E))/binary, "}">>;
            true ->
               <<BinAcc/binary, "}">>
         end
   end.

writeMap(Map, D, E, BinAcc) when is_integer(D) ->
   if
      D =:= 1 ->
         <<BinAcc/binary, "...}">>;
      true ->
         writeMapBody(maps:iterator(Map), D, E, BinAcc)
   end.

writeMapBody(I, D, E, BinAcc) ->
   if
      D =:= 1 ->
         <<BinAcc/binary, " ...}">>;
      true ->
         case maps:next(I) of
            {K, V, none} ->
               <<BinAcc/binary, (writeTerm(K, -1, E))/binary, " => ", (writeTerm(V, D, E))/binary, "}">>;
            {K, V, NextI} ->
               writeMapBody(NextI, D - 1, E, <<BinAcc/binary, (writeTerm(K, -1, E))/binary, " => ", (writeTerm(V, D, E))/binary, ",">>);
            none ->
               <<BinAcc/binary, "}">>
         end
   end.

writeBinary(Bin, D) ->
   if
      D == 1 ->
         <<"...">>;
      true ->
         <<"<<", Bin/binary, ">>">>
   end.

get_option(Key, TupleList, Default) ->
   case lists:keyfind(Key, 1, TupleList) of
      false -> Default;
      {Key, Value} -> Value;
      _ -> Default
   end.


%%% There are two functions to write Unicode strings:
%%% - they both escape control characters < 160;
%%% - write_string() never escapes characters >= 160;
%%% - write_string_as_latin1() also escapes characters >= 255.

%% write_string([Char]) -> [Char]
%%  Generate the list of characters needed to print a string.

-spec write_string(String) -> chars() when
   String :: string().

write_string(S) ->
   write_string(S, $").   %"

-spec write_string(string(), char()) -> chars().

write_string(S, Q) ->
   [Q | write_string1(unicode_as_unicode, S, Q)].

%% Backwards compatibility.
write_unicode_string(S) ->
   write_string(S).

-spec write_latin1_string(Latin1String) -> latin1_string() when
   Latin1String :: latin1_string().

write_latin1_string(S) ->
   write_latin1_string(S, $").   %"

-spec write_latin1_string(latin1_string(), char()) -> latin1_string().

write_latin1_string(S, Q) ->
   [Q | write_string1(latin1, S, Q)].

-spec write_string_as_latin1(String) -> latin1_string() when
   String :: string().

write_string_as_latin1(S) ->
   write_string_as_latin1(S, $").   %"

-spec write_string_as_latin1(string(), char()) -> latin1_string().

write_string_as_latin1(S, Q) ->
   [Q | write_string1(unicode_as_latin1, S, Q)].

write_string1(_, [], Q) ->
   [Q];
write_string1(Enc, [C | Cs], Q) ->
   string_char(Enc, C, Q, write_string1(Enc, Cs, Q)).

string_char(_, Q, Q, Tail) -> [$\\, Q | Tail];   %Must check these first!
string_char(_, $\\, _, Tail) -> [$\\, $\\ | Tail];
string_char(_, C, _, Tail) when C >= $\s, C =< $~ ->
   [C | Tail];
string_char(latin1, C, _, Tail) when C >= $\240, C =< $\377 ->
   [C | Tail];
string_char(unicode_as_unicode, C, _, Tail) when C >= $\240 ->
   [C | Tail];
string_char(unicode_as_latin1, C, _, Tail) when C >= $\240, C =< $\377 ->
   [C | Tail];
string_char(unicode_as_latin1, C, _, Tail) when C >= $\377 ->
   "\\x{" ++ erlang:integer_to_list(C, 16) ++ "}" ++ Tail;
string_char(_, $\n, _, Tail) -> [$\\, $n | Tail];   %\n = LF
string_char(_, $\r, _, Tail) -> [$\\, $r | Tail];   %\r = CR
string_char(_, $\t, _, Tail) -> [$\\, $t | Tail];   %\t = TAB
string_char(_, $\v, _, Tail) -> [$\\, $v | Tail];   %\v = VT
string_char(_, $\b, _, Tail) -> [$\\, $b | Tail];   %\b = BS
string_char(_, $\f, _, Tail) -> [$\\, $f | Tail];   %\f = FF
string_char(_, $\e, _, Tail) -> [$\\, $e | Tail];   %\e = ESC
string_char(_, $\d, _, Tail) -> [$\\, $d | Tail];   %\d = DEL
string_char(_, C, _, Tail) when C < $\240 ->   %Other control characters.
   C1 = (C bsr 6) + $0,
   C2 = ((C bsr 3) band 7) + $0,
   C3 = (C band 7) + $0,
   [$\\, C1, C2, C3 | Tail].

%%% There are two functions to write a Unicode character:
%%% - they both escape control characters < 160;
%%% - write_char() never escapes characters >= 160;
%%% - write_char_as_latin1() also escapes characters >= 255.

%% write_char(Char) -> [char()].
%%  Generate the list of characters needed to print a character constant.
%%  Must special case SPACE, $\s, here.

-spec write_char(Char) -> chars() when
   Char :: char().

write_char($\s) -> "$\\s";         %Must special case this.
write_char(C) when is_integer(C), C >= $\000 ->
   [$$ | string_char(unicode_as_unicode, C, -1, [])].

%% Backwards compatibility.
write_unicode_char(C) ->
   write_char(C).

-spec write_latin1_char(Latin1Char) -> latin1_string() when
   Latin1Char :: unicode:latin1_char().

write_latin1_char(Lat1) when is_integer(Lat1), Lat1 >= $\000, Lat1 =< $\377 ->
   [$$ | string_char(latin1, Lat1, -1, [])].

-spec write_char_as_latin1(Char) -> latin1_string() when
   Char :: char().

write_char_as_latin1(Uni) when is_integer(Uni), Uni >= $\000 ->
   [$$ | string_char(unicode_as_latin1, Uni, -1, [])].

%% latin1_char_list(CharList)
%% deep_latin1_char_list(CharList)
%%  Return true if CharList is a (possibly deep) list of Latin-1
%%  characters, else false.

-spec latin1_char_list(Term) -> boolean() when
   Term :: term().

latin1_char_list([C | Cs]) when is_integer(C), C >= $\000, C =< $\377 ->
   latin1_char_list(Cs);
latin1_char_list([]) -> true;
latin1_char_list(_) -> false.         %Everything else is false

-spec char_list(Term) -> boolean() when
   Term :: term().

char_list([C | Cs]) when is_integer(C), C >= 0, C < 16#D800;
   is_integer(C), C > 16#DFFF, C < 16#FFFE;
   is_integer(C), C > 16#FFFF, C =< 16#10FFFF ->
   char_list(Cs);
char_list([]) -> true;
char_list(_) -> false.         %Everything else is false

-spec deep_latin1_char_list(Term) -> boolean() when
   Term :: term().

deep_latin1_char_list(Cs) ->
   deep_latin1_char_list(Cs, []).

deep_latin1_char_list([C | Cs], More) when is_list(C) ->
   deep_latin1_char_list(C, [Cs | More]);
deep_latin1_char_list([C | Cs], More) when is_integer(C), C >= $\000, C =< $\377 ->
   deep_latin1_char_list(Cs, More);
deep_latin1_char_list([], [Cs | More]) ->
   deep_latin1_char_list(Cs, More);
deep_latin1_char_list([], []) -> true;
deep_latin1_char_list(_, _More) ->         %Everything else is false
   false.

-spec deep_char_list(Term) -> boolean() when
   Term :: term().

deep_char_list(Cs) ->
   deep_char_list(Cs, []).

deep_char_list([C | Cs], More) when is_list(C) ->
   deep_char_list(C, [Cs | More]);
deep_char_list([C | Cs], More)
   when is_integer(C), C >= 0, C < 16#D800;
   is_integer(C), C > 16#DFFF, C < 16#FFFE;
   is_integer(C), C > 16#FFFF, C =< 16#10FFFF ->
   deep_char_list(Cs, More);
deep_char_list([], [Cs | More]) ->
   deep_char_list(Cs, More);
deep_char_list([], []) -> true;
deep_char_list(_, _More) ->      %Everything else is false
   false.

deep_unicode_char_list(Term) ->
   deep_char_list(Term).

%% printable_latin1_list([Char]) -> boolean()
%%  Return true if CharList is a list of printable Latin1 characters, else
%%  false.

-spec printable_latin1_list(Term) -> boolean() when
   Term :: term().

printable_latin1_list([C | Cs]) when is_integer(C), C >= $\040, C =< $\176 ->
   printable_latin1_list(Cs);
printable_latin1_list([C | Cs]) when is_integer(C), C >= $\240, C =< $\377 ->
   printable_latin1_list(Cs);
printable_latin1_list([$\n | Cs]) -> printable_latin1_list(Cs);
printable_latin1_list([$\r | Cs]) -> printable_latin1_list(Cs);
printable_latin1_list([$\t | Cs]) -> printable_latin1_list(Cs);
printable_latin1_list([$\v | Cs]) -> printable_latin1_list(Cs);
printable_latin1_list([$\b | Cs]) -> printable_latin1_list(Cs);
printable_latin1_list([$\f | Cs]) -> printable_latin1_list(Cs);
printable_latin1_list([$\e | Cs]) -> printable_latin1_list(Cs);
printable_latin1_list([]) -> true;
printable_latin1_list(_) -> false.         %Everything else is false

%% printable_list([Char]) -> boolean()
%%  Return true if CharList is a list of printable characters, else
%%  false. The notion of printable in Unicode terms is somewhat floating.
%%  Everything that is not a control character and not invalid unicode
%%  will be considered printable. 
%%  What the user has noted as printable characters is what actually 
%%  specifies when this function will return true. If the VM is started
%%  with +pc latin1, only the latin1 range will be deemed as printable
%%  if on the other hand +pc unicode is given, all characters in the Unicode
%%  character set are deemed printable. latin1 is default.

-spec printable_list(Term) -> boolean() when
   Term :: term().

printable_list(L) ->
   %% There will be more alternatives returns from io:printable range
   %% in the future. To not have a catch-all clause is deliberate.
   case io:printable_range() of
      latin1 ->
         printable_latin1_list(L);
      unicode ->
         printable_unicode_list(L)
   end.

-spec printable_unicode_list(Term) -> boolean() when
   Term :: term().

printable_unicode_list([C | Cs]) when is_integer(C), C >= $\040, C =< $\176 ->
   printable_unicode_list(Cs);
printable_unicode_list([C | Cs])
   when is_integer(C), C >= 16#A0, C < 16#D800;
   is_integer(C), C > 16#DFFF, C < 16#FFFE;
   is_integer(C), C > 16#FFFF, C =< 16#10FFFF ->
   printable_unicode_list(Cs);
printable_unicode_list([$\n | Cs]) -> printable_unicode_list(Cs);
printable_unicode_list([$\r | Cs]) -> printable_unicode_list(Cs);
printable_unicode_list([$\t | Cs]) -> printable_unicode_list(Cs);
printable_unicode_list([$\v | Cs]) -> printable_unicode_list(Cs);
printable_unicode_list([$\b | Cs]) -> printable_unicode_list(Cs);
printable_unicode_list([$\f | Cs]) -> printable_unicode_list(Cs);
printable_unicode_list([$\e | Cs]) -> printable_unicode_list(Cs);
printable_unicode_list([]) -> true;
printable_unicode_list(_) -> false.      %Everything else is false

%%
%% Utilities for collecting characters in input files
%%

count_and_find_utf8(Bin, N) ->
   cafu(Bin, N, 0, 0, none).

cafu(<<>>, _N, Count, _ByteCount, SavePos) ->
   {Count, SavePos};
cafu(<<_/utf8, Rest/binary>>, 0, Count, ByteCount, _SavePos) ->
   cafu(Rest, -1, Count + 1, 0, ByteCount);
cafu(<<_/utf8, Rest/binary>>, N, Count, _ByteCount, SavePos) when N < 0 ->
   cafu(Rest, -1, Count + 1, 0, SavePos);
cafu(<<_/utf8, Rest/binary>> = Whole, N, Count, ByteCount, SavePos) ->
   Delta = byte_size(Whole) - byte_size(Rest),
   cafu(Rest, N - 1, Count + 1, ByteCount + Delta, SavePos);
cafu(_Other, _N, Count, _ByteCount, SavePos) -> % Non Utf8 character at end
   {Count, SavePos}.

%% collect_chars(State, Data, Count). New in R9C.
%%  Returns:
%%      {stop,Result,RestData}
%%      NewState
%%% BC (with pre-R13).
collect_chars(Tag, Data, N) ->
   collect_chars(Tag, Data, latin1, N).

%% Now we are aware of encoding...    
collect_chars(start, Data, unicode, N) when is_binary(Data) ->
   {Size, Npos} = count_and_find_utf8(Data, N),
   if Size > N ->
      {B1, B2} = split_binary(Data, Npos),
      {stop, B1, B2};
      Size < N ->
         {binary, [Data], N - Size};
      true ->
         {stop, Data, eof}
   end;
collect_chars(start, Data, latin1, N) when is_binary(Data) ->
   Size = byte_size(Data),
   if Size > N ->
      {B1, B2} = split_binary(Data, N),
      {stop, B1, B2};
      Size < N ->
         {binary, [Data], N - Size};
      true ->
         {stop, Data, eof}
   end;
collect_chars(start, Data, _, N) when is_list(Data) ->
   collect_chars_list([], N, Data);
collect_chars(start, eof, _, _) ->
   {stop, eof, eof};
collect_chars({binary, Stack, _N}, eof, _, _) ->
   {stop, binrev(Stack), eof};
collect_chars({binary, Stack, N}, Data, unicode, _) ->
   {Size, Npos} = count_and_find_utf8(Data, N),
   if Size > N ->
      {B1, B2} = split_binary(Data, Npos),
      {stop, binrev(Stack, [B1]), B2};
      Size < N ->
         {binary, [Data | Stack], N - Size};
      true ->
         {stop, binrev(Stack, [Data]), eof}
   end;
collect_chars({binary, Stack, N}, Data, latin1, _) ->
   Size = byte_size(Data),
   if Size > N ->
      {B1, B2} = split_binary(Data, N),
      {stop, binrev(Stack, [B1]), B2};
      Size < N ->
         {binary, [Data | Stack], N - Size};
      true ->
         {stop, binrev(Stack, [Data]), eof}
   end;
collect_chars({list, Stack, N}, Data, _, _) ->
   collect_chars_list(Stack, N, Data);

%% collect_chars(Continuation, MoreChars, Count)
%%  Returns:
%%	{done,Result,RestChars}
%%	{more,Continuation}

collect_chars([], Chars, _, N) ->
   collect_chars1(N, Chars, []);
collect_chars({Left, Sofar}, Chars, _, _N) ->
   collect_chars1(Left, Chars, Sofar).

collect_chars1(N, Chars, Stack) when N =< 0 ->
   {done, lists:reverse(Stack, []), Chars};
collect_chars1(N, [C | Rest], Stack) ->
   collect_chars1(N - 1, Rest, [C | Stack]);
collect_chars1(_N, eof, []) ->
   {done, eof, []};
collect_chars1(_N, eof, Stack) ->
   {done, lists:reverse(Stack, []), []};
collect_chars1(N, [], Stack) ->
   {more, {N, Stack}}.

collect_chars_list(Stack, 0, Data) ->
   {stop, lists:reverse(Stack, []), Data};
collect_chars_list(Stack, _N, eof) ->
   {stop, lists:reverse(Stack, []), eof};
collect_chars_list(Stack, N, []) ->
   {list, Stack, N};
collect_chars_list(Stack, N, [H | T]) ->
   collect_chars_list([H | Stack], N - 1, T).

%% collect_line(State, Data, _). New in R9C.
%%  Returns:
%%	{stop,Result,RestData}
%%	NewState
%%% BC (with pre-R13).
collect_line(Tag, Data, Any) ->
   collect_line(Tag, Data, latin1, Any).

%% Now we are aware of encoding...    
collect_line(start, Data, Encoding, _) when is_binary(Data) ->
   collect_line_bin(Data, Data, [], Encoding);
collect_line(start, Data, _, _) when is_list(Data) ->
   collect_line_list(Data, []);
collect_line(start, eof, _, _) ->
   {stop, eof, eof};
collect_line(Stack, Data, Encoding, _) when is_binary(Data) ->
   collect_line_bin(Data, Data, Stack, Encoding);
collect_line(Stack, Data, _, _) when is_list(Data) ->
   collect_line_list(Data, Stack);
collect_line([B | _] = Stack, eof, _, _) when is_binary(B) ->
   {stop, binrev(Stack), eof};
collect_line(Stack, eof, _, _) ->
   {stop, lists:reverse(Stack, []), eof}.


collect_line_bin(<<$\n, T/binary>>, Data, Stack0, _) ->
   N = byte_size(Data) - byte_size(T),
   <<Line:N/binary, _/binary>> = Data,
   case Stack0 of
      [] ->
         {stop, Line, T};
      [<<$\r>> | Stack] when N =:= 1 ->
         {stop, binrev(Stack, [$\n]), T};
      _ ->
         {stop, binrev(Stack0, [Line]), T}
   end;
collect_line_bin(<<$\r, $\n, T/binary>>, Data, Stack, _) ->
   N = byte_size(Data) - byte_size(T) - 2,
   <<Line:N/binary, _/binary>> = Data,
   {stop, binrev(Stack, [Line, $\n]), T};
collect_line_bin(<<$\r>>, Data0, Stack, _) ->
   N = byte_size(Data0) - 1,
   <<Data:N/binary, _/binary>> = Data0,
   [<<$\r>>, Data | Stack];
collect_line_bin(<<_, T/binary>>, Data, Stack, Enc) ->
   collect_line_bin(T, Data, Stack, Enc);
collect_line_bin(<<>>, Data, Stack, _) ->
   %% Need more data here.
   [Data | Stack].

collect_line_list([$\n | T], [$\r | Stack]) ->
   {stop, lists:reverse(Stack, [$\n]), T};
collect_line_list([$\n | T], Stack) ->
   {stop, lists:reverse(Stack, [$\n]), T};
collect_line_list([H | T], Stack) ->
   collect_line_list(T, [H | Stack]);
collect_line_list([], Stack) ->
   Stack.

%% Translator function to emulate a new (R9C and later) 
%% I/O client when you have an old one.
%%
%% Implements a middleman that is get_until server and get_chars client.

%%% BC (with pre-R13).
get_until(Any, Data, Arg) ->
   get_until(Any, Data, latin1, Arg).

%% Now we are aware of encoding...    
get_until(start, Data, Encoding, XtraArg) ->
   get_until([], Data, Encoding, XtraArg);
get_until(Cont, Data, Encoding, {Mod, Func, XtraArgs}) ->
   Chars = if is_binary(Data), Encoding =:= unicode ->
      unicode:characters_to_list(Data, utf8);
              is_binary(Data) ->
                 binary_to_list(Data);
              true ->
                 Data
           end,
   case apply(Mod, Func, [Cont, Chars | XtraArgs]) of
      {done, Result, Buf} ->
         {stop, if is_binary(Data),
         is_list(Result),
         Encoding =:= unicode ->
            unicode:characters_to_binary(Result, unicode, unicode);
                   is_binary(Data),
                   is_list(Result) ->
                      erlang:iolist_to_binary(Result);
%%		     is_list(Data),
%%		     is_list(Result),
%% 		     Encoding =:= latin1 ->
%% 			  % Should check for only latin1, but skip that for
%% 			  % efficiency reasons.
%% 			  [ exit({cannot_convert, unicode, latin1}) || 
%% 			      X <- List, X > 255 ];
                   true ->
                      Result
                end,
            Buf};
      {more, NewCont} ->
         NewCont
   end.

binrev(L) ->
   list_to_binary(lists:reverse(L, [])).

binrev(L, T) ->
   list_to_binary(lists:reverse(L, T)).

-spec limit_term(term(), non_neg_integer()) -> term().

%% The intention is to mimic the depth limitation of io_lib:write()
%% and io_lib_pretty:print(). The leaves ('...') should never be
%% seen when printed with the same depth. Bitstrings are never
%% truncated, which is OK as long as they are not sent to other nodes.
limit_term(Term, Depth) ->
   try test_limit(Term, Depth) of
      ok -> Term
   catch
      throw:limit ->
         limit(Term, Depth)
   end.

limit(_, 0) -> '...';
limit([H | T] = L, D) ->
   if
      D =:= 1 -> ['...'];
      true ->
         case printable_list(L) of
            true -> L;
            false ->
               [limit(H, D - 1) | limit_tail(T, D - 1)]
         end
   end;
limit(Term, D) when is_map(Term) ->
   limit_map(Term, D);
limit({} = T, _D) -> T;
limit(T, D) when is_tuple(T) ->
   if
      D =:= 1 -> {'...'};
      true ->
         list_to_tuple([limit(element(1, T), D - 1) |
            limit_tuple(T, 2, D - 1)])
   end;
limit(<<_/bitstring>> = Term, D) -> limit_bitstring(Term, D);
limit(Term, _D) -> Term.

limit_tail([], _D) -> [];
limit_tail(_, 1) -> ['...'];
limit_tail([H | T], D) ->
   [limit(H, D - 1) | limit_tail(T, D - 1)];
limit_tail(Other, D) ->
   limit(Other, D - 1).

limit_tuple(T, I, _D) when I > tuple_size(T) -> [];
limit_tuple(_, _I, 1) -> ['...'];
limit_tuple(T, I, D) ->
   [limit(element(I, T), D - 1) | limit_tuple(T, I + 1, D - 1)].

%% Cannot limit maps properly since there is no guarantee that
%% maps:from_list() creates a map with the same internal ordering of
%% the selected associations as in Map. Instead of subtracting one
%% from the depth as the map associations are traversed (as is done
%% for tuples and lists), the same depth is applied to each and every
%% (returned) association.
limit_map(Map, D) ->
   %% Keep one extra association to make sure the final ',...' is included.
   limit_map_body(maps:iterator(Map), D + 1, D, []).

limit_map_body(_I, 0, _D0, Acc) ->
   maps:from_list(Acc);
limit_map_body(I, D, D0, Acc) ->
   case maps:next(I) of
      {K, V, NextI} ->
         limit_map_body(NextI, D - 1, D0, [limit_map_assoc(K, V, D0) | Acc]);
      none ->
         maps:from_list(Acc)
   end.

limit_map_assoc(K, V, D) ->
   %% Keep keys as are to avoid creating duplicated keys.
   {K, limit(V, D - 1)}.

limit_bitstring(B, _D) -> B. % Keeps all printable binaries.

test_limit(_, 0) -> throw(limit);
test_limit([H | T] = L, D) when is_integer(D) ->
   if
      D =:= 1 -> throw(limit);
      true ->
         case printable_list(L) of
            true -> ok;
            false ->
               test_limit(H, D - 1),
               test_limit_tail(T, D - 1)
         end
   end;
test_limit(Term, D) when is_map(Term) ->
   test_limit_map(Term, D);
test_limit({}, _D) -> ok;
test_limit(T, D) when is_tuple(T) ->
   test_limit_tuple(T, 1, tuple_size(T), D);
test_limit(<<_/bitstring>> = Term, D) -> test_limit_bitstring(Term, D);
test_limit(_Term, _D) -> ok.

test_limit_tail([], _D) -> ok;
test_limit_tail(_, 1) -> throw(limit);
test_limit_tail([H | T], D) ->
   test_limit(H, D - 1),
   test_limit_tail(T, D - 1);
test_limit_tail(Other, D) ->
   test_limit(Other, D - 1).

test_limit_tuple(_T, I, Sz, _D) when I > Sz -> ok;
test_limit_tuple(_, _, _, 1) -> throw(limit);
test_limit_tuple(T, I, Sz, D) ->
   test_limit(element(I, T), D - 1),
   test_limit_tuple(T, I + 1, Sz, D - 1).

test_limit_map(Map, D) ->
   test_limit_map_body(maps:iterator(Map), D).

test_limit_map_body(_I, 0) -> throw(limit); % cannot happen
test_limit_map_body(I, D) ->
   case maps:next(I) of
      {K, V, NextI} ->
         test_limit_map_assoc(K, V, D),
         test_limit_map_body(NextI, D - 1);
      none ->
         ok
   end.

test_limit_map_assoc(K, V, D) ->
   test_limit(K, D - 1),
   test_limit(V, D - 1).

test_limit_bitstring(_, _) -> ok.

-spec charsLen(chars()) -> non_neg_integer().
%% Optimized for deep lists S such that deep_latin1_char_list(S) is
%% true. No binaries allowed! It is assumed that $\r is never followed
%% by $\n if S is an iolist() (string:length() assigns such a
%% sub-sequence length 1).
charsLen(S) ->
   try
      %% true = deep_latin1_char_list(S),
      iolist_size(S)
   catch
      _:_ ->
         string:length(S)
   end.