diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Tk/DragDrop/Common.pm')
-rw-r--r-- | Master/tlpkg/tlperl/lib/Tk/DragDrop/Common.pm | 59 |
1 files changed, 59 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Tk/DragDrop/Common.pm b/Master/tlpkg/tlperl/lib/Tk/DragDrop/Common.pm new file mode 100644 index 00000000000..2f7a33d4fb4 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/Tk/DragDrop/Common.pm @@ -0,0 +1,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__ + |