From b9d58953d3bc0e8c307d9c6e7bb5ca227122462f Mon Sep 17 00:00:00 2001 From: SisMaker <1713699517@qq.com> Date: Sun, 21 Feb 2021 15:34:18 +0800 Subject: [PATCH] =?UTF-8?q?ft:=E6=A8=A1=E5=9D=97=E8=9E=8D=E5=90=88?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/eFmt.erl | 1391 +++++++++++++++++++------------------------- src/eFmtFormat.erl | 627 -------------------- src/eFmtPretty.erl | 1130 +++++++++++++++++++++++++++++++++++ 3 files changed, 1717 insertions(+), 1431 deletions(-) delete mode 100644 src/eFmtFormat.erl create mode 100644 src/eFmtPretty.erl diff --git a/src/eFmt.erl b/src/eFmt.erl index 7006fee..460cfd9 100644 --- a/src/eFmt.erl +++ b/src/eFmt.erl @@ -1,283 +1,117 @@ -module(eFmt). +-compile(inline). +-compile({inline_size, 128}). + -include("eFmt.hrl"). -export([ + %% eFmt format/2 , format/3 - , scan_format/2 - , unscan_format/1 - , build_text/1 - , build_text/2 - + , scan/2 + , build/1 + , build/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 + , write/4 -%% Utilities for collecting characters. + %% eFmtformat + , fWrite/2 + , fWrite/3 + , fScan/2 + , fBuild/1 + , fBuild/2 - , 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 + %% eFmtPretty + %% utils + , toLowerStr/1 + , toUpperStr/1 + , toBinary/1 , 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()]. +%% ********************************************** eFmt start *********************************************************** +-type chars() :: [char() | chars() | binary()]. -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 encoding() :: epp:source_encoding() | 'unicode'. +-type charsLimit() :: integer(). -type fmtSpec() :: #fmtSpec{}. -%%---------------------------------------------------------------------- -spec format(Format :: io:format(), Data :: [term()]) -> chars(). format(Format, Args) -> - try eFmtFormat:fwrite(Format, Args) + try fWrite(Format, Args) catch - C:R:S -> - test_modules_loaded(C, R, S), - erlang:error(badarg, [Format, Args, S]) + _C:_R -> + erlang:error(badarg, [Format, Args]) end. --spec format(Format :: io:format(), Data :: [term()], Options :: [{'chars_limit', CharsLimit :: chars_limit()}]) -> chars(). +-spec format(Format :: io:format(), Data :: [term()], Options :: [{charsLimit, CharsLimit :: charsLimit()}]) -> chars(). format(Format, Args, Options) -> - try eFmtFormat:fwrite(Format, Args, Options) + try fWrite(Format, Args, Options) catch - C:R:S -> - test_modules_loaded(C, R, S), + _C:_R -> 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) +-spec scan(Format :: io:format(), Data :: [term()]) -> FormatList :: [char() | fmtSpec()]. +scan(Format, Args) -> + try fScan(Format, Args) catch - C:R:S -> - test_modules_loaded(C, R, S), + _C:_R -> 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) +-spec build(FormatList :: [char() | fmtSpec()]) -> chars(). +build(FormatList) -> + try fBuild(FormatList) catch - C:R:S -> - test_modules_loaded(C, R, S), + _C:_R -> 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) +-spec build(FormatList :: [char() | fmtSpec()], Options :: [{charsLimit, CharsLimit :: charsLimit()}]) -> chars(). +build(FormatList, Options) -> + try fBuild(FormatList, Options) catch - C:R:S -> - test_modules_loaded(C, R, S), + _C:_R -> 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(). - +-spec print(Term :: term()) -> chars(). 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(). + eFmtPretty:pPrint(Term). +-spec print(Term :: term(), Column :: non_neg_integer(), LineLength :: non_neg_integer(), Depth :: depth()) -> chars(). 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(). + eFmtPretty:pPrint(Term, Column, LineLength, Depth). +-spec write(Term :: term()) -> chars(). 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; +-spec write(Term :: term(), Depth :: depth()) -> chars(). write(Term, Depth) -> - write(Term, [{depth, Depth}, {encoding, latin1}]). - + writeTerm(Term, Depth, latin1). +-spec write(Term :: term(), Depth :: depth(), IsPretty :: boolean()) -> chars(). +write(Term, Depth, IsPretty) -> + case IsPretty of + true -> + eFmtPretty:pPrint(Term, 1, 80, Depth); + _ -> + writeTerm(Term, Depth, latin1) + end. -doWrite(Term, Depth, Encoding, CharsLimit) -> +-spec write(Term :: term(), Depth :: depth(), Encoding :: encoding(), CharsLimit :: charsLimit()) -> chars(). +write(Term, Depth, Encoding, CharsLimit) -> if Depth =:= 0 orelse CharsLimit =:= 0 -> <<"...">>; @@ -285,41 +119,18 @@ doWrite(Term, Depth, Encoding, CharsLimit) -> 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) + If = eFmtPretty:pIntermediate(Term, Depth, CharsLimit, RecDefFun, Encoding, _Str = false), + eFmtPretty:pWrite(If) end. -define(writeInt(Int), integer_to_binary(Term)). - --define(writeFloat(Float), eFmtFormat:floatG(Term)). - +-define(writeFloat(Float), 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) -> <>; writeList([One], D, E, BinAcc) -> @@ -378,603 +189,575 @@ writeBinary(Bin, D) -> <<"<<", Bin/binary, ">>">> end. -get_option(Key, TupleList, Default) -> - case lists:keyfind(Key, 1, TupleList) of - false -> Default; - {Key, Value} -> Value; - _ -> Default - end. +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), <<"{">>). +%% ********************************************** eFmt end ************************************************************* +%% ********************************************** eFmtFormat start ***************************************************** +-spec fWrite(Format :: io:format(), Data :: [term()]) -> chars(). +fWrite(Format, Args) -> + fBuild(fScan(Format, Args), []). -%%% 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. +-spec fWrite(Format :: io:format(), Data :: [term()], Options :: [{'chars_limit', CharsLimit :: integer()}]) -> chars(). +fWrite(Format, Args, Options) -> + fBuild(fScan(Format, Args), Options). -%% write_string([Char]) -> [Char] -%% Generate the list of characters needed to print a string. --spec write_string(String) -> chars() when - String :: string(). +%% Parse all control sequences in the format string. +-spec fScan(Format :: io:format(), Data :: [term()]) -> FormatList :: [char() | fmtSpec()]. -write_string(S) -> - write_string(S, $"). %" +%% 格式 ~F.P.PadModC +fScan(Format, Args) -> + if + is_atom(Format) -> + doCollect(atom_to_binary(Format, utf8), Args, []); + is_list(Format) -> + doCollect(list_to_binary(Format), Args, []); + true -> + doCollect(Format, Args, []) + end. --spec write_string(string(), char()) -> chars(). +doCollect(FmtBinStr, Args, Acc) -> + case binary:split(FmtBinStr, <<"~">>) of + [NotMatch] -> + [NotMatch | Acc]; + [FPart, LPart] -> + doCollWidth(LPart, Args, 0, right, [FPart | Acc]) + end. -write_string(S, Q) -> - [Q | write_string1(unicode_as_unicode, S, Q)]. +doCollWidth(<<>>, _Args, _Width, _Adjust, Acc) -> + Acc; +doCollWidth(LPart, Args, Width, Adjust, Acc) -> + case LPart of + <<"-*", LeftLPart/binary>> -> + [WidthArgs | LeftArgs] = Args, + doCollPrecision(LeftLPart, LeftArgs, WidthArgs, left, Acc); + <<"-", LeftLPart/binary>> -> + doCollWidth(LeftLPart, Args, Width, left, Acc); + <<"*", LeftLPart/binary>> -> + [WidthArgs | LeftArgs] = Args, + doCollPrecision(LeftLPart, LeftArgs, WidthArgs, right, Acc); + <> -> + case WidthInt >= $0 andalso WidthInt =< $9 of + true -> + doCollWidth(LeftLPart, Args, 10 * Width + (WidthInt - $0), Adjust, Acc); + _ -> + case Width == 0 of + true -> + doCollPrecision(LPart, Args, none, left, Acc); + _ -> + doCollPrecision(LPart, Args, Width, Adjust, Acc) + end + end + end. -%% Backwards compatibility. -write_unicode_string(S) -> - write_string(S). +doCollPrecision(LPart, Args, Width, Adjust, Acc) -> + case LPart of + <<".", LeftLPart/binary>> -> + doCollPrecision(LeftLPart, Args, Width, Adjust, 0, Acc); + _ -> + doCollPadChar(LPart, Args, Width, Adjust, none, Acc) + end. --spec write_latin1_string(Latin1String) -> latin1_string() when - Latin1String :: latin1_string(). +doCollPrecision(LPart, Args, Width, Adjust, Precision, Acc) -> + case LPart of + <<"*", LeftLPart/binary>> -> + [PrecisionArgs | LeftArgs] = Args, + doCollPadChar(LeftLPart, LeftArgs, Width, Adjust, PrecisionArgs, Acc); + <> -> + case PrecisionInt >= $0 andalso PrecisionInt =< $9 of + true -> + doCollPrecision(LeftLPart, Args, Width, Adjust, 10 * Precision + (PrecisionInt - $0), Acc); + _ -> + case Precision == 0 of + true -> + doCollPadChar(LPart, Args, Width, Adjust, none, Acc); + _ -> + doCollPadChar(LPart, Args, Width, Adjust, Precision, Acc) + end + end + end. -write_latin1_string(S) -> - write_latin1_string(S, $"). %" +doCollPadChar(LPart, Args, Width, Adjust, Precision, Acc) -> + case LPart of + <<".*", LeftLPart/binary>> -> + [PadChar | LeftArgs] = Args, + doCollEncoding(LeftLPart, LeftArgs, Width, Adjust, Precision, PadChar, Acc); + <<".", PadChar:8/integer, LeftLPart/binary>> -> + doCollEncoding(LeftLPart, Args, Width, Adjust, Precision, PadChar, Acc); + _ -> + doCollEncoding(LPart, Args, Width, Adjust, Precision, 32, Acc) + end. --spec write_latin1_string(latin1_string(), char()) -> latin1_string(). +doCollEncoding(LPart, Args, Width, Adjust, Precision, PadChar, Acc) -> + case LPart of + <<"t", LeftLPart/binary>> -> + %true = Char =/= $l, + doCollStrings(LeftLPart, Args, Width, Adjust, Precision, PadChar, unicode, Acc); + _ -> + doCollStrings(LPart, Args, Width, Adjust, Precision, PadChar, latin1, Acc) + end. -write_latin1_string(S, Q) -> - [Q | write_string1(latin1, S, Q)]. +doCollStrings(LPart, Args, Width, Adjust, Precision, PadChar, Encoding, Acc) -> + case LPart of + <<"l", LeftLPart/binary>> -> + %true = Char =/= $t, + doCollCA(LeftLPart, Args, Width, Adjust, Precision, PadChar, Encoding, false, Acc); + _ -> + doCollCA(LPart, Args, Width, Adjust, Precision, PadChar, Encoding, true, Acc) + end. --spec write_string_as_latin1(String) -> latin1_string() when - String :: string(). +doCollCA(LPart, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, Acc) -> + <> = LPart, + case CtlChar of + $w -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $p -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $W -> [OneArgs | LeftArgs] = Args, [Depth | LastArgs] = LeftArgs, As = [OneArgs, Depth], NextArgs = LastArgs; + $P -> [OneArgs | LeftArgs] = Args, [Depth | LastArgs] = LeftArgs, As = [OneArgs, Depth], NextArgs = LastArgs; + $s -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $e -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $f -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $g -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $b -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $B -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $x -> [OneArgs | LeftArgs] = Args, [Prefix | LastArgs] = LeftArgs, As = [OneArgs, Prefix], NextArgs = LastArgs; + $X -> [OneArgs | LeftArgs] = Args, [Prefix | LastArgs] = LeftArgs, As = [OneArgs, Prefix], NextArgs = LastArgs; + $+ -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $# -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $c -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; + $~ -> As = undefined, NextArgs = Args; + $n -> As = undefined, NextArgs = Args; + $i -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs + end, + FmtSpec = #fmtSpec{ctlChar = CtlChar, args = As, width = Width, adjust = Adjust, precision = Precision, padChar = PadChar, encoding = Encoding, strings = Strings}, + doCollect(LeftLPart, NextArgs, [FmtSpec | Acc]). + +%% Build the output text for a pre-parsed format list. +-spec fBuild(FormatList :: [char() | fmtSpec()]) -> chars(). +fBuild(Cs) -> + fBuild(Cs, []). + +-spec fBuild(FormatList :: [char() | fmtSpec()], Options :: [{'chars_limit', CharsLimit :: integer()}]) -> chars(). +fBuild(Cs, Options) -> + CharsLimit = getOpt(chars_limit, Options, -1), + ResList = buildSmall(Cs, []), + {P, S, W, Other} = cntSmall(ResList, 0, 0, 0, 0), + NumOfLimited = P + S + W, + case NumOfLimited of + 0 -> + ResList; + _ -> + RemainChars = remainChars(CharsLimit, Other), + buildLimited(ResList, P, NumOfLimited, RemainChars, 0, []) + end. -write_string_as_latin1(S) -> - write_string_as_latin1(S, $"). %" +buildSmall([], Acc) -> Acc; +buildSmall([OneCA | Cs], Acc) -> + case OneCA of + #fmtSpec{ctlChar = CtlChar, args = Args, width = Width, adjust = Adjust, precision = Precision, padChar = PadChar, encoding = Encoding} -> + case ctlSmall(CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding) of + not_small -> buildSmall(Cs, [OneCA | Acc]); + ignore -> buildSmall(Cs, Acc); + Str -> buildSmall(Cs, [Str | Acc]) + end; + _ -> + buildSmall(Cs, [OneCA | Acc]) + end. --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 +ctlSmall($s, Args, Width, Adjust, Precision, PadChar, Encoding) when is_atom(Args) -> + case Encoding of latin1 -> - printable_latin1_list(L); + AtomBinStr = ?writeAtom(Args, latin1); + _ -> + AtomBinStr = ?writeAtom(Args, uft8) + end, + string(AtomBinStr, Width, Adjust, Precision, PadChar, Encoding); +ctlSmall($e, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_float(Args) -> + floatE(Args, Width, Adjust, Precision, PadChar); +ctlSmall($f, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_float(Args) -> + floatF(Args, Width, Adjust, Precision, PadChar); +ctlSmall($g, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_float(Args) -> + floatG(Args, Width, Adjust, Precision, PadChar); +ctlSmall($b, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> + unPrefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, true); +ctlSmall($B, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> + unPrefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, false); +ctlSmall($x, [Args, Prefix], Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args), is_atom(Prefix) -> + prefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, atom_to_binary(Prefix, utf8), true); +ctlSmall($x, [Args, Prefix], Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> + prefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, Prefix, true); +ctlSmall($X, [Args, Prefix], Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args), is_atom(Prefix) -> + prefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, atom_to_binary(Prefix, utf8), false); +ctlSmall($X, [Args, Prefix], Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> + prefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, Prefix, false); +ctlSmall($+, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> + Base = ?base(Precision), + prefixedInt(Args, Width, Adjust, Base, PadChar, integer_to_binary(Base), $#, true); +ctlSmall($#, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> + Base = ?base(Precision), + prefixedInt(Args, Width, Adjust, Base, PadChar, integer_to_binary(Base), $#, false); +ctlSmall($c, Args, Width, Adjust, Precision, PadChar, Encoding) when is_integer(Args) -> + case Encoding of 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} + char(Args, Width, Adjust, Precision, PadChar); + _ -> + char(Args band 255, Width, Adjust, Precision, PadChar) 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}; +ctlSmall($~, _Args, Width, Adjust, Precision, PadChar, _Encoding) -> char($~, Width, Adjust, Precision, PadChar); +ctlSmall($n, _Args, Width, Adjust, Precision, PadChar, _Encoding) -> newline(Width, Adjust, Precision, PadChar); +ctlSmall($i, _Args, _Width, _Adjust, _Precision, _PadChar, _Encoding) -> ignore; +ctlSmall(_C, _Args, _Width, _Adjust, _Precision, _PadChar, _Encoding) -> not_small. + +cntSmall([], P, S, W, Other) -> + {P, S, W, Other}; +cntSmall([OneRes | Cs], P, S, W, Other) -> + case OneRes of + #fmtSpec{ctlChar = CtlChar} -> + case CtlChar of + $p -> + cntSmall(Cs, P + 1, S, W, Other); + $P -> + cntSmall(Cs, P + 1, S, W, Other); + $w -> + cntSmall(Cs, P, S, W + 1, Other); + $W -> + cntSmall(Cs, P, S, W + 1, Other); + $s -> + cntSmall(Cs, P, S, W + 1, Other); + _ -> + cntSmall(Cs, P, S, W, Other) + end; + _ -> + if + is_binary(OneRes) orelse is_list(OneRes) -> + cntSmall(Cs, P, S, W, Other + charsLen(OneRes)); + is_integer(OneRes) -> + cntSmall(Cs, P, S, W, Other + 1); + true -> + cntSmall(Cs, P, S, W, Other) + end + end. + +buildLimited([], _, _, _, _, Acc) -> Acc; +buildLimited([OneCA | Cs], NumOfPs, Count, MaxLen, I, Acc) -> + case OneCA of + #fmtSpec{ctlChar = CtlChar, args = Args, width = Width, adjust = Adjust, precision = Precision, padChar = PadChar, encoding = Encoding, strings = Strings} -> + MaxChars = if MaxLen < 0 -> MaxLen; true -> MaxLen div Count end, + IoListStr = ctlLimited(CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, MaxChars, I), + NewNumOfPs = decrPc(CtlChar, NumOfPs), + NewCount = Count - 1, + MaxLen = ?IIF(MaxLen < 0, MaxLen, remainChars(MaxLen, charsLen(IoListStr))), + if + NewNumOfPs > 0 -> + buildLimited(Cs, NewNumOfPs, NewCount, MaxLen, I, [IoListStr | Acc]); + true -> + buildLimited(Cs, NewNumOfPs, NewCount, MaxLen, I, [IoListStr | Acc]) + end; + _ -> + buildLimited(Cs, NumOfPs, Count, MaxLen, I + 1, [OneCA | Acc]) + end. + +decrPc($p, Pc) -> Pc - 1; +decrPc($P, Pc) -> Pc - 1; +decrPc(_, Pc) -> Pc. + +%% (CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, MaxChars, I) +ctlLimited($s, Args, Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> + case Encoding of + latin1 -> + BinStr = erlang:iolist_to_binary(Args); + + _ -> + BinStr = case catch unicode:characters_to_binary(Args, unicode) of + Str when is_binary(Str) -> Str; + _ -> toBinary(Args) + end + end, + TemBinStr = strToChars(BinStr, Width, CharsLimit), + string(TemBinStr, ?IIF(CharsLimit < 0 orelse Width =:= none, Width, max(3, min(Width, CharsLimit))), Adjust, Precision, PadChar, Encoding); +ctlLimited($w, Args, Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> + Chars = write(Args, -1, Encoding, CharsLimit), + term(Chars, Width, Adjust, Precision, PadChar); +ctlLimited($p, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I) -> + print(Args, -1, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I); +ctlLimited($W, [Args, Depth], Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> + Chars = write(Args, Depth, Encoding, CharsLimit), + term(Chars, Width, Adjust, Precision, PadChar); +ctlLimited($P, [Args, Depth], Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I) -> + print(Args, Depth, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I). + +term(BinStrOrIoList, Width, Adjust, Precision, PadChar) -> + if + Width == none andalso Precision == none -> + BinStrOrIoList; + Width == none -> + StrLen = charsLen(BinStrOrIoList), + NewPrecision = erlang:min(StrLen, Precision), + if + StrLen > NewPrecision -> + adjust(Adjust, makePadChars($*, NewPrecision, <<>>), <<>>); + true -> + adjust(Adjust, BinStrOrIoList, makePadChars(PadChar, Precision - StrLen, <<>>)) + end; 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}; + StrLen = charsLen(BinStrOrIoList), + NewPrecision = erlang:min(StrLen, case Precision of none -> Width; _ -> min(Precision, Width) end), + if + StrLen > NewPrecision -> + adjust(Adjust, makePadChars($*, NewPrecision, <<>>), makePadChars(PadChar, Width - NewPrecision, <<>>)); + true -> + adjust(Adjust, BinStrOrIoList, makePadChars(PadChar, Width - StrLen, <<>>)) + end + end. + +print(Term, Depth, Width, _Adjust, Precision, _PadChar, Encoding, Strings, CharsLimit, I) -> + if + Width == none -> NewWidth = 80; + true -> NewWidth = Width + end, + if + Precision == none -> NewPrecision = I + 1; + true -> NewPrecision = Precision + end, + eFmtPretty:print(Term, NewPrecision, NewWidth, Depth, -1, CharsLimit, no_fun, Encoding, Strings). + +floatE(Float, Width, Adjust, Precision, PadChar) -> + case Precision of + none -> + NewPrecision = 6; + _ -> + NewPrecision = Precision + end, + case Width of + none -> + float_to_binary(Float, [{scientific, NewPrecision}]); + _ -> + term(float_to_binary(Float, [{scientific, NewPrecision}]), Width, Adjust, Width, PadChar) + end. + +floatF(Float, Width, Adjust, Precision, PadChar) -> + case Precision of + none -> + NewPrecision = 6; + _ -> + NewPrecision = Precision + end, + case Width of + none -> + float_to_binary(Float, [{decimals, NewPrecision}]); + _ -> + term(float_to_binary(Float, [{decimals, NewPrecision}]), Width, Adjust, Width, PadChar) + end. + +floatG(Float, Width, Adjust, Precision, PadChar) -> + case Float > -10000.0 andalso Float < 10000.0 of 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), - <> = Data, - case Stack0 of - [] -> - {stop, Line, T}; - [<<$\r>> | Stack] when N =:= 1 -> - {stop, binrev(Stack, [$\n]), T}; + floatF(Float, Width, Adjust, Precision, PadChar); _ -> - {stop, binrev(Stack0, [Line]), T} - end; -collect_line_bin(<<$\r, $\n, T/binary>>, Data, Stack, _) -> - N = byte_size(Data) - byte_size(T) - 2, - <> = Data, - {stop, binrev(Stack, [Line, $\n]), T}; -collect_line_bin(<<$\r>>, Data0, Stack, _) -> - N = byte_size(Data0) - 1, - <> = 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) + floatE(Float, Width, Adjust, Precision, PadChar) end. -limit(_, 0) -> '...'; -limit([H | T] = L, D) -> +floatG(Float) -> + float_to_binary(Float, [{decimals, 6}]). + +strToChars(BinStr, Width, CharsLimit) -> + ByteSize = byte_size(BinStr), if - D =:= 1 -> ['...']; + Width == none -> + case CharsLimit < 0 orelse CharsLimit >= ByteSize of + true -> + BinStr; + _ -> + <<(binary:part(BinStr, 0, CharsLimit))/binary, "...">> + end; + CharsLimit < 0 orelse CharsLimit >= Width -> + BinStr; true -> - case printable_list(L) of - true -> L; - false -> - [limit(H, D - 1) | limit_tail(T, D - 1)] + <<(binary:part(BinStr, 0, CharsLimit))/binary, "...">> + end. + +string(Str, Width, Adjust, Precision, PadChar, Encoding) -> + if + Width == none andalso Precision == none -> + Str; + Precision == none -> + strField(Str, Width, Adjust, charsLen(Str), PadChar, Encoding); + Width == none -> + strField(Str, Precision, left, charsLen(Str), PadChar, Encoding); + true -> + StrLen = charsLen(Str), + if + Width > Precision -> + if StrLen > Precision -> + adjust(Adjust, flatTrunc(Str, Precision, Encoding), makePadChars(PadChar, Width - Precision, <<>>)); + StrLen < Precision -> + adjust(Adjust, [Str | makePadChars(PadChar, Precision - StrLen, <<>>)], makePadChars(PadChar, Width - Precision, <<>>)); + true -> % N == P + adjust(Adjust, Str, makePadChars(PadChar, Width - Precision, <<>>)) + end; + true -> % F == P + strField(Str, Width, Adjust, StrLen, PadChar, Encoding) end - end; -limit(Term, D) when is_map(Term) -> - limit_map(Term, D); -limit({} = T, _D) -> T; -limit(T, D) when is_tuple(T) -> + end. + +strField(Str, Width, Adjust, StrLen, PadChar, Encoding) when StrLen > Width -> if - D =:= 1 -> {'...'}; + StrLen > Width -> + flatTrunc(Str, Width, Encoding); + StrLen < Width -> + adjust(Adjust, Str, makePadChars(PadChar, Width - StrLen, <<>>)); 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) + Str + end. + +flatTrunc(List, Width, _Encoding) -> + binary:part(iolist_to_binary(List), 0, Width). + +makePadChars(PadChar, Cnt, BinStr) -> + case Cnt > 0 of + true -> + makePadChars(PadChar, Cnt - 1, <>); + _ -> + BinStr end. -limit_map_assoc(K, V, D) -> - %% Keep keys as are to avoid creating duplicated keys. - {K, limit(V, D - 1)}. +adjust(left, Data, Pad) -> [Data, Pad]; +adjust(right, Data, Pad) -> [Pad, Data]. -limit_bitstring(B, _D) -> B. % Keeps all printable binaries. +unPrefixedInt(Int, Width, Adjust, Base, PadChar, Lowercase) -> + case Lowercase of + true -> + term(toLowerStr(integer_to_binary(Int, Base)), Width, Adjust, none, PadChar); + _ -> + term(integer_to_binary(Int, Base), Width, Adjust, none, PadChar) + end. -test_limit(_, 0) -> throw(limit); -test_limit([H | T] = L, D) when is_integer(D) -> - if - D =:= 1 -> throw(limit); +prefixedInt(Int, Width, Adjust, Base, PadChar, Prefix, Lowercase) -> + case Int < 0 of true -> - case printable_list(L) of - true -> ok; - false -> - test_limit(H, D - 1), - test_limit_tail(T, D - 1) + case Lowercase of + true -> + term(<<"-", (toBinary(Prefix))/binary, (toLowerStr(integer_to_binary(-Int, Base)))/binary>>, Width, Adjust, none, PadChar); + _ -> + term(<<"-", (toBinary(Prefix))/binary, (integer_to_binary(-Int, Base))/binary>>, Width, Adjust, none, PadChar) + end; + _ -> + case Lowercase of + true -> + term(<<(toBinary(Prefix))/binary, (toLowerStr(integer_to_binary(Int, Base)))/binary>>, Width, Adjust, none, PadChar); + _ -> + term(<<(toBinary(Prefix))/binary, (integer_to_binary(Int, Base))/binary>>, Width, Adjust, none, PadChar) 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). +prefixedInt(Int, Width, Adjust, Base, PadChar, Prefix, Prefix2, Lowercase) -> + case Int < 0 of + true -> + case Lowercase of + true -> + term(<<"-", (toBinary(Prefix))/binary, Prefix2:8, (toLowerStr(integer_to_binary(-Int, Base)))/binary>>, Width, Adjust, none, PadChar); + _ -> + term(<<"-", (toBinary(Prefix))/binary, Prefix2:8, (integer_to_binary(-Int, Base))/binary>>, Width, Adjust, none, PadChar) + end; + _ -> + case Lowercase of + true -> + term(<<(toBinary(Prefix))/binary, Prefix2:8, (toLowerStr(integer_to_binary(Int, Base)))/binary>>, Width, Adjust, none, PadChar); + _ -> + term(<<(toBinary(Prefix))/binary, Prefix2:8, (integer_to_binary(Int, Base))/binary>>, Width, Adjust, none, PadChar) + end + end. -test_limit_bitstring(_, _) -> ok. +char(Char, Width, Adjust, Precision, PadChar) -> + if + Width == none andalso Precision == none -> + Char; + Precision == none -> + makePadChars(Char, Width, <<>>); + Width == none -> + makePadChars(Char, Precision, <<>>); + true -> + adjust(Adjust, makePadChars(Char, Precision, <<>>), makePadChars(PadChar, Width - Precision, <<>>)) + end. + +newline(none, _Adjust, _Precision, _PadChar) -> <<"\n">>; +newline(Width, Adjust, _Precision, _PadChar) -> + case Adjust of + right -> + makePadChars($\n, Width, <<>>); + _ -> + <<"\n">> + end. + +remainChars(T, E) -> + if + T < 0 -> + T; + T >= E -> + T - E; + true -> + 0 + end. +%% ********************************************** eFmtFormat end ***************************************************** +%% ********************************************** eFmtPretty start ***************************************************** +%% ********************************************** eFmtPretty end ***************************************************** +%% ********************************************** utils start ********************************************************** +toLowerStr(BinStr) -> + <= $A andalso C =< $Z of + true -> + <<(C + 32)>>; + _ -> + <> + end + end || <> <= BinStr + >>. + +toUpperStr(BinStr) -> + <= $a andalso C =< $z of + true -> + <<(C - 32)>>; + _ -> + <> + end + end || <> <= BinStr + >>. -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. + +getOpt(Key, TupleList, Default) -> + case lists:keyfind(Key, 1, TupleList) of + false -> + Default; + ValueTuple -> + element(2, ValueTuple) + end. + +toBinary(Value) when is_integer(Value) -> integer_to_binary(Value); +toBinary(Value) when is_list(Value) -> list_to_binary(Value); +toBinary(Value) when is_float(Value) -> float_to_binary(Value, [{decimals, 6}, compact]); +toBinary(Value) when is_atom(Value) -> atom_to_binary(Value, utf8); +toBinary(Value) when is_binary(Value) -> Value; +toBinary([Tuple | PropList] = Value) when is_list(PropList) and is_tuple(Tuple) -> + lists:map(fun({K, V}) -> {toBinary(K), toBinary(V)} end, Value); +toBinary(Value) -> term_to_binary(Value). +%% ********************************************** utils end ********************************************************** \ No newline at end of file diff --git a/src/eFmtFormat.erl b/src/eFmtFormat.erl deleted file mode 100644 index ad86615..0000000 --- a/src/eFmtFormat.erl +++ /dev/null @@ -1,627 +0,0 @@ --module(eFmtFormat). - --include("eFmt.hrl"). - --compile(export_all). - -%% Formatting functions of io library. --export([ - fwrite/2 - , fwrite/3 - , floatG/1 - , scan/2 - , build/1 - , build/2 -]). - -%% 在字符串格式之后将参数格式化为Args。刚产生 -%% 如果参数中有错误，则为错误。 -%% -%% 要正确执行打印命令，我们需要计算 -%% 当前缩进的所有内容。这可能非常 -%% 价格昂贵，尤其是在不需要时，因此我们首先确定 -%% 是否以及需要多长时间来计算缩进。我们的确是 -%% 首先收集所有控制序列，然后 -%% 相应的参数，然后计算打印顺序，然后 -%% 然后构建输出。这种方法有一些缺点，它确实 -%% 在格式字符串上两次传递并创建更多临时数据， -%% 并且还将控制字符的处理分为两个 -%% 部分。 - --spec fwrite(Format :: io:format(), Data :: [term()]) -> eFmt:chars(). -fwrite(Format, Args) -> - build(scan(Format, Args), []). - --spec fwrite(Format :: io:format(), Data :: [term()], Options :: [{'chars_limit', CharsLimit :: integer()}]) -> eFmt:chars(). -fwrite(Format, Args, Options) -> - build(scan(Format, Args), Options). - - -%% Parse all control sequences in the format string. --spec scan(Format :: io:format(), Data :: [term()]) -> FormatList :: [char() | eFmt:fmtSpec()]. - -%% 格式 ~F.P.PadModC -scan(Format, Args) -> - if - is_atom(Format) -> - doCollect(atom_to_binary(Format, utf8), Args, []); - is_list(Format) -> - doCollect(list_to_binary(Format), Args, []); - true -> - doCollect(Format, Args, []) - end. - -doCollect(FmtBinStr, Args, Acc) -> - case binary:split(FmtBinStr, <<"~">>) of - [NotMatch] -> - [NotMatch | Acc]; - [FPart, LPart] -> - doCollWidth(LPart, Args, 0, right, [FPart | Acc]) - end. - -doCollWidth(<<>>, _Args, _Width, _Adjust, Acc) -> - Acc; -doCollWidth(LPart, Args, Width, Adjust, Acc) -> - %% 匹配宽度 - case LPart of - <<"-*", LeftLPart/binary>> -> - [WidthArgs | LeftArgs] = Args, - doCollPrecision(LeftLPart, LeftArgs, WidthArgs, left, Acc); - <<"-", LeftLPart/binary>> -> - doCollWidth(LeftLPart, Args, Width, left, Acc); - <<"*", LeftLPart/binary>> -> - [WidthArgs | LeftArgs] = Args, - doCollPrecision(LeftLPart, LeftArgs, WidthArgs, right, Acc); - <> -> - case WidthInt >= $0 andalso WidthInt =< $9 of - true -> - doCollWidth(LeftLPart, Args, 10 * Width + (WidthInt - $0), Adjust, Acc); - _ -> - case Width == 0 of - true -> - doCollPrecision(LPart, Args, none, left, Acc); - _ -> - doCollPrecision(LPart, Args, Width, Adjust, Acc) - end - end - end. - -doCollPrecision(LPart, Args, Width, Adjust, Acc) -> - case LPart of - <<".", LeftLPart/binary>> -> - doCollPrecision(LeftLPart, Args, Width, Adjust, 0, Acc); - _ -> - doCollPadChar(LPart, Args, Width, Adjust, none, Acc) - end. - -doCollPrecision(LPart, Args, Width, Adjust, Precision, Acc) -> - case LPart of - <<"*", LeftLPart/binary>> -> - [PrecisionArgs | LeftArgs] = Args, - doCollPadChar(LeftLPart, LeftArgs, Width, Adjust, PrecisionArgs, Acc); - <> -> - case PrecisionInt >= $0 andalso PrecisionInt =< $9 of - true -> - doCollPrecision(LeftLPart, Args, Width, Adjust, 10 * Precision + (PrecisionInt - $0), Acc); - _ -> - case Precision == 0 of - true -> - doCollPadChar(LPart, Args, Width, Adjust, none, Acc); - _ -> - doCollPadChar(LPart, Args, Width, Adjust, Precision, Acc) - end - end - end. - -doCollPadChar(LPart, Args, Width, Adjust, Precision, Acc) -> - case LPart of - <<".*", LeftLPart/binary>> -> - [PadChar | LeftArgs] = Args, - doCollEncoding(LeftLPart, LeftArgs, Width, Adjust, Precision, PadChar, Acc); - <<".", PadChar:8/integer, LeftLPart/binary>> -> - doCollEncoding(LeftLPart, Args, Width, Adjust, Precision, PadChar, Acc); - _ -> - doCollEncoding(LPart, Args, Width, Adjust, Precision, 32, Acc) - end. - -doCollEncoding(LPart, Args, Width, Adjust, Precision, PadChar, Acc) -> - case LPart of - <<"t", LeftLPart/binary>> -> - %true = Char =/= $l, - doCollStrings(LeftLPart, Args, Width, Adjust, Precision, PadChar, unicode, Acc); - _ -> - doCollStrings(LPart, Args, Width, Adjust, Precision, PadChar, latin1, Acc) - end. - -doCollStrings(LPart, Args, Width, Adjust, Precision, PadChar, Encoding, Acc) -> - case LPart of - <<"l", LeftLPart/binary>> -> - %true = Char =/= $t, - doCollCA(LeftLPart, Args, Width, Adjust, Precision, PadChar, Encoding, false, Acc); - _ -> - doCollCA(LPart, Args, Width, Adjust, Precision, PadChar, Encoding, true, Acc) - end. - -doCollCA(LPart, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, Acc) -> - <> = LPart, - io:format("IMY*********************doCollCA:~p~p~n", [CtlChar, LPart]), - case CtlChar of - $w -> [OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $p ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $W ->[OneArgs | LeftArgs] = Args, [Depth | LastArgs] = LeftArgs, As = [OneArgs, Depth], NextArgs = LastArgs; - $P -> [OneArgs | LeftArgs] = Args,[Depth | LastArgs] = LeftArgs, As = [OneArgs, Depth], NextArgs = LastArgs; - $s ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $e ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $f ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $g -> [OneArgs | LeftArgs] = Args,As = OneArgs, NextArgs = LeftArgs; - $b ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $B ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $x ->[OneArgs | LeftArgs] = Args, [Prefix | LastArgs] = LeftArgs, As = [OneArgs, Prefix], NextArgs = LastArgs; - $X -> [OneArgs | LeftArgs] = Args,[Prefix | LastArgs] = LeftArgs, As = [OneArgs, Prefix], NextArgs = LastArgs; - $+ -> [OneArgs | LeftArgs] = Args,As = OneArgs, NextArgs = LeftArgs; - $# ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $c ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs; - $~ -> As = undefined, NextArgs = Args; - $n -> As = undefined, NextArgs = Args; - $i ->[OneArgs | LeftArgs] = Args, As = OneArgs, NextArgs = LeftArgs - end, - FmtSpec = #fmtSpec{ctlChar = CtlChar, args = As, width = Width, adjust = Adjust, precision = Precision, padChar = PadChar, encoding = Encoding, strings = Strings}, - io:format("IMY***************~p~n", [FmtSpec]), - doCollect(LeftLPart, NextArgs, [FmtSpec | Acc]). - -%% Build the output text for a pre-parsed format list. --spec build(FormatList :: [char() | eFmt:fmtSpec()]) -> eFmt:chars(). -build(Cs) -> - build(Cs, []). - --spec build(FormatList :: [char() | eFmt:fmtSpec()], Options :: [{'chars_limit', CharsLimit :: integer()}]) -> eFmt:chars(). -build(Cs, Options) -> - CharsLimit = getOpt(chars_limit, Options, -1), - ResList = buildSmall(Cs, []), - {P, S, W, Other} = cntSmall(ResList, 0, 0, 0, 0), - NumOfLimited = P + S + W, - case NumOfLimited of - 0 -> - ResList; - _ -> - RemainChars = remainChars(CharsLimit, Other), - buildLimited(ResList, P, NumOfLimited, RemainChars, 0, []) - end. - -%% build_small([Control]) -> eFmt:chars(). -%% Interpret the control structures, but only the small ones. The big ones are saved for later. -%% build_limited([Control], NumberOfPps, NumberOfLimited, CharsLimit, Indentation) -%% Interpret the control structures. Count the number of print -%% remaining and only calculate indentation when necessary. Must also -%% be smart when calculating indentation for characters in format. -buildSmall([], Acc) -> Acc; -buildSmall([OneCA | Cs], Acc) -> - case OneCA of - #fmtSpec{ctlChar = CtlChar, args = Args, width = Width, adjust = Adjust, precision = Precision, padChar = PadChar, encoding = Encoding} -> - case ctlSmall(CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding) of - not_small -> buildSmall(Cs, [OneCA | Acc]); - ignore -> buildSmall(Cs, Acc); - Str -> buildSmall(Cs, [Str | Acc]) - end; - _ -> - buildSmall(Cs, [OneCA | Acc]) - end. - -%% control_small(FormatChar, [Argument], FieldWidth, Adjust, Precision, -%% PadChar, Encoding) -> String -%% control_limited(FormatChar, [Argument], FieldWidth, Adjust, Precision, -%% PadChar, Encoding, StringP, ChrsLim, Indentation) -> String -%% These are the dispatch functions for the various formatting controls. - -ctlSmall($s, Args, Width, Adjust, Precision, PadChar, Encoding) when is_atom(Args) -> - case Encoding of - latin1 -> - AtomBinStr = eFmt:writeAtom(Args, latin1); - _ -> - AtomBinStr = eFmt:writeAtom(Args, uft8) - end, - string(AtomBinStr, Width, Adjust, Precision, PadChar, Encoding); -ctlSmall($e, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_float(Args) -> - floatE(Args, Width, Adjust, Precision, PadChar); -ctlSmall($f, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_float(Args) -> - floatF(Args, Width, Adjust, Precision, PadChar); -ctlSmall($g, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_float(Args) -> - floatG(Args, Width, Adjust, Precision, PadChar); -ctlSmall($b, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> - unPrefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, true); -ctlSmall($B, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> - unPrefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, false); -ctlSmall($x, [Args, Prefix], Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args), is_atom(Prefix) -> - prefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, atom_to_binary(Prefix, utf8), true); -ctlSmall($x, [Args, Prefix], Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> - prefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, Prefix, true); -ctlSmall($X, [Args, Prefix], Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args), is_atom(Prefix) -> - prefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, atom_to_binary(Prefix, utf8), false); -ctlSmall($X, [Args, Prefix], Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> - prefixedInt(Args, Width, Adjust, ?base(Precision), PadChar, Prefix, false); -ctlSmall($+, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> - Base = ?base(Precision), - prefixedInt(Args, Width, Adjust, Base, PadChar, integer_to_binary(Base), $#, true); -ctlSmall($#, Args, Width, Adjust, Precision, PadChar, _Encoding) when is_integer(Args) -> - Base = ?base(Precision), - prefixedInt(Args, Width, Adjust, Base, PadChar, integer_to_binary(Base), $#, false); -ctlSmall($c,Args, Width, Adjust, Precision, PadChar, Encoding) when is_integer(Args) -> - case Encoding of - unicode -> - char(Args, Width, Adjust, Precision, PadChar); - _ -> - char(Args band 255, Width, Adjust, Precision, PadChar) - end; -ctlSmall($~, _Args, Width, Adjust, Precision, PadChar, _Encoding) -> char($~, Width, Adjust, Precision, PadChar); -ctlSmall($n, _Args, Width, Adjust, Precision, PadChar, _Encoding) -> newline(Width, Adjust, Precision, PadChar); -ctlSmall($i, _Args, _Width, _Adjust, _Precision, _PadChar, _Encoding) -> ignore; -ctlSmall(_C, _Args, _Width, _Adjust, _Precision, _PadChar, _Encoding) -> not_small. - -cntSmall([], P, S, W, Other) -> - {P, S, W, Other}; -cntSmall([OneRes | Cs], P, S, W, Other) -> - case OneRes of - #fmtSpec{ctlChar = CtlChar} -> - case CtlChar of - $p -> - cntSmall(Cs, P + 1, S, W, Other); - $P -> - cntSmall(Cs, P + 1, S, W, Other); - $w -> - cntSmall(Cs, P, S, W + 1, Other); - $W -> - cntSmall(Cs, P, S, W + 1, Other); - $s -> - cntSmall(Cs, P, S, W + 1, Other); - _ -> - cntSmall(Cs, P, S, W, Other) - end; - _ -> - if - is_binary(OneRes) orelse is_list(OneRes) -> - cntSmall(Cs, P, S, W, Other + eFmt:charsLen(OneRes)); - is_integer(OneRes) -> - cntSmall(Cs, P, S, W, Other + 1); - true -> - cntSmall(Cs, P, S, W, Other) - end - end. - -buildLimited([], _, _, _, _, Acc) -> Acc; -buildLimited([OneCA | Cs], NumOfPs, Count, MaxLen, I, Acc) -> - case OneCA of - #fmtSpec{ctlChar = CtlChar, args = Args, width = Width, adjust = Adjust, precision = Precision, padChar = PadChar, encoding = Encoding, strings = Strings} -> - MaxChars = if MaxLen < 0 -> MaxLen; true -> MaxLen div Count end, - IoListStr = ctlLimited(CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, MaxChars, I), - NewNumOfPs = decrPc(CtlChar, NumOfPs), - NewCount = Count - 1, - MaxLen = ?IIF(MaxLen < 0, MaxLen, remainChars(MaxLen, eFmt:charsLen(IoListStr))), - if - NewNumOfPs > 0 -> - buildLimited(Cs, NewNumOfPs, NewCount, MaxLen, I, [IoListStr | Acc]); - true -> - buildLimited(Cs, NewNumOfPs, NewCount, MaxLen, I, [IoListStr | Acc]) - end; - _ -> - buildLimited(Cs, NumOfPs, Count, MaxLen, I + 1, [OneCA | Acc]) - end. - -decrPc($p, Pc) -> Pc - 1; -decrPc($P, Pc) -> Pc - 1; -decrPc(_, Pc) -> Pc. - -%% (CtlChar, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, MaxChars, I) -ctlLimited($s, Args, Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> - case Encoding of - latin1 -> - BinStr = erlang:iolist_to_binary(Args); - - _ -> - BinStr = case catch unicode:characters_to_binary(Args, unicode) of - Str when is_binary(Str) -> Str; - _ -> toBinary(Args) - end - end, - TemBinStr = strToChars(BinStr, Width, CharsLimit), - string(TemBinStr, ?IIF(CharsLimit < 0 orelse Width =:= none, Width, max(3, min(Width, CharsLimit))), Adjust, Precision, PadChar, Encoding); -ctlLimited($w, Args, Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> - Chars = eFmt:doWrite(Args, -1, Encoding, CharsLimit), - term(Chars, Width, Adjust, Precision, PadChar); -ctlLimited($p, Args, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I) -> - print(Args, -1, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I); -ctlLimited($W, [Args, Depth], Width, Adjust, Precision, PadChar, Encoding, _Strings, CharsLimit, _I) -> - Chars = eFmt:doWrite(Args, Depth, Encoding, CharsLimit), - term(Chars, Width, Adjust, Precision, PadChar); -ctlLimited($P, [Args, Depth], Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I) -> - print(Args, Depth, Width, Adjust, Precision, PadChar, Encoding, Strings, CharsLimit, I). - -%% term(TermList, Field, Adjust, Precision, PadChar) -%% Output the characters in a term. -%% Adjust the characters within the field if length less than Max padding -%% with PadChar. - -term(BinStrOrIoList, Width, Adjust, Precision, PadChar) -> - if - Width == none andalso Precision == none -> - BinStrOrIoList; - Width == none -> - StrLen = eFmt:charsLen(BinStrOrIoList), - NewPrecision = erlang:min(StrLen, Precision), - if - StrLen > NewPrecision -> - adjust(Adjust, makePadChars($*, NewPrecision, <<>>), <<>>); - true -> - adjust(Adjust, BinStrOrIoList, makePadChars(PadChar, Precision - StrLen, <<>>)) - end; - true -> - io:format("IMY****************1111 ~p ~n", [PadChar]), - StrLen = eFmt:charsLen(BinStrOrIoList), - NewPrecision = erlang:min(StrLen, case Precision of none -> Width; _ -> min(Precision, Width) end), - if - StrLen > NewPrecision -> - adjust(Adjust, makePadChars($*, NewPrecision, <<>>), makePadChars(PadChar, Width - NewPrecision, <<>>)); - true -> - io:format("IMY****************22222~p ~p ~n", [BinStrOrIoList, PadChar]), - A = adjust(Adjust, BinStrOrIoList, makePadChars(PadChar, Width - StrLen, <<>>)), - io:format("IMY****************333 ~p ~p ~n", [A, PadChar]), - A - end - end. - -%% print(Term, Depth, Field, Adjust, Precision, PadChar, Encoding, -%% Indentation) -%% Print a term. Field width sets maximum line length, Precision sets -%% initial indentation. -print(Term, Depth, Width, _Adjust, Precision, _PadChar, Encoding, Strings, CharsLimit, I) -> - if - Width == none -> NewWidth = 80; - true -> NewWidth = Width - end, - if - Precision == none -> NewPrecision = I + 1; - true -> NewPrecision = Precision - end, - Options = [ - {chars_limit, CharsLimit}, - {column, Precision}, - {line_length, Width}, - {depth, Depth}, - {encoding, Encoding}, - {strings, Strings} - ], - io_lib_pretty:print(Term, Options). - -print(Term, Options) when is_list(Options) -> - Col = get_option(column, Options, 1), - Ll = get_option(line_length, Options, 80), - D = get_option(depth, Options, -1), - M = get_option(line_max_chars, Options, -1), - T = get_option(chars_limit, Options, -1), - RecDefFun = get_option(record_print_fun, Options, no_fun), - Encoding = get_option(encoding, Options, epp:default_encoding()), - Strings = get_option(strings, Options, true), - print(Term, Col, Ll, D, M, T, RecDefFun, Encoding, Strings); - - - - -floatE(Float, Width, Adjust, Precision, PadChar) -> - case Precision of - none -> - NewPrecision = 6; - _ -> - NewPrecision = Precision - end, - case Width of - none -> - float_to_binary(Float, [{scientific, NewPrecision}]); - _ -> - term(float_to_binary(Float, [{scientific, NewPrecision}]), Width, Adjust, Width, PadChar) - end. - -floatF(Float, Width, Adjust, Precision, PadChar) -> - case Precision of - none -> - NewPrecision = 6; - _ -> - NewPrecision = Precision - end, - case Width of - none -> - float_to_binary(Float, [{decimals, NewPrecision}]); - _ -> - term(float_to_binary(Float, [{decimals, NewPrecision}]), Width, Adjust, Width, PadChar) - end. - -%% fwrite_g(Float, Field, Adjust, Precision, PadChar) -%% Use the f form if Float is >= 0.1 and < 1.0e4, -%% and the prints correctly in the f form, else the e form. -%% Precision always means the # of significant digits. -floatG(Float, Width, Adjust, Precision, PadChar) -> - case Float > -10000.0 andalso Float < 10000.0 of - true -> - floatF(Float, Width, Adjust, Precision, PadChar); - _ -> - floatE(Float, Width, Adjust, Precision, PadChar) - end. - -floatG(Float) -> - float_to_binary(Float, [{decimals, 6}]). - -strToChars(BinStr, Width, CharsLimit) -> - ByteSize = byte_size(BinStr), - if - Width == none -> - case CharsLimit < 0 orelse CharsLimit >= ByteSize of - true -> - BinStr; - _ -> - <<(binary:part(BinStr, 0, CharsLimit))/binary, "...">> - end; - CharsLimit < 0 orelse CharsLimit >= Width -> - BinStr; - true -> - <<(binary:part(BinStr, 0, CharsLimit))/binary, "...">> - end. - -string(Str, Width, Adjust, Precision, PadChar, Encoding) -> - if - Width == none andalso Precision == none -> - Str; - Precision == none -> - strField(Str, Width, Adjust, eFmt:charsLen(Str), PadChar, Encoding); - Width == none -> - strField(Str, Precision, left, eFmt:charsLen(Str), PadChar, Encoding); - true -> - StrLen = eFmt:charsLen(Str), - if - Width > Precision -> - if StrLen > Precision -> - adjust(Adjust, flatTrunc(Str, Precision, Encoding), makePadChars(PadChar, Width - Precision, <<>>)); - StrLen < Precision -> - adjust(Adjust, [Str | makePadChars(PadChar, Precision - StrLen, <<>>)], makePadChars(PadChar, Width - Precision, <<>>)); - true -> % N == P - adjust(Adjust, Str, makePadChars(PadChar, Width - Precision, <<>>)) - end; - true -> % F == P - strField(Str, Width, Adjust, StrLen, PadChar, Encoding) - end - end. - -strField(Str, Width, Adjust, StrLen, PadChar, Encoding) when StrLen > Width -> - if - StrLen > Width -> - flatTrunc(Str, Width, Encoding); - StrLen < Width -> - adjust(Adjust, Str, makePadChars(PadChar, Width - StrLen, <<>>)); - true -> - Str - end. - -flatTrunc(List, Width, _Encoding) -> - binary:part(iolist_to_binary(List), 0, Width). - -makePadChars(PadChar, Cnt, BinStr) -> - case Cnt > 0 of - true -> - makePadChars(PadChar, Cnt - 1, <>); - _ -> - BinStr - end. - -adjust(left, Data, Pad) -> [Data, Pad]; -adjust(right, Data, Pad) -> [Pad, Data]. - -unPrefixedInt(Int, Width, Adjust, Base, PadChar, Lowercase) -> - case Lowercase of - true -> - term(toLowerStr(integer_to_binary(Int, Base)), Width, Adjust, none, PadChar); - _ -> - term(integer_to_binary(Int, Base), Width, Adjust, none, PadChar) - end. - -prefixedInt(Int, Width, Adjust, Base, PadChar, Prefix, Lowercase) -> - case Int < 0 of - true -> - case Lowercase of - true -> - term(<<"-", (toBinary(Prefix))/binary, (toLowerStr(integer_to_binary(-Int, Base)))/binary>>, Width, Adjust, none, PadChar); - _ -> - term(<<"-", (toBinary(Prefix))/binary, (integer_to_binary(-Int, Base))/binary>>, Width, Adjust, none, PadChar) - end; - _ -> - case Lowercase of - true -> - term(<<(toBinary(Prefix))/binary, (toLowerStr(integer_to_binary(Int, Base)))/binary>>, Width, Adjust, none, PadChar); - _ -> - term(<<(toBinary(Prefix))/binary, (integer_to_binary(Int, Base))/binary>>, Width, Adjust, none, PadChar) - end - end. - -prefixedInt(Int, Width, Adjust, Base, PadChar, Prefix, Prefix2, Lowercase) -> - case Int < 0 of - true -> - case Lowercase of - true -> - term(<<"-", (toBinary(Prefix))/binary, Prefix2:8, (toLowerStr(integer_to_binary(-Int, Base)))/binary>>, Width, Adjust, none, PadChar); - _ -> - term(<<"-", (toBinary(Prefix))/binary, Prefix2:8, (integer_to_binary(-Int, Base))/binary>>, Width, Adjust, none, PadChar) - end; - _ -> - case Lowercase of - true -> - term(<<(toBinary(Prefix))/binary, Prefix2:8, (toLowerStr(integer_to_binary(Int, Base)))/binary>>, Width, Adjust, none, PadChar); - _ -> - term(<<(toBinary(Prefix))/binary, Prefix2:8, (integer_to_binary(Int, Base))/binary>>, Width, Adjust, none, PadChar) - end - end. - -char(Char, Width, Adjust, Precision, PadChar) -> - if - Width == none andalso Precision == none -> - Char; - Precision == none -> - makePadChars(Char, Width, <<>>); - Width == none -> - makePadChars(Char, Precision, <<>>); - true -> - adjust(Adjust, makePadChars(Char, Precision, <<>>), makePadChars(PadChar, Width - Precision, <<>>)) - end. - -newline(none, _Adjust, _Precision, _PadChar) -> <<"\n">>; -newline(Width, Adjust, _Precision, _PadChar) -> - case Adjust of - right -> - makePadChars($\n, Width, <<>>); - _ -> - <<"\n">> - end. - -remainChars(T, E) -> - if - T < 0 -> - T; - T >= E -> - T - E; - true -> - 0 - end. - -getOpt(Key, TupleList, Default) -> - case lists:keyfind(Key, 1, TupleList) of - {_, Value} -> - Value; - _ -> - Default - end. - -toLowerStr(BinStr) -> - << begin - case C >= $A andalso C =< $Z of - true -> - <<(C + 32)>>; - _ -> - <> - end - end || <> <= BinStr - >>. - -toUpperStr(BinStr) -> - << begin - case C >= $a andalso C =< $z of - true -> - <<(C - 32)>>; - _ -> - <> - end - end || <> <= BinStr ->>. - -toBinary(Value) when is_integer(Value) -> integer_to_binary(Value); -toBinary(Value) when is_list(Value) -> list_to_binary(Value); -toBinary(Value) when is_float(Value) -> float_to_binary(Value, [{decimals, 6}, compact]); -toBinary(Value) when is_atom(Value) -> atom_to_binary(Value, utf8); -toBinary(Value) when is_binary(Value) -> Value; -toBinary([Tuple | PropList] = Value) when is_list(PropList) and is_tuple(Tuple) -> - lists:map(fun({K, V}) -> {toBinary(K), toBinary(V)} end, Value); -toBinary(Value) -> term_to_binary(Value). diff --git a/src/eFmtPretty.erl b/src/eFmtPretty.erl new file mode 100644 index 0000000..28959cf --- /dev/null +++ b/src/eFmtPretty.erl @@ -0,0 +1,1130 @@ +-module(eFmtPretty). + +-export([ + pPrint/1 + , pPrint/2 + , pPrint/3 + , pPrint/4 + , pPrint/5 + , pPrint/6 + + %% To be used by io_lib only. + , pIntermediate/6 + , pWrite/1 +]). + + +%%% +%%% Exported functions +%%% + +%% print(Term) -> [Chars] +%% print(Term, Column, LineLength, Depth) -> [Chars] +%% Depth = -1 gives unlimited print depth. Use io_lib:write for atomic terms. + +-spec pPrint(term()) -> io_lib:chars(). +pPrint(Term) -> + print(Term, 1, 80, -1, -1, -1, no_fun, latin1, true). + +%% print(Term, RecDefFun) -> [Chars] +%% print(Term, Depth, RecDefFun) -> [Chars] +%% RecDefFun = fun(Tag, NoFields) -> [FieldTag] | no +%% Used by the shell for printing records and for Unicode. + +-type rec_print_fun() :: fun((Tag :: atom(), NFields :: non_neg_integer()) -> 'no' | [FieldName :: atom()]). +-type column() :: integer(). +-type encoding() :: epp:source_encoding() | 'unicode'. +-type line_length() :: pos_integer(). +-type depth() :: integer(). +-type line_max_chars() :: integer(). +-type chars_limit() :: integer(). + +-type chars() :: io_lib:chars(). +-type option() :: {'chars_limit', chars_limit()} +| {'column', column()} +| {'depth', depth()} +| {'encoding', encoding()} +| {'line_length', line_length()} +| {'line_max_chars', line_max_chars()} +| {'record_print_fun', rec_print_fun()} +| {'strings', boolean()}. +-type options() :: [option()]. + +-spec pPrint(term(), rec_print_fun()) -> chars(); + (term(), options()) -> chars(). + +pPrint(Term, Options) when is_list(Options) -> + Col = get_option(column, Options, 1), + Ll = get_option(line_length, Options, 80), + D = get_option(depth, Options, -1), + M = get_option(line_max_chars, Options, -1), + T = get_option(chars_limit, Options, -1), + RecDefFun = get_option(record_print_fun, Options, no_fun), + Encoding = get_option(encoding, Options, epp:default_encoding()), + Strings = get_option(strings, Options, true), + print(Term, Col, Ll, D, M, T, RecDefFun, Encoding, Strings); +pPrint(Term, RecDefFun) -> + pPrint(Term, -1, RecDefFun). + +-spec pPrint(term(), depth(), rec_print_fun()) -> chars(). + +pPrint(Term, Depth, RecDefFun) -> + pPrint(Term, 1, 80, Depth, RecDefFun). + +-spec pPrint(term(), column(), line_length(), depth()) -> chars(). +pPrint(Term, Col, Ll, D) -> + print(Term, Col, Ll, D, _M = -1, _T = -1, no_fun, latin1, true). + +-spec pPrint(term(), column(), line_length(), depth(), rec_print_fun()) -> + chars(). +pPrint(Term, Col, Ll, D, RecDefFun) -> + pPrint(Term, Col, Ll, D, _M = -1, RecDefFun). + +-spec pPrint(term(), column(), line_length(), depth(), line_max_chars(), + rec_print_fun()) -> chars(). + +pPrint(Term, Col, Ll, D, M, RecDefFun) -> + print(Term, Col, Ll, D, M, _T = -1, RecDefFun, latin1, true). + +%% D = Depth, default -1 (infinite), or LINEMAX=30 when printing from shell +%% T = chars_limit, that is, maximal number of characters, default -1 +%% Used together with D to limit the output. It is possible that +%% more than T characters are returned. +%% Col = current column, default 1 +%% Ll = line length/~p field width, default 80 +%% M = CHAR_MAX (-1 if no max, 60 when printing from shell) +print(_, _, _, 0, _M, _T, _RF, _Enc, _Str) -> "..."; +print(_, _, _, _D, _M, 0, _RF, _Enc, _Str) -> "..."; +print(Term, Col, Ll, D, M, T, RecDefFun, Enc, Str) when Col =< 0 -> + %% ensure Col is at least 1 + print(Term, 1, Ll, D, M, T, RecDefFun, Enc, Str); +print(Atom, _Col, _Ll, _D, _M, _T, _RF, Enc, _Str) when is_atom(Atom) -> + write_atom(Atom, Enc); +print(Term, Col, Ll, D, M0, T, RecDefFun, Enc, Str) when is_tuple(Term); + is_list(Term); + is_map(Term); + is_bitstring(Term) -> + %% preprocess and compute total number of chars + {_, Len, _Dots, _} = If = + case T < 0 of + true -> print_length(Term, D, T, RecDefFun, Enc, Str); + false -> pIntermediate(Term, D, T, RecDefFun, Enc, Str) + end, + %% use Len as CHAR_MAX if M0 = -1 + M = max_cs(M0, Len), + if + Ll =:= 0 -> + pWrite(If); + Len < Ll - Col, Len =< M -> + %% write the whole thing on a single line when there is room + pWrite(If); + true -> + %% compute the indentation TInd for tagged tuples and records + TInd = while_fail([-1, 4], + fun(I) -> cind(If, Col, Ll, M, I, 0, 0) end, + 1), + pp(If, Col, Ll, M, TInd, indent(Col), 0, 0) + end; +print(Term, _Col, _Ll, _D, _M, _T, _RF, _Enc, _Str) -> + %% atomic data types (bignums, atoms, ...) are never truncated + io_lib:write(Term). + +%%% +%%% Local functions +%%% + +%% use M only if nonnegative, otherwise use Len as default value +max_cs(M, Len) when M < 0 -> + Len; +max_cs(M, _Len) -> + M. + +-define(ATM(T), is_list(element(1, T))). +-define(ATM_PAIR(Pair), + ?ATM(element(2, element(1, Pair))) % Key + andalso + ?ATM(element(3, element(1, Pair)))). % Value +-define(ATM_FLD(Field), ?ATM(element(4, element(1, Field)))). + +pp({_S, Len, _, _} = If, Col, Ll, M, _TInd, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M -> + pWrite(If); +pp({{list, L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> + [$[, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $|, W + 1), $]]; +pp({{tuple, true, L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> + [${, pp_tag_tuple(L, Col, Ll, M, TInd, Ind, LD, W + 1), $}]; +pp({{tuple, false, L}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> + [${, pp_list(L, Col + 1, Ll, M, TInd, indent(1, Ind), LD, $,, W + 1), $}]; +pp({{map, Pairs}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> + [$#, ${, pp_map(Pairs, Col + 2, Ll, M, TInd, indent(2, Ind), LD, W + 1), + $}]; +pp({{record, [{Name, NLen} | L]}, _Len, _, _}, Col, Ll, M, TInd, Ind, LD, W) -> + [Name, ${, pp_record(L, NLen, Col, Ll, M, TInd, Ind, LD, W + NLen + 1), $}]; +pp({{bin, S}, _Len, _, _}, Col, Ll, M, _TInd, Ind, LD, W) -> + pp_binary(S, Col + 2, Ll, M, indent(2, Ind), LD, W); +pp({S, _Len, _, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + S. + +%% Print a tagged tuple by indenting the rest of the elements +%% differently to the tag. Tuple has size >= 2. +pp_tag_tuple([{Tag, Tlen, _, _} | L], Col, Ll, M, TInd, Ind, LD, W) -> + %% this uses TInd + TagInd = Tlen + 2, + Tcol = Col + TagInd, + S = $,, + if + TInd > 0, TagInd > TInd -> + Col1 = Col + TInd, + Indent = indent(TInd, Ind), + [Tag | pp_tail(L, Col1, Tcol, Ll, M, TInd, Indent, LD, S, W + Tlen)]; + true -> + Indent = indent(TagInd, Ind), + [Tag, S | pp_list(L, Tcol, Ll, M, TInd, Indent, LD, S, W + Tlen + 1)] + end. + +pp_map([], _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + ""; % cannot happen +pp_map({dots, _, _, _}, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + "..."; % cannot happen +pp_map([P | Ps], Col, Ll, M, TInd, Ind, LD, W) -> + {PS, PW} = pp_pair(P, Col, Ll, M, TInd, Ind, last_depth(Ps, LD), W), + [PS | pp_pairs_tail(Ps, Col, Col + PW, Ll, M, TInd, Ind, LD, PW)]. + +pp_pairs_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + ""; +pp_pairs_tail({dots, _, _, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) -> + ",..."; +pp_pairs_tail([{_, Len, _, _} = P | Ps], Col0, Col, Ll, M, TInd, Ind, LD, W) -> + LD1 = last_depth(Ps, LD), + ELen = 1 + Len, + if + LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P); + LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) -> + [$,, write_pair(P) | + pp_pairs_tail(Ps, Col0, Col + ELen, Ll, M, TInd, Ind, LD, W + ELen)]; + true -> + {PS, PW} = pp_pair(P, Col0, Ll, M, TInd, Ind, LD1, 0), + [$,, $\n, Ind, PS | + pp_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, TInd, Ind, LD, PW)] + end. + +pp_pair({_, Len, _, _} = Pair, Col, Ll, M, _TInd, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M -> + {write_pair(Pair), if + ?ATM_PAIR(Pair) -> + Len; + true -> + Ll % force nl + end}; +pp_pair({{map_pair, K, V}, _Len, _, _}, Col0, Ll, M, TInd, Ind0, LD, W) -> + I = map_value_indent(TInd), + Ind = indent(I, Ind0), + {[pp(K, Col0, Ll, M, TInd, Ind0, LD, W), " =>\n", + Ind | pp(V, Col0 + I, Ll, M, TInd, Ind, LD, 0)], Ll}. % force nl + +pp_record([], _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + ""; +pp_record({dots, _, _, _}, _Nlen, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + "..."; +pp_record([F | Fs], Nlen, Col0, Ll, M, TInd, Ind0, LD, W0) -> + Nind = Nlen + 1, + {Col, Ind, S, W} = rec_indent(Nind, TInd, Col0, Ind0, W0), + {FS, FW} = pp_field(F, Col, Ll, M, TInd, Ind, last_depth(Fs, LD), W), + [S, FS | pp_fields_tail(Fs, Col, Col + FW, Ll, M, TInd, Ind, LD, W + FW)]. + +pp_fields_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _W) -> + ""; +pp_fields_tail({dots, _, _, _}, _Col0, _Col, _M, _Ll, _TInd, _Ind, _LD, _W) -> + ",..."; +pp_fields_tail([{_, Len, _, _} = F | Fs], Col0, Col, Ll, M, TInd, Ind, LD, W) -> + LD1 = last_depth(Fs, LD), + ELen = 1 + Len, + if + LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_FLD(F); + LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_FLD(F) -> + [$,, write_field(F) | + pp_fields_tail(Fs, Col0, Col + ELen, Ll, M, TInd, Ind, LD, W + ELen)]; + true -> + {FS, FW} = pp_field(F, Col0, Ll, M, TInd, Ind, LD1, 0), + [$,, $\n, Ind, FS | + pp_fields_tail(Fs, Col0, Col0 + FW, Ll, M, TInd, Ind, LD, FW)] + end. + +pp_field({_, Len, _, _} = Fl, Col, Ll, M, _TInd, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M -> + {write_field(Fl), if + ?ATM_FLD(Fl) -> + Len; + true -> + Ll % force nl + end}; +pp_field({{field, Name, NameL, F}, _, _, _}, Col0, Ll, M, TInd, Ind0, LD, W0) -> + {Col, Ind, S, W} = rec_indent(NameL, TInd, Col0, Ind0, W0 + NameL), + Sep = case S of + [$\n | _] -> " ="; + _ -> " = " + end, + {[Name, Sep, S | pp(F, Col, Ll, M, TInd, Ind, LD, W)], Ll}. % force nl + +rec_indent(RInd, TInd, Col0, Ind0, W0) -> + %% this uses TInd + Nl = (TInd > 0) and (RInd > TInd), + DCol = case Nl of + true -> TInd; + false -> RInd + end, + Col = Col0 + DCol, + Ind = indent(DCol, Ind0), + S = case Nl of + true -> [$\n | Ind]; + false -> "" + end, + W = case Nl of + true -> 0; + false -> W0 + end, + {Col, Ind, S, W}. + +pp_list({dots, _, _, _}, _Col0, _Ll, _M, _TInd, _Ind, _LD, _S, _W) -> + "..."; +pp_list([E | Es], Col0, Ll, M, TInd, Ind, LD, S, W) -> + {ES, WE} = pp_element(E, Col0, Ll, M, TInd, Ind, last_depth(Es, LD), W), + [ES | pp_tail(Es, Col0, Col0 + WE, Ll, M, TInd, Ind, LD, S, W + WE)]. + +pp_tail([], _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, _S, _W) -> + []; +pp_tail([{_, Len, _, _} = E | Es], Col0, Col, Ll, M, TInd, Ind, LD, S, W) -> + LD1 = last_depth(Es, LD), + ELen = 1 + Len, + if + LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM(E); + LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM(E) -> + [$,, pWrite(E) | + pp_tail(Es, Col0, Col + ELen, Ll, M, TInd, Ind, LD, S, W + ELen)]; + true -> + {ES, WE} = pp_element(E, Col0, Ll, M, TInd, Ind, LD1, 0), + [$,, $\n, Ind, ES | + pp_tail(Es, Col0, Col0 + WE, Ll, M, TInd, Ind, LD, S, WE)] + end; +pp_tail({dots, _, _, _}, _Col0, _Col, _Ll, _M, _TInd, _Ind, _LD, S, _W) -> + [S | "..."]; +pp_tail({_, Len, _, _} = E, _Col0, Col, Ll, M, _TInd, _Ind, LD, S, W) + when Len + 1 < Ll - Col - (LD + 1), + Len + 1 + W + (LD + 1) =< M, + ?ATM(E) -> + [S | pWrite(E)]; +pp_tail(E, Col0, _Col, Ll, M, TInd, Ind, LD, S, _W) -> + [S, $\n, Ind | pp(E, Col0, Ll, M, TInd, Ind, LD + 1, 0)]. + +pp_element({_, Len, _, _} = E, Col, Ll, M, _TInd, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M, ?ATM(E) -> + {pWrite(E), Len}; +pp_element(E, Col, Ll, M, TInd, Ind, LD, W) -> + {pp(E, Col, Ll, M, TInd, Ind, LD, W), Ll}. % force nl + +%% Reuse the list created by io_lib:write_binary()... +pp_binary([LT, LT, S, GT, GT], Col, Ll, M, Ind, LD, W) -> + N = erlang:max(8, erlang:min(Ll - Col, M - 4 - W) - LD), + [LT, LT, pp_binary(S, N, N, Ind), GT, GT]. + +pp_binary([BS, $, | S], N, N0, Ind) -> + Len = length(BS) + 1, + case N - Len of + N1 when N1 < 0 -> + [$\n, Ind, BS, $, | pp_binary(S, N0 - Len, N0, Ind)]; + N1 -> + [BS, $, | pp_binary(S, N1, N0, Ind)] + end; +pp_binary([BS1, $:, BS2] = S, N, _N0, Ind) + when length(BS1) + length(BS2) + 1 > N -> + [$\n, Ind, S]; +pp_binary(S, N, _N0, Ind) -> + case iolist_size(S) > N of + true -> + [$\n, Ind, S]; + false -> + S + end. + +%% write the whole thing on a single line +pWrite({{tuple, _IsTagged, L}, _, _, _}) -> + [${, write_list(L, $,), $}]; +pWrite({{list, L}, _, _, _}) -> + [$[, write_list(L, $|), $]]; +pWrite({{map, Pairs}, _, _, _}) -> + [$#, ${, write_list(Pairs, $,), $}]; +pWrite({{map_pair, _K, _V}, _, _, _} = Pair) -> + write_pair(Pair); +pWrite({{record, [{Name, _} | L]}, _, _, _}) -> + [Name, ${, write_fields(L), $}]; +pWrite({{bin, S}, _, _, _}) -> + S; +pWrite({S, _, _, _}) -> + S. + +write_pair({{map_pair, K, V}, _, _, _}) -> + [pWrite(K), " => ", pWrite(V)]. + +write_fields([]) -> + ""; +write_fields({dots, _, _, _}) -> + "..."; +write_fields([F | Fs]) -> + [write_field(F) | write_fields_tail(Fs)]. + +write_fields_tail([]) -> + ""; +write_fields_tail({dots, _, _, _}) -> + ",..."; +write_fields_tail([F | Fs]) -> + [$,, write_field(F) | write_fields_tail(Fs)]. + +write_field({{field, Name, _NameL, F}, _, _, _}) -> + [Name, " = " | pWrite(F)]. + +write_list({dots, _, _, _}, _S) -> + "..."; +write_list([E | Es], S) -> + [pWrite(E) | write_tail(Es, S)]. + +write_tail([], _S) -> + []; +write_tail([E | Es], S) -> + [$,, pWrite(E) | write_tail(Es, S)]; +write_tail({dots, _, _, _}, S) -> + [S | "..."]; +write_tail(E, S) -> + [S | pWrite(E)]. + +-type more() :: fun((chars_limit(), DeltaDepth :: non_neg_integer()) -> + intermediate_format()). + +-type if_list() :: maybe_improper_list(intermediate_format(), +{'dots', non_neg_integer(), + non_neg_integer(), more()}). + +-type intermediate_format() :: +{chars() +| {'bin', chars()} +| 'dots' +| {'field', Name :: chars(), NameLen :: non_neg_integer(), + intermediate_format()} +| {'list', if_list()} +| {'map', if_list()} +| {'map_pair', K :: intermediate_format(), + V :: intermediate_format()} +| {'record', [{Name :: chars(), NameLen :: non_neg_integer()} +| if_list()]} +| {'tuple', IsTagged :: boolean(), if_list()}, + Len :: non_neg_integer(), + NumOfDots :: non_neg_integer(), + More :: more() | 'no_more' +}. + +-spec pIntermediate(term(), depth(), pos_integer(), rec_print_fun(), + encoding(), boolean()) -> intermediate_format(). + +pIntermediate(Term, D, T, RF, Enc, Str) when T > 0 -> + D0 = 1, + If = print_length(Term, D0, T, RF, Enc, Str), + case If of + {_, Len, Dots, _} when Dots =:= 0; Len > T; D =:= 1 -> + If; + _ -> + find_upper(If, Term, T, D0, 2, D, RF, Enc, Str) + end. + +find_upper(Lower, Term, T, Dl, Dd, D, RF, Enc, Str) -> + Dd2 = Dd * 2, + D1 = case D < 0 of + true -> Dl + Dd2; + false -> min(Dl + Dd2, D) + end, + If = expand(Lower, T, D1 - Dl), + case If of + {_, _, _Dots = 0, _} -> % even if Len > T + If; + {_, _Len = T, _, _} -> % increasing the depth is meaningless + If; + {_, Len, _, _} when Len < T, D1 < D orelse D < 0 -> + find_upper(If, Term, T, D1, Dd2, D, RF, Enc, Str); + _ -> + search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str) + end. + +%% Lower has NumOfDots > 0 and Len =< T. +%% Upper has NumOfDots > 0 and Len > T. +search_depth(Lower, Upper, _Term, T, Dl, Du, _RF, _Enc, _Str) + when Du - Dl =:= 1 -> + %% The returned intermediate format has Len >= T. + case Lower of + {_, T, _, _} -> + Lower; + _ -> + Upper + end; +search_depth(Lower, Upper, Term, T, Dl, Du, RF, Enc, Str) -> + D1 = (Dl + Du) div 2, + If = expand(Lower, T, D1 - Dl), + case If of + {_, Len, _, _} when Len > T -> + %% Len can be greater than Upper's length. + %% This is a bit expensive since the work to + %% crate Upper is wasted. It is the price + %% to pay to get a more balanced output. + search_depth(Lower, If, Term, T, Dl, D1, RF, Enc, Str); + _ -> + search_depth(If, Upper, Term, T, D1, Du, RF, Enc, Str) + end. + +%% The depth (D) is used for extracting and counting the characters to +%% print. The structure is kept so that the returned intermediate +%% format can be formatted. The separators (list, tuple, record, map) are +%% counted but need to be added later. + +%% D =/= 0 +print_length([], _D, _T, _RF, _Enc, _Str) -> + {"[]", 2, 0, no_more}; +print_length({}, _D, _T, _RF, _Enc, _Str) -> + {"{}", 2, 0, no_more}; +print_length(#{} = M, _D, _T, _RF, _Enc, _Str) when map_size(M) =:= 0 -> + {"#{}", 3, 0, no_more}; +print_length(Atom, _D, _T, _RF, Enc, _Str) when is_atom(Atom) -> + S = write_atom(Atom, Enc), + {S, io_lib:chars_length(S), 0, no_more}; +print_length(List, D, T, RF, Enc, Str) when is_list(List) -> + %% only flat lists are "printable" + case Str andalso printable_list(List, D, T, Enc) of + true -> + %% print as string, escaping double-quotes in the list + S = write_string(List, Enc), + {S, io_lib:chars_length(S), 0, no_more}; + {true, Prefix} -> + %% Truncated lists when T < 0 could break some existing code. + S = write_string(Prefix, Enc), + %% NumOfDots = 0 to avoid looping--increasing the depth + %% does not make Prefix longer. + {[S | "..."], 3 + io_lib:chars_length(S), 0, no_more}; + false -> + case print_length_list(List, D, T, RF, Enc, Str) of + {What, Len, Dots, _More} when Dots > 0 -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(List, D + Dd, T1, RF, Enc, Str) + end, + {What, Len, Dots, More}; + If -> + If + end + end; +print_length(Fun, _D, _T, _RF, _Enc, _Str) when is_function(Fun) -> + S = io_lib:write(Fun), + {S, iolist_size(S), 0, no_more}; +print_length(R, D, T, RF, Enc, Str) when is_atom(element(1, R)), + is_function(RF) -> + case RF(element(1, R), tuple_size(R) - 1) of + no -> + print_length_tuple(R, D, T, RF, Enc, Str); + RDefs -> + print_length_record(R, D, T, RF, RDefs, Enc, Str) + end; +print_length(Tuple, D, T, RF, Enc, Str) when is_tuple(Tuple) -> + print_length_tuple(Tuple, D, T, RF, Enc, Str); +print_length(Map, D, T, RF, Enc, Str) when is_map(Map) -> + print_length_map(Map, D, T, RF, Enc, Str); +print_length(<<>>, _D, _T, _RF, _Enc, _Str) -> + {"<<>>", 4, 0, no_more}; +print_length(<<_/bitstring>> = Bin, 1, _T, RF, Enc, Str) -> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Bin, 1 + Dd, T1, RF, Enc, Str) end, + {"<<...>>", 7, 3, More}; +print_length(<<_/bitstring>> = Bin, D, T, RF, Enc, Str) -> + D1 = D - 1, + case + Str andalso + (bit_size(Bin) rem 8) =:= 0 andalso + printable_bin0(Bin, D1, tsub(T, 6), Enc) + of + {true, List} when is_list(List) -> + S = io_lib:write_string(List, $"), %" + {[$<, $<, S, $>, $>], 4 + length(S), 0, no_more}; + {false, List} when is_list(List) -> + S = io_lib:write_string(List, $"), %" + {[$<, $<, S, "/utf8>>"], 9 + io_lib:chars_length(S), 0, no_more}; + {true, true, Prefix} -> + S = io_lib:write_string(Prefix, $"), %" + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Bin, D + Dd, T1, RF, Enc, Str) + end, + {[$<, $<, S | "...>>"], 7 + length(S), 3, More}; + {false, true, Prefix} -> + S = io_lib:write_string(Prefix, $"), %" + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Bin, D + Dd, T1, RF, Enc, Str) + end, + {[$<, $<, S | "/utf8...>>"], 12 + io_lib:chars_length(S), 3, More}; + false -> + case io_lib:write_binary(Bin, D, T) of + {S, <<>>} -> + {{bin, S}, iolist_size(S), 0, no_more}; + {S, _Rest} -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Bin, D + Dd, T1, RF, Enc, Str) + end, + {{bin, S}, iolist_size(S), 3, More} + end + end; +print_length(Term, _D, _T, _RF, _Enc, _Str) -> + S = io_lib:write(Term), + %% S can contain unicode, so iolist_size(S) cannot be used here + {S, io_lib:chars_length(S), 0, no_more}. + +print_length_map(Map, 1, _T, RF, Enc, Str) -> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Map, 1 + Dd, T1, RF, Enc, Str) end, + {"#{...}", 6, 3, More}; +print_length_map(Map, D, T, RF, Enc, Str) when is_map(Map) -> + Next = maps:next(maps:iterator(Map)), + PairsS = print_length_map_pairs(Next, D, D - 1, tsub(T, 3), RF, Enc, Str), + {Len, Dots} = list_length(PairsS, 3, 0), + {{map, PairsS}, Len, Dots, no_more}. + +print_length_map_pairs(none, _D, _D0, _T, _RF, _Enc, _Str) -> + []; +print_length_map_pairs(Term, D, D0, T, RF, Enc, Str) when D =:= 1; T =:= 0 -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Term, D + Dd, D0, T1, RF, Enc, Str) + end, + {dots, 3, 3, More}; +print_length_map_pairs({K, V, Iter}, D, D0, T, RF, Enc, Str) -> + Pair1 = print_length_map_pair(K, V, D0, tsub(T, 1), RF, Enc, Str), + {_, Len1, _, _} = Pair1, + Next = maps:next(Iter), + [Pair1 | + print_length_map_pairs(Next, D - 1, D0, tsub(T, Len1 + 1), RF, Enc, Str)]. + +print_length_map_pair(K, V, D, T, RF, Enc, Str) -> + {_, KL, KD, _} = P1 = print_length(K, D, T, RF, Enc, Str), + KL1 = KL + 4, + {_, VL, VD, _} = P2 = print_length(V, D, tsub(T, KL1), RF, Enc, Str), + {{map_pair, P1, P2}, KL1 + VL, KD + VD, no_more}. + +print_length_tuple(Tuple, 1, _T, RF, Enc, Str) -> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Tuple, 1 + Dd, T1, RF, Enc, Str) end, + {"{...}", 5, 3, More}; +print_length_tuple(Tuple, D, T, RF, Enc, Str) -> + L = print_length_tuple1(Tuple, 1, D, tsub(T, 2), RF, Enc, Str), + IsTagged = is_atom(element(1, Tuple)) and (tuple_size(Tuple) > 1), + {Len, Dots} = list_length(L, 2, 0), + {{tuple, IsTagged, L}, Len, Dots, no_more}. + +print_length_tuple1(Tuple, I, _D, _T, _RF, _Enc, _Str) + when I > tuple_size(Tuple) -> + []; +print_length_tuple1(Tuple, I, D, T, RF, Enc, Str) when D =:= 1; T =:= 0 -> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Tuple, I, D + Dd, T1, RF, Enc, Str) end, + {dots, 3, 3, More}; +print_length_tuple1(Tuple, I, D, T, RF, Enc, Str) -> + E = element(I, Tuple), + T1 = tsub(T, 1), + {_, Len1, _, _} = Elem1 = print_length(E, D - 1, T1, RF, Enc, Str), + T2 = tsub(T1, Len1), + [Elem1 | print_length_tuple1(Tuple, I + 1, D - 1, T2, RF, Enc, Str)]. + +print_length_record(Tuple, 1, _T, RF, RDefs, Enc, Str) -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Tuple, 1 + Dd, T1, RF, RDefs, Enc, Str) + end, + {"{...}", 5, 3, More}; +print_length_record(Tuple, D, T, RF, RDefs, Enc, Str) -> + Name = [$# | write_atom(element(1, Tuple), Enc)], + NameL = io_lib:chars_length(Name), + T1 = tsub(T, NameL + 2), + L = print_length_fields(RDefs, D - 1, T1, Tuple, 2, RF, Enc, Str), + {Len, Dots} = list_length(L, NameL + 2, 0), + {{record, [{Name, NameL} | L]}, Len, Dots, no_more}. + +print_length_fields([], _D, _T, Tuple, I, _RF, _Enc, _Str) + when I > tuple_size(Tuple) -> + []; +print_length_fields(Term, D, T, Tuple, I, RF, Enc, Str) + when D =:= 1; T =:= 0 -> + More = fun(T1, Dd) -> + ?FUNCTION_NAME(Term, D + Dd, T1, Tuple, I, RF, Enc, Str) + end, + {dots, 3, 3, More}; +print_length_fields([Def | Defs], D, T, Tuple, I, RF, Enc, Str) -> + E = element(I, Tuple), + T1 = tsub(T, 1), + Field1 = print_length_field(Def, D - 1, T1, E, RF, Enc, Str), + {_, Len1, _, _} = Field1, + T2 = tsub(T1, Len1), + [Field1 | + print_length_fields(Defs, D - 1, T2, Tuple, I + 1, RF, Enc, Str)]. + +print_length_field(Def, D, T, E, RF, Enc, Str) -> + Name = write_atom(Def, Enc), + NameL = io_lib:chars_length(Name) + 3, + {_, Len, Dots, _} = + Field = print_length(E, D, tsub(T, NameL), RF, Enc, Str), + {{field, Name, NameL, Field}, NameL + Len, Dots, no_more}. + +print_length_list(List, D, T, RF, Enc, Str) -> + L = print_length_list1(List, D, tsub(T, 2), RF, Enc, Str), + {Len, Dots} = list_length(L, 2, 0), + {{list, L}, Len, Dots, no_more}. + +print_length_list1([], _D, _T, _RF, _Enc, _Str) -> + []; +print_length_list1(Term, D, T, RF, Enc, Str) when D =:= 1; T =:= 0 -> + More = fun(T1, Dd) -> ?FUNCTION_NAME(Term, D + Dd, T1, RF, Enc, Str) end, + {dots, 3, 3, More}; +print_length_list1([E | Es], D, T, RF, Enc, Str) -> + {_, Len1, _, _} = Elem1 = print_length(E, D - 1, tsub(T, 1), RF, Enc, Str), + [Elem1 | print_length_list1(Es, D - 1, tsub(T, Len1 + 1), RF, Enc, Str)]; +print_length_list1(E, D, T, RF, Enc, Str) -> + print_length(E, D - 1, T, RF, Enc, Str). + +list_length([], Acc, DotsAcc) -> + {Acc, DotsAcc}; +list_length([{_, Len, Dots, _} | Es], Acc, DotsAcc) -> + list_length_tail(Es, Acc + Len, DotsAcc + Dots); +list_length({_, Len, Dots, _}, Acc, DotsAcc) -> + {Acc + Len, DotsAcc + Dots}. + +list_length_tail([], Acc, DotsAcc) -> + {Acc, DotsAcc}; +list_length_tail([{_, Len, Dots, _} | Es], Acc, DotsAcc) -> + list_length_tail(Es, Acc + 1 + Len, DotsAcc + Dots); +list_length_tail({_, Len, Dots, _}, Acc, DotsAcc) -> + {Acc + 1 + Len, DotsAcc + Dots}. + +%% ?CHARS printable characters has depth 1. +-define(CHARS, 4). + +%% only flat lists are "printable" +printable_list(_L, 1, _T, _Enc) -> + false; +printable_list(L, _D, T, latin1) when T < 0 -> + io_lib:printable_latin1_list(L); +printable_list(L, _D, T, latin1) when T >= 0 -> + N = tsub(T, 2), + case printable_latin1_list(L, N) of + all -> + true; + 0 -> + {L1, _} = lists:split(N, L), + {true, L1}; + _NC -> + false + end; +printable_list(L, _D, T, _Unicode) when T >= 0 -> + N = tsub(T, 2), + %% Be careful not to traverse more of L than necessary. + try string:slice(L, 0, N) of + "" -> + false; + Prefix -> + case is_flat(L, lists:flatlength(Prefix)) of + true -> + case string:equal(Prefix, L) of + true -> + io_lib:printable_list(L); + false -> + io_lib:printable_list(Prefix) + andalso {true, Prefix} + end; + false -> + false + end + catch _:_ -> false + end; +printable_list(L, _D, T, _Uni) when T < 0 -> + io_lib:printable_list(L). + +is_flat(_L, 0) -> + true; +is_flat([C | Cs], N) when is_integer(C) -> + is_flat(Cs, N - 1); +is_flat(_, _N) -> + false. + +printable_bin0(Bin, D, T, Enc) -> + Len = case D >= 0 of + true -> + %% Use byte_size() also if Enc =/= latin1. + DChars = erlang:min(?CHARS * D, byte_size(Bin)), + case T >= 0 of + true -> + erlang:min(T, DChars); + false -> + DChars + end; + false when T < 0 -> + byte_size(Bin); + false when T >= 0 -> % cannot happen + T + end, + printable_bin(Bin, Len, D, Enc). + +printable_bin(_Bin, 0, _D, _Enc) -> + false; +printable_bin(Bin, Len, D, latin1) -> + N = erlang:min(20, Len), + L = binary_to_list(Bin, 1, N), + case printable_latin1_list(L, N) of + all when N =:= byte_size(Bin) -> + {true, L}; + all when N =:= Len -> % N < byte_size(Bin) + {true, true, L}; + all -> + case printable_bin1(Bin, 1 + N, Len - N) of + 0 when byte_size(Bin) =:= Len -> + {true, binary_to_list(Bin)}; + NC when D > 0, Len - NC >= D -> + {true, true, binary_to_list(Bin, 1, Len - NC)}; + NC when is_integer(NC) -> + false + end; + NC when is_integer(NC), D > 0, N - NC >= D -> + {true, true, binary_to_list(Bin, 1, N - NC)}; + NC when is_integer(NC) -> + false + end; +printable_bin(Bin, Len, D, _Uni) -> + case valid_utf8(Bin, Len) of + true -> + case printable_unicode(Bin, Len, [], io:printable_range()) of + {_, <<>>, L} -> + {byte_size(Bin) =:= length(L), L}; + {NC, Bin1, L} when D > 0, Len - NC >= D -> + {byte_size(Bin) - byte_size(Bin1) =:= length(L), true, L}; + {_NC, _Bin, _L} -> + false + end; + false -> + printable_bin(Bin, Len, D, latin1) + end. + +printable_bin1(_Bin, _Start, 0) -> + 0; +printable_bin1(Bin, Start, Len) -> + N = erlang:min(10000, Len), + L = binary_to_list(Bin, Start, Start + N - 1), + case printable_latin1_list(L, N) of + all -> + printable_bin1(Bin, Start + N, Len - N); + NC when is_integer(NC) -> + Len - (N - NC) + end. + +%% -> all | integer() >=0. Adopted from io_lib.erl. +printable_latin1_list([_ | _], 0) -> 0; +printable_latin1_list([C | Cs], N) when C >= $\s, C =< $~ -> + printable_latin1_list(Cs, N - 1); +printable_latin1_list([C | Cs], N) when C >= $\240, C =< $\377 -> + printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\n | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\r | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\t | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\v | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\b | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\f | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([$\e | Cs], N) -> printable_latin1_list(Cs, N - 1); +printable_latin1_list([], _) -> all; +printable_latin1_list(_, N) -> N. + +valid_utf8(<<>>, _) -> + true; +valid_utf8(_, 0) -> + true; +valid_utf8(<<_/utf8, R/binary>>, N) -> + valid_utf8(R, N - 1); +valid_utf8(_, _) -> + false. + +printable_unicode(<> = Bin, I, L, Range) when I > 0 -> + case printable_char(C, Range) of + true -> + printable_unicode(R, I - 1, [C | L], Range); + false -> + {I, Bin, lists:reverse(L)} + end; +printable_unicode(Bin, I, L, _) -> + {I, Bin, lists:reverse(L)}. + +printable_char($\n, _) -> true; +printable_char($\r, _) -> true; +printable_char($\t, _) -> true; +printable_char($\v, _) -> true; +printable_char($\b, _) -> true; +printable_char($\f, _) -> true; +printable_char($\e, _) -> true; +printable_char(C, latin1) -> + C >= $\s andalso C =< $~ orelse + C >= 16#A0 andalso C =< 16#FF; +printable_char(C, unicode) -> + C >= $\s andalso C =< $~ orelse + C >= 16#A0 andalso C < 16#D800 orelse + C > 16#DFFF andalso C < 16#FFFE orelse + C > 16#FFFF andalso C =< 16#10FFFF. + +write_atom(A, latin1) -> + io_lib:write_atom_as_latin1(A); +write_atom(A, _Uni) -> + io_lib:write_atom(A). + +write_string(S, latin1) -> + io_lib:write_latin1_string(S, $"); %" +write_string(S, _Uni) -> + io_lib:write_string(S, $"). %" + +expand({_, _, _Dots = 0, no_more} = If, _T, _Dd) -> If; +expand({{tuple, IsTagged, L}, _Len, _, no_more}, T, Dd) -> + {NL, NLen, NDots} = expand_list(L, T, Dd, 2), + {{tuple, IsTagged, NL}, NLen, NDots, no_more}; +expand({{map, Pairs}, _Len, _, no_more}, T, Dd) -> + {NPairs, NLen, NDots} = expand_list(Pairs, T, Dd, 3), + {{map, NPairs}, NLen, NDots, no_more}; +expand({{map_pair, K, V}, _Len, _, no_more}, T, Dd) -> + {_, KL, KD, _} = P1 = expand(K, tsub(T, 1), Dd), + KL1 = KL + 4, + {_, VL, VD, _} = P2 = expand(V, tsub(T, KL1), Dd), + {{map_pair, P1, P2}, KL1 + VL, KD + VD, no_more}; +expand({{record, [{Name, NameL} | L]}, _Len, _, no_more}, T, Dd) -> + {NL, NLen, NDots} = expand_list(L, T, Dd, NameL + 2), + {{record, [{Name, NameL} | NL]}, NLen, NDots, no_more}; +expand({{field, Name, NameL, Field}, _Len, _, no_more}, T, Dd) -> + F = {_S, L, Dots, _} = expand(Field, tsub(T, NameL), Dd), + {{field, Name, NameL, F}, NameL + L, Dots, no_more}; +expand({_, _, _, More}, T, Dd) -> + More(T, Dd). + +expand_list(Ifs, T, Dd, L0) -> + L = expand_list(Ifs, tsub(T, L0), Dd), + {Len, Dots} = list_length(L, L0, 0), + {L, Len, Dots}. + +expand_list([], _T, _Dd) -> + []; +expand_list([If | Ifs], T, Dd) -> + {_, Len1, _, _} = Elem1 = expand(If, tsub(T, 1), Dd), + [Elem1 | expand_list(Ifs, tsub(T, Len1 + 1), Dd)]; +expand_list({_, _, _, More}, T, Dd) -> + More(T, Dd). + +%% Make sure T does not change sign. +tsub(T, _) when T < 0 -> T; +tsub(T, E) when T >= E -> T - E; +tsub(_, _) -> 0. + +%% Throw 'no_good' if the indentation exceeds half the line length +%% unless there is room for M characters on the line. + +cind({_S, Len, _, _}, Col, Ll, M, Ind, LD, W) when Len < Ll - Col - LD, + Len + W + LD =< M -> + Ind; +cind({{list, L}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> + cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1); +cind({{tuple, true, L}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> + cind_tag_tuple(L, Col, Ll, M, Ind, LD, W + 1); +cind({{tuple, false, L}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> + cind_list(L, Col + 1, Ll, M, Ind, LD, W + 1); +cind({{map, Pairs}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> + cind_map(Pairs, Col + 2, Ll, M, Ind, LD, W + 2); +cind({{record, [{_Name, NLen} | L]}, _Len, _, _}, Col, Ll, M, Ind, LD, W) -> + cind_record(L, NLen, Col, Ll, M, Ind, LD, W + NLen + 1); +cind({{bin, _S}, _Len, _, _}, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind; +cind({_S, _Len, _, _}, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind. + +cind_tag_tuple([{_Tag, Tlen, _, _} | L], Col, Ll, M, Ind, LD, W) -> + TagInd = Tlen + 2, + Tcol = Col + TagInd, + if + Ind > 0, TagInd > Ind -> + Col1 = Col + Ind, + if + M + Col1 =< Ll; Col1 =< Ll div 2 -> + cind_tail(L, Col1, Tcol, Ll, M, Ind, LD, W + Tlen); + true -> + throw(no_good) + end; + M + Tcol < Ll; Tcol < Ll div 2 -> + cind_list(L, Tcol, Ll, M, Ind, LD, W + Tlen + 1); + true -> + throw(no_good) + end. + +cind_map([P | Ps], Col, Ll, M, Ind, LD, W) -> + PW = cind_pair(P, Col, Ll, M, Ind, last_depth(Ps, LD), W), + cind_pairs_tail(Ps, Col, Col + PW, Ll, M, Ind, LD, W + PW); +cind_map(_, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind. % cannot happen + +cind_pairs_tail([{_, Len, _, _} = P | Ps], Col0, Col, Ll, M, Ind, LD, W) -> + LD1 = last_depth(Ps, LD), + ELen = 1 + Len, + if + LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_PAIR(P); + LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_PAIR(P) -> + cind_pairs_tail(Ps, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen); + true -> + PW = cind_pair(P, Col0, Ll, M, Ind, LD1, 0), + cind_pairs_tail(Ps, Col0, Col0 + PW, Ll, M, Ind, LD, PW) + end; +cind_pairs_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind. + +cind_pair({{map_pair, _Key, _Value}, Len, _, _} = Pair, Col, Ll, M, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M -> + if + ?ATM_PAIR(Pair) -> + Len; + true -> + Ll + end; +cind_pair({{map_pair, K, V}, _Len, _, _}, Col0, Ll, M, Ind, LD, W0) -> + cind(K, Col0, Ll, M, Ind, LD, W0), + I = map_value_indent(Ind), + cind(V, Col0 + I, Ll, M, Ind, LD, 0), + Ll. + +map_value_indent(TInd) -> + case TInd > 0 of + true -> + TInd; + false -> + 4 + end. + +cind_record([F | Fs], Nlen, Col0, Ll, M, Ind, LD, W0) -> + Nind = Nlen + 1, + {Col, W} = cind_rec(Nind, Col0, Ll, M, Ind, W0), + FW = cind_field(F, Col, Ll, M, Ind, last_depth(Fs, LD), W), + cind_fields_tail(Fs, Col, Col + FW, Ll, M, Ind, LD, W + FW); +cind_record(_, _Nlen, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind. + +cind_fields_tail([{_, Len, _, _} = F | Fs], Col0, Col, Ll, M, Ind, LD, W) -> + LD1 = last_depth(Fs, LD), + ELen = 1 + Len, + if + LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM_FLD(F); + LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM_FLD(F) -> + cind_fields_tail(Fs, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen); + true -> + FW = cind_field(F, Col0, Ll, M, Ind, LD1, 0), + cind_fields_tail(Fs, Col0, Col + FW, Ll, M, Ind, LD, FW) + end; +cind_fields_tail(_, _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind. + +cind_field({{field, _N, _NL, _F}, Len, _, _} = Fl, Col, Ll, M, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M -> + if + ?ATM_FLD(Fl) -> + Len; + true -> + Ll + end; +cind_field({{field, _Name, NameL, F}, _Len, _, _}, Col0, Ll, M, Ind, LD, W0) -> + {Col, W} = cind_rec(NameL, Col0, Ll, M, Ind, W0 + NameL), + cind(F, Col, Ll, M, Ind, LD, W), + Ll. + +cind_rec(RInd, Col0, Ll, M, Ind, W0) -> + Nl = (Ind > 0) and (RInd > Ind), + DCol = case Nl of + true -> Ind; + false -> RInd + end, + Col = Col0 + DCol, + if + M + Col =< Ll; Col =< Ll div 2 -> + W = case Nl of + true -> 0; + false -> W0 + end, + {Col, W}; + true -> + throw(no_good) + end. + +cind_list({dots, _, _, _}, _Col0, _Ll, _M, Ind, _LD, _W) -> + Ind; +cind_list([E | Es], Col0, Ll, M, Ind, LD, W) -> + WE = cind_element(E, Col0, Ll, M, Ind, last_depth(Es, LD), W), + cind_tail(Es, Col0, Col0 + WE, Ll, M, Ind, LD, W + WE). + +cind_tail([], _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind; +cind_tail([{_, Len, _, _} = E | Es], Col0, Col, Ll, M, Ind, LD, W) -> + LD1 = last_depth(Es, LD), + ELen = 1 + Len, + if + LD1 =:= 0, ELen + 1 < Ll - Col, W + ELen + 1 =< M, ?ATM(E); + LD1 > 0, ELen < Ll - Col - LD1, W + ELen + LD1 =< M, ?ATM(E) -> + cind_tail(Es, Col0, Col + ELen, Ll, M, Ind, LD, W + ELen); + true -> + WE = cind_element(E, Col0, Ll, M, Ind, LD1, 0), + cind_tail(Es, Col0, Col0 + WE, Ll, M, Ind, LD, WE) + end; +cind_tail({dots, _, _, _}, _Col0, _Col, _Ll, _M, Ind, _LD, _W) -> + Ind; +cind_tail({_, Len, _, _} = E, _Col0, Col, Ll, M, Ind, LD, W) + when Len + 1 < Ll - Col - (LD + 1), + Len + 1 + W + (LD + 1) =< M, + ?ATM(E) -> + Ind; +cind_tail(E, _Col0, Col, Ll, M, Ind, LD, _W) -> + cind(E, Col, Ll, M, Ind, LD + 1, 0). + +cind_element({_, Len, _, _} = E, Col, Ll, M, _Ind, LD, W) + when Len < Ll - Col - LD, Len + W + LD =< M, ?ATM(E) -> + Len; +cind_element(E, Col, Ll, M, Ind, LD, W) -> + cind(E, Col, Ll, M, Ind, LD, W), + Ll. + +last_depth([_ | _], _LD) -> + 0; +last_depth(_, LD) -> + LD + 1. + +while_fail([], _F, V) -> + V; +while_fail([A | As], F, V) -> + try F(A) catch _ -> while_fail(As, F, V) end. + +%% make a string of N spaces +indent(N) when is_integer(N), N > 0 -> + chars($\s, N - 1). + +%% prepend N spaces onto Ind +indent(1, Ind) -> % Optimization of common case + [$\s | Ind]; +indent(4, Ind) -> % Optimization of common case + S2 = [$\s, $\s], + [S2, S2 | Ind]; +indent(N, Ind) when is_integer(N), N > 0 -> + [chars($\s, N) | Ind]. + +%% A deep version of string:chars/2 +chars(_C, 0) -> + []; +chars(C, 2) -> + [C, C]; +chars(C, 3) -> + [C, C, C]; +chars(C, N) when (N band 1) =:= 0 -> + S = chars(C, N bsr 1), + [S | S]; +chars(C, N) -> + S = chars(C, N bsr 1), + [C, S | S]. + +get_option(Key, TupleList, Default) -> + case lists:keyfind(Key, 1, TupleList) of + false -> Default; + {Key, Value} -> Value; + _ -> Default + end.