view release on metacpan or  search on metacpan

XMLViewer.pm  view on Meta::CPAN

# -*- perl -*-

#
# $Id: XMLViewer.pm,v 1.42 2009/11/10 18:47:50 eserte Exp $
# Author: Slaven Rezic
#
# Copyright © 2000, 2003, 2004, 2007, 2009 Slaven Rezic. All rights reserved.
# This package is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# Mail: srezic@cpan.org
# WWW:  http://www.sourceforge.net/projects/srezic
#

package Tk::XMLViewer;

use Tk 800.013; # -elide
require Tk::ROText;
require Tk::Pixmap;
use strict;
use vars qw($VERSION);

use base qw(Tk::Derived Tk::ROText);
use XML::Parser;

BEGIN {
    if ($] < 5.006) {
	$INC{"warnings.pm"} = 1;
	*warnings::import = sub { };
	*warnings::unimport = sub { };
    }
}

Construct Tk::Widget 'XMLViewer';

$VERSION = '0.21';

my($curr_w); # ugly, but probably faster than defining handlers for everything
my $curr_xpath;
my $indent_width = 32;
my $use_elide = $Tk::VERSION < 800 || $Tk::VERSION >= 804.025;
my @tagAdds;

sub SetIndent {
    my $w = shift;
    my $arg = shift;
    $indent_width = $arg;
}

sub Populate {
    my($w,$args) = @_;
    $w->SUPER::Populate($args);
    $w->configure(-wrap   => 'word',
		  -cursor => 'left_ptr');

    my $tagcolor     = delete $args->{-tagcolor}     || 'red';
    my $attrkeycolor = delete $args->{-attrkeycolor} || 'green4';
    my $attrvalcolor = delete $args->{-attrvalcolor} || 'DarkGreen';
    my $commentcolor = delete $args->{-commentcolor} || 'gold3';

    $w->tagConfigure('xml_tag',
		     -foreground => $tagcolor,
		     #-font => 'boldXXX',
		     );
    $w->tagConfigure('xml_attrkey',
		     -foreground => $attrkeycolor,
		     );
    $w->tagConfigure('xml_attrval',
		     -foreground => $attrvalcolor,
		     );
    $w->tagConfigure('xml_comment',
		     -foreground => $commentcolor,
		     );
    $w->{IndentTags}  = [];
    $w->{RegionCount} = 0;
    $w->{XmlInfo}     = {};

    # XXX warum parent?
    $w->{PlusImage}  = $w->parent->Pixmap(-id => 'plus');
    $w->{MinusImage} = $w->parent->Pixmap(-id => 'minus');
}

sub insertXML {