#!/usr/bin/env perl
##
## $Id: scry,v 1.12 2005/04/22 18:00:07 dgc Exp $
##

# Term::ReadLine is standard in 5.8.0+: a stub superclass for other
# readlines. Install Term::ReadLine::Gnu (e.g.) for extra functionality.
# If you don't have either, scry will read from STDIN, with no smarts.

use strict;
use vars qw($Screen $User $Host $Err $SockDir $Quit $ScreenCols $NumberCols
            $MinNameLen $MaxPtyLen $MaxStackLen @StackChars $ClearScreen
            $RCDir $RCFile $PtySed $FillChar $Banner $AttachedChar $AnyKey
            $Tclear $Table $InheritSSH %SAVENV $UsingTermReadline %Codes
            $Color @S @cmds %cmds %cmdsR %cmdTable %setVars $A0);
use Getopt::Std;

require "ctime.pl";
require "stat.pl";

$RCDir        = $ENV{HOME}."/.scry";
$RCFile       = "$RCDir/rc";
$Screen       = "screen";
$Banner       = "SCREEN MENU";
$User         = `whoami`; chomp $User;
$Host         = `hostname`; chomp $Host;
$Tclear       = `tput clear`;
$Err          = undef;
$SockDir      = undef;
$Table        = undef;		# global table ref for sigal handlers
$Quit         = 0;		# hair trigger
$ClearScreen  = 0;		# clear on refresh?
$ScreenCols   = 80;		# assumed, but check this later via tput
$NumberCols   = 3;		# how many columns in table view
$MaxPtyLen    = 0;		# updated in s_ps_update;
$MinNameLen   = 3;		# min length of screen name shown
$MaxStackLen  = 10;		# how much screen history to remember
@StackChars   = qw(+ - >);	# mark most recent screens with these syms
$FillChar     = ".";		# fill gap between name and pty with this
$AttachedChar = "#";		# indicates an attached screen
$InheritSSH   = 1;		# Inherit SSH environment inheritance?
$Color        = 1;		# color supported?
$AnyKey       = 0;		# allow any key, or only enter?
$PtySed       = undef;		# regexp for munging pty name
				# e.g. $PtySed = "s,pts/,,";

##
## Just assume standard ANSI attribute sequences here, until someone
## reports that it doesn't work. I'm not sure how to figure this out at
## runtime, in perl, without running a bunch of tputs, and that would
## be slow. But we could cache it. So that's the strategy if the need
## arises.
##
%Codes = (
	norm	=> '',
	normal	=> '',
	bold	=> '',
	bright	=> '',
	dim	=> '',
	italic	=> '',
	under	=> '',
	blink	=> '',
	rev	=> '',
	black	=> '',
	red	=> '',
	green	=> '',
	yellow	=> '',
	blue	=> '',
	purple	=> '',
	cyan	=> '',
	white	=> '',
	bgblack	=> '',
	bgred	=> '',
	bggreen	=> '',
	bgyellow=> '',
	bgblue	=> '',
	bgpurple=> '',
	bgcyan	=> '',
	bgwhite	=> '',
	# leave rmso at end, to reset screen attrs during paging
	rmso	=> '',
	#reset	=> '{rmso}',
	reset	=> '',
);

BEGIN {
	$UsingTermReadline = 0;

	eval 'require Term::ReadLine;' and $UsingTermReadline = 1;
}

# I regret this.
$[ = 1;

@S = ();			# stack containing screen order

%setVars = (			# variables that can be set
	clear	=> [ \$ClearScreen, "Clear screen on update?"],
	columns	=> [ \$NumberCols,  "Number of columns to display"],
	cols	=> "columns",		# alias
	namelen	=> [ \$MinNameLen,  "Space reserved for screen name"],
	chars	=> [ \@StackChars,  "Marker characters for recent screens"],
	pty     => [ \$PtySed,      "s/// expression for munging pty names"],
	fill	=> [ \$FillChar,    "Character for fill between name and pty"],
	banner	=> [ \$Banner,      "Text for menu banner"],
	screen	=> [ \$Screen,      "Path to screen command"],
	attached=> [ \$AttachedChar,"Character to indicate an attached screen"],
	ssh	=> [ \$InheritSSH,  "Inherit SSH agent and socket properties?"],
	color	=> [ \$Color,       "Enable color display?"],
	default	=> [ \$Codes{reset},"Default color sequences for all text"],
	anykey  => [ \$AnyKey,      "Allow any keystroke at pauses, or only ENTER?"],
);

@cmds = (			# this is meant to be an array, yes...
	n	=> "new",
	d	=> "detach",
	k	=> "kill",
	r	=> "resume",
	q	=> "quit",
	u	=> "update",
	f	=> "forget",
	s	=> "swap",
	"<"	=> "rotateL",
	">"	=> "rotateR",
	#S	=> "set",
	#U	=> "unset",
	j	=> "jump",
	"+"	=> "next",
	"-"	=> "prev",
	"!"	=> "shell",
	h	=> "help",
	"?"	=> "help",
);
%cmds = @cmds;
# produce a reverse mapping, too
map {
	$cmdsR{$cmds{$_}} = $_;
} keys %cmds;

# first array member is an integer:
# 	0:	requires no args
#	+n:	requires at least n args
#	-n:	requires exactly n args
%cmdTable = (
	new	=> [-1, "c_new"     , "create a new screen"],
	again	=> [ 0, "c_again"   , "attach the most recent screen again"],
	detach	=> [ 1, "c_detach"  , "detach a designated screen"],
	kill	=> [ 1, "c_kill"    , "kill a designated screen"],
	resume	=> [-1, "c_resume"  , "resume a designated screen"],
	quit	=> [ 0, "c_quit"    , "quit"],
	update	=> [ 0, sub {0;}    , "update the display"],
	forget	=> [ 0, "c_forget"  , "forget the most recent screen from the history"],
	swap	=> [ 0, "c_swap"    , "swap the two most recent screens, resuming the second"],
	rotateL	=> [ 0, "c_rotateL" , "rotate the recent list to the left"],
	rotateR	=> [ 0, "c_rotateR" , "rotate the recent list to the right"],
	set	=> [ 0, "c_set"     , "set (or show) a variable"],
	# set will use show syntax :)
	show	=> [ 0, "c_set"     , "show (or set) a variable"],
	unset	=> [ 0, "c_unset"   , "unset a variable"],
	jump	=> [-1, "c_jump"    , "jump to a designated screen, forgetting the current one"],
	next	=> [ 0, "c_next"    , "jump to the next screen, forgetting the current one"],
	prev	=> [ 0, "c_prev"    , "jump to the previous screen, forgetting the current one"],
	shell	=> [ 1, "c_shell"   , "execute a shell command"],
	help	=> [ 0, "c_help"    , "this help [or \"help topic\"]"],
);

sub sigwinch {
	my ($on) = @_;

	if ($on) {
		$SIG{WINCH} = \&sigwinch;
	}
	else {
		$SIG{WINCH} = 'DEFAULT';
	}

	$_ = `tput cols`; chomp;
	$ScreenCols = $_ if (/^\d+$/);

	# Term::Readline[::Gnu] seems not to work well with signal handlers
	#$Table = update();
}

###########################################################################
## Display management

sub fmt {
	my (@s) = @_;
	my $s;
	my $code;

	$s = join("", "{reset}", @s);

	if ($Color) {
		1 while ($s =~ s/{reset}/{rmso}{RESET}/g);
		1 while ($s =~ s/{RESET}/{reset}/g);
		1 while ($s =~ s/{([^\\}]+)}/$Codes{$1}/);

		#for $code (keys %Codes) {
		#	$s =~ s/{$code}/$Codes{$code}/g;
		#}
	}
	else {
		1 while ($s =~ s/{([^\\}]+)}//);
	}
	$s =~ s/\\}/}/g;
	print $s;
}

sub fmtf {
	my ($fmt, @args) = @_;

	fmt(sprintf($fmt, @args));
}

###########################################################################
# support funcs for command handlers

sub find_screen {
	my ($table, $ident) = @_;
	my $k;

	# first two checks are numeric-only
	if ($ident =~ /^\d+$/) {
		# first check indices
	for $k (keys %{$table}) {
			return $table->{$k}->{pid}
				if ($table->{$k}->{index} == $ident);
		}

		# then check pids
		for $k (keys %{$table}) {
			return $table->{$k}->{pid}
				if ($table->{$k}->{pid} == $ident);
		}
	}

	# then check names
	for $k (keys %{$table}) {
		return $table->{$k}->{pid}
			if ($table->{$k}->{name} eq $ident);
	}

	return undef;
}

# true if arg is same as TOS
sub iscurrent {
	my ($id) = @_;

	return ($S[ $[ ] == $id);
}

# places designated id onto history list
sub pushstack {
	my ($id) = @_;

	splice(@S, $MaxStackLen) if ($#S > $MaxStackLen);
	unshift(@S, $id);
	return;
}

# removes an id (given by index) from history list
# index is an integer >= 1
sub delstack {
	my ($n) = @_;
	my @r;
	@r = splice(@S, $[+$n-1, 1);
	return @r;
}

# validate history stack, eliding elements that no longer exist
sub stackcheck {
	my ($table) = @_;
	my $i;

	for $i ($[ .. $#S) {
		if (!exists($table->{$S[$i]})) {
			splice(@S, $i, 1);
		}
	}
}

# runs a screen command, given a list of options
# returns error status
sub c_screen_cmd {
	my ($cmd) = join(" ", @_);
	my $rc;

	$rc = system("$Screen $cmd");
	$Err = "$!";
	return $rc;
}

# pause for a keypress if and only if we're about to clear the screen
sub checkpause {
	my $saved;

	if ($ClearScreen) {
		if ($AnyKey) {
			fmt "[press any key]";
			$saved = `stty -g`;
			`stty raw isig`;
			sysread(STDIN, $_, 1);
			`stty $saved`;
		}

		else {
			fmt "[press ENTER]";
			$_ = <STDIN>;
		}
	}
	return undef;	# disregard $_;
}

###########################################################################
# command handlers

sub c_unset	{ return $Err = "unimplemented command; use \"set foo no\""; }

# show help
sub c_help {
	my ($table, $topic, @args) = @_;
	my $cmd = undef;
	my $req;
	my $key;
	my ($n, $s);

	if ($topic) {
		if ($cmdTable{$topic}) {
			$cmd = $cmdTable{$topic};
		}
		elsif ($cmdTable{$cmds{$topic}}) {
			$cmd = $cmdTable{$topic = $cmds{$topic}};
		}
		else {
			return $Err = "no such help topic";
		}

		$n = $cmd->[1];
		if ($n == 0) {
			$req = "no";
		}
		elsif ($n > 0) {
			$req = "at least $n";
		}
		else {
			$n = -$n;
			$req = "exactly $n";
		}
		$s = "s";
		$s = "" if ($n == 1);

		fmt "$topic:\n";
		fmt "\t- ", $cmd->[3], "\n";
		fmt "\t- requires $req argument$s\n";
	}

	else {
		my $prog = "{bold}" . $A0 . "{norm}";
		my $rcfile = "{under}" . $RCFile . "{norm}";
		my $pager = $ENV{PAGER} || "more";
		open (PAGER, "| $pager");
		select PAGER;

		fmt <<GENERAL_HELP;

$prog is a menu-oriented manager for screen(1) sessions. $prog helps
keep track of what screens you have open and what their statuses are,
and it provides a simple, menu-driven interface to creating, detaching,
and resuming sessions. It additionally provides a history of recently-
used screens, so that it's straightforward to resume your previous
session, or the one before it, etc., without remembering the specific
name of that session. It tracks recent screens in a FIFO queue, so that
the most recent N screens are always remembered. (See the "set" command
and the "chars" variable for more information: as many recent screens
are available as you have tokens in the "chars" setting.)

There are a number of commands available in the menu interface. Most
are abbreviable. The full command names and abbreviations (if any) are
shown below, with a quick summary of what each does. You can use "help
command" to get slightly more specific help on a particular command or
abbreviation. Enter "set" with no arguments to see settable variables.

$prog has a startup file; a template may have been created for you the
first time $prog was run. The file is located at $rcfile.
Please read this file for a guide to more advanced settings.

GENERAL_HELP

		fmtf "{under}%-8.8s{norm} {under}%3.3s{norm} {under}%-40s\n", "command", "key", "description";
		for $cmd (sort keys %cmdTable) {
			if ($cmdsR{$cmd}) {
				$key = "[" . $cmdsR{$cmd} . "]";
			}
			else {
				$key = "   ";
			}
			fmtf "%-8.8s %3.3s %s\n", $cmd, $key,
				$cmdTable{$cmd}->[3];
		}

		fmt "\n";

		close(PAGER);
		select(STDOUT);
	}

	checkpause();
	return 0;
}

# set a runtime option
sub c_set_set {
	my ($table, $var, @args) = @_;

	my ($r, $d) = @{$setVars{$var}};
	if (ref($r) eq "ARRAY") {
		# array
		@{$r} = @args;
	}
	else {
		# scalar
		${$r} = join(" ", @args);
		${$r} = 0 if (${$r} eq "no");
	}

	&c_set_update($table, $var, @args);	# any additional processing?
}
sub c_set_show {
	my ($table, $var, @args) = @_;
	my $val;
	my ($r, $d) = @{$setVars{$var}};
	my ($fmtd, $fmtv, $fmtg, $gap, $desc);

	if (ref($r) eq "ARRAY") {
		# array
		$val = join(" ", @{$r});
	}
	else {
		# scalar
		$val = ${$r};
	}

	# format display

	# how wide the basic value display is
	$fmtv = length($var) + 3 + length($val);

	# max space available for description
	$fmtd = $ScreenCols - $fmtv - 3;
	$fmtd = length($d) if ($fmtd > length($d));	# truncate

	# width of gap
	$fmtg = $ScreenCols - $fmtd - 3 - $fmtv;

	if ($fmtg > 0) {
		$gap = $FillChar x $fmtg;
	}
	else {
		$gap = "";
	}

	printf ("%s = %s %s[%-${fmtd}.${fmtd}s]\n",
		$var, $val, $gap, $d);
}
sub c_set {
	my ($table, $var, @args) = @_;
	my ($r, $d);

	if ($var eq "help" or !$var) {
		# do help
		fmt "\nThe following can be set:\n";
		map {
			if (ref($setVars{$_})) {
				c_set_show($table, $_);
			}
		} sort keys %setVars;
		fmt "\nUse \"set variablename\" to see a current value.\n";
		checkpause();
		return 0;
	}

	if (! $setVars{$var}) {
		return $Err = "no variable called \"$var\"";
	}

	if (! ref($setVars{$var})) {
		$var = $setVars{$var};	# alias
	}

	if ($#args < $[) {
		# show assignment
		c_set_show($table, $var, @args);
		checkpause();
	}
	else {
		# make assignment
		c_set_set($table, $var, @args);
	}

	return 0;
}

# additional processing for some options
sub c_set_update {
	my ($table, $var, @args) = @_;

	if ($var eq "ssh") {
		my @keys = qw(SSH_AUTHENTICATION_SOCKET SSH_CLIENT SSH_AGENT_TTY SSH_AGENT_PID SSH_AUTH_SOCK);
		my $k;
		if ($InheritSSH) {
			for $k (@keys) {
				$ENV{$k} = $SAVENV{$k};
			}
		}
		else {
			for $k (@keys) {
				$SAVENV{$k} = $ENV{$k};
				delete $ENV{$k};
			}
		}
	}

	#if ($var eq "default") {
	#	$Codes{reset} = '{rmso}' . $Codes{reset};
	#}
}

# resume an existing screen. push it onto history stack when done.
sub c_resume {
	my ($table, @args) = @_;
	my $screenid;

	if ($screenid = find_screen($table, $args[0])) {
		if (! &iscurrent($screenid)) {
			&pushstack($screenid);
		}
		return c_screen_cmd("-d -r", $screenid);
	}
	return $Err = "no such screen";
}

# resume the most recent screen
sub c_again {
	my ($table, @args) = @_;
	my $screenid;

	if ($#S >= $[) {
		return c_screen_cmd("-d -r", $S[ $[ ]);
	}
	return $Err = "there is no current screen";
}

# detach existing screen remotely
sub c_detach {
	my ($table, @args) = @_;
	my $screenid;

	if ($screenid = find_screen($table, $args[0])) {
		return c_screen_cmd("-d", $screenid);
	}
	return $Err = "no such screen";
}

# quit the program
sub c_quit { $Quit = 1; 0; }

# open a new screen
sub c_new {
	my ($table, @args) = @_;
	my $rc;
	my $id;

	$rc = c_screen_cmd("-S $args[0]");
	$table = &s_table_update;
	# try to find the screen we just made
	if ($id = find_screen($table, $args[0])) {
		&pushstack($id);
	}
	return $rc;
}

# swap top two screens in history, and resume previous
sub c_swap {
	my ($table, @args) = @_;
	my $id;

	($id) = &delstack(2);		# remove previous and save id
	return c_resume($table, $id);	# resume that id
}

# jump to another screen, removing last from history
sub c_jump {
	my ($table, @args) = @_;
	my $id;

	&delstack(1);			# remove top id from stack
	return c_resume($table, @args);	# resume that id
}

# jump to relative to current
sub c_jump_rel {
	my ($table, @args) = @_;
	my $id;
	my $idx;
	my @all;

	# if no history, fail
	if ($#S < $[) {
		return $Err = "no current screen";
	}

	# find index of most recent
	$idx = $table->{$S[ $[ ]}->{index};

	$idx += $args[0];

	@all = keys %{$table};
	if ($idx < $[) {
		$idx += $#all;
	}
	elsif ($idx > $#all) {
		$idx -= $#all;
	}

	return c_jump($table, $idx);
}

sub c_next { return c_jump_rel($_[0], 1); }
sub c_prev { return c_jump_rel($_[0], -1); }

# rotate order among the most recent screens,
# for however many StackChars there are.
# then resume the top one.
sub c_rotateL {
	my ($table, @args) = @_;
	my @s;

	@s = splice(@S, $[, $#StackChars);
	$_ = shift @s;
	push @s, $_;
	splice(@S, $[, 0, @s);
	return c_again($table);
}
sub c_rotateR {
	my ($table, @args) = @_;
	my @s;

	@s = splice(@S, $[, $#StackChars);
	$_ = pop @s;
	unshift @s, $_;
	splice(@S, $[, 0, @s);
	return c_again($table);
}

# drop the most recent off the history
sub c_forget {
	my ($table, @args) = @_;
	&delstack(1);
	return 0;
}

# terminate the screen
sub c_kill {
	my ($table, @args) = @_;
	my $id;

	$id = find_screen($table, $args[0]);
	if (! $id) {
		$Err = "no such screen";
		return 1;
	}

	if (kill("TERM", $table->{$id}->{pid})) {
		# if successful, splice this screen out of history
		@S = grep {$_ != $table->{$id}->{pid};} @S;
		return 0;
	}
	return $Err = "$!";
}

# run a shell command
sub c_shell {
	my ($table, @args) = @_;
	my $rc;

	$rc = system($args[0]);
	$Err = "$!";
	return $rc;
}

###########################################################################
# internal suppprt functions

sub get_screen_dir {
	my $dir;
	open (SCREEN, "$Screen -ls |");
	while (<SCREEN>) {
		next unless (/^\d+ sockets? in (.*)\.$/i);
		$dir = $1;
	}
	close (SCREEN);
	return $dir;
}

sub s_table_update {
	my $table = {};
	my $socket;

	opendir (SOCKETS, $SockDir) or do {
		fmt "[cannot open socket directory $SockDir!]\n";
		return $table;
	};
	while ($socket = readdir(SOCKETS)) {
		next if ($socket =~ /^\./);

		$socket =~ /^([0-9]+)\.(.*)$/;
		$table->{$1} = {};
		$table->{$1}->{pid} = $1;
		$table->{$1}->{name} = $2;
		if (-x "$SockDir/$socket") {
			$table->{$1}->{status} = $AttachedChar;	# attached
		}
		else {
			$table->{$1}->{status} = " ";	# unattached
		}
	}
	closedir(SOCKETS);

	return $table;
}

sub s_table_update_old {
	my $table = {};

	open (SCREEN, "$Screen -ls |");
	while (<SCREEN>) {
		if (/ (\/.*)\.+$/) {
			$SockDir = $1;
		} elsif (/^\t([0-9]+)\.([^\s]+)\s+\(([a-zA-Z]+)/) {
			$table->{$1} = {};
			$table->{$1}->{pid} = $1;
			$table->{$1}->{name} = $2;
			$table->{$1}->{status} = $3;
		}
	}
	close (SCREEN);
	return $table;
}

sub s_ps_update {
	my ($table) = @_;

	$MaxPtyLen = 0;
	open (PS, "ps -eoppid,tty |");
	while (<PS>) {
		if (/^\s*([0-9]+)\s(\S*)/) {
			if (exists($table->{$1})) {
				$_ = $2;
				eval "$PtySed" if ($PtySed);
				$table->{$1}->{pty} = $_;
				$_ = length($table->{$1}->{pty});
				$MaxPtyLen = $_ if ($_ > $MaxPtyLen);
			}
		}
	}
	close (PS);
	return $table;
}

sub header {
	#my $date = `date`; chomp $date;
	my $date = ctime(time); chomp $date;
	my ($textw, $space, $space1);

	# format things nicely
	($_ = $Banner) =~ s/\{[^}]*\}//g;
	$textw = length($_) + length($User) + length($Host) + 1 +
		 length($date);
	$space = $ScreenCols - $textw;
	$space1 = int(($space+1)/2);

	fmt ("$Banner", " " x $space1, "$User\@$Host",
		" " x ($space-$space1), "$date\{reset}\n\n");
}

sub show_table {
	my ($table) = @_;
	my @list;
	my $pid;
	my ($i, $j, $per_col, $index, $name);
	my ($namew, $ptyw, $n, $p, $ln, $rn);
	my $ncols;
	my $colw = 0;
	my $ptyfmt;
	my $nfmtw = 1;	# (default) width of screen number

	# colw needs to be at least 5+MinNameLen+MaxPtyLen for
	# a minimal display. This should be the only magic number,
	# but it's a dependency for the formatting in the printf below.
	#
	# Many months later, I belive the value 4 comes from:
	#   + 1 for the number of the screen
	#   + 1 for the close-paren following it
	#   + 1 for marking current/previous/etc
	#   + 1 as a gutter between columns
	# The number of the screen can require more than one digit, of
	# course. We account for that below.
	my $fmtoverhead = 4;

	# if maxptylen is 0, then fmtoverhead is correct. If not,
	# we need to add overhead for pty display. Another magic number.
	$fmtoverhead += 2 if ($MaxPtyLen);

	# figure out whether we can show as many columns as were
	# requested. If not, reduce that number until we can.
	$ncols = $NumberCols + 1;
	while ($colw < ($fmtoverhead + $MinNameLen + $MaxPtyLen)) {
		--$ncols;		# eliminate a column
		$colw = int(($ScreenCols - $ncols + 1) / $ncols) - 1;
	}

	@list = sort {$table->{$a}->{name} cmp $table->{$b}->{name}}
	        keys %{$table};

	# Add to fmtoverhead if the number of items in the list requires
	# 2 or 3 columns to display.
	if ($#list >= 10) {
		++$fmtoverhead;
		++$nfmtw;
	}
	if ($#list >= 100) {
		++$fmtoverhead;
		++$nfmtw;
	}

	# apply marks to table
	map {
		$table->{$_}->{color} = "";
		$table->{$_}->{mark} = " ";
	} @list;

	## Look through recent items (again, where "recent" are as many
	## from the top as there are StackChars). As each is found, mark
	## that entry in the table with the corresponding StackChar.
	## We go in reverse order because if a screen was (for example)
	## both first and third most recent, we want first to take priority.
	for $i ($[ .. $#StackChars) {
		$i = $#StackChars - $i + $[;		# invert order
		if ($S[$i]) {
			#$_ = $StackChars[$i];
			#$_ =~ /({[^}]+})*(.)({[^}]+})*/;
			#$table->{$S[$i]}->{mark} = $2;
			#$table->{$S[$i]}->{color} = $1.$3;
			$table->{$S[$i]}->{mark} = $StackChars[$i];
		}
	}

	$per_col = int(($#list+$ncols-1) / $ncols);

	for $i ($[ .. $per_col) {
		for $j (0 .. ($ncols - 1)) {

			$index = $j * $per_col + $i;
			next if ($index > $#list);
			$table->{$list[$index]}->{index} = $index;

			$name = $table->{$list[$index]}->{name};
			$namew = length($name);
			$ptyw = length($table->{$list[$index]}->{pty});

			# find formatter lengths for the screen name and pty
			# ptyw + namew + fmtoverhead == colw
			$n = $colw - $MaxPtyLen - $fmtoverhead;
			$p = $MaxPtyLen;

			if ($namew > $n) {
				$ln = int($n/2)-1;
				$rn = $n-$ln-1;
				$name =~ s/^(.{$ln}).*(.{$rn})$/$1*$2/;
			}

			# if ptys are elided, don't show empty brackets
			if ($MaxPtyLen == 0) {
				$ptyfmt = "";
			}
			else {
				$ptyfmt = "[%-${p}.${p}s]";
			}

			if ($list[$index]) {
				#fmtf("%s%s%s{reset}%${nfmtw}d)%s%s%-0.${n}s {reset}%s$ptyfmt",
				fmtf("%s%s%${nfmtw}d)%s%-0.${n}s {reset}%s$ptyfmt",
					$j ? " " : "",		# extra space
					$table->{$list[$index]}->{mark},
					$index,
					$table->{$list[$index]}->{status},
					$name,
					$FillChar x ($n - $namew),
					$table->{$list[$index]}->{pty});
			}
		}
		fmt "\n";
	}

}

sub ask {
	my $resp;
	fmt $_[0];
	$resp = <STDIN>;
	chomp $resp;
	return $resp;
}

sub mkprompt {
	my ($table) = @_;
	my ($i, $initials);
	my ($low, $high);

	$initials = "";
	for $i ($[ .. $#cmds/2) {
		$initials .= $cmds[($i-1)*2+1];
		$i++;	# look only at keys; skip values
	}
	$low = $[;
	@_ = keys %{$table};
	$high = $#_;
	return "Attach [$low-$high, $initials]: ";
}

sub do_command {
	my ($table, $term, $cmd, @v) = @_;
	my ($req, $handler, $args);
	my $rc;

	($req, $handler, $args) = @{$cmdTable{$cmd}};

	# $req is an integer:
	# 	0:	requires no args
	#	+n:	requires at least n args
	#	-n:	requires exactly n args
	if ($req < 0) {
		$req = -$req;
		if ($#v != $req) {
			my $s = ($req == 1) ? "" : "s";
			fmt "$cmd requires exactly $req argument$s\n";
			$_ = prompt($term, "$cmd? ");
# busticated #			$term->add_history("$cmd $_");
			@v = parse($_);
		}
	}

	elsif ($req > $#v) {
		my $s = ($req == 1) ? "" : "s";
		fmt "$cmd requires at least $req argument$s\n";
		$_ = prompt($term, "$cmd? ");
# busticated #		$term->add_history("$cmd $_");
		@v = parse($_);
	}

	else {
		$_ = join(" ", @v);
# busticated #		$term->add_history("$cmd $_");
	}

	if (ref($handler) eq "CODE") {
		$rc = &{$handler}($table, @v);
	}
	elsif ($handler) {
		$rc = eval "$handler".'($table, @v);';
	}
	else {
		$rc = $Err = "unimplemented command";
	}

	if ($rc) {
		fmt "$cmd: $Err\n";
		checkpause();
	}

	return $rc;
}

sub do_rc {
	my ($term, $file) = @_;
	my $table;
	my ($cmd, @v);

	open(RC, $file) or return;
	$table = &s_table_update;
	while (<RC>) {
		chomp;
		s/\s*#.*//;
		next if (/^\s*$/);
		($cmd, @v) = split (" ", $_);
		&do_command($table, $term, $cmd, @v);
	}
	close(RC);
}

##
## Creates a template rc file from the __DATA__ section
##
sub mk_rc {
	my ($term, $file) = @_;
	my ($path, @path);
	my $savedcols;
	my $table;
	my ($text1, $text2);

	## read the __DATA__
	@_ = <DATA>;
	$text1 = join("", @_);

	## split the rc file into path and filename
	@path = split('/', $file);
	$file = pop @path;

	## make the path (mkdir -p)
	map {
		$path = "$path/$_";
		mkdir ($path, 0755);
	} @path;

	## Open rc file as output. The c_set_show() routine prints
	## settings to the default output stream, so select it.
	open (RC, ">$path/$file");
	select(RC);

	## Split text around the point where defaults will be displayed.
	## Show the first piece.
	($text1, $text2) = split("<DEFAULTS>", $text1);
	print $text1;

	## Fool the show command handler into showing us default settings
	## formatted for a 78-col screen, with comment marks in front. This
	## is a total hack.
	$savedcols = $ScreenCols;
	$ScreenCols = 78;
	map {
		if (ref($setVars{$_})) {
			print "# ";
			c_set_show($table, $_);
		}
	} sort keys %setVars;
	## Don't forget to restore actual screen dimension.
	$ScreenCols = $savedcols;

	## Show the second piece.
	print $text2;

	## Close the rc file, select stdout, and return
	close(RC);
	select(STDOUT);
	return;
}

sub prompt {
	my ($term, $prompt) = @_;

	if ($term) {
		return $term->readline($prompt);
	}
	fmt $prompt;
	$_ = <STDIN>;
	return $_;
}


sub parse {
	my ($line) = @_;
	my @w = ();

	while ($line =~ /^([^"]*)"(.*)/) {
		push(@w, split(" ", $1));
		$2 =~ /([^"]*)"(.*)/;
		push(@w, $1);
		$line = $2;
	}
	push(@w, split(" ", $line));
	return @w;
}

sub update {
	my $table;

	$table = &s_table_update;
	&s_ps_update($table);
	&stackcheck($table);

	if ($ClearScreen) {
		fmt $Tclear;
	}
	else {
		fmt "\n";
	}
	&header;
	&show_table ($table);
	fmt "\n";
	$| = 1;

	return $table;
}

sub usage {
	print STDERR "usage: $A0 [-f rcfile] [cmd]\n";
	print STDERR "       \"$A0 help\" for more help\n";
}

sub main {
	my $prompt;
	$ENV{PERL_RL} = "Gnu perl";	# prefer gnu readline
	my $term;
	my ($cmd, @v);
	my $resp;
	my $attrs;
	my ($tty, $mesg);
	my %o;

	$A0 = $0;
	$A0 =~ s,.*/,,;

	if ("$UsingTermReadline") {
		#$term = new Term::ReadLine $ARGV[0];
		$term = new Term::ReadLine $A0;
	}
	else {
		$term = undef;
	}

	if ($ENV{STY}) {
		fmt STDERR "$A0: running under existing screen sessions has been shown to be hazardous\nto your sanity.\n";
		exit(10);
	}

	# If term type is screen, map to vt100. I forgot why, but I've
	# been doing this for years for some reason within my call to
	# the previous two implementations of the screen front-end.
	$ENV{TERM} = "vt100" if ($ENV{TERM} eq "screen");

        # This chmod is the equivalent of running "mesg n" at shell,
        # to hide your menu session from write commands. if you want
        # writes, your individual screens can have mesg set. But
	# having them on the scry tty will cause you great grief.
	#
	# This could easily be a runtime option, if that's important
	# to someone.
	$tty = `tty`; chomp $tty;
	my @s = stat($tty);
	$mesg = $s[$[+2];
	chmod ($mesg & ~0020, $tty);
	
	$SockDir = &get_screen_dir;

	if ($term) {
		$term->ornaments(0);	# no underlining and crap
		$attrs = $term->Attribs;
		$attrs->{do_expand} = 1;
	}

	#map {
	#	print ": $_: ", $attrs->{$_}, "\n";
	#} sort keys %{$attrs};

	getopts('hf:', \%o);

	if ($o{h}) {
		usage;
		exit 2;
	}
	$RCFile = $o{f} if ($o{f});

	## If no rc file, try to create it first
	if (! -r $RCFile) {
		mk_rc($term, $RCFile);
	}

	## Then source it
	if (-r $RCFile) {
		do_rc($term, $RCFile);
	}

	## Main event loop
	while (! $Quit) {

                # Set up window change handler. While in the menu we
                # want winch handling. While running screens, we want to
                # pass it through.
		sigwinch(1);

		$Table = update();

		if ($#ARGV < $[) {
			# interactive time
			$resp = prompt($term, &mkprompt($Table));
		}
		else {
			# preloaded cmds from argv
			$resp = shift @ARGV;
		}

		if (! $resp) {
			$cmd = "again";
			@v = ();
		}

		else {
			@v = parse($resp);
			$cmd = shift @v;

			if ($cmd =~ /^\d+$/) {
				@v = ($cmd);
				$cmd = "resume";
			}
			elsif ($cmdTable{$cmd}) {
				# already translated
			}
			elsif ($cmds{$cmd} eq "shell") {
				# special exception for shell: no parse/split
				@v = ();
				$v[0] = $resp;
				$v[0] =~ s!^$cmd\s*!!;
				$cmd = $cmds{$cmd};
			}
			elsif (find_screen($Table, $cmd)) {
				@v = ($cmd);
				$cmd = "resume";
			}
			elsif (! $cmds{$cmd}) {
				fmt "$cmd: unknown command\n";
# busticated #				$term->add_history($cmd);
				next;
			}
			else {
				$cmd = $cmds{$cmd};
			}
		}

                # Set up window change handler. While in the menu we
                # want winch handling. While running screens, we want to
                # pass it through.
		sigwinch(0);

		&do_command($Table, $term, $cmd, @v);
	}

	# say goodnight, gracie
	fmt "Ta ta!\n";

	# un-mesg
	chmod ($mesg, $tty);

	exit(0);
}

&main();

##
## $Log: scry,v $
## Revision 1.12  2005/04/22 18:00:07  dgc
## + adjusted/added some documentary comments
##
## + better (less obnoxious) SIGWINCH handling, though it seems not always
##   to trigger
##
## + dynamically adjusts layout to < 10, < 100, >= 100 screens. Previously
##   supported only a 2-digit screen number, causing right-edge overflow
##   on the 100th screeen.
##
## + bugfix on columnation when terminal resize requires fewer cols.
##
## + usage statement.
##
## + supports arguments to pre-select a screen. Actually, arguments are
##   just preloaded commands -- anything that works from the menu can
##   be given as a cmdline arg.
##
## + supports screen selection by name as well as by number. This was
##   intended from the start but overlooked.
##
## Revision 1.11  2004/11/14 21:02:23  dgc
## bugfix: pressing return to resume current worked fine, but if user
## entered the number of the current screen it sucked the previous screen
## off the stack. This is fixed.
##
## Revision 1.10  2004/10/11 06:52:04  dgc
## Added anykey variable -- this was implemented but incomplete.
##
## Revision 1.9  2004/10/11 06:20:05  dgc
## Lexical fixes against older perls than 5.8.0
##
## Revision 1.8  2004/10/11 05:45:25  dgc
## Implemented help command
##
## Revision 1.7  2004/10/11 04:20:16  dgc
## Embedded first-time rc file generation
##
## Revision 1.6  2004/10/07 06:53:18  dgc
## Finished adding color support, I think
##
## Revision 1.5  2004/09/29 19:50:27  dgc
## No longer require Term::ReadLine
##
## Revision 1.4  2004/09/28 01:44:34  dgc
## "Fixed" the quote-mark parsing issue. (It didn't.) Now it basically works,
## as long as you're not nesting, for double-quotes only. Not sure about
## failure modes, and not sure I'll ever fully address this -- proper
## syntax parsing in perl is awful.
##
## Revision 1.3  2004/09/26 02:54:31  dgc
## More stuff! Almost complete now, just a few open bugs.
##
##


## This __DATA__ segment is an rc file template:

__DATA__
##
## This startup file for scry can technically contain any valid scry
## commands, spelled out in full or abbreviated. Realistically, though,
## it's only useful for set commands.
##
## The command parser in scry is quite dumb, because it doesn't generally
## need to be smart. For purposes of these settings I've made it deal
## minimally with quotation, but this is very poor support and you'll
## probably have little luck trying anything fancy unless you plug at
## the code.
##

## Default settings [as from the "show" command]:
<DEFAULTS>

#
# The attached, banner, chars, default, and fill settings can have
# color or other text attributs applied. These are indicated inside
# {curlybraces}. Currently 16 color attributes are recognized, plus
# {bold}, {normal} (aka {rmso}), and {reset}. {reset} is a meta-
# indicator which resets to whatever the default variable is defined
# as. The sixteen color attributes are:
# 
# {black}   {red}   {green}   {yellow}   {blue}   {purple}   {cyan}   {white}
# {bgblack} {bgred} {bggreen} {bgyellow} {bgblue} {bgpurple} {bgcyan} {bgwhite}
#
# The {bgcolor} attributes set background color; the others set text color.
#

## Examples:

# Allow any keystroke at pauses (normally you must use ENTER):
#set anykey 1
#set anykey yes

# Indicate attached screens with the "X" character:
#set attached X

# Change top banner text to "Yo homie":
#set banner Yo homie

# Change top banner text to "Yo homie", and print banner on a purple
# background with yellow text.
#set banner {bgpurple}{yellow}Yo homie

# Change top banner text to "Yo homie", and print banner on a purple
# background with yellow text. Use regular modes for the user and time
# fields.
#set banner {bgpurple}{yellow}Yo homie{reset}


# Change marker characters to "a", "b", "c", "d", "e":
#set chars a b c d e

# Change marker characters to 8859-1's superscripted "1", "2", "3", then +/-:
#set chars ¹ ² ³ + -

# Clear screen on update:
#set clear yes
#set clear 1

# Do not clear screen:
#set clear no
#set clear 0

# Translate {attribute} sequences ({color}, {bgcolor}, and {bold}):
#set color yes
#set color 1

# Ignore {attribute} sequences ({color}, {bgcolor}, and {bold}):
#set color no
#set color 0

# Set number of display columns to 5:
# [If there are too many columns for your terminal width, scry will decrease
# this to fit. Resize your terminal, and scry will increment back up.
#set columns 5

# Set {attributes} for default text. This is white text on a cyan background.
#set default {bgcyan}{white}

# Set fill character to a hyphen:
#set fill -

# Set fill character to whitespace:
#set fill " "

# Reserve at least 10 characters for screen names. This interacts with
# autoscaling the number of columns of display: there must be enough
# space for this many characters of screen name per column of display,
# or columns will be reduced. If a screen name is longer than this, it
# will be abbreviated.
#set namelen 10

# "pty" is a perl s/// expression that will alter pty names for display.
# Elide the "pts/" on SysVish systems:
#set pty s,pts/,,

# Elide the "tty" on BSDish systems:
#set pty s,tty,,

# It can be a tr too -- any =~ operator will do:
#set pty tr/p/t/

# If you erase the pty completely, it won't be considered in the display.
#set pty tr/\x01-\xff//d

# The location of the screen command can be set if it's not in your PATH:
#set screen /usr/prehistoric/bin/screen

# Normally scry inherits SSH agent and socket settings from its parent.
# That's good if you want your screens to pick up your terminal's ssh
# properties, but bad if your screens might outlive your desktop session's
# agent.
#set ssh no


# dgc's settings:
#set banner {bgblue}{white}Yo homie
##set default {bgcyan}{black}
#set chars {bold}{white}+ {bold}{yellow}- {bold}{red}.
#set clear yes
##set pty s,pts/,p,
#set namelen 8
#set ssh no