summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Tk/DragDrop/Common.pm
blob: 2f7a33d4fb4823d9c193c61da82c387a82cac1ff (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
package Tk::DragDrop::Common;

use strict;
use Carp;

use vars qw($VERSION);
$VERSION = '4.004'; # $Id: //depot/Tkutf8/DragDrop/DragDrop/Common.pm#4 $

sub Type
{
 my ($base,$name,$class) = @_;
 no strict 'refs';
 my $hash  = \%{"${base}::type"};
 my $array = \@{"${base}::types"};
 unless (exists $hash->{$name})
  {
   push(@$array,$name);
   $class = (caller(0))[0] unless (@_ > 2);
   $hash->{$name} = $class;
   # confess "Strange class $class for $base/$name" unless ($class =~ /^Tk/);
   # print "$base $name is ",$class,"\n";
  }
}

sub import
{
 my $class = shift;
 no strict 'refs';
 my $types = \%{"${class}::type"};
 while (@_)
  {
   my $type = shift;
   unless (exists $types->{$type})
    {
     if ($type eq 'Local')
      {
       $class->Type($type,$class);
      }
     else
      {
       my ($kind) = $class =~ /([A-Z][a-z]+)$/;
       my $file = Tk->findINC("DragDrop/${type}${kind}.pm");
       if (defined $file)
        {
         # print "Loading $file\n";
         require $file;
        }
       else
        {
         croak "Cannot find ${type}${kind}";
        }
      }
    }
  }
}

1;
__END__