| Subject: | Add Anchor Callbacks |
I sent this patch to Sean a while ago. It adds a very simple callback for anchor tags, so that if a user needs to add more than the usual stuff to an anchor tag, she can. For the API browser that I wrote, this is essential for adding an onclick attribute to the anchor element. It looks something like this:
$psh->perldoc_url_tag_extras_callback(sub {
my ($url, $token) = @_;
my $to = $token->attr('to') or return '';
my $search = PodBrowser::Pod::Search->instance or return '';
# If we have a local link, use podlink(). Otherwise, use leavelink().
return $search->name2path->{$to}
? qq{onclick="return podlink('$to');"}
: qq{onclick="return leavelink(this)"};
});
Now, whether you want to generalize this into a callback architecture for all HTML tags I don't know. That'd certainly be fine with me. The upshot is that once this capabiliity is built into Pod::Simple::HTML (or there's some other way to do it--subclasses that override an "a" method?), I can release the pod browser code for general use. Here's what it looks like:
http://www.bricolage.cc/docs/current/api/
Thanks!
David
--- Pod/Simpmle/HTML.pm~ Mon Jun 7 21:27:06 2004
+++ Pod/Simple/HTML.pm Mon Jun 7 21:42:32 2004
@@ -52,6 +52,9 @@
'perldoc_url_postfix',
# what to put after "Foo%3a%3aBar" in the URL. Normally "".
+ # Want to add extra information to the anchor tag?
+ 'perldoc_url_tag_extras_callback',
+
'batch_mode', # whether we're in batch mode
'batch_mode_current_level',
# When in batch mode, how deep the current module is: 1 for "LWP",
@@ -432,12 +435,15 @@
$linktype = $token->attr('type') || 'insane';
$linkto = $self->do_link($token);
-
if(defined $linkto and length $linkto) {
esc($linkto);
# (Yes, SGML-escaping applies on top of %-escaping!
# But it's rarely noticeable in practice.)
- print $fh qq{<a href="$linkto" class="podlink$linktype"\n>};
+ my $extra = '';
+ if (my $code = $self->perldoc_url_tag_extras_callback) {
+ $extra = ' ' . $code->($linkto, $token) . ' ';
+ }
+ print $fh qq{<a href="$linkto"$extra class="podlink$linktype"\n>};
} else {
print $fh "<a>"; # Yes, an 'a' element with no attributes!
}