Change 17666 by pudge@pudge-mobile on 2002/07/29 20:04:54
Integrate from maint-5.6/macperl
Changes 17660, 17661, 17662, 17663, 17664
Affected files ...
.... //depot/macperl/macos/ext/Mac/Dialogs/Dialogs.pm#2 edit
.... //depot/macperl/macos/lib/Mac/AETE/App.pm#2 edit
.... //depot/macperl/macos/lib/Mac/AETE/Format/Glue.pm#2 edit
.... //depot/macperl/macos/lib/Mac/OSA/Simple.pm#3 edit
.... //depot/macperl/macos/macperl/Droplets/gluemac.plx#2 edit
.... //depot/macperl/perl.c#8 edit
Differences ...
==== //depot/macperl/macos/ext/Mac/Dialogs/Dialogs.pm#2 (text) ====
Index: macperl/macos/ext/Mac/Dialogs/Dialogs.pm
--- macperl/macos/ext/Mac/Dialogs/Dialogs.pm#1~16123~ Tue Apr 23 18:25:17 2002
+++ macperl/macos/ext/Mac/Dialogs/Dialogs.pm Mon Jul 29 13:04:54 2002
@@ -475,9 +475,16 @@
=cut
sub click {
- my($handled);
- defined($handled = $_[0]->callhook("click", @_)) and return 1;
- _dialogselect(@_);
+ my($self, $pt) = @_;
+ for my $pane (@{$self->{panes}}) {
+ if ($pane->click($self, $pt)) {
+ $self->advance_focus($pane);
+ return 1;
+ }
+ };
+ my($handled);
+ defined($handled = $self->callhook("click", @_)) and return 1;
+ _dialogselect(@_);
}
=item modal [FILTER]
@@ -523,7 +530,7 @@
$CurrentEvent->what(0);
&_dialogselect;
$CurrentEvent->what($savedwhat);
- &MacWindow::idle;
+ &MacWindow::idle;
}
=item KIND = item_kind ITEM
==== //depot/macperl/macos/lib/Mac/AETE/App.pm#2 (text) ====
Index: macperl/macos/lib/Mac/AETE/App.pm
--- macperl/macos/lib/Mac/AETE/App.pm#1~16123~ Tue Apr 23 18:25:17 2002
+++ macperl/macos/lib/Mac/AETE/App.pm Mon Jul 29 13:04:54 2002
@@ -111,13 +111,15 @@
use strict;
+use File::Basename;
+use File::Spec::Functions qw(catfile);
use Mac::AETE::Parser;
use Mac::AppleEvents;
use Mac::Files;
use Mac::Memory;
use Mac::Processes;
use Mac::Resources;
-use File::Basename;
+use Symbol;
use Carp;
@@ -128,13 +130,14 @@
my $self = {};
my $aete_handle;
- my($name, $running) = &get_app_status_and_launch($target);
+ my($name, $running, $sign) = &get_app_status_and_launch($target);
return unless $name;
$self->{_target} = $name;
+ $self->{ID} = $sign;
if ($running) {
- unless ($aete_handle = get_aete_via_event($target)) {
+ unless ($aete_handle = get_aete_via_event($target, $sign)) {
carp("The application is not scriptable");
return;
}
@@ -164,53 +167,81 @@
{
my ($app_path) = @_;
my ($name, $path, $suffix, $running, $ok_to_launch, $pname, $launch);
- my ($psn, $psi);
-
+ my ($psn, $psi, $sign);
+
$running = 0;
- fileparse_set_fstype("MacOS");
- ($name,$path,$suffix) = fileparse($app_path, "");
- for $psn (keys %Process) {
- $pname = $Process{$psn}->processName;
-# print "$pname", " $name\n";
- $running = 1, last if $pname eq $name;
+
+ # test for package, works under Mac OS X/Classic too
+ my $pkginfo = catfile($app_path, 'Contents', 'PkgInfo');
+ if (-d $app_path && -f $pkginfo) {
+ my $fh = gensym();
+ open $fh, "<" . $pkginfo or croak "Can't open $pkginfo: $!";
+ (my($type), $sign) = (<$fh> =~ /^(.{4})(.{4})$/);
+ for $psn (keys %Process) {
+ $pname = $Process{$psn}->processName;
+ $running = 1, $name = $pname, last
+ if $sign eq $Process{$psn}->processSignature;
+ }
+ $ok_to_launch = !$running;
+
+ } else {
+ fileparse_set_fstype("MacOS");
+ ($name,$path,$suffix) = fileparse($app_path, "");
+ for $psn (keys %Process) {
+ $pname = $Process{$psn}->processName;
+# print "$pname", " $name\n";
+ $running = 1, last if $pname eq $name;
+ }
}
+
if (!$running) {
- my $RF = OpenResFile($app_path);
- if (!defined($RF) || $RF == 0) {
- carp("No Resource Fork available for '$app_path': $^E");
- return;
+ unless (-d $app_path && -f $pkginfo) {
+ my $RF = OpenResFile($app_path);
+ if (!defined($RF) || $RF == 0) {
+ carp("No Resource Fork available for '$app_path': $^E");
+ return;
+ }
+ my $check_resource = Get1Resource('scsz', 0);
+ if (!defined($check_resource) || $check_resource == 0) {
+ $check_resource = Get1Resource('scsz', 128);
+ }
+ $ok_to_launch = defined($check_resource) && $check_resource;
+ CloseResFile($RF); # don't do anything with the resource now!
}
- my $check_resource = Get1Resource('scsz', 0);
- if (!defined($check_resource) || $check_resource == 0) {
- $check_resource = Get1Resource('scsz', 128);
- }
- $ok_to_launch = defined($check_resource) && $check_resource;
- CloseResFile($RF); # don't do anything with the resource now!
- if ($ok_to_launch) {
+ if ($ok_to_launch) {
$launch = new LaunchParam(
launchControlFlags => eval(launchContinue + launchNoFileFlags +
launchDontSwitch),
launchAppSpec => $app_path
);
LaunchApplication $launch;
$running = 1;
+ sleep 10;
}
}
-
+
while (($psn, $psi) = each(%Process)) {
- $pname = $psi->processName;
- $running = 1, last if $pname eq $name;
+ if (defined $sign) {
+ $running = 1, $name = $psi->processName,
+ last if $sign eq $psi->processSignature;
+ } else {
+ $running = 1, $sign = $psi->processSignature,
+ last if $name eq $psi->processName;
+ }
}
$name = $app_path if $name !~ /:/;
- ($name, $running);
+ ($name, $running, $sign);
}
sub get_aete_via_event
{
- my($target) = @_;
- my $info = FSpGetFInfo($target);
-
- my $addr_desc = AECreateDesc(typeApplSignature, $info->fdCreator);
- my $event = AEBuildAppleEvent('ascr', 'gdte', 'sign', $info->fdCreator, 0, 0, ,
"'----':0");
+ my($target, $sign) = @_;
+ if (!$sign) {
+ my $info = FSpGetFInfo($target);
+ $sign = $info->fdCreator;
+ }
+
+ my $addr_desc = AECreateDesc(typeApplSignature, $sign);
+ my $event = AEBuildAppleEvent('ascr', 'gdte', 'sign', $sign, 0, 0, , "'----':0");
my $reply = AESend($event, kAEWaitReply);
my @handles;
if ($reply) {
==== //depot/macperl/macos/lib/Mac/AETE/Format/Glue.pm#2 (text) ====
Index: macperl/macos/lib/Mac/AETE/Format/Glue.pm
--- macperl/macos/lib/Mac/AETE/Format/Glue.pm#1~16123~ Tue Apr 23 18:25:17 2002
+++ macperl/macos/lib/Mac/AETE/Format/Glue.pm Mon Jul 29 13:04:54 2002
@@ -1,11 +1,14 @@
package Mac::AETE::Format::Glue;
+use Carp;
use Data::Dumper;
use Fcntl;
use File::Basename;
use File::Path;
+use File::Spec::Functions qw(catfile);
use Mac::AETE::Parser;
use Mac::Glue;
use MLDBM ('DB_File', $Mac::Glue::SERIALIZER);
+use Symbol;
use strict;
use vars qw(@ISA $VERSION $TYPE);
@@ -205,7 +208,19 @@
sub write_title {
my($self, $title) = @_;
- $self->{ID} = (MacPerl::GetFileInfo($title))[0];
+
+ my $pkginfo = catfile($title, 'Contents', 'PkgInfo');
+ if (-d $title && -f $pkginfo) {
+ my $fh = gensym();
+ open $fh, "<" . $pkginfo or croak "Can't open $pkginfo: $!";
+ my($type, $sign) = (<$fh> =~ /^(.{4})(.{4})$/);
+ $self->{ID} = $sign;
+ } else {
+ $self->{ID} = (MacPerl::GetFileInfo($title))[0];
+ }
+ croak("Can't get application signature for $title")
+ if !$self->{ID};
+
$self->{TITLE} = basename($self->{OUTPUT});
}
==== //depot/macperl/macos/lib/Mac/OSA/Simple.pm#3 (text) ====
Index: macperl/macos/lib/Mac/OSA/Simple.pm
--- macperl/macos/lib/Mac/OSA/Simple.pm#2~16469~ Tue May 7 20:48:53 2002
+++ macperl/macos/lib/Mac/OSA/Simple.pm Mon Jul 29 13:04:54 2002
@@ -17,7 +17,7 @@
load_osa_script %ScriptComponents);
@EXPORT_OK = @Mac::OSA::EXPORT;
%EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]);
-$REVISION = '$Id: Simple.pm,v 1.2 2002/01/23 05:45:12 pudge Exp $';
+$REVISION = '$Id: Simple.pm,v 1.3 2002/05/08 03:59:30 pudge Exp $';
$VERSION = '1.00';
tie %ScriptComponents, 'Mac::OSA::Simple::Components';
==== //depot/macperl/macos/macperl/Droplets/gluemac.plx#2 (text) ====
Index: macperl/macos/macperl/Droplets/gluemac.plx
--- macperl/macos/macperl/Droplets/gluemac.plx#1~16123~ Tue Apr 23 18:25:17 2002
+++ macperl/macos/macperl/Droplets/gluemac.plx Mon Jul 29 13:04:54 2002
@@ -18,6 +18,7 @@
$drop = readlink $drop while -l $drop;
# initialize
+ $drop =~ s/:$//; # is dir/package ?
($file, $dir) = fileparse($drop, '');
$fixed = Mac::AETE::Format::Glue::fixname($file);
$fixed = MacPerl::Ask('What is the glue name?', $fixed);
==== //depot/macperl/perl.c#8 (text) ====
Index: macperl/perl.c
--- macperl/perl.c#7~17528~ Sun Jul 14 05:07:17 2002
+++ macperl/perl.c Mon Jul 29 13:04:54 2002
@@ -1158,7 +1158,7 @@
#ifdef MACOS_TRADITIONAL
/* ignore -e for Dev:Pseudo argument */
if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
- break;
+ break;
#endif
if (PL_euid != PL_uid || PL_egid != PL_gid)
Perl_croak(aTHX_ "No -e allowed in setuid scripts");
@@ -3274,6 +3274,9 @@
S_find_beginning(pTHX)
{
register char *s, *s2;
+#ifdef MACOS_TRADITIONAL
+ int maclines = 0;
+#endif
/* skip forward in input to the real script? */
@@ -3285,16 +3288,16 @@
if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
if (!gMacPerl_AlwaysExtract)
Perl_croak(aTHX_ "No Perl script found in input\n");
-
+
if (PL_doextract) /* require explicit override ? */
if (!OverrideExtract(PL_origfilename))
Perl_croak(aTHX_ "User aborted script\n");
else
PL_doextract = FALSE;
-
+
/* Pater peccavi, file does not have #! */
PerlIO_rewind(PL_rsfp);
-
+
break;
}
#else
@@ -3317,7 +3320,18 @@
;
}
#ifdef MACOS_TRADITIONAL
+ /* We are always searching for the #!perl line in MacPerl,
+ * so if we find it, still keep the line count correct
+ * by counting lines we already skipped over
+ */
+ for (; maclines > 0 ; maclines--)
+ PerlIO_ungetc(PL_rsfp, '\n');
+
break;
+
+ /* gMacPerl_AlwaysExtract is false in MPW tool */
+ } else if (gMacPerl_AlwaysExtract) {
+ ++maclines;
#endif
}
}
End of Patch.
--
Chris Nandor [EMAIL PROTECTED] http://pudge.net/
Open Source Development Network [EMAIL PROTECTED] http://osdn.com/
