Change 14079: Add more droplets
[email protected] (Chris Nandor) Fri, 4 Jan 2002 17:35:17 -0500
| Newsgroups | perl.perl5.changes.mac |
|---|---|
| Message-ID | <p05100315b85bdea11b57@[10.0.1.177]> |
Change 14079 by pudge@pudge-mobile on 2002/01/04 21:09:40
Add more droplets
Affected files ...
.... //depot/maint-5.6/macperl/macos/macperl/Droplets/gluedialect.plx#1 add
.... //depot/maint-5.6/macperl/macos/macperl/Droplets/glueedit.plx#1 add
.... //depot/maint-5.6/macperl/macos/macperl/Droplets/gluemac.plx#1 add
.... //depot/maint-5.6/macperl/macos/macperl/Droplets/gluescriptadds.plx#1 add
.... //depot/maint-5.6/macperl/macos/macperl/Droplets/installme.plx#1 add
.... //depot/maint-5.6/macperl/macos/macperl/Droplets/show_glue_pods.plx#1 add
.... //depot/maint-5.6/macperl/macos/macperl/Droplets/tarzipme.plx#1 add
.... //depot/maint-5.6/macperl/macos/macperl/Droplets/untarzipme.plx#1 add
Differences ...
==== //depot/maint-5.6/macperl/macos/macperl/Droplets/gluedialect.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/gluedialect.plx
--- perl/macos/macperl/Droplets/gluedialect.plx.~1~ Fri Jan 4 14:15:08 2002
+++ perl/macos/macperl/Droplets/gluedialect.plx Fri Jan 4 14:15:08 2002
@@ -0,0 +1,77 @@
+#!perl -w
+use strict;
+
+BEGIN { $Mac::Glue::CREATINGGLUES = 1 }
+
+use Cwd;
+use File::Basename;
+use File::Spec::Functions;
+use Mac::Files;
+use Mac::Gestalt qw[Gestalt gestaltSystemVersion];
+use Mac::Glue;
+use Mac::AETE::App;
+use Mac::AETE::Dialect;
+use Mac::AETE::Format::Glue;
+
+if (!@ARGV) {
+ $ARGV[0] = catdir((Gestalt(gestaltSystemVersion) >= hex(800)
+ ? FindFolder(kOnSystemDisk, 'Âscr')
+ : catdir(FindFolder(kOnSystemDisk, kExtensionFolderType),
+ 'Scripting Additions')), 'Dialects');
+}
+die "Can't find Dialects folder\n" if !@ARGV;
+
+if (Gestalt(gestaltSystemVersion) >= hex(900)) {
+ @ARGV = catfile(FindFolder(kOnSystemDisk, kExtensionFolderType), 'AppleScript');
+ warn "Because you are using Mac OS 9, which has a different \"dialect\" setup,\n",
+ "you should go delete old dialect files manually from:\n $ENV{MACGLUEDIR}dialects:\n\n";
+} elsif (@ARGV == 1) {
+ die "Can't find Dialects folder: $ARGV[0] " .
+ "(feel free to drag-and-drop the folder on this droplet)\n" if ! -e $ARGV[0];
+ if (-d _) {
+ chdir $ARGV[0] or die $!;
+ opendir DIR, $ARGV[0] or die $!;
+ @ARGV = readdir DIR;
+ }
+}
+
+my $delete = MacPerl::Answer('Overwrite existing glues if they exist?',
+ qw(OK No Cancel));
+exit if $delete == 0;
+$delete = 0 if $delete == 2;
+
+foreach my $dlct (@ARGV) {
+ my $cwd = cwd();
+ my($conv, $aeut, $output, $file, $dir, $fixed);
+
+ # initialize
+ ($file, $dir) = fileparse($dlct, '');
+
+ print("$file does not appear to be a Dialect (Skipped)\n")
+ && next unless is_dialect($dlct);
+
+ $file =~ s/\s+Dialect$//;
+ $fixed = Mac::AETE::Format::Glue::fixname($file);
+ $output = "$ENV{MACGLUEDIR}dialects:" . $fixed;
+
+ $aeut = Mac::AETE::Dialect->new( -e catfile($cwd, $dlct) ? catfile($cwd, $dlct) : $dlct);
+ $conv = Mac::AETE::Format::Glue->new($output, !$delete);
+
+ $aeut->set_format($conv);
+ $aeut->read();
+ $aeut->write();
+ $conv->finish();
+ print "Created and installed Dialect glue for $file ($fixed)\n";
+}
+
+sub is_dialect {
+ my $dlct = shift;
+
+ return unless -f $dlct;
+
+ my($creator, $type) = MacPerl::GetFileInfo($dlct);
+ return if !$type || !$creator || $creator ne 'ascr' ||
+ ($type ne 'shlb' && $type ne 'dlct' && $type ne 'thng');
+
+ return 1;
+}
==== //depot/maint-5.6/macperl/macos/macperl/Droplets/glueedit.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/glueedit.plx
--- perl/macos/macperl/Droplets/glueedit.plx.~1~ Fri Jan 4 14:15:08 2002
+++ perl/macos/macperl/Droplets/glueedit.plx Fri Jan 4 14:15:08 2002
@@ -0,0 +1,102 @@
+#!perl -w
+use DB_File;
+use Data::Dumper;
+use File::Spec::Functions;
+use Mac::AETE::Format::Glue;
+use Mac::Files;
+use Mac::Glue;
+use Symbol;
+
+=pod
+
+=head1 NAME
+
+glueedit - Edit Mac::Glue glues
+
+=head1 DESCRIPTION
+
+Drop a glue file on here to create a file on the desktop to edit.
+Save it back by dropping the text file back on the droplet again.
+Careful: this droplet will evaluate the contents of the text
+file, and then write to whatever file is named on the first line
+of that file, and then save the contents of the file as a glue.
+So be careful not to do something Bad.
+
+=cut
+
+my $dir = FindFolder(kOnSystemDisk, kDesktopFolderType);
+my $gtype = $Mac::AETE::Format::Glue::TYPE || 'McPp';
+
+
+for my $glue (@ARGV) {
+ my $type = MacPerl::GetFileInfo($glue);
+ if ($type eq $gtype) {
+ get_glue($glue);
+ } elsif ($type eq 'TEXT') {
+ save_glue($glue);
+ }
+}
+
+sub save_glue {
+ my $file = shift;
+ my $glue = {Mac::AETE::Format::Glue::_init(), DELETE => 1};
+
+ my $fh = gensym;
+ open $fh, "< $file" or die "Can't open $file: $!";
+
+ chomp($glue->{OUTPUT} = <$fh>);
+ my $dump;
+ { local $/;
+ $dump = eval <$fh>;
+ }
+ close $fh;
+
+ $glue->{N} = $dump->{ENUM};
+ $glue->{C} = $dump->{CLASS};
+ $glue->{E} = $dump->{EVENT};
+ $glue->{P} = $dump->{COMPARISON};
+ $glue->{ID} = $dump->{ID};
+
+ Mac::AETE::Format::Glue::finish($glue, 1); # 1 == no pod
+
+ print <<EOT;
+Created glue $glue->{OUTPUT}
+ from file $file
+
+EOT
+}
+
+ $dbm{ENUM} = $self->{N};
+ $dbm{CLASS} = $self->{C};
+ $dbm{EVENT} = $self->{E};
+ $dbm{COMPARISON} = $self->{P};
+ $dbm{ID} = $self->{ID};
+
+sub get_glue {
+ my $glue = shift;
+ tie my %db, 'MLDBM', $glue, O_RDONLY or die "Can't tie '$glue': $!";
+
+ my $file = get_filename($db{ID});
+
+ my $fh = gensym;
+ open $fh, "> $file" or die "Can't open $file: $!";
+ print $fh $glue, "\n";
+ print $fh Dumper \%db;
+ untie %db;
+
+ print <<EOT;
+Created file $file
+ for glue $glue
+
+EOT
+}
+
+
+sub get_filename {
+ my $id = shift;
+ my $c = '';
+ $c++ while -e catfile($dir, "glueedit-$id$c.txt");
+ return catfile($dir, "glueedit-$id$c.txt");
+}
+
+__END__
==== //depot/maint-5.6/macperl/macos/macperl/Droplets/gluemac.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/gluemac.plx
--- perl/macos/macperl/Droplets/gluemac.plx.~1~ Fri Jan 4 14:15:08 2002
+++ perl/macos/macperl/Droplets/gluemac.plx Fri Jan 4 14:15:08 2002
@@ -0,0 +1,36 @@
+#!perl -w
+use strict;
+
+use File::Basename;
+use Mac::Glue;
+use Mac::AETE::App;
+use Mac::AETE::Dialect;
+use Mac::AETE::Format::Glue;
+
+my $delete = MacPerl::Answer('Overwrite existing glues if they exist?',
+ qw(OK No Cancel));
+exit if $delete == 0;
+$delete = 0 if $delete == 2;
+
+foreach my $drop (@ARGV) {
+ my($oldfh, $conv, $aeut, $aete, $output, $file, $dir, $fixed);
+
+ $drop = readlink $drop while -l $drop;
+
+ # initialize
+ ($file, $dir) = fileparse($drop, '');
+ $fixed = Mac::AETE::Format::Glue::fixname($file);
+ $fixed = MacPerl::Ask('What is the glue name?', $fixed);
+ print("No name given for $file (Skipped)\n")
+ && next if !$fixed || $fixed eq '';
+ $output = $ENV{MACGLUEDIR} . $fixed;
+
+ next unless $aete = Mac::AETE::App->new($drop);
+ $conv = Mac::AETE::Format::Glue->new($output, !$delete);
+
+ $aete->set_format($conv);
+ $aete->read();
+ $aete->write();
+ $conv->finish();
+ print "Created and installed glue for $file ($fixed)\n";
+}
==== //depot/maint-5.6/macperl/macos/macperl/Droplets/gluescriptadds.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/gluescriptadds.plx
--- perl/macos/macperl/Droplets/gluescriptadds.plx.~1~ Fri Jan 4 14:15:08 2002
+++ perl/macos/macperl/Droplets/gluescriptadds.plx Fri Jan 4 14:15:08 2002
@@ -0,0 +1,71 @@
+#!perl -w
+use strict;
+
+BEGIN { $Mac::Glue::CREATINGGLUES = 1 }
+
+use Mac::Glue;
+use Cwd;
+use File::Basename;
+use File::Spec::Functions;
+use Mac::Files;
+use Mac::Gestalt;
+use Mac::AETE::App;
+use Mac::AETE::Dialect;
+use Mac::AETE::Format::Glue;
+
+if (!@ARGV) {
+ $ARGV[0] = Gestalt(gestaltSystemVersion) >= hex(800)
+ ? FindFolder(kOnSystemDisk, 'Âscr')
+ : catdir(FindFolder(kOnSystemDisk, kExtensionFolderType),
+ 'Scripting Additions');
+}
+die "Can't find Scripting Additions folder\n" if !@ARGV;
+
+if (@ARGV == 1 && -d $ARGV[0]) {
+ die "Can't find Scripting Additions folder: $ARGV[0] " .
+ "(feel free to drag-and-drop the folder on this droplet)\n" if ! -e $ARGV[0];
+ if (-d _) {
+ chdir $ARGV[0] or die $!;
+ opendir DIR, $ARGV[0] or die $!;
+ my $cwd = cwd();
+ @ARGV = map { catfile($cwd, $_) } readdir DIR;
+ }
+}
+
+my $delete = MacPerl::Answer('Overwrite existing glues if they exist?',
+ qw(OK No Cancel));
+exit if $delete == 0;
+$delete = 0 if $delete == 2;
+
+foreach my $osax (@ARGV) {
+ my($conv, $aete, $output, $file, $dir, $fixed);
+
+ # initialize
+ ($file, $dir) = fileparse($osax, '');
+
+ print("$file does not appear to be an OSAX (Skipping)\n")
+ && next unless is_osax($osax);
+
+ $fixed = Mac::AETE::Format::Glue::fixname($file);
+ $output = "$ENV{MACGLUEDIR}additions:" . $fixed;
+
+ $aete = Mac::AETE::App->new( $osax );
+ $conv = Mac::AETE::Format::Glue->new($output, !$delete);
+
+ $aete->set_format($conv);
+ $aete->read();
+ $aete->write();
+ $conv->finish();
+ print "Created and installed OSAX glue for $file ($fixed)\n";
+}
+
+sub is_osax {
+ my $osax = shift;
+
+ return unless -f $osax;
+
+ my $type = MacPerl::GetFileInfo($osax);
+ return if !$type || $type ne 'osax';
+
+ return 1;
+}
==== //depot/maint-5.6/macperl/macos/macperl/Droplets/installme.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/installme.plx
--- perl/macos/macperl/Droplets/installme.plx.~1~ Fri Jan 4 14:15:08 2002
+++ perl/macos/macperl/Droplets/installme.plx Fri Jan 4 14:15:08 2002
@@ -0,0 +1,59 @@
+#!perl -w
+#-----------------------------------------------------------------#
+# installme.plx
+# http://pudge.net/
+#
+# Created: Chris Nandor ([email protected]) 24 Jan 1999
+# Last Modified: Chris Nandor ([email protected]) 28 Jul 1999
+#-----------------------------------------------------------------#
+# This script installs distributions. It will unpack and install
+# .tar.gz or .tgz archives if they are dropped on it, or install
+# the contents of a folder.
+#
+# Edit $verbose and $switch variables to customize for verbosity
+# and conversion behavior.
+#-----------------------------------------------------------------#
+use Archive::Tar;
+use File::Basename;
+use Mac::Conversions ();
+use Mac::BuildTools ();
+use strict;
+local $| = 1;
+
+my $verbose = 1;
+my $re = '\.t(ar\.)?gz$';
+
+my $archive = my $dir = $ARGV[0];
+
+if ($archive =~ /$re/) {
+ my $switch = MacPerl::Answer(
+ 'Convert all text and MacBinary files?', 'Yes', 'No');
+ my $conv = Mac::Conversions->new(Remove=>1);
+
+ my $tar = Archive::Tar->new($archive, 1) or die $!;
+ chdir(dirname($archive)) or die "Can't chdir: $!";
+
+ my @files = $tar->list_files;
+
+ foreach my $file (@files) {
+ my $dir = ':' . dirname(Archive::Tar::_munge_file($file));
+ die "$dir already exists, will not overwrite\n"
+ if -e $dir;
+ }
+
+ print "Unpacking archive ...\n";
+ $tar->extract(@files);
+
+ print "Converting files ...\n";
+ Mac::BuildTools::convert_files(\@files, $verbose) if $switch;
+
+ $dir =~ s/$re//;
+}
+
+chdir $dir or die "Can't chdir $dir: $!\n";
+Mac::BuildTools::make({});
+Mac::BuildTools::make_install({});
+
+print "Done.\n";
+
+__END__
==== //depot/maint-5.6/macperl/macos/macperl/Droplets/show_glue_pods.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/show_glue_pods.plx
--- perl/macos/macperl/Droplets/show_glue_pods.plx.~1~ Fri Jan 4 14:15:08 2002
+++ perl/macos/macperl/Droplets/show_glue_pods.plx Fri Jan 4 14:15:08 2002
@@ -0,0 +1,24 @@
+#!perl -w
+use File::Spec::Functions;
+use Mac::Glue;
+use Mac::InternetConfig;
+$app = MacPerl::Ask('Enter the name of a glue:') or exit;
+($app1 = $app) =~ tr/ /_/;
+($app2 = $app) =~ tr/_/ /;
+
+OUTER: for my $d (map { "$ENV{MACGLUEDIR}$_" } '', 'dialects', 'additions') {
+ for ($app, $app1, $app2) {
+ my $f = catfile($d, "$_.pod");
+ if (-e $f) {
+ $file = $f;
+ $file =~ tr|:|/|;
+ last OUTER;
+ }
+ }
+}
+
+if ($file) {
+ GetURL "pod:///$file";
+} else {
+ MacPerl::Answer "'$app' not found.";
+}
==== //depot/maint-5.6/macperl/macos/macperl/Droplets/tarzipme.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/tarzipme.plx
--- perl/macos/macperl/Droplets/tarzipme.plx.~1~ Fri Jan 4 14:15:08 2002
+++ perl/macos/macperl/Droplets/tarzipme.plx Fri Jan 4 14:15:08 2002
@@ -0,0 +1,271 @@
+#!perl
+#-----------------------------------------------------------------#
+# tarzipme.plx
+# http://pudge.net/
+#
+# Created: Chris Nandor ([email protected]) 04 Jan 1999
+# Last Modified: Chris Nandor ([email protected]) 28 Jul 1999
+#-----------------------------------------------------------------#
+# This script primarily for developers, to make distributions.
+# Feel free to edit it to suit your needs: you might want to,
+# for instance, make the macbinarizing non-interactive, and
+# work only on certain file types.
+#
+# In file window, text files are normal font, macbinary are bold,
+# and no conversion is italic.
+#
+# Edit $verbose and $switch variables to customize for verbosity
+# and conversion behavior.
+#-----------------------------------------------------------------#
+use Archive::Tar;
+use File::Basename;
+use File::Copy;
+use File::Find;
+use File::Path;
+
+use Mac::Conversions;
+use Mac::Dialogs;
+use Mac::Events;
+use Mac::Files;
+use Mac::Fonts;
+use Mac::Lists;
+use Mac::MoreFiles;
+use Mac::QuickDraw;
+use Mac::Windows;
+
+use strict;
+use constant NO_CONVERSION => 0;
+use constant TEXT => 1;
+use constant MACBINARY => 2;
+
+$^W = 1;
+
+my($verbose, $ans, $switch, $conv, %con, %style);
+$verbose = 1;
+$conv = new Mac::Conversions;
+
+%style = (
+ NO_CONVERSION, italic,
+ TEXT , normal,
+ MACBINARY , bold,
+);
+$ans = <<EOT;
+Select a method for file conversion. Select automatic conversion
+(where -T means CR to LF conversion, and -B means MacBinarize),
+pick a method for each file manually, or do no conversion.
+EOT
+$ans =~ s/\n/ /g;
+
+do_it();
+print "Done.\n";
+
+#-----------------------------------------------------------------#
+sub do_it {
+ my($dir, $tar, $file, @f, $mdir, $ndir, $tdir, $edir);
+ local $|;
+
+ $dir = $ARGV[0];
+ unless ($dir && -d $dir) {
+ die "Need directory name";
+ }
+ $dir =~ s/:$//;
+ $file = get_filename($dir);
+ $ndir = basename($dir);
+ $edir = "$ENV{TMPDIR}macperltar:";
+ $tdir = "$edir$ndir";
+ $mdir = dirname($tdir);
+ $tar = new Archive::Tar;
+
+ die "Cannot continue: archive $file exists\n" if -e $file;
+ create_dir($dir, $edir, $tdir);
+ create_file($file);
+
+ chdir($edir) or die "Can't chdir $edir: $!";
+
+ $switch = MacPerl::Answer($ans, 'Automatic', 'Manual', 'None');
+ do_dialog($tdir, $mdir) if $switch == 1;
+
+ print "Converting files ...\n";
+ find(sub {
+ my $f = $File::Find::name;
+ return if ! -f $f || $f =~ /:Icon\n$/;
+ (my $n = $f) =~ s/^$mdir//;
+ $n = ":$n" unless $n =~ /^:/;
+ $n = convert($f, $n) if $switch;
+ push @f, $n;
+ }, $tdir);
+
+ print "Adding files to archive ...\n";
+ $tar->add_files(@f);
+ print "Writing archive to <$file> ...\n";
+ $tar->write($file, 1);
+ print "Cleaning up ...\n";
+ rmtree($tdir);
+}
+#-----------------------------------------------------------------#
+sub guess {
+ my $f = shift;
+ my $guess = 0;
+ if (-s $f && -T _) {
+ $guess = TEXT;
+ } elsif (-s _ && -B _) {
+ $guess = MACBINARY;
+ } elsif (-B _) {
+ my $cat = FSpGetCatInfo($f);
+ $guess = MACBINARY if ($cat->ioFlRLgLen());
+ }
+ return $guess;
+}
+#-----------------------------------------------------------------#
+sub convert {
+ my($f, $n) = @_;
+ if ($switch == 2) {
+ my $guess = guess($f);
+ if ($guess == TEXT) {
+ return cr2lf($f, $n);
+ } elsif ($guess == MACBINARY) {
+ return bi2bin($f, $n);
+ } else {
+ return leave_alone($f, $n);
+ }
+ } elsif ($switch == 1) {
+ if ($con{$n} == TEXT) {
+ return cr2lf($f, $n);
+ } elsif ($con{$n} == MACBINARY) {
+ return bi2bin($f, $n);
+ } else {
+ return leave_alone($f, $n);
+ }
+ }
+}
+#-----------------------------------------------------------------#
+sub leave_alone {
+ my($f, $n, $t) = @_;
+ print " Left alone $n\n" if $verbose;
+ return $n;
+}
+#-----------------------------------------------------------------#
+sub bi2bin {
+ my($f, $n, $t) = @_;
+ undef $t;
+ $conv->macbinary($f);
+ $n .= '.bin';
+ print " Macbinarized $n\n" if $verbose;
+ return $n;
+}
+#-----------------------------------------------------------------#
+sub cr2lf {
+ local(*F, $/);
+ my($f, $n, $t) = @_;
+ open(F, "< $f\0") or die "Can't open $f: $!";
+ $t = <F>;
+ close(F);
+ $t =~ s/\015\012?/\012/g if $t;
+ open(F, "> $f\0") or die "Can't open $f: $!";
+ print F $t;
+ close(F);
+ print " CRLF? to LF $n\n" if $verbose;
+ return $n;
+}
+#-----------------------------------------------------------------#
+sub create_file {FSpCreate(shift, qw/Gzip Gzip/) or die $^E}
+#-----------------------------------------------------------------#
+sub create_dir {
+ my($dir, $edir, $tdir) = @_;
+ unless (-d $edir) {mkdir $edir, 0777 or die "Cannot create $edir: $!"}
+ rmtree($tdir) if -d $tdir;
+ FSpDirectoryCopy($dir, $edir, 1)
+ or die "Can't copy $dir to $edir: $^E";
+}
+#-----------------------------------------------------------------#
+sub get_filename {
+ my $name = shift;
+ my($file, $path) = fileparse($name, '');
+ my $tfile = length($file) < 24 ? "$file.tar.gz" :
+ length($file) < 28 ? "$file.tgz" :
+ substr($file, 0, 23) . "\xC9.tar.gz";
+ return "$path$tfile";
+}
+
+#=================================================================#
+# List stuff for manual selection #
+#=================================================================#
+sub do_dialog {
+ my($tdir, $mdir) = @_;
+ my @files;
+
+ find(sub {
+ my $f = $File::Find::name;
+ return if ! -f $f || $f =~ /:Icon\n$/;
+ (my $n = $f) =~ s/^$mdir//;
+ push @files, $n;
+ $con{$n} = [guess($f), 0];
+ }, $tdir);
+
+ my $win = MacWindow->new(
+ Rect->new(100, 50, 600, 350), 'Files to tarzip',
+ 1, floatProc(), 1
+ );
+ $win->sethook(redraw => sub {});
+ SetPort($win->window);
+ TextFont(geneva());
+ TextSize(9);
+ my $list = $win->new_list(
+ Rect->new(0, 0, 484, 300),
+ Rect->new(0, 0, 1, scalar @files),
+ Point->new(0, 13), \&myLDEF, 1, 1
+ );
+
+ $list->sethook(key=>sub{
+ my($mod) = $Mac::Events::CurrentEvent->modifiers();
+ if ($_[2] == ord('w') && (($mod & cmdKey()) == cmdKey())) {
+ $win->dispose();
+ return 1;
+ }
+ return;
+ });
+
+ for (my $c = 0; $c <= $#files; $c++) {
+ $list->set(0, $c, $files[$c]);
+ }
+
+ while ($win->window()) {
+ WaitNextEvent();
+ }
+
+ $win->dispose() if defined($win);
+
+ END {
+ $win->dispose() if defined($win);
+ }
+
+ foreach my $n (keys %con) {
+ $con{$n} = $con{$n}->[0] % 3;
+ }
+}
+#-----------------------------------------------------------------#
+sub myLDEF {
+ my($msg, $select, $rect, $cell, $data, $list) = @_;
+
+ return unless $msg == lDrawMsg || $msg == lHiliteMsg;
+ my($where) = AddPt($rect->topLeft, $list->indent);
+ EraseRect $rect;
+
+ $con{$data}->[0]++ if ($select && ($con{$data}->[1]++ % 2));
+ TextFace($style{ $con{$data}->[0] % 3 });
+ LSetSelect(0, $cell, $list);
+
+ MoveTo($where->h, $where->v);
+ DrawString $data;
+}
+#-----------------------------------------------------------------#
+sub check_value {
+ my($win, $list, $x, $y) = @_;
+ return if !$list->{'list'};
+ $y = LGetSelect(1, Point->new(0,1), $list->{'list'});
+ $x = $list->get($y) if $y;
+ return if ref($x);
+}
+#-----------------------------------------------------------------#
+
+__END__
==== //depot/maint-5.6/macperl/macos/macperl/Droplets/untarzipme.plx#1 (text) ====
Index: perl/macos/macperl/Droplets/untarzipme.plx
--- perl/macos/macperl/Droplets/untarzipme.plx.~1~ Fri Jan 4 14:15:08 2002
+++ perl/macos/macperl/Droplets/untarzipme.plx Fri Jan 4 14:15:08 2002
@@ -0,0 +1,52 @@
+#!perl -w
+#-----------------------------------------------------------------#
+# untarzipme.plx
+# http://pudge.net/
+#
+# Created: Chris Nandor ([email protected]) 04 Jan 1999
+# Last Modified: Chris Nandor ([email protected]) 28 Jul 1999
+#-----------------------------------------------------------------#
+# This script unpacks tar.gz archives. It converts all files
+# that test true with -T to Mac newlines, and converts files
+# that test true with -B and have the ending .bin from
+# macbinary to regular Mac files.
+#
+# Edit $verbose and $switch variables to customize for verbosity
+# and conversion behavior.
+#-----------------------------------------------------------------#
+use Archive::Tar;
+use File::Basename;
+use Mac::Conversions ();
+use Mac::BuildTools ();
+use strict;
+local $| = 1;
+
+my $verbose = 1;
+
+my $switch = MacPerl::Answer(
+ 'Convert all text and MacBinary files?', 'Yes', 'No');
+my $conv = Mac::Conversions->new(Remove=>1);
+
+foreach my $archive (@ARGV) {
+ print "Unpacking archive:\n $archive\n";
+ my $tar = Archive::Tar->new($archive, 1) or die $!;
+ chdir(dirname($archive)) or die "Can't chdir: $!";
+
+ my @files = $tar->list_files;
+
+ foreach my $file (@files) {
+ my $dir = ':' . dirname(Archive::Tar::_munge_file($file));
+ die "$dir already exists, will not overwrite\n"
+ if -e $dir;
+ }
+
+ print "Unpacking ...\n";
+ $tar->extract(@files);
+
+ print "Converting files ...\n";
+ Mac::BuildTools::convert_files(\@files, $verbose) if $switch;
+}
+
+print "Done.\n";
+
+__END__
End of Patch.