From a9b65531744f8b2d45cf0b40b8cca8ada14115b7 Mon Sep 17 00:00:00 2001 From: David Mertens Date: Thu, 13 Jun 2013 09:14:15 -0500 Subject: [PATCH 1/9] Make recalc_ymap a bit more legible; remove direct assignment to $_ --- Prima/TextView.pm | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/Prima/TextView.pm b/Prima/TextView.pm index eb2c39626..79b8e7b4b 100644 --- a/Prima/TextView.pm +++ b/Prima/TextView.pm @@ -486,16 +486,20 @@ sub realize_state sub recalc_ymap { my ( $self, $from) = @_; + # if $from is zero or not defined, clear the ymap; otherwise we append + # to what was already calculated. This is optimized for *building* a + # collection of blocks; if you need to change a collection of blocks, + # you should always set from to a false value. $self-> {ymap} = [] unless $from; # ok if $from == 0 my $ymap = $self-> {ymap}; - my ( $i, $lim) = ( defined($from) ? $from : 0, scalar(@{$self-> {blocks}})); - my $b = $self-> {blocks}; + my $blocks = $self-> {blocks}; + my ( $i, $lim) = ( defined($from) ? $from : 0, scalar(@{$blocks})); for ( ; $i < $lim; $i++) { - $_ = $$b[$i]; - my $y1 = $$_[ tb::BLK_Y]; - my $y2 = $$_[ tb::BLK_HEIGHT] + $y1; - for ( int( $y1 / tb::YMAX) .. int ( $y2 / tb::YMAX)) { - push @{$ymap-> [$_]}, $i; + my $block = $$blocks[$i]; + my $y1 = $block->[ tb::BLK_Y]; + my $y2 = $block->[ tb::BLK_HEIGHT] + $y1; + for my $y ( int( $y1 / tb::YMAX) .. int ( $y2 / tb::YMAX)) { + push @{$ymap-> [$y]}, $i; } } } From 790de6f94b76af6ad1a2cf620e20fb8f965f6259 Mon Sep 17 00:00:00 2001 From: David Mertens Date: Thu, 13 Jun 2013 09:26:02 -0500 Subject: [PATCH 2/9] Use named iteration variables in TextView::on_paint --- Prima/TextView.pm | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Prima/TextView.pm b/Prima/TextView.pm index 79b8e7b4b..fa6a61d86 100644 --- a/Prima/TextView.pm +++ b/Prima/TextView.pm @@ -830,10 +830,9 @@ sub on_paint my ( $sx1, $sy1, $sx2, $sy2) = @{$self-> {selection}}; - for ( int( $cy[0] / tb::YMAX) .. int( $cy[1] / tb::YMAX)) { - next unless $self-> {ymap}-> [$_]; - for ( @{$self-> {ymap}-> [$_]}) { - my $j = $_; + for my $ymap_i ( int( $cy[0] / tb::YMAX) .. int( $cy[1] / tb::YMAX)) { + next unless $self-> {ymap}-> [$ymap_i]; + for my $j ( @{$self-> {ymap}-> [$ymap_i]}) { $b = $$bx[$j]; my ( $x, $y) = ( $aa[0] - $offset + $$b[ tb::BLK_X], From a0577a472cca37ca1b84a5afba177a0ff4e76106 Mon Sep 17 00:00:00 2001 From: David Mertens Date: Thu, 13 Jun 2013 10:56:42 -0500 Subject: [PATCH 3/9] Improved error return value handling in TextView's block_draw --- Prima/TextView.pm | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/Prima/TextView.pm b/Prima/TextView.pm index fa6a61d86..76ead8545 100644 --- a/Prima/TextView.pm +++ b/Prima/TextView.pm @@ -938,7 +938,11 @@ sub block_draw $self-> realize_state( $canvas, \@state, tb::REALIZE_COLORS); $c_taint = 1; } - $ret = $canvas-> text_out( substr( $$t, $o + $$b[$i + 1], $$b[$i + 2]), $x, $y); + # Make we ultimately return "fail" if any text_out operation + # in this block fails. XXX if there are multiple failures, $@ + # will only contain the last one. Consider consolidating + # them somehow. + $ret &&= $canvas-> text_out( substr( $$t, $o + $$b[$i + 1], $$b[$i + 2]), $x, $y); } $x += $$b[ $i + 3]; } elsif ( $cmd == tb::OP_FONT) { From edb3e451abf47cb920a6fe5469041c420eae4d89 Mon Sep 17 00:00:00 2001 From: David Mertens Date: Thu, 13 Jun 2013 10:59:04 -0500 Subject: [PATCH 4/9] Added unexpected op handling via an else clause in TextView's block_draw --- Prima/TextView.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Prima/TextView.pm b/Prima/TextView.pm index 76ead8545..88e0eb753 100644 --- a/Prima/TextView.pm +++ b/Prima/TextView.pm @@ -969,6 +969,8 @@ sub block_draw $state[ tb::BLK_COLOR + (($$b[ $i + 1] & tb::BACKCOLOR_FLAG) ? 1 : 0)] = $$b[$i + 1]; $c_taint = undef; + } else { + die("Invalid Prima::TextView block op $cmd\n"); } } From 7669c2123c29b8b97be37cc656b2890798a2a394 Mon Sep 17 00:00:00 2001 From: David Mertens Date: Thu, 13 Jun 2013 18:08:26 -0500 Subject: [PATCH 5/9] Minor comment tweak --- Prima/TextView.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Prima/TextView.pm b/Prima/TextView.pm index 88e0eb753..02bea4ca7 100644 --- a/Prima/TextView.pm +++ b/Prima/TextView.pm @@ -489,7 +489,7 @@ sub recalc_ymap # if $from is zero or not defined, clear the ymap; otherwise we append # to what was already calculated. This is optimized for *building* a # collection of blocks; if you need to change a collection of blocks, - # you should always set from to a false value. + # you should always set $from to a false value. $self-> {ymap} = [] unless $from; # ok if $from == 0 my $ymap = $self-> {ymap}; my $blocks = $self-> {blocks}; From 051c74724f9ff7ec652c2531bd73b5a5eaae8c26 Mon Sep 17 00:00:00 2001 From: David Mertens Date: Thu, 13 Jun 2013 18:08:48 -0500 Subject: [PATCH 6/9] Add SYNOPSIS to TextView --- Prima/TextView.pm | 36 ++++++++++++++++++++++++++++++++++++ 1 file changed, 36 insertions(+) diff --git a/Prima/TextView.pm b/Prima/TextView.pm index 02bea4ca7..eafe72533 100644 --- a/Prima/TextView.pm +++ b/Prima/TextView.pm @@ -1641,6 +1641,42 @@ __END__ Prima::TextView - rich text browser widget +=head1 SYNOPSIS + + use strict; + use warnings; + use Prima qw(TextView Application); + + my $w = Prima::MainWindow-> create( + name => 'TextView example', + ); + + my $t = $w->insert(TextView => + text => 'Hello from TextView!', + pack => { expand => 1, fill => 'both' }, + ); + + # Create a single block that renders all the text using the default font + my $tb = tb::block_create(); + my $text_width_px = $t->get_text_width($t->text); + my $font_height_px = $t->font->height; + $tb->[tb::BLK_WIDTH] = $text_width_px; + $tb->[tb::BLK_HEIGHT] = $font_height_px; + $tb->[tb::BLK_BACKCOLOR] = cl::Back; + $tb->[tb::BLK_FONT_SIZE] = int($font_height_px) + tb::F_HEIGHT; + # Add an operation that draws the text: + push @$tb, tb::text(0, length($t->text), $text_width_px); + + # Set the markup block(s) and recalculate the ymap + $t->{blocks} = [$tb]; + $t->recalc_ymap; + + # Additional step needed for horizontal scroll as well as per-character + # selection: + $t->paneSize($text_width_px, $font_height_px); + + run Prima; + =head1 DESCRIPTION Prima::TextView accepts blocks of formatted text, and provides From 7aa9851277c0ac433ff43a1ebc785b9024dd726b Mon Sep 17 00:00:00 2001 From: David Mertens Date: Fri, 14 Jun 2013 11:43:45 -0500 Subject: [PATCH 7/9] Lightly cleaned up Prima::PodView::read_paragraph Because of the way that PodView matched against the =over pod directive, it was sometimes matching the undefined value against a regex. Such behavior issued this warning: Use of uninitialized value $_ in pattern match This commit lightly revises how the directives are processed. It also removes the non-localized explicit assignment to $_. --- Prima/PodView.pm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Prima/PodView.pm b/Prima/PodView.pm index 43762dd94..ff9d1b8f5 100644 --- a/Prima/PodView.pm +++ b/Prima/PodView.pm @@ -770,8 +770,8 @@ sub read_paragraph } if (s/^=//) { - my $Cmd; - ($Cmd, $_) = split(' ', $_, 2); + my ($Cmd, $args) = split(' ', $_, 2); + $args = '' unless defined $args; if ($Cmd eq 'cut') { $r-> {cutting} = 1; } @@ -779,21 +779,21 @@ sub read_paragraph $r-> {cutting} = 0; } elsif ($Cmd eq 'head1') { - $self-> add($_, STYLE_HEAD_1, 0); + $self-> add( $args, STYLE_HEAD_1, 0); } elsif ($Cmd eq 'head2') { - $self-> add( $_, STYLE_HEAD_2, 0); + $self-> add( $args, STYLE_HEAD_2, 0); } elsif ($Cmd eq 'over') { push(@{$r-> {indentStack}}, $r-> {indent}); - $r-> {indent} += ( m/^(\d+)$/ ) ? $1 : DEF_INDENT; + $r-> {indent} += ( $args =~ m/^(\d+)$/ ) ? $1 : DEF_INDENT; } elsif ($Cmd eq 'back') { $self-> _close_topic( STYLE_ITEM); $r-> {indent} = pop(@{$r-> {indentStack}}) || 0; } elsif ($Cmd eq 'item') { - $self-> add($_, STYLE_ITEM, $r-> {indentStack}-> [-1] || DEF_INDENT); + $self-> add( $args, STYLE_ITEM, $r-> {indentStack}-> [-1] || DEF_INDENT); } } else { From 2e3bca50e587ae24fda230d0a4862c667c875b27 Mon Sep 17 00:00:00 2001 From: David Mertens Date: Fri, 14 Jun 2013 11:49:32 -0500 Subject: [PATCH 8/9] Added annotation to on_paint and revised erroneous else condition in block_draw --- Prima/TextView.pm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Prima/TextView.pm b/Prima/TextView.pm index eafe72533..8d72771e6 100644 --- a/Prima/TextView.pm +++ b/Prima/TextView.pm @@ -899,7 +899,7 @@ sub on_paint $self-> selection_state( $canvas); $self-> block_draw( $canvas, $b, $x, $y); $self-> {selectionPaintMode} = 0; - } else { + } else { # no selection case $self-> block_draw( $canvas, $b, $x, $y); } } @@ -969,8 +969,8 @@ sub block_draw $state[ tb::BLK_COLOR + (($$b[ $i + 1] & tb::BACKCOLOR_FLAG) ? 1 : 0)] = $$b[$i + 1]; $c_taint = undef; - } else { - die("Invalid Prima::TextView block op $cmd\n"); + } elsif ($cmd >= @tb::oplen) { + die("Unknown Prima::TextView block op $cmd\n"); } } From d81798717ec352dc107665038bec4591fb6fdb2a Mon Sep 17 00:00:00 2001 From: David Mertens Date: Wed, 19 Jun 2013 10:25:47 -0500 Subject: [PATCH 9/9] Fix Prima::PodView's rendering of certain in-paragraph code blocks The following example paragraph is incorrectly rendered with PodView: To turn off frobnication, simply say C<< $widget->frobnicate(0) >>. This commit fixes that and reduces the text captures in multibracket in-paragraph code blocks, which should make it ever so slightly more efficient. --- Prima/PodView.pm | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/Prima/PodView.pm b/Prima/PodView.pm index ff9d1b8f5..2f7773cea 100644 --- a/Prima/PodView.pm +++ b/Prima/PodView.pm @@ -1034,7 +1034,6 @@ sub add $p =~ s/[\s\t]+/ /g; $p =~ s/([\200-\377])/"E<".ord($1).">"/ge; $p =~ s/(E<[^<>]+>)/noremap($1)/ge; - $p =~ s/(\W)([\$\@\%\*\&])(?!Z<>)([^\s\(\)\{\}]+)/$1C<$2$3>/g; $p =~ s/([:A-Za-z_][:A-Za-z_0-9]*\([^\)]*\))/C<$1>/g; my $maxnest = 10; my $linkStart = scalar @{$self-> {links}}; @@ -1047,9 +1046,9 @@ sub add [ pos($m) - 1, lc $1, 1]; substr $m, $ids[$_][0], $ids[$_][2], '_' x $ids[$_][2] for -2,-1; } - while ( $m =~ m/([A-Z])(<<+\s?)/gcs) { - my ( $pos, $cmd, $left, $right) = ( pos($m), $1, $2, ' ' . ('>' x ( length($2) - 1))); - if ( $m =~ m/(.*?)($right)(?!>)/gcs) { + while ( $m =~ m/([A-Z])(<<+) /gcs) { + my ( $pos, $cmd, $left, $right) = ( pos($m), $1, $2, ('>' x ( length($2)))); + if ( $m =~ m/\G.*? $right(?!>)/gcs) { push @ids, [ $pos - length($left) - 1,