#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#	hpc.pl
#	readline.pl
# This archive created: Wed May 11 02:04:01 1994
export PATH; PATH=/bin:/usr/bin:$PATH
if test -f 'hpc.pl'
then
	echo shar: "will not over-write existing file 'hpc.pl'"
else
cat << \SHAR_EOF > 'hpc.pl'
#!/usr/local/bin/perl -- # -*-Perl-*-

#  hpc
#
# A harmless perl client (for empire).
#
# Has hooks for parsing data on the fly and running user
# subroutines (using the parsed data).  
# Can make use of the readline.pl package for line editing.
# All parsing and user routines are external to the client.
# Has perl for a command language!  :)
# Written using perl 4.036 under AIX 3.2.  You mileage may vary.
#
#     -harmless (dld@chem.psu.edu)


# all the includes are optional.. the client should work without them.
eval { require 'readline.pl'; }; warn $@ if $@;
eval { require 'parse.pl'; };    warn $@ if $@;
eval { require 'user.pl'; };     warn $@ if $@;


$functionmap{"eval"} = 'eval';
$functionmap{"print"} = 'eval';
$functionmap{"undef"} = 'eval';
$functionmap{"history"} = '&history';
$functionmap{"exec"} = '&execfile';
$functionmap{"help"} = '&help';
$functionmap{"reconnect"} = '&reconnect';
$; = ',';
$, = ', ';




($country,$representative,$them,$port) = @ARGV;
$country = 'Visitor' unless $country;
$representative = 'visitor' unless $representative;
$them = 'opus.chem.psu.edu' unless $them;
$port = 1617 unless $port;




$pat = 'S n C4 x8';
$sockaddr = 'S n a4 x8';

$inet = 2;
$echo = 7;

$SIG{'INT'} = 'dokill';

chop($hostname = `hostname`);
($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
($name, $aliases, $type, $len, $thataddr) = gethostbyname($them);

$this = pack($sockaddr,$inet,0,$thisaddr);
$that = pack($sockaddr,$inet,$port,$thataddr);

if (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; }
if (bind(S,$this)) { print "bind ok\n"; } else { die $!; }
if (connect(S,$that)) { print "connect ok\n"; } else { die $!; }

select(S); $| = 1;
select(stdout);

print S "coun $country\n";
print S "pass $representative\n";
print S "user $ENV{'USER'}\n";
print S "play\n";

&slurp;
&parse_commandline("exec startup.exec\n");
&mainloop;

die "Should not be here";


sub dokill { 
    $SIG{'INT'} = 'dokill';
    print S "aborted\n";
    kill 9,$child if $child;
}

sub history {
    for ($i=0;$i<$#readline'rl_History;$i++) {	## '
	 print "$i) $readline'rl_History[$i]\n";
     }
}

sub help {
    print "The harmless empire perl client help page\n\n";
    print "Commands beginning with # are comments and are ignored.\n";
	print "\t# This is a comment\n";
    print "Any command with a > or | in it is redirected by the client.\n";
    print "\tdump * >dump\n";
    print "Commands that begin with ! are sent to the system shell.\n";
    print "\t! civmover dump >civ.out\n";
    print "Scripts may be executed using the exec command.  Perl,\n";
    print "redirections, and execs are allowed within execs.\n";
    print "\texec civ.out\n";
    print "Commands that begin with \$, &, %, or @ are evaluated as perl.\n";
    print "\t\$etu=48\n";
    print "Any command in the %functionmap table is also evaluated locally.\n";
    print "\tprint sort keys %functionmap  # to list these commands.\n";
    print "All other commands are passed verbatim to the server.\n";
    print "CTRL/C interrupts are supported, but have not been well tested.\n";
    print "Output is parsed by looking up a parse routine in %parsemap.\n";
    print "A list of parsed variables is stored in %vars.  It may not be\n";
    print "complete.  See the source for other variables and examples of\n";
    print "parsing and command routines.\n";
    print "\tprint %parsemap\n\tprint sort keys %vars\n";
    print "Line editing is available if the readline.pl package is loaded.\n";
    print "Use the standard gnu keybindings to edit (^P,^N,^B,^F,^D,^@,^Y).\n";
}
	


sub parse_commandline {
    local (*NEWOUT,$oldout,$redir);
    $_ = $commandline = shift(@_);
    $redir="";
    if (/^\s*#/) {
	return;
    }
    if (/^\s*\!/) {
	system($');
	return;
    }
    if (/ (>|\|)/) {
	$redir= $1 . $';
	$_ = $commandline = $` . "\n";
	open(NEWOUT,$redir) || warn "Unable to open $redir";
	$oldout=select(NEWOUT);
	print $commandline;
    }
    split(' ',$commandline);
    $command=$_[0];
    if ($command =~ /^\s*[\$\&\@\%]/) {
	eval($commandline);
    } elsif (defined($functionmap{$command})) {
	eval($functionmap{$command});
# aliases could go here
    } elsif ($commandline =~ /\S/) {
	print S $commandline;
	&slurp;
    } else {
	## resync output
    }
    if ($redir) {
	close(NEWOUT);
	select($oldout);
    }
}

# Useful for tools - similar to parse_commandline, but it is
# gauranteed to go all the way to a prompt
sub singlecommand {
    local (*NEWOUT,$oldout,$redir);
    $commandline=shift(@_);
    $redir="";
    if ($commandline =~ /^\s*#/) {
	return;
    }
    if ($commandline =~ /^\s*\!/) {
	system($');
	return;
    }
    if ($commandline =~ / (>|\|)/) {
	$redir= $1 . $';
	$commandline=$` . "\n";
	open(NEWOUT,$redir) || warn "Unable to open $redir";
	$oldout=select(NEWOUT);
	print $commandline;
    }
    ($command) = split(' ',$commandline);
    if ($command =~ /^\s*[\$\&\@\%]/) {
	eval($commandline);
    } elsif (defined($functionmap{$command})) {
	eval("$functionmap{$command}");
    } elsif ($commandline =~ /\S/) {
	print S $commandline;

	do {
	    while (&getline) {
		if (defined($parsemap{$command})) {
		    eval("$parsemap{$command}");
		}
	    }
	    if ($mode ne '6') {
		print S "aborted\n";
	    }
	} while ($mode eq '4');

    } else {
	## resync output
    }
    if ($redir) {
	close(NEWOUT);
	select($oldout);
    }
}


## get the next line, return true if it is a data line, else false.
## leaves the data in $_, and the mode in $mode.
sub getline {
    $_=<S>;
    $mode=substr($_,0,1);
    $_ = substr($_,2);
    if ($mode eq '1') {
	print $_;
	return 1;
    }
    if ($mode eq '0' || $mode eq '2') {
	warn $_;
	return 1;
    }
    if ($mode eq '6') {
	($timeused,$btus) = split(' ');
	if ($btus<200) {
#	    &reconnect;
	    # still debugging this..
	}
	return 0;
    }
    if ($mode eq '4') {
	return 0;
    }
    if ($mode eq '3') {
	die "$_";
    }
    die "$mode: $_";
}

sub slurp {
    while (&getline) {
	if (defined($parsemap{$command})) {
	    eval("$parsemap{$command}");
	}
	last if ($mode eq '4' || $mode eq '6');
    }
}


sub execfile {
    local ($dummy,$file) = split(' ',$commandline);
    local (*IN);

    open(IN,"<$file") || warn "unable to open $file for input";

    while ($commandline = <IN>) {
	if ($mode eq '6') {
	    print $commandline;
	    &parse_commandline($commandline);
	} elsif ($mode eq '4') {
	    chop; print $_ . $commandline;
	    print S $commandline;
	} else {
	    &slurp;
	}
    }

    close(IN);
}

sub mainloop {
    while (1) {
	if ($mode eq '6') {
	    print "\n";
	    if (defined(&readline'readline)) { #'
		$commandline = &readline'readline("[$timeused:$btus] Command: ") . "\n"; #'
	    } else {
		print "[$timeused:$btus] Command: ";
		$commandline = <STDIN>;
	    }
	    &parse_commandline($commandline);
	} elsif ($mode eq '4') {
	    chop($_);
	    if (defined(&readline'readline)) { #'
		$line = &readline'readline($_) . "\n"; #'
	    } else {
		print "$_";
		$line = <STDIN>;
	    }
	    print S $line;
	    &slurp;
	} elsif ($mode eq '3') {
	    die "Choke";
	} else {
	    &slurp;
	}
    }
}


sub reconnect {
    close(S);

    if (socket(S,2,1,6)) { print "socket ok\n"; } else { die $!; }
    if (bind(S,$this)) { print "bind ok\n"; } else { die $!; }
    if (connect(S,$that)) { print "connect ok\n"; } else { die $!; }

    select(S); $| = 1;
    select(stdout);

    print S "coun $country\n";
    print S "pass $representative\n";
    print S "user $ENV{'USER'}\n";
    print S "play\n";

    &slurp;
}
SHAR_EOF
fi
if test -f 'readline.pl'
then
	echo shar: "will not over-write existing file 'readline.pl'"
else
cat << \SHAR_EOF > 'readline.pl'
## -*-Perl-*-
## Perl Readline -- The Quick Help
## (this will disappear once a manual gets written, if ever)
##
## Once this package is included (require'd), you can then call
##	$text = &readline'readline($input);
## to get lines of input from the user.
##
## Normally, it reads ~/.inputrc when loaded... to suppress this, set
## 	$readline'rl_NoInitFromFile = 1;
## before requiring the package.
##
## Call rl_bind to add your own key bindings, as in
##	&readline'rl_bind('C-L', 'possible-completions');
##
## Call rl_set to set mode variables yourself, as in
##	&readline'rl_set('TcshCompleteMode', 'On');
##
## Call rl_basic_commands to set your own command completion, as in
##      &readline'rl_basic_commands('print', 'list', 'quit', 'run', 'status');
##
##

package readline;
##
## Perl Readline package,
## Written by Jeffrey Friedl, Omron Corporation
## (jfriedl@omron.co.jp  -or-  jfriedl@cs.cmu.edu)
##
## Comments, corrections welcome.
##
## Thanks to the people at FSF for readline (and the code I referenced
## while writing this), and for Roland Schemers whose line_edit.pl I used
## as an early basis for this.
##
$rl_version = "930122.003";
$[ = 0;

##
## What's Cool
## ----------------------------------------------------------------------
## * hey, it's in perl.
## * Pretty full GNU readline like library...
## *	support for ~/.inputrc
## *    horizontal scrolling
## *	command/file completion
## *	rebinding
## *	history (with search)
## *	undo
## *	numeric prefixes
## * supports multi-byte characters (at least for the Japanese I use).
## * Has a tcsh-like completion-function mode.
##     call &readline'rl_set('tcsh-complete-mode', 'On') to turn on.
## * The meta-character stuff is more cool than the real readline... any
##   character can be a meta character.

##
## What's not Cool
## ----------------------------------------------------------------------
## Can you say HUGE?
## I can't spell, so comments riddled with misspellings.
## Written by someone that has never really used readline.
## Some functions not yet implemented (upcase-word, etc... but who cares)
## History mechanism is slightly different than GNU... may get fixed
##     someday, but I like it as it is now...
## Killbuffer not a ring.. just one level. 
## Obviously not well tested yet.
## Written by someone that doesn't have a bell on his terminal, so
##     proper readline use of the bell may not be here.
##


##
## Functions beginning with F_ are functions that are mapped to keys.
## Variables and functions beginning rl_ may be accessed/set/called/read
## from outside the package.  Other things are internal.
## 
## Some notable internal-only variables of global proportions:
##   $prompt -- line prompt (passed from user)
##   $line  -- the line being input
##   $D     -- ``Dot'' -- index into $line of the cursor's location.
##   $InsertMode -- usually true. False means overwrite mode.
##   $InputLocMsg -- string for error messages, such as "[~/.inputrc line 2]"
##   *emacs_keymap -- keymap for emacs-mode bindings:
##	@emacs_keymap - bindings indexed by ASCII ordinal
##      $emacs_keymap{'name'} = "emacs_keymap"
##      $emacs_keymap{'default'} = "SelfInsert"  (default binding)
##   *vi_keymap -- keymap for vi-mode bindings
##   *KeyMap -- current keymap in effect.
##   *thisKeyMap -- "instantaneous time" keymap in use.
##   $LastCommandKilledText -- needed so that subsequent kills accumulate
##   $lastcommand -- name of command previously run
##   $lastredisplay -- text placed upon screen during previous &redisplay
##   $si -- ``screen index''; index into $line of leftmost char &redisplay'ed
##   $force_redraw -- if set to true, causes &redisplay to be verbose.
##   $AcceptLine -- when set, its value is returned from &readline.
##   $ReturnEOF -- unless this also set, in which case undef is returned.
##   $pending -- if set, value is to be used as input.
##   @undo -- array holding all states of current line, for undoing.
##   $NumericArg -- usually 1, changed by M-# sequence....
##   $KillBuffer -- top of kill ring (well, don't have a kill ring yet)
##   @tcsh_complete_selections -- for tcsh mode, possible selections
##
## Some internal variables modified by &rl_set (see comment at &rl_set for
## info about how these set'able variables work)
##   $var_EditingMode -- either *emacs_map or *vi_map
##   $var_TcshCompleteMode -- if true, the completion function works like
##      in tcsh.  That is, the first time you try to complete something,
##	the common prefix is completed for you. Subsequent completion tries
##	(without other commands in between) cycles the command line through
##	the various possibilities.  If/when you get the one you want, just
##	continue typing.
## Other $var_ things not supported yet.
##
## Some variables used internally, but may be accessed from outside...
##   $rl_version -- just for good looks.
##   $rl_NoInitFromFile -- if defined when package is require'd, ~/.inputrc
##  	will not be read.
##   @rl_History -- array of previous lines input
##   $rl_HistoryIndex -- history pointer (for moving about history array)
##   $rl_completion_function -- see "How Command Completion Works" (way) below.
##   $rl_basic_word_break_characters -- string of characters that can cause
##	a word break for forward-word, etc.
##   $rl_completer_word_break_characters --
##	like $rl_basic_word_break_characters (and in fact defaults to it),
##	but for the completion function.
##   $rl_special_prefixes -- characters that are part of this string as well
##      as of $rl_completer_word_break_characters cause a word break for the
##	completer function, but remain part of the word.  An example: consider
##      when the input might be perl code, and one wants to be able to
##      complete on variable and function names, yet still have the '$',
##	'&', '@',etc. part of the $text to be completed. Then set this var
## 	to '&@$%' and make sure each of these characters is in
## 	$rl_completer_word_break_characters as well....
##   $rl_MaxHistorySize -- maximum size that the history array may grow.
##   $rl_screen_width -- width readline thinks it can use on the screen.
##   $rl_margin -- when moving to within this far from a margin, scrolls.
##   $rl_CLEAR -- what to output to clear the screen.
##



VAR_CONFIG:
{
    ## not yet supported... always on.
    $var_HorizontalScrollMode = 1;
    $var_HorizontalScrollMode{'On'} = 1;
    $var_HorizontalScrollMode{'Off'} = 0;

    $var_EditingMode{'emacs'} = *emacs_keymap;
    $var_EditingMode{'vi'} = *vi_keymap;
    $var_EditingMode = $var_EditingMode{'emacs'};

    ## not yet supported... always off
    $var_MarkModifiedLines = 0;
    $var_MarkModifiedLines{'Off'} = 0;
    $var_MarkModifiedLines{'On'} = 1;

    ## not yet supported... always off
    $var_PreferVisibleBell = 0;
    $var_PreferVisibleBell{'On'} = 1;
    $var_PreferVisibleBell{'Off'} = 0;

    ## this is an addition. Very nice.
    $var_TcshCompleteMode = 0;
    $var_TcshCompleteMode{'On'} = 1;
    $var_TcshCompleteMode{'Off'} = 0;
}

CONFIG:
{
    if (! -t STDIN) {
    	$stdin_not_tty = 1;
    } else {
	eval{require "ioctl.pl"}; ## try to get, don't die if not found.
	$TIOCGETP = 0x40067408 if !defined($TIOCGETP);
	$TIOCSETP = 0x80067409 if !defined($TIOCSETP);
	$TIOCGWINSZ = 0x40087468 if !defined($TIOCGWINSZ);

	## TTY modes
	$RAW	= 040 if !defined($RAW);
	$ECHO	= 010 if !defined($ECHO);
	#$CBREAK = 002 if !defined($CBREAK);
	$mode = $RAW; ## could chose CBREAK for testing....
	$sgttyb_t   = 'C4 S';
	$winsz_t = "S S S S";  # rows,cols, xpixel, ypixel
	$winsz = pack($winsz_t,0,0,0,0);

	$rl_screen_width = 79; ## default
   	if (ioctl(STDIN,$TIOCGWINSZ,$winsz)) {
             local($num_rows,$num_cols) = unpack($winsz_t,$winsz);
             $rl_screen_width = $num_cols if defined($num_cols) && $num_cols;
	}
        $rl_margin = int($rl_screen_width/3);

	$rl_completion_function = "rl_filename_list"
		if !defined($rl_completion_function);
	$rl_basic_word_break_characters = "\\\t\n'".' "`@$><=;|&{(';  #)}
	$rl_completer_word_break_characters = $rl_basic_word_break_characters;
	$rl_special_prefixes = '';
	
	@rl_History=() if !defined(@rl_History);
	$rl_MaxHistorySize = 100 if !defined($rl_MaxHistorySize);

	$InsertMode=1;
	$KillBuffer='';
	$line='';
	$InputLocMsg = ' [initialization]';
	&InitKeymap(*emacs_keymap, 'SelfInsert', 'emacs_keymap',
	    'C-@',	'Ding',
	    'C-a',	'BeginningOfLine',
	    'C-b',	'BackwardChar',
	    'C-c',	'Interrupt',
	    'C-d',	'DeleteChar',
	    'C-e',	'EndOfLine',
	    'C-f',	'ForwardChar',
	    'C-g',	'Abort',
	    'M-C-g',	'Abort',
	    'C-h',	'BackwardDeleteChar',
	    "\t" ,	'Complete',
	    "\n" ,	'AcceptLine',
	    'C-k',	'KillLine',
	    'C-l',	'ClearScreen',
	    "\r" ,	'AcceptLine',
	    'C-n',	'NextHistory',
	    'C-o',	'Ding',
	    'C-p',	'PreviousHistory',
	    'C-q',	'QuotedInsert',
	    'C-r',	'ReverseSearchHistory',
	    'C-s',	'ForwardSearchHistory',
	    'C-t',	'TransposeChars',
	    'C-u',	'UnixLineDiscard',
	    'C-v',	'QuotedInsert',
	    'C-w',	'UnixWordRubout',
	    'C-x',	'ReReadInitFile',
	    'C-y',	'Yank',
	    'C-z',	'Suspend',
	    'C-[',	'Ding',
	    'C-\\',	'Ding',
	    "\e" ,	'PrefixMeta',
	    'C-^',	'Ding',
	    'C-_',	'Undo',
	    'C-?',	'BackwardDeleteChar',
	    'M-<',	'BeginningOfHistory',
	    'M->',	'EndOfHistory',
	    'M-C-?',	'BackwardKillWord',
	    'M-C-j',	'ToggleEditingMode',
	    'M-B',	'BackwardWord',
	    'M-C',	'CapitalizeWord',
	    'M-D',	'KillWord',
	    'M-F',	'ForwardWord',
	    'M-L',	'DownCaseWord',
	    'M-R',	'RevertLine',
	    'M-T',	'TransposeWords',
	    'M-U',	'UpcaseWord',
	    'M-Y',	'YankPop',
	    "M-?",	'PossibleCompletions',
	    "M-\t",	'TabInsert',
	    'M-C-g',	'Abort',
	);

	*KeyMap = *emacs_keymap;
	foreach ('-', '0' .. '9') { &rl_bind("M-$_", 'NumericPrefix'); }
	foreach ('a' .. 'z') { &rl_bind("M-$_", 'DoUppercaseVersion'); }

	## Vi keymap not yet supported... 
	&InitKeymap(*vi_keymap, 'Ding', 'vi_keymap',
	    ' ',	'EmacsEditingMode',
	    "\n",	'EmacsEditingMode',
	    "\r",	'EmacsEditingMode',
	);

	*KeyMap = $var_EditingMode;
	&F_ReReadInitFile if !defined($rl_NoInitFromFile);
	$InputLocMsg = '';
    }
}

##
## This is it. Called as &readline'readline($prompt), the next input line is
## returned (undef on EOF).
##
sub readline
{
    if ($stdin_not_tty) {
	return undef if !defined($line = <STDIN>);
	chop($line);
	return $line;
    }

    local($|) = 1;
    local($input);

    ## prompt should be given to us....
    $prompt = defined($_[0]) ? $_[0] : 'INPUT> ';

    $rl_HistoryIndex = @rl_History; ## Start at the end of the history.
    $line='';	        	    ## Line starts blank...
    $D = 0;			    ## Dot starts at index #0
    $LastCommandKilledText = 0;     ## heck, was no last command.
    $lastcommand = '';		    ## Well, there you go.

    ##
    ## some stuff for &redisplay.
    ##
    $lastredisplay = '';	## Was no last redisplay for this time.
    $lastlen = length($lastredisplay);
    $lastdelta = 0;		## Cursor was nowhere
    $si = 0;			## Want line to start left-justified
    $force_redraw = 0;		## Want to display with brute force.
    &SetTTY;			## Put into raw mode.
    &redisplay;			## Show the line (just prompt at this point).

    *KeyMap = $var_EditingMode;
    undef($AcceptLine);		## When set, will return its value.
    undef($ReturnEOF);		## ...unless this on, then return undef.
    undef($pending);		## If set, contains text to use as input.
    @undo = ();			## Undo history starts empty for each line.

    while (!defined($AcceptLine)) {
	$NumericArg = 1;

	## get a character of input
	if (!defined($pending)) {
	    $input = getc;
	} else {
	    $input = substr($pending, 0, 1);
	    substr($pending, 0, 1) = '';
	    undef($pending) if length($pending) == 0;
	}

	push(@undo, &savestate); ## save state so we can undo.

	$ThisCommandKilledText = 0;
	&docmd(*KeyMap, ord($input));	## actually execute input
	$LastCommandKilledText = $ThisCommandKilledText;
    }

    undef @undo; ## Release the memory.
    &ResetTTY;   ## Restore the tty state.
    return undef if defined($ReturnEOF);
    $AcceptLine; ## return the line accepted.
}



##
## InitKeymap(*keymap, 'default', 'name')
##
sub InitKeymap
{
    local(*KeyMap) = shift(@_);
    $KeyMap{'default'} = 'F_' .shift(@_);
    $KeyMap{'name'} = shift(@_);
    die "Bad default function [$KeyMap{'default'}] ".
	qq/for keymap "$KeyMap{'name'}"/
		if eval "!defined(&$KeyMap{'default'})";

    &rl_bind if @_ > 0;	## The rest of @_ gets passed silently.
}

sub max { $_[0] > $_[1] ? $_[0] : $_[1]; }
sub min { $_[0] < $_[1] ? $_[0] : $_[1]; }


##
## Accepts an array as pairs ($char, $function, [$char, $function]...).
## and maps the associated bindings to the current KeyMap.
##
## CHAR should be the name of a character
##	control characters,      as in: ^D  C-G  Control-X
##	meta characters,         as in: M-a  Meta-3
##	regular characters,      as in: a b c 1 2 3
##      two of the above paired, as in: ^X^C  M-C-A ab
##
## Unlike the real readline, this readline can have more than one meta
## character. Things named "M-" (and "Meta-", etc.) all use ESC by default,
## but if one has bindings such as ^C^A, ^C^B, ^C^C, etc., then one can
## consider '^C' a meta character.
##
## Of course, if there is any binding of <c1><c2>, then <c1> can't have
## a binding all by itself.
##
## FUNC should be in the form 'BeginningOfLine' or 'beginning-of-line'.
## It is an error for the function to not be known....
##
sub rl_bind
{
    local($char, $func, $ord);

    ## translate the name of a single character to the ordinal
    sub charname2ord { local($_) = @_;
	return ord($_) if length == 1;
	return ord("\e") if /esc/i || /m-/i || /meta-?/i;
	return 127 if /del/i || $_ eq '^?' || /c-\?/i;
	return ord("\u$2")-ord('@') if /(\^|c-|ctrl-|control-)(.)/i;
	die "\n\rinternal error[$_]";
    }

    ##
    ## These are pretty tight with the code that follows.... don't
    ## modify blindly.  Particularly, note the number of open-parens
    ## in $patA and how it affects when $patA is used.
    ##
    $patA= '([^^]|m-|meta-|esc-?|del|((\^|c-|ctrl-|control-)[@-_?]))';
    $patB= '([\x00-\xff]|esc|del|((\^|c-|ctrl-|control-)[@-_?]))';
    while (defined($char = shift(@_)) && defined($func = shift(@_)))
    {
	##
	## Change the function name from something like
	##	backward-kill-line
	## to
	##	BackwardKillLine
	## if not already there.
	##
	$func = "\u$func";
	$func =~ s/-(.)/\u$1/g;

	if (!defined($_readline{"F_$func"})) {
	    warn "Warning$InputLocMsg: bad bind function [$func]\n";

	## See if it's a double-character sequence.
	} elsif ($char =~ m/^$patA$patB$/io) {
	    $ord = &charname2ord($1);
	    local($second) = $4;
	    if (defined($KeyMap[$ord]) && $KeyMap[$ord] ne 'F_PrefixMeta')
	    {
		warn "Warning$InputLocMsg:\n".
		      "  Re-binding char #$ord to meta with [$char]".
		      "  from [$KeyMap[$ord]]\n";
	    }
	    $KeyMap[$ord] = 'F_PrefixMeta';
	    $map = "$KeyMap{'name'}_$ord";
	    eval("&InitKeymap(*$map, 'Ding', '$map') if !defined(%$map);1")
		|| die "$@";
	    
	    {
		local(*KeyMap) = eval("*$map");
		local(@x) = ($second, $func); ## stupid use of @x here
		&rl_bind(@x);                 ## gets around some perl bug.
	    }

	## Nope, maybe a single-character "sequence"
	} elsif ($char =~ m/^$patB$/io) {
	    $ord = &charname2ord($1);
	    #print "Bind ", *KeyMap,"[$ord] = $func\n";
	    if ($KeyMap[$ord] eq $KeyMap{'default'}) {
		undef $KeyMap[$ord];
	    } else {
		$KeyMap[$ord] = "F_$func";
	    }
	    
	## Mmm, what is is?
	} else {
	    warn "Warning$InputLocMsg: bad bind character [$char]\n";
	}
    }
}

##
## rl_set(var_name, value_string)
##
## Sets the named variable as per the given value, if both are appropriate.
## Allows the user of the package to set such things as HorizontalScrollMode
## and EditingMode.  Value_string may be of the form
##	HorizontalScrollMode
##      horizontal-scroll-mode
##   
## Also called during the parsing of ~/.inputrc for "set var value" lines.
##
## The previous value is returned, or undef on error.
###########################################################################
## Consider the following example for how to add additional variables
## accessible via rl_set (and hence via ~/.inputrc).
##
## Want:
## We want an external variable called "FooTime" (or "foo-time").
## It may have values "January", "Monday", or "Noon".
## Internally, we'll want those values to translate to 1, 2, and 12.
##
## How:
## Have an internal variable $var_FooTime that will represent the current
## internal value, and initialize it to the default value.
## Make an array %var_FooTime whose keys and values are are the external
## (January, Monday, Noon) and internal (1, 2, 12) values:
##
##	    $var_FooTime = $var_FooTime{'January'} =  1; #default
##	                   $var_FooTime{'Monday'}  =  2;
##	                   $var_FooTime{'Noon'}    = 12;
##
sub rl_set
{
    local($var, $val) = @_;

    ## if the variable is in the form "some-name", change to "SomeName"
    local($_) = "\u$var";
    local($return) = undef;
    s/-(.)/\u$1/g;

    local(*V) = $_readline{"var_$_"};
    if (!defined($V)) {
	warn("Warning$InputLocMsg:\n".
	     "  Invalid variable `$var'\n");
    } elsif (!defined($V{$val})) {
	local(@selections) = keys(%V);
	warn("Warning$InputLocMsg:\n".
	     "  Invalid value `$val' for variable `$var'.\n".
	     "  Choose from [@selections].\n");
    } else {
	$return = $V;
        $V = $V{$val}; ## make the setting
    }
    $return;
}

##
## OnSecondByte($index)
##
## Returns true if the byte at $index into $line is the second byte
## of a two-byte character.
##
sub OnSecondByte
{
    return 0 if $_[0] == 0 || $_[0] == length($line);

    die 'internal error' if $_[0] > length($line);

    ##
    ## must start looking from the beginning of the line .... can
    ## have one- and two-byte characters interspersed, so can't tell
    ## without starting from some know location.....
    ##
    local($i);
    for ($i = 0; $i < $_[0]; $i++) {
	next if ord(substr($line, $i, 1)) < 0x80;
	## We have the first byte... must bump up $i to skip past the 2nd.
	## If that one we're skipping past is the index, it should be changed
	## to point to the first byte of the pair (therefore, decremented).
        return 1 if ++$i == $_[0];
    }
    0; ## seemed to be OK.
}

##
## CharSize(index)
##
## Returns the size of the character at the given INDEX in the
## current line.  Most characters are just one byte in length,
## but if the byte at the index and the one after has the high
## bit set those two bytes are one character of size=2.
##
## Assumes that index points to the first of a 2-byte char if not
## pointing to a 2-byte char.
##
sub CharSize
{
    return 2 if ord(substr($line, $_[0],   1)) >= 0x80 &&
                ord(substr($line, $_[0]+1, 1)) >= 0x80;
    1;
}

sub SetTTY {
#    system 'stty raw -echo';    

    $sgttyb = ''; ## just to quiet "perl -w";
    ioctl(STDIN,$TIOCGETP,$sgttyb) || die "Can't ioctl TIOCGETP: $!";
    @tty_buf = unpack($sgttyb_t,$sgttyb);
    $tty_buf[4] |= $mode;
    $tty_buf[4] &= ~$ECHO;
    $sgttyb = pack($sgttyb_t,@tty_buf);
    ioctl(STDIN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!";
}

sub ResetTTY {
#    system 'stty -raw echo';

    ioctl(STDIN,$TIOCGETP,$sgttyb) || die "Can't ioctl TIOCGETP: $!";
    @tty_buf = unpack($sgttyb_t,$sgttyb);
    $tty_buf[4] &= ~$mode;
    $tty_buf[4] |= $ECHO;
    $sgttyb = pack($sgttyb_t,@tty_buf);
    ioctl(STDIN,$TIOCSETP,$sgttyb) || die "Can't ioctl TIOCSETP: $!";

}

##
## WordBreak(index)
##
## Returns true if the character at INDEX into $line is a basic word break
## character, false otherwise.
##
sub WordBreak
{
    index($rl_basic_word_break_characters, substr($line,$_[0],1)) != -1;
}

##
## docmd(keymap, command)
## 
## If the KEYMAP has an entry for COMMAND, it is executed.
## Otherwise, the default command for the keymap is executed.
##
sub docmd
{
    *thisKeyMap = $_[0];
    local($cmd) = defined($thisKeyMap[$_[1]]) ?
		  $thisKeyMap[$_[1]] :
		  $thisKeyMap{'default'};
    #print "\r\n&$cmd($_[1])\r\n";## DEBUG
    eval("&$cmd($_[1]);1") || warn "$@ ";
    $lastcommand = $cmd;
}

##
## Save whatever state we wish to save as a string.
## Only other function that needs to know about it's encoded is getstate.
##
sub savestate
{
    join("\0", $D, $si, $LastCommandKilledText, $KillBuffer, $line);
}
sub getstate
{
    ($D, $si, $LastCommandKilledText, $KillBuffer, $line) = split(/\0/, $_[0]);
    $ThisCommandKilledText = $LastCommandKilledText;
}


##
## redisplay()
##
## Updates the screen to reflect the current $line.
##
## For the purposes of this routine, we prepend the prompt to a local copy of
## $line so that we display the prompt as well.  We then modify it to reflect
## that some characters have different sizes (i.e. control-C is represented
## as ^C, tabs are expanded, etc.)
##
## This routine is somewhat complicated by two-byte characters.... must
## make sure never to try do display just half of one.
##
## This is some nasty code.
##
sub redisplay
{
    local($line) = $prompt.$line;      ## local $line has prompt also
    local($D) = $D + length($prompt);  ## local dot takes prompt into account

    ##
    ## If the line contains anything that might require special processing
    ## for displaying (such as tabs, control characters, etc.), we will
    ## take care of that now....
    ##
    if ($line =~ m/[^\x20-\x7e]/) {
	local($new, $Dinc, $c) = ('', 0);

	## Look at each character of $line in turn.....
        for ($i = 0; $i < length($line); $i++) {
	    $c = substr($line, $i, 1);
	
	    ## A tab to expand...
	    if ($c eq "\t") {
		$c = ' ' x  (8 - (($i-length($prompt)) % 8));

	    ## A control character....
	    } elsif ($c =~ tr/\000-\037//) {
		$c = sprintf("^%c", ord($c)+ord('@'));

	    ## the delete character....
	    } elsif (ord($c) == 127) {
		$c = '^?';
	    }
	    $new .= $c;

	    ## Bump over $D if this char is expanded and left of $D.
	    $Dinc += length($c) - 1 if (length($c) > 1 && $i < $D);
	}
	$line = $new;
	$D += $Dinc;
    }

    ##
    ## Now $line is what we'd like to display.
    ##
    ## If it's too long to fit on the line, we must decide what we can fit.
    ##
    ## If we end up moving the screen index ($si) [index of the leftmost
    ## character on the screen], to some place other than the front of the
    ## the line, we'll have to make sure that it's not on the first byte of
    ## a 2-byte character, 'cause we'll be placing a '<' marker there, and
    ## that would screw up the 2-byte character.
    ##
    ## Similarly, if the line needs chopped off, we make sure that the
    ## placement of the tailing '>' won't screw up any 2-byte character in
    ## the vicinity.
    ##
    if ($D == length($prompt)) {
	$si = 0;   ## display from the beginning....
    } elsif ($si >= $D) {
	$si = &max(0, $D - $rl_margin);
	$si-- if $si != length($prompt) && !&OnSecondByte($si);
    } elsif ($si + $rl_screen_width <= $D) {
	$si = &min(length($line), ($D - $rl_screen_width) + $rl_margin);
	$si-- if $si != length($prompt) && !&OnSecondByte($si);
    } else {
	## Fine as-is.... don't need to change $si.
    }
    substr($line, $si, 1) = '<' if $si != 0; ## put the "chopped-off" marker

    $thislen = &min(length($line) - $si, $rl_screen_width);
    if ($si + $thislen < length($line)) {
	## need to place a '>'... make sure to place on first byte.
	$thislen-- if &OnSecondByte($si+$thislen-1);
	substr($line, $si+$thislen-1,1) = '>';
    }

    ##
    ## Now know what to display.
    ## Must get substr($line, $si, $thislen) on the screen,
    ## with the cursor at $D-$si characters from the left edge.
    ##
    $line = substr($line, $si, $thislen);
    $delta = $D - $si;	## delta is cursor distance from left margin.

    ##
    ## Now must output $line, with cursor $delta spaces from left margin.
    ##

    ##
    ## If $force_redraw is not set, we can attempt to optimize the redisplay
    ## However, if we don't happen to find an easy way to optimize, we just
    ## fall through to the brute-force method of re-drawing the whole line.
    ##
    if (!$force_redraw)
    {
	## can try to optimize here a bit.

	## For when we only need to move the cursor
	if ($lastredisplay eq $line) {
	    ## If we need to move forward, just overwrite as far as we need.
	    if ($lastdelta < $delta) {
		print substr($line, $lastdelta, $delta-$lastdelta);

	    ## Need to move back.
	    } elsif($lastdelta > $delta) {
		## Two ways to move back... use the fastest. One is to just
		## backspace the proper amount. The other is to jump to the
		## the beginning of the line and overwrite from there....
		if ($lastdelta - $delta < $delta) {
		    print "\b" x ($lastdelta - $delta);
		} else {
		    print "\r", substr($line, 0, $delta);
		}
	    }
	    ($lastlen, $lastredisplay, $lastdelta) = ($thislen, $line, $delta);
	    return;
	}

	## for when we've just added stuff to the end
	if ($thislen > $lastlen &&
	    $lastdelta == $lastlen &&
	    $delta == $thislen &&
	    substr($line, 0, $lastlen) eq $lastredisplay)
	{
	    print substr($line, $lastdelta);
	    ($lastlen, $lastredisplay, $lastdelta) = ($thislen, $line, $delta);
	    return;
	}

	## backspacing
	if ($lastlen > $thislen &&
	    $lastdelta == $lastlen &&
	    $delta == $thislen &&
	    substr($lastredisplay, 0, $thislen) eq $line)
	{
	    print "\b" x ($lastlen - $thislen);
	    print " " x ($lastlen - $thislen);
	    print "\b" x ($lastlen - $thislen);
	    ($lastlen, $lastredisplay, $lastdelta) = ($thislen, $line, $delta);
	    return;
	}

	## There is much more opportunity for optimizing..... 
	## something to work on later.....
    }

    ##
    ## Brute force method of redisplaying... redraw the whole thing.
    ##
    print "\r",$line;
    if ($lastlen > $thislen) {
	print ' ' x ($lastlen - $thislen);
	if ($lastlen - $delta < $delta) {
	    print "\b" x ($lastlen - $delta);
	} else {
	    print "\r", substr($line, 0, $delta);
	}
    } else {
	if ($thislen - $delta < $delta) {
	    print "\b" x ($thislen - $delta);
	} else {
	    print "\r", substr($line, 0, $delta);
	}
    }
    ($lastlen, $lastredisplay, $lastdelta) = ($thislen, $line, $delta);

    $force_redraw = 0;
}

###########################################################################
###########################################################################

##
## Go to beginning of line.
##
sub F_BeginningOfLine
{
    if ($D != 0) {
	$D = 0;
	&redisplay;
    }
}

##
## Move to the end of the line.
##
sub F_EndOfLine
{
    if ($D != length($line)) {
	$D = length($line);
	$D-- if &OnSecondByte($D);
	&redisplay;
    }
}

##
## Move forward (right) $NumericArg characters.
##
sub F_ForwardChar 
{
    if ($D != length($line) && $NumericArg > 0) {
	$D += &CharSize($D) while $NumericArg--;
	&redisplay;
    }
}

##
## Move backward (left) $NumericArg characters.
##
sub F_BackwardChar
{
    if ($D != 0 && $NumericArg > 0) {
	while ($D && $NumericArg--) {
	    $D--;  		       ## Move back one regardless,
	    $D-- if &OnSecondByte($D); ## another if over a big char.
	}
	&redisplay;
    }
}

##
## Move to the beginning of the next word.
## Done as many times as $NumericArg says...
##
sub F_ForwardWord
{
    while ($D != length($line) && $NumericArg-- > 0) {
	## skip forward past any word we're currently on
	$D += &CharSize($D) while ($D < length($line)) && !&WordBreak($D);

	## skip past any whitespace....
	$D += &CharSize($D) while ($D < length($line)) && &WordBreak($D);

	## should be there....
	if ($D > length($line)) {
	    warn "\r\n[adjusting for internal inconsistency]";
	    $D = length($line);
	}
	die 'internal error' if &OnSecondByte($D); ## just to make sure
    }
    &redisplay;
}


##
## If currently in a word but not at the first character, move to the
## beginning of the word.  Otherwise, move to the beginning of the previous
## word.  Done for as many words as $NumericArg.
##
sub F_BackwardWord
{
    &BackwardWord;
    &redisplay;
}

##
## Internal version of this.
## Used for F_BackwardWord and F_BackwardKillWord.
##
sub BackwardWord
{
    while ($D > 0 && $NumericArg-- > 0 ) {
	if ($D == length($line)) {
	    --$D; ## at the end of the line... move back at least once.
	} else {
	    ## will want to skip this word if we're at the first char,
	    ## so move now if we're at any word-like character.
	    --$D if !&WordBreak($D);
	}

	## back over any non-word
	--$D while $D && &WordBreak($D);

	## back over word to skip (if there)
	--$D while $D && !&WordBreak($D);

	## Oops, maybe just went too far...
	$D++ if &WordBreak($D);
    }
    die 'internal error' if &OnSecondByte($D); ## just to make sure
}

##
## Clear the screen
##
sub F_ClearScreen
{
    $rl_CLEAR = `clear` if !defined($rl_CLEAR);
    print $rl_CLEAR;
    $force_redraw = 1;
    &redisplay;
}

##
## Return the line as-is to the user.
##
sub F_AcceptLine
{
    ## Insert into history list if:
    ##	 * not blank
    ##   * not same as last entry
    ##
    if ($line ne '' && (!@rl_History || $rl_History[$#rl_History] ne $line)) {
	## if the history list is full, shift out an old one first....
	shift(@rl_History) if @rl_History == $rl_MaxHistorySize;
        push(@rl_History, $line); ## tack new one on the end
    }
    $AcceptLine = $line;
    print "\r\n";
}

##
## Use the previous entry in the history buffer (if there is one)
##
sub F_PreviousHistory
{
    return if $rl_HistoryIndex == 0;

    $rl_HistoryIndex--;
    $D = length($line = $rl_History[$rl_HistoryIndex]);
    $D-- if &OnSecondByte($D);
    &redisplay;
}

##
## Use the next entry in the history buffer (if there is one)
##
sub F_NextHistory
{
    return if $rl_HistoryIndex == @rl_History;

    $rl_HistoryIndex++;
    if ($rl_HistoryIndex == @rl_History) {
	$D = 0;
	$line = '';
    } else {
        $D = length($line = $rl_History[$rl_HistoryIndex]);
	$D-- if &OnSecondByte($D);
    }
    &redisplay;
}

sub F_BeginningOfHistory
{
    if ($rl_HistoryIndex != 0) {
        $D = length($line = $rl_History[$rl_HistoryIndex = 0]);
	$D-- if &OnSecondByte($D);
	&redisplay;
    }
}

sub F_EndOfHistory
{
    if (@rl_History != 0 && $rl_HistoryIndex != $#rl_History) {
        $D = length($line = $rl_History[$rl_HistoryIndex = $#rl_History]);
	$D-- if &OnSecondByte($D);
	&redisplay;
    }
}

sub F_ReverseSearchHistory
{
    &DoSearch($NumericArg >= 0 ? 1 : 0);
}

sub F_ForwardSearchHistory
{
    &DoSearch($NumericArg >= 0 ? 0 : 1);
}

sub DoSearch
{
    local($reverse) = @_;
    local($oldline) = $line;
    local($oldD) = $D;

    local($searchstr) = '';
    local($I) = -1;

    $si = 0;

    ## returns a new index or -1 if not found.
    sub search { local($index, $str) = @_;
	return -1 if $index < 0 || $index > $#rl_History; ## for safety
	while (1) {
	    return $index if index($rl_History[$index], $str) >= 0;
	    if ($reverse) {
		return -1 if $index-- == 0;
	    } else {
		return -1 if $index++ == $#rl_History;
	    }
	} 
    }

    while (1)
    {
	$line = '('.($reverse?'reverse-':'') ."i-search) `$searchstr': ";
	$D = length($line);
	if ($I != -1) {
	    $line .= $rl_History[$I];
	    $D += index($rl_History[$I], $searchstr);
	}
	&redisplay;

	$c = getc;
	last if ($c eq "\e");
	if ($KeyMap[ord($c)] eq 'F_ReverseSearchHistory') {
	    if ($reverse && $I != -1) {
		if ($tmp = &search($I-1,$searchstr), $tmp >= 0) {
		    $I = $tmp;
		} else {
		    &F_Ding;
		}
	    }
	    $reverse = 1;
	} elsif ($KeyMap[ord($c)] eq 'F_ForwardSearchHistory') {
	    if (!$reverse && $I != -1) {
		if ($tmp = &search($I+1,$searchstr), $tmp >= 0) {
		    $I = $tmp;
		} else {
		    &F_Ding;
		}
	    }
	    $reverse = 0;
        } elsif ($c eq "\007") {  ## abort search... restore line and return
	    $line = $oldline;
	    $D = $oldD;
	    &redisplay;
	    return;
        } elsif (ord($c) < 32 || ord($c) > 126) {
	    $pending = $c;
	    if ($I < 0) {
		## just restore
		$line = $oldline;
		$D = $oldD;
	    } else {
		#chose this line
		$line = $rl_History[$I];
		$D = index($rl_History[$I], $searchstr);
	    }
	    &redisplay;
	    last;
	} else {
	    ## Add this character to the end of the search string and
	    ## see if that'll match anything.
	    $tmp = &search($I < 0 ? $rl_HistoryIndex-$reverse: $I, $searchstr.$c);
	    if ($tmp == -1) {
		&F_Ding;
	    } else {
		$searchstr .= $c;
		$I = $tmp;
	    }
	}
    }
}

###########################################################################
###########################################################################

##
## Removes the $NumericArg chars from under the cursor (and to the right,
## if more than one).
## If there is no line and the last command was different, tells
## readline to return EOF.
##
sub F_DeleteChar
{
    if (length($line) == 0) {
	$AcceptLine = $ReturnEOF = 1 if $lastcommand ne 'F_DeleteChar';
	return;
    }
    return if $D == length($line);
    local($size) = &CharSize($D);
    substr($line, $D, $size) = '';
    &redisplay;
}

##
## Removes $NumericArg chars to left of cursor (if not at beginning of line).
## If $NumericArg > 1, to kill buffer.
##
sub F_BackwardDeleteChar
{
    local($oldD) = $D;
    local($needtoKill) = $NumericArg > 1;
    while ($D != 0 && $NumericArg-- > 0) {
	$D -= 1;	           ## move over Dot
	$D-- if &OnSecondByte($D); ## move over again if on 2-byte char
    }
    if ($needtoKill) {
	$ThisCommandKilledText = 1;
        $KillBuffer = '' if !$LastCommandKilledText;
        $KillBuffer .= substr($line, $D, $oldD-$D);
    }
    substr($line, $D, $oldD-$D) = '';
    &redisplay;
}

##
## Insert the next character read verbatim.
##
sub F_QuotedInsert
{
    &F_SelfInsert(ord(getc));
}

##
## Insert a tab.
##
sub F_TabInsert
{
    &F_SelfInsert(ord("\t"));
}

##
## Argument is an ASCII value
##
## Inserts as per $NumericArg.
##
sub F_SelfInsert
{
    local($text2add) = sprintf("%c", $_[0]) x $NumericArg;
    if ($InsertMode) {
	substr($line,$D,0) .= $text2add;
    } else {
	substr($line,$D,length($text2add)) = $text2add;
    }
    $D += length($text2add);
    &redisplay;
}

##
## Argument is a string.
##
sub TextInsert
{
    local($text2add) = $_[0] x $NumericArg;
    if ($InsertMode) {
	substr($line,$D,0) .= $text2add;
    } else {
	substr($line,$D,length($text2add)) = $text2add;
    }
    $D += length($text2add);
}

sub F_TransposeChars { }

sub F_TransposeWords { }

sub F_UpcaseWord { }

sub F_DownCaseWord { }

sub F_CapitalizeWord { }

###########################################################################
###########################################################################

##
## Kill from cursor to end of line.
##
sub F_KillLine
{
    $ThisCommandKilledText = 1;
    return if !$D >= length($line);
    $KillBuffer = '' if !$LastCommandKilledText;
    $KillBuffer .= substr($line,$D);
    substr($line,$D) = '';
    &redisplay;
}

##
## Delete from cursor to beginning of line.
##
sub F_BackwardKillLine
{
    $ThisCommandKilledText = 1;
    return if $D == 0;
    $KillBuffer = '' if !$LastCommandKilledText;
    $KillBuffer .= substr($line, 0, $D);
    substr($line, 0, $D) = '';
    $D = 0;
    &redisplay;
}

##
## Kill to the end of the current word. If not on a word, kill to
## the end of the next word.
##
sub F_KillWord
{
    local($d) = $D;

    while ($d < length($line) && $NumericArg-- > 0) {
	## skip past any whitespace
	$d += &CharSize($d) while ($d < length($line)) && &WordBreak($d);

	## skip past any word
	$d += &CharSize($d) while ($d < length($line)) && !&WordBreak($d);

	## should be there....
	if ($d > length($line)) {
	    warn "\r\n[adjusting for internal inconsistency]";
	    $d = length($line);
	}
        die 'internal error' if &OnSecondByte($D); ## just to make sure
    }

    ## now delete from $D to $d.
    if ($d != $D) {
        $ThisCommandKilledText = 1;
        $KillBuffer = '' if !$LastCommandKilledText;
	$KillBuffer .= substr($line, $D, $d-$D);
	substr($line, $D, $d-$D) = '';
	&redisplay;
    }
}

##
## Kill backward to the start of the current word, or, if currently
## not on a word (or just at the start of a word), to the start of the
## previous word.
##
sub F_BackwardKillWord
{
    local($oldD) = $D;
    &BackwardWord;
    $ThisCommandKilledText = 1;
    $KillBuffer = '' if !$LastCommandKilledText;
    $KillBuffer .= substr($line, $D, $oldD-$D);
    substr($line, $D, $oldD-$D) = '';
    &redisplay;
}

##
## Kill entire line
##
sub F_UnixLineDiscard
{
    $ThisCommandKilledText = 1;
    if (length($line) > 0) {
	$KillBuffer = '' if !$LastCommandKilledText;
	$KillBuffer .= $line;
	$line = '';
	$D = 0;
	&redisplay;
    }
}

##
## Kill to previous whitespace.
##
sub F_UnixWordRubout
{
    local($rl_basic_word_break_characters) = "\t ";
    &F_BackwardKillWord;
}

sub F_Yank
{
    &TextInsert($KillBuffer);
    &redisplay;
}

sub F_YankPop { }

sub F_ReReadInitFile
{
    local($file) = $ENV{'HOME'}."/.inputrc";
    return if !open(RC, $file);
    while (<RC>) {
	next if m/^#/;
	$InputLocMsg = " [$file line $.]";
	if (m/\s*set\s+(\S+)\s+(\S*)\s*$/) {
	    &rl_set($1, $2, $file);
	} elsif (m/^\s*(\S+):\s+(\S+)\s*$/) {
	    &rl_bind($1, $2);
	} else {
	    chop;
	    warn "\r\nBad line [$_] in $file\n";
	}
    }
    close(RC);
}

###########################################################################
###########################################################################


sub F_Abort {}

##
## If the character that got us here is lower case, do the upper-case
## equiv...
##
sub F_DoUppercaseVersion
{
    local($ord) = @_;
    if ($ord >= ord('a') && $ord <= ord('z')) {
	&docmd(*thisKeyMap, $ord - (ord('a') - ord('A')));
    } else {
	&F_Ding;
    }
}

##
## Undo one level.
##
sub F_Undo
{
    pop(@undo); ## get rid of the state we just put on, so we can go back one.
    if (@undo) {
	&getstate(pop(@undo));
	&redisplay
    } else {
	&F_Ding;
    }
}

##
## Replace the current line to some "before" state.
##
sub F_RevertLine
{
    if ($rl_HistoryIndex >= @rl_History) {
	$line = '';
    } else {
	$line = $rl_History[$rl_HistoryIndex];
    }
    $D = length($line);
    &redisplay;
}

sub F_EmacsEditingMode
{
    $var_EditingMode = $var_EditingMode{'emacs'};
}

sub F_ToggleEditingMode
{
    if ($var_EditingMode{$var_EditingMode} eq $var_EditingMode{'emacs'}) {
        $var_EditingMode = $var_EditingMode{'vi'};
    } else {
        $var_EditingMode = $var_EditingMode{'emacs'};
    }
}

###########################################################################
###########################################################################


##
## (Attempt to) interrupt the current program.
##
sub F_Interrupt
{
    print "\r\n";
    &ResetTTY;
    kill ("INT", 0);

    ## We're back.... must not have died.
    $force_redraw = 1;
    &redisplay;
}

##
## Execute the next character input as a command in a meta keymap.
##
sub F_PrefixMeta
{
    die "<internal error, $_[0]>" if eval("!defined(%$KeyMap{'name'}_$_[0])");
    &docmd(eval("*$KeyMap{'name'}_$_[0]"), ord(getc));
}

##
## For typing a numeric prefix to a command....
## 
sub F_NumericPrefix
{
    local($ord) = $_[0];
    local($sign) = 1;
    $NumericArg = 0;
    if ($ord eq ord('-')) {
	$sign = -1;
    } else {
	$NumericArg = $ord - ord('0');
    }
    while ($ord = ord(getc)) {
	last if !($ord >= ord('0') && $ord <= ord('9'));
	$NumericArg = $NumericArg * 10 + $ord - ord('0');
    }
    $NumericArg = 1 if $NumericArg == 0;
    $NumericArg *= $sign;
    &docmd(*KeyMap, $ord);
}

sub F_OverwriteMode
{
    $InsertMode = 0;
}

sub F_InsertMode
{
    $InsertMode = 1;
}


##
## Refresh the input line.
##
sub F_Redisplay
{
     $force_redraw = 1;
     &redisplay;
}

##
## (Attempt to) suspend the program.
##
sub F_Suspend
{
    print "\r\n";
    &ResetTTY;
    kill "TSTP",0;

    ## We're back....
    &SetTTY;
    $force_redraw = 1;
    &redisplay;
}

##
## Ring the bell.
## Should do something with $var_PreferVisibleBell here, but what?
##
sub F_Ding {
    print "\007";
}

##########################################################################
#### command/file completion  ############################################
##########################################################################

##
## How Command Completion Works
##
## When asked to do a completion operation, readline isolates the word
## to the immediate left of the cursor (i.e. what's just been typed).
## This information is then passed to some function (which may be supplied
## by the user of this package) which will return an array of possible
## completions.
##
## If there is just one, that one is used.  Otherwise, they are listed
## in some way (depends upon $var_TcshCompleteMode).
##
## The default is to do filename completion.  The function that performs
## this task is readline'rl_filename_list.
##
## A minimal-trouble way to have command-completion is to call
## readline'rl_basic_commands with an array of command names, such as
##    &readline'rl_basic_commands('quit', 'run', 'set', 'list')
## Those command names will then be used for completion if the word being
## completed begins the line. Otherwise, completion is disallowed.
##
## The way to have the most power is to provide a function to readline
## which will accept information about a partial word that needs completed,
## and will return the appropriate list of possibilities.
## This is done by setting $readline'rl_completion_function to the name of
## the function to run.
##
## That function will be called with three args ($text, $line, $start).
## TEXT is the partial word that should be completed.  LINE is the entire
## input line as it stands, and START is the index of the TEXT in LINE
## (i.e. zero if TEXT is at the beginning of LINE).
##
## A cool completion function will look at LINE and START and give context-
## sensitive completion lists. Consider something that will do completion
## for two commands
## 	cat FILENAME
##	finger USERNAME
##	status [this|that|other]
##
## It (untested) might look like:
##
##	$readline'rl_completion_function = "main'complete";
##	sub complete { local($text, $_, $start) = @_;
##	    ## return commands which may match if at the beginning....
##	    return grep(/^$text/, 'cat', 'finger') if $start == 0;
##	    return &rl_filename_list($text) if /^cat\b/;
##	    return &my_namelist($text) if /^finger\b/;
##	    return grep(/^text/, 'this', 'that','other') if /^status\b/;
##	    ();
##	}
## Of course, a real completion function would be more robust, but you
## get the idea (I hope). 
##

##
## List possible completions
##
sub F_PossibleCompletions
{
    &complete_internal('?');
}

##
## Do a completion operation.
## If the last thing we did was a completion operation, we'll
## now list the options available (under normal emacs mode).
##
## Under TcshCompleteMode, each contiguous subsequent completion operation
## lists another of the possible options.
##
sub F_Complete
{
    if ($lastcommand eq 'F_Complete') {
	if ($var_TcshCompleteMode && @tcsh_complete_selections > 0) {
	    substr($line, $tcsh_complete_start, $tcsh_complete_len)
		= $tcsh_complete_selections[0];
	    $D -= $tcsh_complete_len;
	    $tcsh_complete_len = length($tcsh_complete_selections[0]);
	    $D += $tcsh_complete_len;
	    push(@tcsh_complete_selections, shift(@tcsh_complete_selections));
	    &redisplay;
	} else {
	    &complete_internal('?');
	}
    } else {
	@tcsh_complete_selections = ();
	&complete_internal("\t");
    }
}

##
## The meat of command completion. Patterned closely after GNU's.
##
## The supposedly partial word at the cursor is "completed" as per the
## single argument:
##	"\t"	complete as much of the word as is unambiguous
##	"?"	list possibilities.
## 	"*"	replace word with all possibilities. (who would use this?)
##
## A few notable variables used:
##   $rl_completer_word_break_characters
##	-- characters in this string break a word.
##   $rl_special_prefixes
##	-- but if in this string as well, remain part of that word.
##
sub complete_internal
{
    local($what_to_do) = @_;
    local($point, $end) = ($D, $D);

    if ($point)
    {
        ## Not at the beginning of the line; Isolate the word to be completed.
	1 while (--$point && (-1 == index($rl_completer_word_break_characters,
		substr($line, $point, 1))));

	# Either at beginning of line or at a word break.
	# If at a word break (that we don't want to save), skip it.
	$point++ if (
    		(index($rl_completer_word_break_characters,
		       substr($line, $point, 1)) != -1) &&
    		(index($rl_special_prefixes, substr($line, $point, 1)) == -1)
	);
    }

    local($text) = substr($line, $point, $end - $point);
    @matches = &completion_matches($rl_completion_function,$text,$line,$point);

    if (@matches == 0) {
	&F_Ding;
    } elsif ($what_to_do eq "\t") {
	local($replacement) = shift(@matches);
	$replacement .= ' ' if @matches == 1;
	if (!$var_TcshCompleteMode) {
	    &F_Ding if @matches != 1;
	} else {
	    @tcsh_complete_selections = (@matches, $text);
	    $tcsh_complete_start = $point;
	    $tcsh_complete_len = length($replacement);
	}
	if ($replacement ne '') {
	    substr($line, $point, $end-$point) = $replacement;
	    $D = $D - ($end - $point) + length($replacement);
	    &redisplay;
	}
    } elsif ($what_to_do eq '?') {
	shift(@matches); ## remove prepended common prefix
	print "\n\r@matches\n\r";
	$force_redraw = 1;
	&redisplay;
    } elsif ($what_to_do eq '*') {
	shift(@matches); ## remove common prefix.
	substr($line, $point, $end-$point) = "@matches"; ## insert all.
    } else {
	warn "\r\n[Internal error]";
    }
}

##
## completion_matches(func, text, line, start)
##
## FUNC is a function to call as FUNC(TEXT, LINE, START)
## 	where TEXT is the item to be completed
##	      LINE is the whole command line, and
##	      START is the starting index of TEXT in LINE.
## The FUNC should return a list of items that might match.
##
## completion_matches will return that list, with the longest common
## prefix prepended as the first item of the list.  Therefor, the list
## will either be of zero length (meaning no matches) or of 2 or more.....
##
sub completion_matches
{
    local($func, $text, $line, $start) = @_;

    ## Works with &rl_basic_commands. Return items from @rl_basic_commands
    ## that start with the pattern in $text.
    sub use_basic_commands
    {
	local($text, $line, $start) = @_;
	return () if $start != 0;
	grep(/^$text/, @rl_basic_commands);
    }

    ## get the raw list
    local(@matches);

    #print qq/\r\neval("\@matches = &$func(\$text, \$line, \$start)\n\r/;#DEBUG
    eval("\@matches = &$func(\$text, \$line, \$start);1") || warn "$@ ";

    ## if anything returned , find the common prefix among them
    if (@matches) {
	local($prefix) = $matches[0];
	local($len) = length($prefix);
	for ($i = 1; $i < @matches; $i++) {
	    next if substr($matches[$i], 0, $len) eq $prefix;
	    $prefix = substr($prefix, 0, --$len);
	    last if $len == 0;
	    $i--; ## retry this one to see if the shorter one matches.
	}
	unshift(@matches, $prefix); ## make common prefix the first thing.
    }
    @matches;
}

##
## For use in passing to completion_matches(), returns a list of
## filenames that begin with the given pattern.  The user of this package
## can set $rl_completion_function to 'rl_filename_list' to restore the
## default of filename matching if they'd changed it earlier, either
## directly or via &rl_basic_commands.
##
sub rl_filename_list
{
    local($pattern) = $_[0];
    return (<$pattern*>);
}

##
## For use by the user of the package. Called with a list of possible
## commands, will allow command completion on those commands, but only
## for the first word on a line.
## For example: &rl_basic_commands('set', 'quit', 'type', 'run');
##
## This is for people that want quick and simple command completion.
## A more thoughtful implementation would set $rl_completion_function
## to a routine that would look at the context of the word being completed
## and return the appropriate possibilities.
##
sub rl_basic_commands
{
     @rl_basic_commands = @_;
     $rl_completion_function = 'use_basic_commands';
}

1;

SHAR_EOF
fi
exit 0
#	End of shell archive