133 lines
2.9 KiB
Perl
133 lines
2.9 KiB
Perl
|
package Text::Wrap;
|
||
|
|
|
||
|
|
use warnings::register;
|
||
|
|
require Exporter;
|
||
|
|
|
||
|
|
@ISA = qw(Exporter);
|
||
|
|
@EXPORT = qw(wrap fill);
|
||
|
|
@EXPORT_OK = qw($columns $break $huge);
|
||
|
|
|
||
|
|
$VERSION = 2013.0523;
|
||
|
|
$SUBVERSION = 'modern';
|
||
|
|
|
||
|
|
use 5.010_000;
|
||
|
|
|
||
|
|
use vars qw($VERSION $SUBVERSION $columns $debug $break $huge $unexpand $tabstop $separator $separator2);
|
||
|
|
use strict;
|
||
|
|
|
||
|
|
BEGIN {
|
||
|
|
$columns = 76; # <= screen width
|
||
|
|
$debug = 0;
|
||
|
|
$break = '(?=\s)\X';
|
||
|
|
$huge = 'wrap'; # alternatively: 'die' or 'overflow'
|
||
|
|
$unexpand = 1;
|
||
|
|
$tabstop = 8;
|
||
|
|
$separator = "\n";
|
||
|
|
$separator2 = undef;
|
||
|
|
}
|
||
|
|
|
||
|
|
my $CHUNK = qr/\X/;
|
||
|
|
|
||
|
|
sub _xlen(_) { scalar(() = $_[0] =~ /$CHUNK/g) }
|
||
|
|
|
||
|
|
sub _xpos(_) { _xlen( substr( $_[0], 0, pos($_[0]) ) ) }
|
||
|
|
|
||
|
|
use Text::Tabs qw(expand unexpand);
|
||
|
|
|
||
|
|
sub wrap
|
||
|
|
{
|
||
|
|
my ($ip, $xp, @t) = @_;
|
||
|
|
|
||
|
|
local($Text::Tabs::tabstop) = $tabstop;
|
||
|
|
my $r = "";
|
||
|
|
my $tail = pop(@t);
|
||
|
|
my $t = expand(join("", (map { /\s+\z/ ? ( $_ ) : ($_, ' ') } @t), $tail));
|
||
|
|
my $lead = $ip;
|
||
|
|
my $nll = $columns - _xlen(expand($xp)) - 1;
|
||
|
|
if ($nll <= 0 && $xp ne '') {
|
||
|
|
my $nc = _xlen(expand($xp)) + 2;
|
||
|
|
warnings::warnif "Increasing \$Text::Wrap::columns from $columns to $nc to accommodate length of subsequent tab";
|
||
|
|
$columns = $nc;
|
||
|
|
$nll = 1;
|
||
|
|
}
|
||
|
|
my $ll = $columns - _xlen(expand($ip)) - 1;
|
||
|
|
$ll = 0 if $ll < 0;
|
||
|
|
my $nl = "";
|
||
|
|
my $remainder = "";
|
||
|
|
|
||
|
|
use re 'taint';
|
||
|
|
|
||
|
|
pos($t) = 0;
|
||
|
|
while ($t !~ /\G(?:$break)*\Z/gc) {
|
||
|
|
if ($t =~ /\G((?:(?=[^\n])\X){0,$ll})($break|\n+|\z)/xmgc) {
|
||
|
|
$r .= $unexpand
|
||
|
|
? unexpand($nl . $lead . $1)
|
||
|
|
: $nl . $lead . $1;
|
||
|
|
$remainder = $2;
|
||
|
|
} elsif ($huge eq 'wrap' && $t =~ /\G((?:(?=[^\n])\X){$ll})/gc) {
|
||
|
|
$r .= $unexpand
|
||
|
|
? unexpand($nl . $lead . $1)
|
||
|
|
: $nl . $lead . $1;
|
||
|
|
$remainder = defined($separator2) ? $separator2 : $separator;
|
||
|
|
} elsif ($huge eq 'overflow' && $t =~ /\G((?:(?=[^\n])\X)*?)($break|\n+|\z)/xmgc) {
|
||
|
|
$r .= $unexpand
|
||
|
|
? unexpand($nl . $lead . $1)
|
||
|
|
: $nl . $lead . $1;
|
||
|
|
$remainder = $2;
|
||
|
|
} elsif ($huge eq 'die') {
|
||
|
|
die "couldn't wrap '$t'";
|
||
|
|
} elsif ($columns < 2) {
|
||
|
|
warnings::warnif "Increasing \$Text::Wrap::columns from $columns to 2";
|
||
|
|
$columns = 2;
|
||
|
|
return ($ip, $xp, @t);
|
||
|
|
} else {
|
||
|
|
die "This shouldn't happen";
|
||
|
|
}
|
||
|
|
|
||
|
|
$lead = $xp;
|
||
|
|
$ll = $nll;
|
||
|
|
$nl = defined($separator2)
|
||
|
|
? ($remainder eq "\n"
|
||
|
|
? "\n"
|
||
|
|
: $separator2)
|
||
|
|
: $separator;
|
||
|
|
}
|
||
|
|
$r .= $remainder;
|
||
|
|
|
||
|
|
print "-----------$r---------\n" if $debug;
|
||
|
|
|
||
|
|
print "Finish up with '$lead'\n" if $debug;
|
||
|
|
|
||
|
|
my($opos) = pos($t);
|
||
|
|
|
||
|
|
$r .= $lead . substr($t, pos($t), length($t) - pos($t))
|
||
|
|
if pos($t) ne length($t);
|
||
|
|
|
||
|
|
print "-----------$r---------\n" if $debug;;
|
||
|
|
|
||
|
|
return $r;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub fill
|
||
|
|
{
|
||
|
|
my ($ip, $xp, @raw) = @_;
|
||
|
|
my @para;
|
||
|
|
my $pp;
|
||
|
|
|
||
|
|
for $pp (split(/\n\s+/, join("\n",@raw))) {
|
||
|
|
$pp =~ s/\s+/ /g;
|
||
|
|
my $x = wrap($ip, $xp, $pp);
|
||
|
|
push(@para, $x);
|
||
|
|
}
|
||
|
|
|
||
|
|
# if paragraph_indent is the same as line_indent,
|
||
|
|
# separate paragraphs with blank lines
|
||
|
|
|
||
|
|
my $ps = ($ip eq $xp) ? "\n\n" : "\n";
|
||
|
|
return join ($ps, @para);
|
||
|
|
}
|
||
|
|
|
||
|
|
1;
|
||
|
|
__END__
|
||
|
|
|