: # Exec perl
eval 'exec perl -S $0 "$@"'
    if $running_under_some_shell;

# Set up some global variables

$version = "5.5.6";
$software = "frame";
$sw_locker = "/mit/${software}_v${version}";
$message_dir = "$sw_locker/Athena/messages";
$swtoolsDir = "/afs/athena/software/swtools";
$swtoolsBin = "$swtoolsDir/bin";

#$cookie = "frame_5.5";
#&delete_cookie($cookie);

@license_server_list = (
			'lydian',
			);

# Do the real stuff
&initialize_environment;
&process_local_args;
&set_license_server;

if ( ($0 =~ /maker/)) {
    &handle_resources;

}

&run_program ($sys);

# -----------------------------------------------------------------------
# initialize_environment
#
# Set up all kinds of environment variables and other variables we
# will need later.
#
# Globals Set
#	$sys		envvar ATHENA_SYS
#	$distrib	location of Frame distribution
#	cookie, message pairs
#
# Globals Referenced
#	$sw_locker
#
# ----------------------------------------------------------------------
sub initialize_environment
{
    local (*BINDIR);
    local (*MACH);

    if (! defined ($sys = $ENV{"ATHENA_SYS"})) {
	open (MACH, "/srvd/bin/athena/machtype -S|");
	chop ($sys = <MACH>);
	if (length ($sys) == 0) {
	    $sys = "\@sys";
	}
	close MACH;
    }
    $distrib = "$sw_locker/distrib/$sys";

# next few lines were for bibframe stuff which no longer works
#    mkdir("/usr/tmp/$ENV{'USER'}", 0775) unless -d "/usr/tmp/$ENV{'USER'}";
#    $ENV{'TMPDIR'} = "/usr/tmp/$ENV{'USER'}";
    $ENV{'FMHOME'} = "$sw_locker/distrib/$sys";

#    $ENV{'FMGROUPMENU'} = "fmCustomUI";
}

#-----------------------------------------------------------------------
# process_local_args
#
# Read through the command line arguments, pulling out Athena specific
# ones.  This routine also handles the backwards compatibility for
# foreign language interfaces.  
#
# Globals Set
#	$0		For backwards-compatibility
#	@arglist	non-athena command line args
#
# Globals Referenced
#	$crash_cookie
#	@ARGV
#
# ----------------------------------------------------------------------
sub process_local_args 
{
    local ($arg);

    if ($0 =~ /german/) {
	push (@arglist, "-l", "deutsch");
	$0 = "imaker";
    }

    if ($0 =~ /french/) {
	push (@arglist, "-l", "francais");
	$0 = "imaker";
    }

    while (@ARGV) {
	$arg = shift (@ARGV);
      ARGS:			
	{
	    if ($arg eq "-server") {
		$ENV{'FM_FLS_HOST'} = shift (@ARGV);
		last ARGS;
	    }
	    if ($arg eq "-nomsg") {
		&add_cookie ($crash_cookie);
		last ARGS;
	    }
	    if ($arg eq "-nomsgver") {
		# not used any more
		last ARGS;
	    }
	    push (@arglist, $arg);
	}
    }

    if ($ENV{'FRAME_MSG'} == 1) {
	&add_cookie ($crash_cookie);
    }
}

#-----------------------------------------------------------------------
# set_license_server
#
# This routine picks one of n license servers using the parent
# process pid as a sort of key.  It uses the global array of license
# servers and number of license servers.
#
# Globals Set
#
# Globals Referenced
#	@license_server_list	List of license servers.  You cann
#				effectively weight servers by including
#				them more than once.
# ----------------------------------------------------------------------
sub set_license_server
{
    local ($server_num, $number_of_servers);

    if (! defined ($ENV{'FM_FLS_HOST'})) {
	$number_of_servers = @license_server_list;
	$server_num = ($$ % $number_of_servers);
	$ENV{'FM_FLS_HOST'} = $license_server_list[$server_num];
    }
}

#-----------------------------------------------------------------------
# sub run_program
#
# Globals Set
#
# Globals Referenced
#	
# ----------------------------------------------------------------------
sub run_program
{
    local ($sys_type) = @_;

    local ($frame_bin_dir);

    if ($sys_type =~ /sun4/) {
	chop ($host = `hostname`);
	system ("rpcinfo -T udp $host 300214 > /dev/null 2>&1");
    }
    if ($sys_type =~ /sgi/) {
	chop ($host = `hostname`);
	system ("/usr/etc/rpcinfo -u $host 300214 1 > /dev/null 2>&1");
    }

    $pos = rindex ($0, "/") + 1;
    $program = substr ($0, $pos);
    $frame_bin_dir = "$distrib/bin";
    exec ("${frame_bin_dir}/$program", @arglist);
    print ("Exec of $program failed -- please report this error\n");
    exit -1;
}

#-----------------------------------------------------------------------
# sub handle_resources
#
# While Frame understands the standard X resource location, it also
# looks for files under $FMHOME and finds things such as language-
# specific files here.  We use the Frame standard to locate the
# system default resource file and add customizations via xrm.
#
# Here is the order in which Frame finds Maker resources on Athena:
# ( FMHOME is /mit/frame_v4.0/distrib/@sys)
#
#	1. $FMHOME/fminit/xresources/Maker
#	2. $FMHOME/fminit/<lang>/Maker
#	3. user specification
#	4. command line options
#
# We use the command line options only for things for which is okay
# to possibly override user settings.
#
# Globals Set
#
# Globals Referenced
#	$distrib
#
# ----------------------------------------------------------------------
sub handle_resources

{
    local ($default_printer, $host, $printer_set);

    if (defined ($ENV{"DISPLAY"})) {
	# Monochrome displays
	if (grep (/-DPLANES=1/, `xrdb -symbols`)) {
	    push (@arglist, "-xrm", "Maker.textStippleFilled: False");
	}

	# Maker.printerName resource for print dialog box
	$printer_set = grep (/Maker[\.\*]printerName/, `xrdb -q`) ||
	    grep (/printerName/, @arglist);
	if ( $printer_set == 0 ) {
	    $default_printer = $ENV{'PRINTER'};
	    if ( length ($default_printer) == 0 ){ 
		chop ($host = `hostname`);
		open (CLUSTER, "hesinfo $host cluster |");
		while (<CLUSTER>) {
		    next unless /lpr/;
		    ($default_printer = $_) =~ s/(^lpr )([a-z]*)/$2/;
		    chop ($default_printer);
		}
		close CLUSTER;
		# Give them something so that print to file works.
		if (length ($default_printer) == 0) {
		    $default_printer = "python";
		}
	    }			# 
	    push (@arglist, "-xrm", "Maker.printerName: $default_printer");
	}			

    }
    push (@arglist, "-xrm", "Maker.license.bb.item6.mappedWhenManaged: false");
}

# ----------------------------------------------------------------------
# send_message
#
# Use this routine to direct messages to users
#
# Globals Set
#
# Globals Referenced
#	$swtoolsBin
#
# ----------------------------------------------------------------------
sub send_message
{
    local ($cookie, $msg) = @_;
    local ($message_prog);

    $message_prog = "$swtoolsBin/send_message";

    if ( -x $message_prog ) {
      FORK: {
          if ($pid = fork) {
              # parent continues
          }
          elsif (defined $pid) {
              exec ("$message_prog $cookie $msg");
	      exit 0;
          }
          elsif ($! =~ /No more proces/) {
              sleep 5;
              redo FORK;
          }
          else {
              # weird fork error - just continue
          }
      }
    }
    else {
        # Cannot access program for some reason - just continue
    }
}

# ----------------------------------------------------------------------
# add_cookie
#
# Globals Set
#
# Globals Referenced
#	$swtoolsBin
#
# ----------------------------------------------------------------------
sub add_cookie
{
    local ($cookie) = @_;
    local ($add_cookie_prog) = "$swtoolsBin/add_cookie";

    if ( -x $add_cookie_prog ) {
      FORK: {
          if ($pid = fork) {
              # parent continues
          }
          elsif (defined $pid) {
              exec ("$add_cookie_prog $cookie");
	      # Should not get here
	      exit 0;
          }
          elsif ($! =~ /No more proces/) {
              sleep 5;
              redo FORK;
          }
          else {
              # weird fork error - just continue
          }
      }
    }
    else {
        # Cannot access program for some reason - just continue
    }
}

# ----------------------------------------------------------------------
# delete_cookie
#
# Globals Set
#
# Globals Referenced
#	$swtoolsBin
#
# ----------------------------------------------------------------------
sub delete_cookie
{
    local ($cookie) = @_;
    local ($delete_cookie_prog) = "$swtoolsBin/delete_cookie";

    if ( -x $delete_cookie_prog ) {
      FORK: {
          if ($pid = fork) {
              # parent continues
          }
          elsif (defined $pid) {
	      system ("sleep 1");
              exec ("$delete_cookie_prog $cookie");
	      # Should not get here
	      exit 0;
          }
          elsif ($! =~ /No more proces/) {
              sleep 5;
              redo FORK;
          }
          else {
              # weird fork error - just continue
          }
      }
    }
    else {
        # Cannot access program for some reason - just continue
    }
}
