[MacPerl] my_geometry

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

This is an elaboration of delete_geometry.

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) AND replaces them with the TFSS and
TFSP resource of !!!the file you save this script as!!!

(In fact, I keep two versions (differently named) of this
around -- one, my_geometry, for my normal 1024x768 box,
and another, my_geometry_for_wee_screens, with good
geometry for 640x480 -- and when I know I'm going to have
to edit a given script on the 640x480 box, I'll drop that
script onto the my_geometry_for_wee_screens.)

This script demonstrates reading, deleting, and writing
of resources.

#!Perl
#
# "my geometry"
#
#Copies my ("me" being the file on disk for this script) window,
# font choice and size, and printing setup into given Perl scripts
# (Resources TFSS 255 and TFSP 255, resp);
#
# 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;
&get_my_geometry();
find(\&put_window_prefs, @ARGV);
print "Done\n";
exit;

#--------------------------------------------------------------------------
sub get_my_geometry {
  local($SPEC) = $0;
  die "Can't find myself on disk!\n" unless -f $SPEC;

  my($creator, $type) = MacPerl::GetFileInfo($SPEC);
  unless($creator eq 'MrPL' or $creator eq 'McPL') {
    die "I'm not a Perl script?!?  Open me in MacPerl and save me.";
  }

  my $refnum = FSpOpenResFile($SPEC, 1); # read only
  unless(defined($refnum)) {
    die "I have no resource fork?!?  Open me in MacPerl and save me.\n";
  }

  my $handle = Get1Resource('TFSP', 255);
  if( $handle ) {
    $Master_TFSP = $handle->get;
  } else {
    CloseResFile($refnum);
    die "I have no TFSP.  Open me in MacPerl and save me.\n";
  }

  $handle = Get1Resource('TFSS', 255);
  if( $handle ) {
    $Master_TFSS = $handle->get;
  } else {
    CloseResFile($refnum);
    die "I have no TFSS.  Open me in MacPerl and save me.\n";
  }
  CloseResFile($refnum);
}

#--------------------------------------------------------------------------

sub put_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)) {
    #No res fork.  Make one.
    if(CreateResFile($SPEC)) {
      $refnum = OpenResFile($SPEC);
    } else {
      warn "Can't make a resource fork for $SPEC";
      return;
    }
  }

  my $handle = Get1Resource('TFSP', 255);
  # 'TFSP' (255)         The printing setup for the file.
  RemoveResource($handle) if $handle;
  $handle = new Handle($Master_TFSP); # make a new one
  AddResource($handle, 'TFSP', 255, "Printer Info");

  $handle = Get1Resource('TFSS', 255);
  # 'TFSS' (255)                The font, size and rectangle for the
file.
  RemoveResource($handle) if $handle;
  $handle = new Handle($Master_TFSS); # make a new one
  AddResource($handle, 'TFSS', 255, "Header Info");

  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