#!/usr/athena/bin/perl

# This runs an X app (which must take -name) and changes the geometry
# for subsequent runs to be next to the first window.  The app's
# original geometry should be in the X resource database, and must
# specify width and height in addition to positioning.

### extract just the program name
$0 =~ s@.*/@@;

$WM_BORDER = 4;

### parse args

# if the arg is one of +x -x +y -y, it's the translation direction
while ($ARGV[0] =~ /^[+-]/) {
  local ($arg) = shift;

  (($arg eq '--n') || ($arg eq '--dryrun')) && ($DRYRUN = 1,        next);
  (($arg eq '--d') || ($arg eq '--debug'))  && ($DEBUG = 1,         next);
  (($arg eq '--b') || ($arg eq '--border')) && ($WM_BORDER = shift, next);
  (($arg eq '--f') || ($arg eq '--force'))  && ($FORCE_NEW = 1,     next);

  ($arg =~ /^([+-])([xy])$/) || die "$0: invalid argument '$0'\n";

  local ($sign, $dir) = ($1, $2);
  warn "$0: translation specified more than once!\n" if @translate;
  @translate = ( ($dir eq 'x') ? ($sign . '1') : 0, 
		 ($dir eq 'y') ? ($sign . '1') : 0 );
}

die "$0: no X application program specified!\n" unless @ARGV;
$app = shift(@ARGV);

@translate = (-1, 0) unless @translate;

### sanity checking
die "$0: set your \$DISPLAY!\n" unless defined $ENV{'DISPLAY'};

($host = `hostname`) =~ s/[\012\015]+$//;
die "$0: \`hostname\` failed?\n" unless length($host);

### read data

@app_base = ();
$known_host = 0;

&open_resources_read;
while (defined($_ = &read_resource)) {
  /^$app([.*-])/ || next;
  if ($1 eq '-') {
    ($' =~ /^$host[.*]/) && ($known_host = 1);
  } else {
    push(@app_base, $1 . $');
  }
}
&close_resources_read;

### write data

if ($FORCE_NEW || ! $known_host) {
  &open_resources_add;
  foreach (@app_base) {
    &add_resource($app . '-' . $host . $_);
    if (/[.*]geometry:\s*/) {
      $base = $` . $&;

      if (@coord = ($' =~ /^(\d+)([xX])(\d+)([+-])(\d+)([+-])(\d+)\s*$/)) {

	# translate by the window size, in direction specified by @translate
	$coord[4] += ("$coord[3]1" * $translate[0] * ($coord[0] + $WM_BORDER));
	$coord[6] += ("$coord[5]1" * $translate[1] * ($coord[2] + $WM_BORDER));
	die "$0: outside of screen!\n" if ($coord[4]<0) || ($coord[6]<0);
	&add_resource($app . $base . join('', @coord));

      } else {
	warn "$0: can't use geometry '$''\n";
      }
    }
  }
  &close_resources_add;
}

### run!

@ARGV = ($app, '-name', $app . '-' . $host, @ARGV);

if ($DRYRUN) {
  print "would run: @ARGV\n";
} else {
  print STDERR "running: @ARGV\n" if $DEBUG;
  exec @ARGV;
}

### support code

sub open_resources_read {
  open(XRDB_Q, "xrdb -query |")
    || die("$0: Failed to open a pipe to xrdb -query!\n");
}
sub close_resources_read {
  close(XRDB_Q);
}
sub read_resource {
  local ($_) = scalar(<XRDB_Q>);
  return undef unless defined($_);
  s/[\012\015]+$//;
  $_;
}

sub open_resources_add {
  if ($DRYRUN) {
    print STDOUT "would merge:\n";
    open(XRDB_M, ">& STDOUT")
      || die "$0: Failed to open a pipe to stderr (for -merge)!\n";
  } else {
    open(XRDB_M, "| xrdb -merge")
      || die "$0: Failed to open a pipe to xrdb -merge!\n";
  }
}
sub close_resources_add {
  close(XRDB_M);
}
sub add_resource {
  local ($_);
  foreach (@_) {
    print XRDB_M "$_\n";
    print STDERR "adding resource: $_\n" if ($DEBUG && !$DRYRUN);
  }
}