Re: Bug in Gtk::HTML::Simple ? Navigating witnin an HTML page ?

[Jörn Reder <joern netcologne de>]

Latevi Max LAWSON DAKU wrote:

> I would like to display in HTML format data which are generated 
> on the fly. 

[...]

> I also have another question: how do I proceed in order to navigate, 
> using links, within a displayed page ? Since I'm working on pages 
> generated on the fly, I would like to avoid writing the page contents 
> into a file, (or even several files in order to navigate successfully 
> within the page's paragraphs) . 

I think Gtk::HTML::Simple is too simple for this job... ;)

I wrote a class for doing more complex things around the Gtk::HTML 
widget. Its embed in a somewhat bigger environment, but I downsized it 
to a simpler version which shows the concept.

I attached a few small files, which demonstrate the module:

  HTMLSurface.pm      The module itself
  test.pl             guess what ;)
  test.gif            an example image

The code is small and straightforward so hopefully readable without the
hundreds of missing comments ;)

Joern

-- 
sub i($){print$_[0]}*j=*ENV;sub w($){sleep$_[0]}sub _($){i"$p$c > ",w
1,$_=$_[0],tr;i-za-h,;a-hi-z ;,i$_,w 1,i"\n"}$|=1;$f='HO';($c=$j{PWD}
)=~s/$j{$f."ME"}/~/;$p="$j{USER}\ $j{HOSTNAME}:";_"kl",$c='~',_"zu,".
"-zn,*",_"#,epg,lw,gwc,mfmkcbm,cvsvwev,uiqt,kwvbmvb?",i"$p$c > ";w 99

# $Id: HTMLSurface.pm,v 1.8 2001/08/12 15:00:48 joern Exp $

#--------------------------------------------------------
# Copyright (c) 2001 Joern Reder, All Rights Reserved
#--------------------------------------------------------
# This library is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#--------------------------------------------------------

package HTMLSurface;

use strict;
use Carp;
use Gtk::HTML;
use FileHandle;
use Data::Dumper;

sub widget                { my $s = shift; $s->{widget}
                            = shift if @_; $s->{widget}           }

sub handle                { my $s = shift; $s->{handle}
                            = shift if @_; $s->{handle}           }

sub image_pool            { my $s = shift; $s->{image_pool}
                            = shift if @_; $s->{image_pool}       }

sub image_dir             { my $s = shift; $s->{image_dir}
                            = shift if @_; $s->{image_dir}        }

sub url_in_focus          { my $s = shift; $s->{url_in_focus}
                            = shift if @_; $s->{url_in_focus}       }

sub button_press_callback { my $s = shift; $s->{button_press_callback}
                            = shift if @_; $s->{button_press_callback} }

sub new {
        my $type = shift;
        my %par = @_;
        
        my  ($image_dir, $button_press_callback) =
        @par{'image_dir','button_press_callback'};

        my $widget;
        eval {
                $widget = new Gtk::HTML;
        };
        confess ($@) if $@;
        
        my $self = bless {
                widget                => $widget,
                image_dir             => $image_dir,
                button_press_callback => $button_press_callback,
                handle                => undef,
                image_pool            => {},
        }, $type;
        
        $widget->signal_connect (
                'url_requested',
                sub { $self->cb_url_requested (@_)
        } );
        
        $widget->signal_connect (
                'on_url',
                sub { $self->cb_on_url (@_)
        } );
        
        $widget->signal_connect (
                'button_press_event',
                $button_press_callback
        );

        $widget->show;

        return $self;
}

#-- callbacks --------------------------------------------------------

sub cb_url_requested {
        my $self = shift;
        my ($widget, $url, $handle) = @_;

        my $image_dir = $self->image_dir;
        my $filename = "$image_dir/$url";
        my $fh = new FileHandle;
        
        if ( $url =~ m!^pool://(.*)! ) {
                # internal image pool request
                $widget->write ($handle, $self->image_pool->{$1});
                $widget->end ($handle,'ok');

        } elsif ( open ($fh, $filename) ) {
                # external file request
                while (<$fh>) {
                        $widget->write ($handle, $_);
                }
                close $fh;
                $widget->end ($handle,'ok');

        } else {
                # error reading file
                warn ("can't read $filename");
                $widget->end ($handle,'error');
        }
        
        1;
}

sub cb_on_url {
        my $self = shift;
        my ($widget, $url) = @_;
        $self->url_in_focus ( $url );
}

#-- methods to add html code -----------------------------------------

sub begin {
        my $self = shift;
        $self->handle($self->widget->begin);
        $self->image_pool ({});
        $self->write ('<html><body bgcolor="#d5d5d5">');
        1;
}

sub end {
        my $self = shift;
        $self->write ('</body></html>');
        $self->widget->end ($self->handle, 'ok');
        1;
}

sub write {
        my $self = shift;
        local $_;
        for (@_) { $self->widget->write ($self->handle, $_) if length($_) }
        1;
}


sub fixed {
        shift->write ('<font face="Courier">'.$_[0].'</font>');
}

sub fixed_start {
        shift->write ('<font face="Courier">');
}

sub fixed_end {
        shift->write ('</font>');
}


sub bold {
        shift->write ('<b>'.$_[0].'</b>');
}

sub bold_start {
        shift->write ('<b>');
}

sub bold_end {
        shift->write ('</b>');
}


sub color {
        shift->write ('<font color="'.$_[0].'">'.$_[1].'</font>');
}

sub color_start {
        shift->write ('<font color="'.$_[0].'">');
}

sub color_end {
        shift->write ('</font>');
}


sub pre {
        shift->write ('<pre><font face="Courier">'.$_[0].'</font></pre>');
}

sub pre_start {
        shift->write ('<pre><font face="Courier">');
}

sub pre_end {
        shift->write ('</font></pre>');
}


sub p {
        shift->write ('<p>');
}

sub br {
        shift->write ('<br>');
}

sub hr {
        shift->write ('<hr width="100%">');
}

sub image {
        my $self = shift;
        my %par = @_;
        my ($pool, $name) = @par{'pool','name'};
        
        if ( $pool ) {
                $self->write ('<a href="pool://'.$pool.'"><img border="0" src="pool://'.$pool.'"></a>');
        } else {
                $self->write ('<a href="'.$name.'"><img border="0" src="'.$name.'"></a>');
        }
        1;
}

1;

#!/usr/local/bin/perl

use strict;
use Gtk;
use HTMLSurface;

main: {
        Gtk->init;
        
        my $win = Gtk::Window->new;
        $win->set_title ("HTMLSurface test");
        $win->show;
        $win->signal_connect ("destroy", sub { Gtk->exit(0) } );

        my $sw = new Gtk::ScrolledWindow(undef, undef);
        $sw->set_policy('automatic', 'automatic');

        my $html;
        $html = HTMLSurface->new (
                image_dir => ".",
                button_press_callback => sub {
                        my ($widget, $event) = @_;
                        button_press (
                                html   => $html,
                                widget => $widget,
                                event  => $event
                        );
                }
        ); 
        
        my $widget = $html->widget;
        $sw->show;
        $sw->add($widget);
        $win->add($sw);

        # this is necessary to initialize the Gtk::HTML widget
        $html->begin;
        
        $html->write ("huhu");
        $html->p;
        
        $html->write ("image from file:<p>");

        # add image with a filename reference
        # (test.gif is expected in the current directory, 
        #  because we set image_dir => ".")
        $html->image ( name => "test.gif" );

        $html->p;
        
        # add the same image via a memory reference

        # first load the image into memory.
        open (IN, "test.gif") or die "can't read test.gif";
        my $image = join ('',<IN>);
        close IN;
        
        # store the image inside the image pool hash, which
        # assigns the image to an arbitrary key value
        $html->image_pool->{42} = $image;
        
        $html->write ("the sameimage from memory:<p>");
        
        # call the image method, but now with the pool
        # parameter which holds our key
        $html->image ( pool => 42 );

        # this closes the data stream
        $html->end;
        
        Gtk->main;
}

sub button_press {
        my %par = @_;
        my  ($widget, $event, $html) =
        @par{'widget','event','html'};

        if ( $html->url_in_focus ) {
                print "button click on ".$html->url_in_focus."\n";
        } else {
                print "button click on surface\n";
        }
        
        1;
}