## core-prettyprinter-box-formatting-policies-g.pkg
#
# Formatting text is an art dominated by esthetics and
# formatting code is doubly do; it is rare for any two
# people to agree on how it should be done.
#
# Consequently we try to isolate the policy decisions
# of formatting from the mechanisms needed to implement
# them, and allow client coders to provide their own
# policies.
#
# This file contains the canned policies we provide.
# Compiled by:
# src/lib/prettyprint/big/prettyprinter.libstipulate
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package l2s = list_to_string; # list_to_string is from src/lib/src/list-to-string.pkgherein
# This generic is invoked (only) from
#
# src/lib/prettyprint/big/src/core-prettyprinter-g.pkg #
generic package core_prettyprinter_box_formatting_policies_g ( #
# ===============================================
# # "tt" == "traitful text"
package typ: Core_Prettyprinter_Types; # Core_Prettyprinter_Types is from src/lib/prettyprint/big/src/core-prettyprinter-types.api # core_prettyprinter_types_g is from src/lib/prettyprint/big/src/core-prettyprinter-types-g.pkg package dbg: # core_prettyprinter_debug_g is from src/lib/prettyprint/big/src/core-prettyprinter-debug-g.pkg api {
left_margin_is_to_string: typ::Left_Margin_Is -> String;
phase1_token_to_string: typ::Phase1_Token -> String;
phase1_tokens_to_string: List(typ::Phase1_Token) -> String;
prettyprint_prettyprinter: (fil::Output_Stream, typ::Prettyprinter) -> Void;
};
too_long: Int;
)
{
debug_prints = FALSE; # When debugging I usually just replace debug_prints by *log::debugging throughout this file.
# Usually you'll want to do the same in src/lib/prettyprint/big/src/core-prettyprinter-g.pkg # Note that with debug_prints==FALSE, 'if debug_prints ... fi;' will optimize to no code produced courtesy of dead-code removal.
Break_Policy
#
= NONE # All on one line -- break never rendered as newline.
| ALL # One line each -- every break rendered as newline.
| ALL_OR_NONE # NONE if it fits, else ALL.
| AS_NEEDED # Normal wordwrap: break rendered as newline only when necessary.
;
fun nblanks n
=
string::implode (map (\\ _ = ' ') (1 .. n));
fun count_breaks [] => 0;
count_breaks (typ::BREAK _ ! rest) => 1 + count_breaks rest;
count_breaks ( _ ! rest) => 0 + count_breaks rest;
end;
fun tablen (column, { tab_to, tabstops_are_every }) # We are at (zero-based) 'column' and tabstops are set
= # every 'tabstop_are_every' chars. What is the minimum number
if (tabstops_are_every <= 0 # of blanks to print to make (column % tabstop) == tab_to?
or tab_to < 0
or tab_to >= tabstops_are_every)
0;
else
((tab_to + tabstops_are_every) - (column % tabstops_are_every)) % tabstops_are_every; # Phrased to avoid negative numbers because the behavior of '%' is not well-defined for them.
fi;
fun breaklen (column', { blanks, tab_to, tabstops_are_every }) # Compute length of break.
=
{ column = column' + blanks;
column = column + tablen (column, { tab_to, tabstops_are_every });
column - column';
};
# Given the list of tokens in a BOX,
# wrap either all BREAKs or none of them.
#
# Any embedded boxes have already been
# wrap_box()'d, so they have valid values
# for actual_width and is_multiline.
#
fun wrap_box_contents_all_or_none
#
wrap_policy # Which BREAKs should we wrap? One of ALL, NONE, ALL_OR_NONE.
{
target_width, # Target width for this box.
box_contents => tokens # List of tokens in this box.
}
=
{
if debug_prints
printf "wrap_box_contents_all_or_none: target_width d=%d, %d tokens: %s -- wrap_box_contents_all_or_none/TOP in prettyprinter-g.pkg\n"
target_width (list::length tokens) (dbg::phase1_tokens_to_string tokens);
fi;
box_is_multiline = REF FALSE;
actual_width = REF 0;
column = 0; # Current column, relative to box left margin
#
wrap_them # Should we wrap all BREAKs, or none or them?
=
case wrap_policy
#
ALL => TRUE;
NONE => FALSE;
ALL_OR_NONE
=>
{ unwrapped_length
=
total_length (tokens, 0)
where
fun total_length' (tokens, column)
=
{
if debug_prints
printf "total_length: column d=%d tokens==%s\n" column (dbg::phase1_tokens_to_string tokens);
fi;
total_length (tokens, column);
}
also
fun total_length ([], column) => column;
#
total_length (((typ::LIT s) ! rest), column) => total_length' (rest, column + string::length_in_bytes s );
total_length (((typ::ENDLIT s) ! rest), column) => total_length' (rest, column + string::length_in_bytes s );
total_length (((typ::TAB t) ! rest), column) => total_length' (rest, column + breaklen (0, t) );
total_length (((typ::BREAK b) ! rest), column) => total_length' (rest, column + breaklen(column, b.ifnotwrap));
total_length ([ typ::BOX box ], column)
=>
{
if debug_prints
printf "[box] case: column=%d *box.is_multiline=%B *box.actual_width=%d left_margin_is=%s\n" column *box.is_multiline *box.actual_width (dbg::left_margin_is_to_string box.left_margin_is);
fi;
case box.left_margin_is
#
typ::CURSOR_RELATIVE _ => column + *box.actual_width; # Multiline is potentially OK when it is last in line and a cbox.
typ::BOX_RELATIVE _ => if *box.is_multiline too_long;
else column + *box.actual_width;
fi;
esac;
};
total_length (((typ::BOX box) ! rest), column)
=>
if *box.is_multiline too_long;
else total_length' (rest, column + *box.actual_width);
fi;
total_length ((_ ! rest), column)
=>
total_length' (rest, column);
end;
end;
if debug_prints
if (unwrapped_length > target_width)
printf "wrap_box_contents_all_or_none: unwrapped_length %d > target_width %d, %d tokens: %s: WE WILL WRAP YOU! -- wrap_box_contents_all_or_none/TOP in prettyprinter-g.pkg\n"
unwrapped_length target_width (list::length tokens) (dbg::phase1_tokens_to_string tokens);
fi;
fi;
unwrapped_length > target_width;
};
AS_NEEDED => raise exception DIE "wrap_box_contents_all_or_none: wrap_policy == AS_NEEDED!?";
esac;
fun per_token ([], column) => column;
#
per_token (tokens as (token ! rest), column)
=>
case token
#
typ::BREAK b
=>
# if (column <= breaklen (0, b.ifwrap) and count_breaks tokens == 1)
#
# per_token (rest, column + breaklen (column, b.ifnotwrap)); # Wrapping won't move us leftward anyhow, so don't even consider it.
# elif wrap_them
if wrap_them
#
if debug_prints
printf "WRAPPING at column %d indent after wrap d=%d -- wrap_box_contents_all_or_none in prettyprinter-g.pkg\n" column (breaklen (0, b.ifwrap));
fi;
if (*actual_width < column) actual_width := column; fi;
b.wrap := TRUE;
box_is_multiline := TRUE;
per_token (rest, breaklen (0, b.ifwrap) );
else
per_token (rest, column + breaklen(column, b.ifnotwrap));
fi;
typ::NEWLINE => { if (*actual_width < column) actual_width := column; fi;
box_is_multiline := TRUE;
per_token (rest, 0);
};
typ::BLANKS i => per_token (rest, column + i );
typ::LIT s => per_token (rest, column + string::length_in_bytes s );
typ::ENDLIT s => per_token (rest, column + string::length_in_bytes s );
typ::TAB t => per_token (rest, column + breaklen(column, t) );
typ::PUSH_TT _ => per_token (rest, column );
typ::POP_TT => per_token (rest, column );
typ::CONTROL _ => per_token (rest, column );
typ::INDENT _ => per_token (rest, column ); # We don't track left margin in this pass.
typ::BOX box => { if(*actual_width < column + *box.actual_width)
actual_width := column + *box.actual_width;
fi;
if *box.is_multiline
box_is_multiline := TRUE;
per_token( rest, 0 );
else
per_token (rest, column + *box.actual_width);
fi;
};
esac;
end; # fun per_token
column = per_token (tokens, column);
if (*actual_width < column) actual_width := column; fi;
{ actual_box_width => *actual_width,
is_multiline => *box_is_multiline
};
}; # fun wrap_box_contents_all_or_none
# Here we implement a conventional word-wrap
# style algorithm where we wrap a line at
# a BREAK iff it is our last chance to avoid
# exceeding our assigned box width.
fun wrap_box_contents_as_needed { target_width, box_contents => tokens }
=
{ column = per_token (tokens, /*column=*/0);
#
if (*actual_width < column) actual_width := column; fi;
{ actual_box_width => *actual_width,
is_multiline => *box_is_multiline
};
}
where
if debug_prints
printf "target_width d=%d, %d tokens -- wrap_box_contents_as_needed in prettyprinter-g.pkg\n" target_width (list::length tokens);
fi;
box_is_multiline = REF FALSE;
actual_width = REF 0;
fun forced_followon_fits_in (tokens, space_left_on_line) # Decide if tokens from here to next break/newline will fit in remaining space on line.
=
fits_in' (tokens, 0)
where
fun fits_in' (tokens, column) # Early-out check: Stop iterating as soon as we know we don't fit.
=
{
if debug_prints
printf "forced_followon_fits_in (column=%d, %d tokens: %s\n" column (list::length tokens) (dbg::phase1_tokens_to_string tokens);
fi;
if (column > space_left_on_line) FALSE;
else fits_in (tokens, column);
fi;
}
also
fun fits_in ([], column) => (column <= space_left_on_line);
#
fits_in ([ typ::BOX { left_margin_is => typ::CURSOR_RELATIVE _, is_multiline => REF TRUE, actual_width => REF width, ... } ], column)
=>
(column + width) <= space_left_on_line; # Multiline box is ok when CURSOR_RELATIVE and last in line.
fits_in (token ! rest, column)
=>
case token
#
typ::BLANKS i => fits_in' (rest, column + i );
typ::LIT s => fits_in' (rest, column + string::length_in_bytes s );
typ::ENDLIT s => fits_in' (rest, column + string::length_in_bytes s );
typ::TAB t => fits_in' (rest, column + breaklen(column, t));
typ::PUSH_TT _ => fits_in' (rest, column );
typ::POP_TT => fits_in' (rest, column );
typ::CONTROL _ => fits_in' (rest, column );
typ::INDENT _ => fits_in' (rest, column );
(typ::NEWLINE | typ::BREAK _ ) => column <= space_left_on_line;
typ::BOX box => if *box.is_multiline FALSE; # Multiline boxes by definition don't fit on one line. :-)
else fits_in' (rest, column + *box.actual_width); # Monoline box, so first line == whole box.
fi;
esac;
end; # fun fits_in
end; # fun forced_followon_fits_in
fun per_token ([], column) => column; # Scan the tokens in a LINE setting BREAKs to wrap as appropriate.
#
per_token (token ! rest, column)
=>
{
if debug_prints
printf "per_token/TOP column d=%d %d tokens = %s) -- wrap_box_contents_as_needed() in prettyprinter-g.pkg\n"
column (list::length (token ! rest)) (dbg::phase1_tokens_to_string (token ! rest));
fi;
case token
typ::PUSH_TT _ => per_token (rest, column );
typ::POP_TT => per_token (rest, column );
typ::CONTROL _ => per_token (rest, column );
typ::INDENT _ => per_token (rest, column ); # We don't track left margin in this pass.
typ::BLANKS i => per_token (rest, column + i );
typ::LIT s => per_token (rest, column + string::length_in_bytes s );
typ::ENDLIT s => per_token (rest, column + string::length_in_bytes s );
typ::TAB t => per_token (rest, column + breaklen(column, t)); # This isn't quite right because 'column' is box-relative but tabstops should be absolute.
# We format boxes innermost first, so at present there's no way to know our absolute column at this point.
# We mostly keep boxes tab-aligned, which should hide this problem most of the time.
typ::NEWLINE => { if (*actual_width < column) actual_width := column; fi;
box_is_multiline := TRUE;
per_token( rest, /*column=*/ 0 );
};
typ::BREAK b => { space_left_on_line = target_width - (column + breaklen (column, b.ifnotwrap));
#
if (column <= breaklen (0, b.ifwrap))
#
per_token (rest, column + breaklen (column, b.ifnotwrap)); # Wrapping won't move us left anyhow, so no point in considering it.
elif (forced_followon_fits_in (rest, space_left_on_line)) # Is next BREAK or NEWLINE beyond right margin of box?
#
per_token (rest, column + breaklen (column, b.ifnotwrap)); # No, treat BREAK as blanks.
else
if debug_prints
printf "WRAPPING at column %d indent-after-wrap d=%d target_width %d space_left_on_line %d -- wrap_box_contents_as_needed in prettyprinter-g.pkg\n"
column (breaklen (0, b.ifwrap)) target_width space_left_on_line;
fi;
if (*actual_width < column) actual_width := column; fi; # Yes, treat BREAK as newline.
b.wrap := TRUE;
box_is_multiline := TRUE;
per_token (rest, /*column=*/ breaklen (0, b.ifwrap));
fi;
};
typ::BOX box => { if(*actual_width < column + *box.actual_width)
actual_width := column + *box.actual_width;
fi;
if *box.is_multiline
box_is_multiline := TRUE;
per_token( rest, 0 ); # Return to left margin after each multiline box. This does the best job of decoupling
else # events inside and outside a box, making for simple predictable behavior.
per_token (rest, column + *box.actual_width);
fi;
};
esac;
};
end; # fun per_token
end; # fun wrap_box_contents_as_needed
};
end;
## COPYRIGHT (c) 2005 John Reppy (http://www.cs.uchicago.edu/~jhr)
## All rights reserved.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.