Skip to content

unicode line folding #1

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
l wants to merge 4 commits into
base: master
Choose a base branch
from
Open

unicode line folding #1

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
61a28e4
unicode line folding
May 23, 2012
7e84965
fix typo
May 23, 2012
9a7d97d
use Unicode::LineBreak for calculating min column width
May 25, 2012
e9c290d
add test cases with CJK text, revert SYNOPSIS
Jun 21, 2014
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
93 changes: 33 additions & 60 deletions lib/Text/FormatTable.pm
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,10 @@ use Carp;
use strict;
use warnings;
use vars qw($VERSION);
use Unicode::GCString;
use Unicode::LineBreak;
use Text::LineFold;
use Encode;

$VERSION = '1.03';

Expand Down Expand Up @@ -32,24 +36,39 @@ Methods:

=cut

sub _linefold_columns_min {
my $str = shift;
my $min;
my $lb = Unicode::LineBreak->new( ColMax => 1 );
foreach ($lb->break($str)) {
my $l = $_->columns;
$min = $l if not defined $min or $l > $min;
}
return $min ? $min : 1;
}

sub _columns {
my $str = scalar shift;

return 0 if ( !defined $str || $str eq '' );

$str = decode_utf8($str) unless utf8::is_utf8($str);
return Unicode::GCString->new($str)->columns();
}

# Remove ANSI color sequences when calculating length
sub _uncolorized_length($)
{
my $str = shift;
$str =~ s/\e \[ [^m]* m//xmsg;
return length $str;
return _columns $str;
}

# minimal width of $1 if word-wrapped
sub _min_width($)
{
my $str = shift;
my $min;
for my $s (split(/\s+/,$str)) {
my $l = _uncolorized_length $s;
$min = $l if not defined $min or $l > $min;
}
return $min ? $min : 1;
return _linefold_columns_min $str;
}

# width of $1 if not word-wrapped
Expand All @@ -71,63 +90,17 @@ sub _max($$)
sub _wrap($$)
{
my ($width, $text) = @_;
my @lines = split(/\n/, $text);
my @w = ();
for my $l (@lines) {
push @w, @{_wrap_line($width, $l)};
}
my $lf = Text::LineFold->new( ColMax => $width );
@w = split /\n/,
decode_utf8(
$lf->fold(
'', '', utf8::is_utf8($text) ? encode_utf8($text) : $text
)
);
return \@w;
}

sub _wrap_line($$)
{
my ($width, $text) = @_;
my $width_m1 = $width-1;
my @t = ($text);
while(1) {
my $t = pop @t;
my $l = _uncolorized_length $t;
if($l <= $width){
# last line is ok => done
push @t, $t;
return \@t;
}
elsif($t =~ /^(.{0,$width_m1}\S)\s+(\S.*?)$/) {
# farest space < width
push @t, $1;
push @t, $2;
}
elsif($t =~ /(.{$width,}?\S)\s+(\S.*?)$/) {
# nearest space > width
if ( _uncolorized_length $1 > $width_m1 )
{
# hard hyphanation
my $left = substr($1,0,$width);
my $right= substr($1,$width);

push @t, $left;
push @t, $right;
push @t, $2;
}
else
{
push @t, $1;
push @t, $2;
}
}
else {
# hard hyphanation
my $left = substr($t,0,$width);
my $right= substr($t,$width);

push @t, $left;
push @t, $right;
return \@t;
}
}
return \@t;
}

# render left-box $2 with width $1
sub _l_box($$)
{
Expand Down
110 changes: 96 additions & 14 deletions test.pl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -5,6 +5,7 @@

use strict;
use warnings;
use utf8;

{
my $table = Text::FormatTable->new('r| l l');
Expand All @@ -17,20 +18,19 @@
my $is = $table->render(15);

my $shouldbe = <<'END';
a| b c
=================
this a| oh, yep
test,| cool,
a nice| a
test| test!
------+----------
you| yes, z
mean| it
it's| is.
really|
a|
test?|
=================
a| b c
====================
this a| oh, yep
test, a| cool, a
nice| test!
test|
-------+------------
you| yes, it z
mean| is.
it's|
really|
a test?|
====================
END

ok($is, $shouldbe);
Expand Down Expand Up @@ -72,3 +72,85 @@ END
my $output = $table->render();
ok(not defined $warning);
}

# line folding using Text::LineFold
{
my @format = (' 14l ', ' 20L ', ' 30r ', ' 40R ');
my $table = Text::FormatTable->new( '|' . ( join '|', @format ) . '|' );
my @text = ();
push @text,
q(This document is intended to give you a quick overview of the Perl programming language, along with pointers to further documentation. It is intended as a "bootstrap" guide for those who are new to the language, and provides just enough information for you to be able to read other peoples' Perl and understand roughly what it's doing, or write your own simple scripts.);
push @text,
q(この文書は Perl プログラミング言語の簡単な概要を伝えて、更なる 文書へのポインタを示すことを目的としています。 これはこの言語を知らない人のためへの「自習」ガイドを目的としていて、 他の人の Perl を読んで何をしているかを大まかに理解したり、 自分自身で簡単なスクリプトを書くことができるようになるために 十分な情報を提供しています。);
$table->rule('-');
$table->head(@format);
foreach my $text (@text) {
$table->rule('-');
$table->row( map { $text } ( 0 .. $#format ) );
}
$table->rule('-');
my $is = $table->render();
my $shouldbe = <<'END';
+----------------+----------------------+--------------------------------+------------------------------------------+
| 14l | 20L | 30r | 40R |
+----------------+----------------------+--------------------------------+------------------------------------------+
| This document | | This document is intended to | |
| is intended to | | give you a quick overview of | |
| give you a | | the Perl programming language, | |
| quick overview | | along with pointers to further | |
| of the Perl | | documentation. It is intended | |
| programming | | as a "bootstrap" guide for | |
| language, | | those who are new to the | |
| along with | | language, and provides just | |
| pointers to | | enough information for you to | |
| further | | be able to read other peoples' | |
| documentation. | | Perl and understand roughly | |
| It is intended | This document is | what it's doing, or write your | |
| as a | intended to give you | own simple scripts. | |
| "bootstrap" | a quick overview of | | |
| guide for | the Perl programming | | |
| those who are | language, along with | | |
| new to the | pointers to further | | |
| language, and | documentation. It is | | |
| provides just | intended as a | | |
| enough | "bootstrap" guide | | |
| information | for those who are | | |
| for you to be | new to the language, | | This document is intended to give you a |
| able to read | and provides just | | quick overview of the Perl programming |
| other peoples' | enough information | | language, along with pointers to further |
| Perl and | for you to be able | | documentation. It is intended as a |
| understand | to read other | | "bootstrap" guide for those who are new |
| roughly what | peoples' Perl and | | to the language, and provides just |
| it's doing, or | understand roughly | | enough information for you to be able to |
| write your own | what it's doing, or | | read other peoples' Perl and understand |
| simple | write your own | | roughly what it's doing, or write your |
| scripts. | simple scripts. | | own simple scripts. |
+----------------+----------------------+--------------------------------+------------------------------------------+
| この文書は | | この文書は Perl プログラミング | |
| Perl プログラ | | 言語の簡単な概要を伝えて、更な | |
| ミング言語の簡 | | る 文書へのポインタを示すこと | |
| 単な概要を伝え | | を目的としています。 これはこ | |
| て、更なる 文 | | の言語を知らない人のためへの | |
| 書へのポインタ | | 「自習」ガイドを目的としてい | |
| を示すことを目 | | て、 他の人の Perl を読んで何 | |
| 的としていま | この文書は Perl プロ | をしているかを大まかに理解した | |
| す。 これはこ | グラミング言語の簡単 | り、 自分自身で簡単なスクリプ | |
| の言語を知らな | な概要を伝えて、更な | トを書くことができるようになる | |
| い人のためへの | る 文書へのポインタ | ために 十分な情報を提供してい | |
| 「自習」ガイド | を示すことを目的とし | ます。 | |
| を目的としてい | ています。 これはこ | | |
| て、 他の人の | の言語を知らない人の | | |
| Perl を読んで | ためへの「自習」ガイ | | |
| 何をしているか | ドを目的としていて、 | | この文書は Perl プログラミング言語の簡単 |
| を大まかに理解 | 他の人の Perl を読ん | | な概要を伝えて、更なる 文書へのポインタ |
| したり、 自分 | で何をしているかを大 | | を示すことを目的としています。 これはこ |
| 自身で簡単なス | まかに理解したり、 | | の言語を知らない人のためへの「自習」ガイ |
| クリプトを書く | 自分自身で簡単なスク | | ドを目的としていて、 他の人の Perl を読 |
| ことができるよ | リプトを書くことがで | | んで何をしているかを大まかに理解したり、 |
| うになるために | きるようになるために | | 自分自身で簡単なスクリプトを書くことがで |
| 十分な情報を提 | 十分な情報を提供して | | きるようになるために 十分な情報を提供し |
| 供しています。 | います。 | | ています。 |
+----------------+----------------------+--------------------------------+------------------------------------------+
END
ok( $is, $shouldbe );
}