view release on metacpan or  search on metacpan

lib/Parse/Vipar/Shell.pm  view on Meta::CPAN

			     foreach ($t->curTagNames()) {
				 next unless /rule_(\d+)/;
				 $vipar->select_rule($1);
			     }
			 });

    $t->tagInvisibleLink('state', sub {
			     foreach ($t->curTagNames()) {
				 next unless /state_(\d+)/;
				 $vipar->select_state($1);
			     }
			 });

    ######### BUTTON MENU ############
    my $buttons = $info->{actions_f} = $info->{f1}->Frame()
        ->pack(-fill => 'y');

    my %listen;

    my @button_info =
        ( [ 'Step' =>
            'step', have_file => 'normal', no_file => 'disabled' ],
          [ 'Next Action' =>
            'na', have_file => 'normal', no_file => 'disabled' ],
          [ 'Next Reduce' =>
            'nr', have_file => 'normal', no_file => 'disabled' ],
          [ 'Next Input' =>
            'ni', have_file => 'normal', no_file => 'disabled' ],
          [ 'Restart' =>
            'restart' ],
          [ 'Stop' =>
            'stop', have_file => 'normal', no_file => 'disabled' ],
          [ 'End Run' =>
            'end', have_file => 'normal', no_file => 'disabled' ],
        );

    foreach (@button_info) {
        my ($name, $action, %transitions) = @$_;
        my $b = $buttons->Button(-text => $name,
                                 -command => sub { $t->userinput($action) })
            ->pack(-side => 'top', -fill => 'x');
        while (my ($event, $state) = each %transitions) {
            push @{$listen{$event}}, sub { $b->configure(-state => $state) };
        }
    }

    $self->{listen} = \%listen;

    ######### MENU ############
    my $menubar = $info->{menu_m} = $info->{shell_f}->Menu(-type => 'menubar');
    $win->configure(-menu => $menubar);

    # Stolen from example code menus.pl
    my $modifier = 'Meta';	# Unix
    if ($^O eq 'MSWin32') {
	$modifier = 'Control';
    } elsif ($^O eq 'MacOS') {  # one of these days
	$modifier = 'Command';
    }

    my $m_file = $menubar->cascade(-label => '~File', -tearoff => 0);
    $m_file->command(-label => 'Load ~Parser...',
                     -command => sub {
                         $self->fileDialog("load parser %s",
                                           ["YACC files", '*.y'])
                     });
    $m_file->command(-label => 'Load ~Input...',
                     -command => sub { $self->fileDialog("load %s") });
    $m_file->command(-label => 'Exit', -command => \&Tk::exit);

    # Setup lookahead explanations

    $self->setup_why() if $vipar->{builder}->{why};
    $self->setup();
}

sub setup_why {
    my ($self) = @_;
    my $t = $self->{_t};
    my $vipar = $self->{parent};

    $t->map->{pre}->{lookahead} = sub {
	my ($xmltag) = @_;
	if (exists $xmltag->{state}) {
	    my $tag = $t->makeTag('lookahead',
				  state => $xmltag->{state},
				  item => $xmltag->{item},
				  token => $xmltag->{token});
	    $xmltag->{body} = [ makestart('lookahead'),
				@{$xmltag->{body}}, ' ',
				makestart($tag),
				'(why)',
				makeend('lookahead', $tag) ];
	    $t->tagLink($tag);
	} else {
	    $xmltag->{body} = [	makestart('lookahead'),
				@{$xmltag->{body}},
				makeend('lookahead') ];
	}
    };

    $t->tagBind('lookahead', '<1>', sub {
		    my %info = $t->getNumericalAttrs('lookahead');
		    $vipar->why_lookahead(@info{'state','item','token'});
		});

    my $parser = $self->{parent}->{parser};
    $t->map->{pre}->{FIRST} = sub {
	my ($xmltag) = @_;
	my ($token, $symbol) = @$xmltag{'token','symbol'};
	my @tags = ("FIRST",
		    "FIRST_symbol_${symbol}_token${token}");
	$xmltag->{body} = [ @{$xmltag->{body}}, ' ',
			    makestart(@tags),
			    '(why)',
			    makeend(@tags) ];
	$t->tagLink($tags[1], sub { $t->userinput("why is token ".$parser->dump_sym($token)." in FIRST(".$parser->dump_sym($symbol).")"); });
    };

    $t->map->{pre}->{nullable} = sub {
	my ($xmltag) = @_;