home *** CD-ROM | disk | FTP | other *** search
/ CD Actual Thematic 7: Programming / CDAT7.iso / Share / Editores / Perl5 / perl / lib / site / auto / Tk / Menu / MenuDup.al < prev    next >
Encoding:
Text File  |  1997-08-10  |  1.4 KB  |  58 lines
  1. # NOTE: Derived from ..\blib\lib\Tk\Menu.pm.  Changes made here will be lost.
  2. package Tk::Menu;
  3.  
  4. # tkMenuDup --
  5. # Given a menu (hierarchy), create a duplicate menu (hierarchy)
  6. # in a given window.
  7. #
  8. # Arguments:
  9. # src - Source window. Must be a menu. It and its
  10. # menu descendants will be duplicated at dst.
  11. # dst - Name to use for topmost menu in duplicate
  12. # hierarchy.
  13. sub MenuDup
  14. {
  15.  my $src    = shift;
  16.  my $parent = shift;
  17.  my @args   = ();
  18.  my $option;
  19.  foreach $option ($src->configure())
  20.   {
  21.    next if (@$option == 2);
  22.    push(@args,$$option[0],$$option[4]);
  23.   }
  24.  my $dst = $parent->Menu(@args);
  25.  my $last = $src->index("last");
  26.  return if ($last eq 'none');
  27.  my $i;
  28.  for ($i = $src->cget("-tearoff");$i <= $last;$i += 1)
  29.   {
  30.    my $type = $src->type($i);
  31.    if (defined $type)
  32.     {
  33.      @args = ();
  34.      foreach $option ($src->entryconfigure($i))
  35.       {
  36.        next if (@$option == 2);
  37.        push(@args,$$option[0],$$option[4]) if (defined $$option[4]);
  38.       }
  39.      $dst->add($type,@args);
  40.      if ($type eq "cascade")
  41.       {
  42.        my $srcm = $src->entrycget($i,"-menu");
  43.        if (defined $srcm)
  44.         {
  45.          $dst->entryconfigure($i,"-menu",$srcm->MenuDup($dst));
  46.         }
  47.       }
  48.      elsif ($type eq "checkbutton" || $type eq "radiobutton")
  49.       {
  50.        $dst->entryconfigure($i,"-variable",$src->entrycget($i,"-variable"));
  51.       }
  52.     }
  53.   }
  54.  return $dst;
  55. }
  56.  
  57. 1;
  58.