#!/usr/bin/perl use XML::STX; use Gtk; use strict; my $vGtk; eval { require Gtk; $vGtk = $Gtk::VERSION; }; if ($@) { print "Gtk-Perl is missing!\n"; print "It must be installed before you can run stxview.pl\n"; exit; } set_locale Gtk; # internationalize init Gtk; # initialize Gtk-Perl my $false = 0; my $true = 1; my @titles; my $window; my $vbox; my $pane; my $tree_scrolled_win; my $list_scrolled_win; my $tree; my $root; my $subtree; my $item; my $list; my $entry; my $pass_through = {0 => 'none', 1 => 'all', 2 => 'text'}; my $yn = {0 => 'no', 1 => 'yes'}; my $visibility = {1 => 'local', 2 => 'group', 3 => 'global'}; # Create a window $window = new Gtk::Window( 'toplevel' ); $window->set_usize( 750, 500 ); $window->set_title( "STX Viewer" ); $window->set_policy( $false, $false, $true ); $window->signal_connect( "delete_event", sub { Gtk->exit( 0 ); } ); # Create the main VBox $vbox = new Gtk::VBox( $false, 0 ); $window->add( $vbox ); $vbox->show(); # ---------------------------------------- # Create a menu my $menubar = new Gtk::MenuBar(); $vbox->pack_start( $menubar, $false, $false, 2 ); $menubar->show(); my $menu_sheet = new Gtk::MenuItem( "Stylesheet" ); $menu_sheet->signal_connect( 'activate', \&openSheet ); $menubar->append( $menu_sheet ); $menu_sheet->show(); my $menu_about = new Gtk::MenuItem( "About" ); $menu_about->signal_connect( 'activate', \&about ); $menubar->append( $menu_about ); $menu_about->show(); my $menu_exit = new Gtk::MenuItem( "Exit" ); $menu_exit->signal_connect( 'activate', sub { Gtk->exit( 0 ); } ); $menubar->append( $menu_exit ); $menu_exit->show(); # ---------------------------------------- # Create a horizontal pane $pane = new Gtk::HPaned(); $vbox->pack_start( $pane, $false, $false, 2 ); $pane->set_handle_size( 10 ); $pane->set_gutter_size( 8 ); $pane->show(); # Create a ScrolledWindow for the tree $tree_scrolled_win = new Gtk::ScrolledWindow( undef, undef ); $tree_scrolled_win->set_usize( 225, 470 ); $pane->add1($tree_scrolled_win); $tree_scrolled_win->set_policy( 'automatic', 'automatic' ); $tree_scrolled_win->show(); # Create a ScrolledWindow for the list $list_scrolled_win = new Gtk::ScrolledWindow( undef, undef ); $pane->add2( $list_scrolled_win ); $list_scrolled_win->set_policy( 'automatic', 'automatic' ); $list_scrolled_win->show(); # Create root tree $tree = new Gtk::Tree(); $tree_scrolled_win->add_with_viewport( $tree ); $tree->set_selection_mode( 'single' ); $tree->set_view_mode( 'item' ); $tree->show(); # Create list box # @titles = qw( Filename Size Permissions Owner Group Time Date ); $list = new Gtk::CList( 2 ); $list_scrolled_win->add( $list ); $list->set_column_width( 0, 175 ); $list->set_column_width( 1, 310 ); $list->set_selection_mode( 'single' ); $list->set_shadow_type( 'none' ); $list->show(); $window->show(); main Gtk; exit( 0 ); ### Subroutines ######################################## # Callback for expanding a tree sub expandTree { my ( $item, $subtree ) = @_; my $group = $item->get_user_data(); my $item_new; my $new_subtree; foreach my $t ( sort keys(%{$group->{templates}}) ) { my $name = $group->{templates}->{$t}->{pattern}; $name =~ s/\{([^\}]+)\}/{ns}/g; $item_new = new_with_label Gtk::TreeItem( "template $t ($name)" ); $item_new->signal_connect( 'select', \&selectItem, $group->{templates}->{$t}); $subtree->append( $item_new ); $item_new->show(); } foreach my $p ( sort keys(%{$group->{procedures}}) ) { my $name = $group->{procedures}->{$p}->{name}; $name =~ s/\{([^\}]+)\}/{ns}/g; $item_new = new_with_label Gtk::TreeItem( "procedure $p ($name)" ); $item_new->signal_connect( 'select', \&selectItem, $group->{procedures}->{$p}); $subtree->append( $item_new ); $item_new->show(); } foreach my $g ( sort keys(%{$group->{groups}}) ) { my $name = $group->{groups}->{$g}->{name}; $name =~ s/\{([^\}]+)\}/{ns}/g; $item_new = new_with_label Gtk::TreeItem( "group $g ($name)" ); $item_new->set_user_data( $group->{groups}->{$g} ); $item_new->signal_connect( 'select', \&selectItem, $group->{groups}->{$g}); $subtree->append( $item_new ); $item_new->show(); $new_subtree = new Gtk::Tree(); $item_new->set_subtree( $new_subtree ); $item_new->signal_connect( 'expand', \&expandTree, $new_subtree ); $item_new->signal_connect( 'collapse', \&collapseTree ); } } # Callback for collapsing a tree sub collapseTree { my ( $item ) = @_; my $subtree = new Gtk::Tree(); $item->remove_subtree(); $item->set_subtree( $subtree ); $item->signal_connect( 'expand', \&expandTree, $subtree ); } # Called whenever an item is clicked sub selectItem { my ( $widget, $o ) = @_; $list->clear(); if (ref $o eq 'XML::STX::Stylesheet') { $list->append('STYLESHEET', ''); my @name = split("/", $o->{URI}); $list->append('- principal module file:', $name[-1]); $list->append('', ''); $list->append('Stylesheet options', ''); $list->append('- stxpath-default-namespace:', $o->{Options}->{'stxpath-default-namespace'}->[-1]); $list->append('- output-encoding:', $o->{Options}->{'output-encoding'}); _groupProperties($o->{dGroup}, 'Default group options'); } elsif (ref $o eq 'XML::STX::Group') { $list->append('GROUP', ''); $list->append('- name:', exists $o->{name} ? $o->{name} : '#anonymous'); _groupProperties($o, 'Group options'); } elsif (ref $o eq 'XML::STX::Template' && exists $o->{name}) { $list->append('PROCEDURE', ''); $list->append('- name:', $o->{name}); _templateProperties($o); } else { $list->append('TEMPLATE', ''); $list->append('- match pattern:', $o->{pattern}); $list->append('- priority:', $o->{eff_p} == 10 ? join('|',@{$o->{priority}}) : $o->{eff_p}); _templateProperties($o); } } sub _groupProperties { my ($g, $label) = @_; $list->append('', ''); $list->append($label, ''); $list->append('- pass-through:', $pass_through->{$g->{Options}->{'pass-through'}}); $list->append('- recognize-cdata:', $yn->{$g->{Options}->{'recognize-cdata'}}); $list->append('- strip-space:', $yn->{$g->{Options}->{'strip-space'}}); $list->append('', ''); $list->append('Visible templates', ''); my @pc1 = sort {$a <=> $b} map($_->{tid}, @{$g->{pc1}}, @{$g->{pc1A}}); $list->append('- precedence category 1:', join(',', @pc1)); my @pc2 = sort {$a <=> $b} map($_->{tid}, @{$g->{pc2}}, @{$g->{pc2A}}); $list->append('- precedence category 2:', join(',', @pc2)); my @pc3 = sort {$a <=> $b} map($_->{tid}, @{$g->{pc3}}, @{$g->{pc3A}}); $list->append('- precedence category 3:', join(',', @pc3)); $list->append('', ''); $list->append('Visible procedures', ''); @pc1 = sort keys %{$g->{pc1P}}; $list->append('- precedence category 1:', join(',', @pc1)); @pc2 = sort keys %{$g->{pc2P}}; $list->append('- precedence category 2:', join(',', @pc2)); @pc3 = sort keys %{$g->{pc3P}}; $list->append('- precedence category 3:', join(',', @pc3)); $list->append('', ''); $list->append('Group variables and buffers', ''); my @v = map('$' . $_, sort keys %{$g->{vars}->[-1]}); $list->append('- variables:', join(',', @v)); my @b = sort keys %{$g->{bufs}->[-1]}; $list->append('- buffers:', join(',', @b)); } sub _templateProperties { my $t = shift; $list->append('', ''); $list->append('Properties', ''); $list->append('- visibility:', $visibility->{$t->{visibility}}); $list->append('- public:', $yn->{$t->{public}}); $list->append('- new scope:', $yn->{$t->{'new-scope'}}); } # Open a stylesheet file sub openSheet { # Create a new file selection widget my $dialog = new Gtk::FileSelection( "File Selection" ); $dialog->signal_connect( "destroy", sub { $dialog->destroy(); } ); $dialog->hide_fileop_buttons(); # Connect the ok_button to file_ok_sel function $dialog->ok_button->signal_connect( "clicked", \&fileOK, $dialog ); # Connect the cancel_button to destroy the widget $dialog->cancel_button->signal_connect( "clicked", sub { $dialog->destroy(); } ); $dialog->show(); } # Get the selected filename and print it to the console sub fileOK { my ($widget, $dialog) = @_; my $file = $dialog->get_filename(); my $stx = XML::STX->new(); my $templ; eval { $templ = $stx->new_templates($file); }; if ($@) { displayPopUp('STX Parser Error', $@, 550, 120); } else { displayTree($file, $templ); } $dialog->destroy(); } # Displays tree sub displayTree { my ($file, $template) = @_; $root->destroy() if $root; $list->clear(); my @name = split("/", $file); my $subtree; $root = new_with_label Gtk::TreeItem ( $name[-1] ); $tree->append( $root ); $root->signal_connect( 'select', \&selectItem, $template->{Stylesheet}); $root->set_user_data( $template->{Stylesheet}->{dGroup} ); $root->show(); $subtree = new Gtk::Tree(); $root->set_subtree( $subtree ); $root->signal_connect( 'expand', \&expandTree, $subtree ); $root->signal_connect( 'collapse', \&collapseTree ); $root->expand(); } # About box sub about { displayPopUp('About STX Viewer', "STX Viewer for XML::STX\n" . "(XML-STX v$XML::STX::VERSION, Gtk-Perl v$vGtk)\n\n" . '(c) 2002-2003 Ginger Alliance', 300, 150); } sub displayPopUp { my ($title, $text, $width, $height) = @_; my $popup = new Gtk::Dialog(); $popup->set_title( $title ); $popup->set_position('center'); $popup->set_default_size($width, $height) if ($width and $height); my $button = new Gtk::Button( 'OK' ); $button->signal_connect("clicked", sub { $popup->destroy(); }); $popup->action_area->pack_start( $button, $true, $true, 0 ); $button->show(); my $label = new Gtk::Label( $text ); $popup->vbox->pack_start( $label, $false, $false, 10 ); $label->show(); $popup->show(); }