view release on metacpan or  search on metacpan

tkged  view on Meta::CPAN

  # print "$final_tag from $tag\n";
  $final_tag;
}

sub show_menu_children($;$$)
{
  my ($record, $parent, $ind) = @_;
  # TODO - fix this tag
  my $tag = defined $parent ? "${parent}_$record->{tag}1" : "";
  my $canv = $Top->{_canv};
  my $cascade = [];
  push @$cascade,
       [
         Button   => "Self",
         -state   => has_entry($tag) ? "disabled" : "normal",
         -command => sub
                     {
                       create_record($canv, $tag);
                       add_show_menu($ind || $record);
                     }
       ]
    if defined $parent;
  my %c;
  push @$cascade,
       map {
             my $t = $_->{tag} . ++$c{$_->{tag}};
             @{$_->{children}}
               ? [
                   Cascade    => get_name($t),
                   -menuitems => show_menu_children($_, $tag, $ind || $record)
                 ]
               : do {
                      my $tg = "${tag}_$t";
                      [

tkged  view on Meta::CPAN

                        -command => sub
                                    {
                                      create_record($canv, $tg);
                                      add_show_menu($ind || $record);
                                    }
                      ]
                    }
           }
           sort { get_name($a->{tag}) cmp get_name($b->{tag}) }
                @{$record->{children}};
# print "returning ", Dumper $cascade;
  $cascade;
}

sub add_menu_children($;$$)
{
  my ($grammar, $parent, $menu_items) = @_;
  # print "grammar is $grammar->{tag}\n";
  my $tag = defined $parent ? "${parent}_$grammar->{tag}1" : "";
  my $cascade = [];
  push @$cascade,
       [
         Button   => "Self",
#        -state   => has_entry($tag) ? "disabled" : "normal",
         -command => sub
                     {
                       my $t = add_record($Rec, $tag);
                       create_record($Top->{_canv}, $t);
                       add_show_menu($Rec);
                     }
       ]
    if $parent;
  push @$cascade,
       map {
             my $c = $grammar->child($_);
             my $t = $_;
#            print "child <$t> in <$tag>\n";
             (@{$c->{children}} &&
              (($tag =~ tr/_//) < 1) &&
              ($tag !~ /_${t}\d*_/))
               ? [
                   Cascade    => get_name($t),
                   -menuitems => add_menu_children($c, $tag)

tkged  view on Meta::CPAN

#                                     print "ind is $Rec\n";
                                      my $t = add_record($Rec, $tg);
                                      create_record($Top->{_canv}, $t);
                                      add_show_menu($Rec);
                                    }
                      ]
                    }
           }
           sort { get_name($a) cmp get_name($b) }
                keys %{$grammar->valid_children};
# print "returning ", Dumper $cascade;
  if (@$cascade <= 20)
  {
    unshift @$cascade, @$menu_items if $menu_items;
    return $cascade;
  }
  my $index = [];
  while (@$cascade)
  {
    my @items = splice(@$cascade, 0, @$cascade > 20 ? 20 : @$cascade);
    push @$index,
         [
           Cascade    => "$items[0][1] - $items[-1][1]",
           -menuitems => \@items,
         ];
  }
  unshift @$index, @$menu_items if $menu_items;
  $index;
}