Du kan inte välja fler än 25 ämnen
Ämnen måste starta med en bokstav eller siffra, kan innehålla bindestreck ('-') och vara max 35 tecken långa.
980 rader
30 KiB
980 rader
30 KiB
-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.
|