[MacPerl] delete_geometry

["Sean M. Burke" <sean@misinc.net>]

MacPerl files have two resources of note in them:
A TFSP resource #255 (the printing setup for the file) and a
TFSS resource #255 (the font, size and window dimenions for
the file.
When moving MacPerl files between two boxes that have very
different screen sizes (which may call for very different
screen preferences) I find that especially TFSS can be an
annoyance.

The following script deletes the TFSS and TFSP
resources in any MacPerl files you drop on it -- or if
you drop a directory on it, any MacPerl files in or under
that directory.

This script demonstrates deleting resources.

#!Perl
#
# "delete geometry"
#
#Delete window geometry and printing preferences for
# given MacPerl files
#
# Useful for solving the annoying problems created when you move
#  MacPerl files between boxen with wildly different screen sizes.
#
# sburke@netadventure.net 1998-03-19

use Mac::Memory;
use Mac::Resources;
use File::Find;

exit unless @ARGV;
find(\&kill_window_prefs, @ARGV);
print "Done\n";
exit;

sub kill_window_prefs {
  my $SPEC = $File::Find::name;

  return unless -f $SPEC;

  my($creator, $type) = MacPerl::GetFileInfo($SPEC);
  return unless $creator eq 'MrPL' or $creator eq 'McPL';

  my $refnum = OpenResFile($SPEC);
  unless(defined($refnum)) {
    print "$SPEC has no resource fork!\n";
    return;
  }
  #print "Changing $SPEC\n";
  my $handle = Get1Resource('TFSP', 255);
  # 'TFSP' (255)         The printing setup for the file.
  if( $handle ) {
    #print "Removing handle $handle\n";
    RemoveResource($handle)  || print "Error removing: $! $^E\n";
  }

  $handle = Get1Resource('TFSS', 255);
  # 'TFSS' (255)                The font, size and rectangle for the
file.
  if( $handle ) {
    #print "Removing handle $handle\n";
    RemoveResource($handle)  || print "Error removing: $! $^E\n";
  }

  UpdateResFile($refnum) || print "Error writing: $! $^E\n";
  CloseResFile($refnum);
}

__END__

***** Want to unsubscribe from this list?
***** Send mail with body "unsubscribe" to mac-perl-request@iis.ee.ethz.ch