summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm')
-rw-r--r--Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm93
1 files changed, 72 insertions, 21 deletions
diff --git a/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm b/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
index 9d31db0badd..df896e64a7c 100644
--- a/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
+++ b/Master/tlpkg/tlperl/lib/Pod/Simple/XHTML.pm
@@ -45,7 +45,7 @@ declare the output character set as UTF-8 before parsing, like so:
package Pod::Simple::XHTML;
use strict;
use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES );
-$VERSION = '3.20';
+$VERSION = '3.28';
use Pod::Simple::Methody ();
@ISA = ('Pod::Simple::Methody');
@@ -151,7 +151,7 @@ Add additional meta tags here, or blocks of inline CSS or JavaScript
A string containing all characters that should be encoded as HTML entities,
specified using the regular expression character class syntax (what you find
within brackets in regular expressions). This value will be passed as the
-second argument to the C<encode_entities> fuction of L<HTML::Entities>. IF
+second argument to the C<encode_entities> function of L<HTML::Entities>. If
L<HTML::Entities> is not installed, then any characters other than C<&<>"'>
will be encoded numerically.
@@ -251,7 +251,6 @@ sub new {
$new->man_url_prefix('http://man.he.net/man');
$new->html_charset('ISO-8859-1');
$new->nix_X_codes(1);
- $new->codes_in_verbatim(1);
$new->{'scratch'} = '';
$new->{'to_index'} = [];
$new->{'output'} = [];
@@ -301,11 +300,27 @@ something like:
my ($self, $text) = @_;
if ($self->{'in_foo'}) {
$self->{'scratch'} .= build_foo_html($text);
- } else {
- $self->{'scratch'} .= $text;
+ return;
}
+ $self->SUPER::handle_text($text);
}
+=head2 handle_code
+
+This method handles the body of text that is marked up to be code.
+You might for instance override this to plug in a syntax highlighter.
+The base implementation just escapes the text.
+
+The callback methods C<start_code> and C<end_code> emits the C<code> tags
+before and after C<handle_code> is invoked, so you might want to override these
+together with C<handle_code> if this wrapping isn't suiteable.
+
+Note that the code might be broken into mulitple segments if there are
+nested formatting codes inside a C<< CE<lt>...> >> sequence. In between the
+calls to C<handle_code> other markup tags might have been emitted in that
+case. The same is true for verbatim sections if the C<codes_in_verbatim>
+option is turned on.
+
=head2 accept_targets_as_html
This method behaves like C<accept_targets_as_text>, but also marks the region
@@ -328,18 +343,47 @@ sub accept_targets_as_html {
sub handle_text {
# escape special characters in HTML (<, >, &, etc)
- $_[0]{'scratch'} .= $_[0]->__in_literal_xhtml_region
- ? $_[1]
- : $_[0]->encode_entities( $_[1] );
+ my $text = $_[0]->__in_literal_xhtml_region
+ ? $_[1]
+ : $_[0]->encode_entities( $_[1] );
+
+ if ($_[0]{'in_code'} && @{$_[0]{'in_code'}}) {
+ # Intentionally use the raw text in $_[1], even if we're not in a
+ # literal xhtml region, since handle_code calls encode_entities.
+ $_[0]->handle_code( $_[1], $_[0]{'in_code'}[-1] );
+ } else {
+ $_[0]{'scratch'} .= $text;
+ }
+
+ $_[0]{htext} .= $text if $_[0]{'in_head'};
}
-sub start_Para { $_[0]{'scratch'} = '<p>' }
-sub start_Verbatim { $_[0]{'scratch'} = '<pre><code>' }
+sub start_code {
+ $_[0]{'scratch'} .= '<code>';
+}
-sub start_head1 { $_[0]{'in_head'} = 1 }
-sub start_head2 { $_[0]{'in_head'} = 2 }
-sub start_head3 { $_[0]{'in_head'} = 3 }
-sub start_head4 { $_[0]{'in_head'} = 4 }
+sub end_code {
+ $_[0]{'scratch'} .= '</code>';
+}
+
+sub handle_code {
+ $_[0]{'scratch'} .= $_[0]->encode_entities( $_[1] );
+}
+
+sub start_Para {
+ $_[0]{'scratch'} = '<p>';
+}
+
+sub start_Verbatim {
+ $_[0]{'scratch'} = '<pre>';
+ push(@{$_[0]{'in_code'}}, 'Verbatim');
+ $_[0]->start_code($_[0]{'in_code'}[-1]);
+}
+
+sub start_head1 { $_[0]{'in_head'} = 1; $_[0]{htext} = ''; }
+sub start_head2 { $_[0]{'in_head'} = 2; $_[0]{htext} = ''; }
+sub start_head3 { $_[0]{'in_head'} = 3; $_[0]{htext} = ''; }
+sub start_head4 { $_[0]{'in_head'} = 4; $_[0]{htext} = ''; }
sub start_item_number {
$_[0]{'scratch'} = "</li>\n" if ($_[0]{'in_li'}->[-1] && pop @{$_[0]{'in_li'}});
@@ -397,7 +441,8 @@ sub end_over_text {
sub end_Para { $_[0]{'scratch'} .= '</p>'; $_[0]->emit }
sub end_Verbatim {
- $_[0]{'scratch'} .= '</code></pre>';
+ $_[0]->end_code(pop(@{$_[0]->{'in_code'}}));
+ $_[0]{'scratch'} .= '</pre>';
$_[0]->emit;
}
@@ -408,14 +453,14 @@ sub _end_head {
$add = 1 unless defined $add;
$h += $add - 1;
- my $id = $_[0]->idify($_[0]{scratch});
+ my $id = $_[0]->idify($_[0]{htext});
my $text = $_[0]{scratch};
- $_[0]{'scratch'} = $_[0]->backlink && ($h - $add == 0)
+ $_[0]{'scratch'} = $_[0]->backlink && ($h - $add == 0)
# backlinks enabled && =head1
? qq{<a href="#_podtop_"><h$h id="$id">$text</h$h></a>}
: qq{<h$h id="$id">$text</h$h>};
$_[0]->emit;
- push @{ $_[0]{'to_index'} }, [$h, $id, $text];
+ push @{ $_[0]{'to_index'} }, [$h, $id, delete $_[0]{'htext'}];
}
sub end_head1 { shift->_end_head(@_); }
@@ -568,8 +613,8 @@ sub end_Document {
sub start_B { $_[0]{'scratch'} .= '<b>' }
sub end_B { $_[0]{'scratch'} .= '</b>' }
-sub start_C { $_[0]{'scratch'} .= '<code>' }
-sub end_C { $_[0]{'scratch'} .= '</code>' }
+sub start_C { push(@{$_[0]{'in_code'}}, 'C'); $_[0]->start_code($_[0]{'in_code'}[-1]); }
+sub end_C { $_[0]->end_code(pop(@{$_[0]{'in_code'}})); }
sub start_F { $_[0]{'scratch'} .= '<i>' }
sub end_F { $_[0]{'scratch'} .= '</i>' }
@@ -692,6 +737,11 @@ underscores (_), colons (:), and periods (.).
=item *
+The final character can't be a hyphen, colon, or period. URLs ending with these
+characters, while allowed by XHTML, can be awkward to extract from plain text.
+
+=item *
+
Each id must be unique within the document.
=back
@@ -713,6 +763,7 @@ sub idify {
s/^([^a-zA-Z]+)$/pod$1/; # Prepend "pod" if no valid chars.
s/^[^a-zA-Z]+//; # First char must be a letter.
s/[^-a-zA-Z0-9_:.]+/-/g; # All other chars must be valid.
+ s/[-:.]+$//; # Strip trailing punctuation.
}
return $t if $not_unique;
my $i = '';
@@ -757,7 +808,7 @@ pod-people@perl.org mail list. Send an empty email to
pod-people-subscribe@perl.org to subscribe.
This module is managed in an open GitHub repository,
-L<http://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
+L<https://github.com/theory/pod-simple/>. Feel free to fork and contribute, or
to clone L<git://github.com/theory/pod-simple.git> and send patches!
Patches against Pod::Simple are welcome. Please send bug reports to