Change 17666: Integrate from maint-5.6/macperl

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                      pudge@pobox.com    http://pudge.net/
Open Source Development Network    pudge@osdn.com     http://osdn.com/

• Change 17666: Integrate from maint-5.6/macperl by Chris Nandor