Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | package Tk::DragDrop::Common; |
2 | ||
3 | use strict; | |
4 | use Carp; | |
5 | ||
6 | use vars qw($VERSION); | |
7 | $VERSION = '3.014'; # $Id: //depot/Tk8/DragDrop/DragDrop/Common.pm#14 $ | |
8 | ||
9 | sub Type | |
10 | { | |
11 | my ($base,$name,$class) = @_; | |
12 | no strict 'refs'; | |
13 | my $hash = \%{"${base}::type"}; | |
14 | my $array = \@{"${base}::types"}; | |
15 | unless (exists $hash->{$name}) | |
16 | { | |
17 | push(@$array,$name); | |
18 | $class = (caller(0))[0] unless (@_ > 2); | |
19 | $hash->{$name} = $class; | |
20 | # confess "Strange class $class for $base/$name" unless ($class =~ /^Tk/); | |
21 | # print "$base $name is ",$class,"\n"; | |
22 | } | |
23 | } | |
24 | ||
25 | sub import | |
26 | { | |
27 | my $class = shift; | |
28 | no strict 'refs'; | |
29 | my $types = \%{"${class}::type"}; | |
30 | while (@_) | |
31 | { | |
32 | my $type = shift; | |
33 | unless (exists $types->{$type}) | |
34 | { | |
35 | if ($type eq 'Local') | |
36 | { | |
37 | $class->Type($type,$class); | |
38 | } | |
39 | else | |
40 | { | |
41 | my ($kind) = $class =~ /([A-Z][a-z]+)$/; | |
42 | my $file = Tk->findINC("DragDrop/${type}${kind}.pm"); | |
43 | if (defined $file) | |
44 | { | |
45 | # print "Loading $file\n"; | |
46 | require $file; | |
47 | } | |
48 | else | |
49 | { | |
50 | croak "Cannot find ${type}${kind}"; | |
51 | } | |
52 | } | |
53 | } | |
54 | } | |
55 | } | |
56 | ||
57 | 1; | |
58 | __END__ | |
59 |