# Parser style for the auto-layouter package neb::LayoutParser; use strict; use neb::Tree::Container; use neb::Tree::Sub; use neb::Tree::Tag; use neb::Tree::Stuff; use neb::Tree::Perl; use neb::Tree::Block; use neb::Tree::Vars; use neb::Tree::LayoutBox; use neb::Tree::HBox; use neb::Tree::VBox; # esto engancha como se llaman las clases con como se llaman los tags # que invocan las clases. my %classes = ( 'lam:hbox' => 'HBox', 'lam:vbox' => 'VBox', 'form' => 'VBox', 'label' => 'ScreenObject', 'entry' => 'ScreenObject', 'button' => 'Button', 'label' => 'Label'); # create a regexp to find out whether we handle a given tag my $handled_tags = join("|", map {s/(\W)/\\$1/g, $_} keys %classes); sub Init { my $expat = shift; my $obj = neb::Tree::Container->new; $expat->{"lam_parser_current"} = $obj; $expat->{"lam_parser_stack"} = [ $obj ]; } sub Start { my $expat = shift; my $name = shift; my $class = 'neb::Tree::'; if ($name =~ m'^($handled_tags)$') { $class .= exists $classes{$1} ? $classes{$1} : $1; } else { $class .= 'Tag'; } my $obj = $class->new($name, @_); $expat->{"lam_parser_current"}->add_content($obj); push @{$expat->{"lam_parser_stack"}}, $expat->{"lam_parser_current"}; $expat->{"lam_parser_current"} = $obj; } sub End { my $expat = shift; my $name = shift; $expat->{"lam_parser_current"} = pop @{$expat->{"lam_parser_stack"}} } sub Default { my $expat = shift; my $stuff = shift; my $obj = neb::Tree::Stuff->new($stuff); $expat->{"lam_parser_current"}->add_content($obj); return $obj; } sub Final { my $expat = shift; my $result = $expat->{"lam_parser_stack"}->[0]; delete $expat->{"lam_parser_stack"}; delete $expat->{"lam_parser_current"}; return $result; } 1;