#
#	start of command line editing functions
#

$cmds{"batch_file_input"} = '&batch_file_input';
$cmds{"backward_char"} = '&backward_char';
$cmds{"backward_delete_char"} = '&backward_delete_char';
$cmds{"backward_word"} = '&backward_word';
$cmds{"beginning_of_line"} = '&beginning_of_line';
$cmds{"cli_error"} = '&cli_error';
$cmds{"end_of_line"} = '&end_of_line';
$cmds{"escape_prefix"} = '&escape_prefix';
$cmds{"expand_known_word"} = '&expand_known_word';
$cmds{"forward_char"} = '&forward_char';
$cmds{"forward_delete_char"} = '&forward_delete_char';
$cmds{"forward_word"} = '&forward_word';
$cmds{"get_input"} = '&get_input';
$cmds{"kill_backward_word"} = '&kill_backward_word';
$cmds{"kill_forward_word"} = '&kill_forward_word';
$cmds{"kill_line"} = '&kill_line';
$cmds{"kill_to_beginning"} = '&kill_to_beginning';
$cmds{"kill_whole_line"} = '&kill_whole_line';
$cmds{"new_line"} = '&new_line';
$cmds{"next_history"} = '&next_history';
$cmds{"previous_history"} = '&previous_history';
$cmds{"redraw_line"} = '&redraw_line';
$cmds{"run_shell"} = '&run_shell';
$cmds{"search_previous_history"} = '&search_previous_history';
$cmds{"self_insert"} = '&self_insert';
$cmds{"tab"} = '&tab';
$cmds{"transpose"} = '&transpose';

# support for field editing/CLI
# keystrokes pass through %edit_cmds and %escape_cmds on their
# way to different editing functions.

# gawd this is so silly...
foreach $i (0..127) {
    $edit_cmds{pack("c", $i)} = '&self_insert';
}


#	editing commands...
$edit_cmds{pack("c", 0)} = '&set_mark';	# C-SP
$edit_cmds{pack("c", 1)} = '&beginning_of_line';	# C-a
$edit_cmds{pack("c", 2)} = '&backward_char';		# C-b
$edit_cmds{pack("c", 4)} = '&forward_delete_char';	# C-d
$edit_cmds{pack("c", 5)} = '&end_of_line';		# C-e
$edit_cmds{pack("c", 6)} = '&forward_char';		# C-f
$edit_cmds{pack("c", 9)} = '&tab';			# TAB
$edit_cmds{pack("c", 10)} = '&new_line';		# NL
$edit_cmds{pack("c", 11)} = '&kill_line';		# C-k
$edit_cmds{pack("c", 12)} = '&redraw_line';		# C-l
$edit_cmds{pack("c", 14)} = '&next_history';		# C-n
$edit_cmds{pack("c", 16)} = '&previous_history';	# C-p
$edit_cmds{pack("c", 18)} = '&redraw_line';		# C-r
$edit_cmds{pack("c", 20)} = '&transpose';		# C-t
$edit_cmds{pack("c", 21)} = '&kill_whole_line';		# C-u
$edit_cmds{pack("c", 23)} = '&kill_region';             # C-w
$edit_cmds{pack("c", 24)} = '&kill_to_beginning';	# C-x
$edit_cmds{pack("c", 25)} = '&yank';			# C-y
$edit_cmds{pack("c", 27)} = '&escape_prefix';		# ESC
$edit_cmds{pack("c", 127)} = '&backward_delete_char';	# DEL
$edit_cmds{pack("c", 8)} = '&backward_delete_char';	# BS

#	The ESCape prefix...
$escape_cmds{'!'} = '&run_shell';			# ESC-!
$escape_cmds{'~'} = '&forward_char_flip';		# ESC-~
$escape_cmds{'b'} = '&backward_word';			# ESC-b
$escape_cmds{'c'} = '&capitalize_word';			# ESC-c
$escape_cmds{'d'} = '&kill_forward_word';		# ESC-d
$escape_cmds{'f'} = '&forward_word';			# ESC-f
$escape_cmds{'l'} = '&downcase_word';			# ESC-l
$escape_cmds{'p'} = '&search_previous_history';		# ESC-p
$escape_cmds{'t'} = '&transpose_word';      		# ESC-t
$escape_cmds{'u'} = '&upcase_word';      		# ESC-u
$escape_cmds{pack("c", 127)} = '&kill_backward_word';	# ESC-DEL
$escape_cmds{pack("c", 8)} = '&kill_backward_word';	# ESC-BS
$escape_cmds{pack("c", 9)} = '&expand_known_word';	# ESC-TAB

#	there's a lot to filename expansion, so we'll tuck this 
#	off into a file of its own.  Once it's loaded this next line
#	becomes: "$escape_cmds{pack("c", 27)} = '&expand_file_name'"
$escape_cmds{pack("c", 27)} =
	'&load_routine ("expand.pl", "expand")'; # ESC-ESC

#	hmmm, recursive CLI's anyone?  maybe someday :-)
# $escape_cmds{'@'} = '&eval_perl_expression';		# ESC-@

$forward_char_func = "forward_char";

#	get_input - print a prompt and get an entry
sub get_input {
    local($prompt) = @_;

    # this is a hack that lets you force feed a default answer that can be
    # edited.  Should be particulary useful in the case of long pathnames
    $| = 1;
    if (defined($force_input)) {
	print TTYOUT "\n";
	$cur_line = $force_input;
	$cur_len = length($cur_line);
	$cur_pos = $cur_len;
	&redraw_line;
	undef($force_input);
    } else {
	print TTYOUT $prompt;
    }
    $keep_going = 1;
    $in_digit = 0;
    $dig_arg = 1;
    while ($keep_going) {
	read(TTYIN, $ans, 1);
	&do_callbacks("KeyPress");
	eval($edit_cmds{$ans});
    }
    1;
}


#	set_mark (C-space on console, C-shift-@ on terminal)
sub set_mark {
    $mark_pos = $cur_pos;
    1;
}


#	escape_prefix
sub escape_prefix {
    read(TTYIN, $ans, 1);
    eval($escape_cmds{$ans});
    1;
}

#	tab
sub tab {
    1;	# I don't feel like defining this yet, have at it...
}


#	previous_history - scroll backwards through current history stack
sub previous_history {
    &kill_whole_line;
    $| = 1;
    $cur_line = pop @command_history;
    unshift(@command_history, "$cur_line");
    $cur_pos = $cur_len = length($cur_line);
    print TTYOUT $cur_line;
    1;
}


#	next_history - scroll forwards through current history stack
sub next_history {
    &kill_whole_line;
    $| = 1;
    $cur_line = shift @command_history;
    push(@command_history, "$cur_line");
    $cur_pos = $cur_len = length($cur_line);
    print TTYOUT $cur_line;
    1;
}


#	search_previous_history - look for regexp in current history stack
#
#	this barely works, should work like ESC-p in tcsh
sub search_previous_history {
    @foo = grep(/^$cur_line/, @command_history);
    &kill_whole_line;
    $cur_line = $foo[0];
    $cur_pos = $cur_len = length($cur_line);
    print TTYOUT $cur_line;
    1;
}



#	expand_known_word
#
# this is a flaky start, but then, it's starting to work...
sub expand_known_word {
    @current_line_words = split(/\W*\s+\W*/, substr($cur_line, 0, $cur_pos));
    @expansions = sort grep(/^$current_line_words[$#current_line_words]/,
			    (keys %known_words));
    if ($#expansions == 0 && length($expansions[0]) > 1 &&
	$expansions[0] !~ " ") {
	# then tack onto current word...
	$our_expansion = substr($expansions[0],
			length($current_line_words[$#current_line_words]));

	# have the self_insert routine do the work for us, keeping
	# the current line in a known state
	foreach $ans (split(//, $our_expansion)) {
	    &self_insert;
	}
    } else {
	if ($#expansions > 0) {
	    foreach $possibilities (@expansions) {
		print TTYOUT "\n$possibilities";
	    }
	    &redraw_line;
	    
	}
    }
    1;
}


#	new_line - handle end of line
sub new_line {
    $keep_going = 0;
    $mark_pos = 0;
    $yank_str = '';
    push(@command_history, ($cur_line));
    foreach $word (split(/\W*\s+\W*/, $cur_line)) {
	$known_words{$word}++;    # Increment the entry.
    }
    $cur_line = '';
    $cur_pos = $cur_len = 0;
    1;
}


#	beginning_of_line (C-a)
sub beginning_of_line {
    if ($cur_pos > 0) {
	print TTYOUT "\b" x $cur_pos;
	$cur_pos = 0;
    }
    1;
}


#	redraw_line (C-r)
sub redraw_line {
    $| = 1;
    print TTYOUT "\n$prompt$cur_line";
    print TTYOUT "\b" x ($cur_len - $cur_pos);
    1;
}


#	backward_char (C-b)
sub backward_char {
    if ($cur_pos > 0) {
	$cur_pos--;
	print TTYOUT "\b";
    }
    1;
}


#	forward_char (C-f)
sub forward_char {
    if ($cur_pos < $cur_len) {
	print TTYOUT substr($cur_line, $cur_pos, 1);
	$cur_pos++;
    }
    1;
}

#	forward_char_upper
sub forward_char_upper {
    substr($cur_line, $cur_pos, 1) =~ tr/a-z/A-Z/;
    &forward_char;
    1;
}


#	forward_char_lower
sub forward_char_lower {
    substr($cur_line, $cur_pos, 1) =~ tr/A-Z/a-z/;
    &forward_char;
    1;
}

#	forward_char_flip - change existing case
sub forward_char_flip {
    local($flipme) = substr($cur_line, $cur_pos, 1);

    if ($flipme =~ /[a-z]/) {
	substr($cur_line, $cur_pos, 1) =~ tr/a-z/A-Z/;
    } elsif ($flipme =~ /[A-Z]/) {
	substr($cur_line, $cur_pos, 1) =~ tr/A-Z/a-z/;
    }
    &forward_char;
    1;
}

#	transpose (C-t)
sub transpose {
    if ($cur_pos > 1) {
	$last = substr($cur_line, $cur_pos - 1, 1);
	$first = substr($cur_line, $cur_pos - 2, 1);
	substr($cur_line, $cur_pos - 2, 1) = $last;
	substr($cur_line, $cur_pos - 1, 1) = $first;
	print TTYOUT "\b\b".substr($cur_line, $cur_pos - 2, 2);
	&forward_char;
    }
    if ($cur_pos < 2) {
	&forward_char;
    }
    1;
}



#	kill_forward_word (ESC-d)
sub kill_forward_word {
    $yank_str = '';
    $save_pos = $cur_pos;
    &forward_word;
    foreach $i (1..($cur_pos - $save_pos)) {
	&backward_delete_char;
    }
    1;
}


#	kill_backward_word (ESC-DEL)
sub kill_backward_word {
    $yank_str = '';

    $save_pos = $cur_pos;
    &backward_word;
    foreach (1..($save_pos - $cur_pos)) {
	&forward_delete_char;
    }
    1;
}


#	transpose_word
sub transpose_word {


    # nope, not yet...

    &forward_word;
    &set_mark;
    &backword_word;
    &backword_word;
    &kill_region;
    $save_word = $yank_str;

    $yank_str = '';
    &set_mark;
    &forward_word;
    &kill_region;
    foreach $ans (split(//, $save_word)) {
	&self_insert;
    }
    &yank;
    1;

}


#	case changing functions
#
#	These next three (upcase_word, downcase_word, and capitalize_word,
#	were pretty easy to implement (half an hour).  They work with
#	forward_char_{upper,lower}.  &forward_word now uses
#	&$forward_char_func to call the appropriate function.

#	upcase_word (ESC-u)
sub upcase_word {
    local($save_ff) = $forward_char_func;
    $forward_char_func = "forward_char_upper";
    &forward_word;
    $forward_char_func = $save_ff;
    1;
}


#	downcase_word (ESC-l)
sub downcase_word {
    local($save_ff) = $forward_char_func;
    $forward_char_func = "forward_char_lower";
    &forward_word;
    $forward_char_func = $save_ff;
    1;
}

#	capitalize_word (ESC-c)
sub capitalize_word {
    &forward_word; &backward_word; # yes, this is silly, we're trying to
				   # get to the first char of a word reliably
				   # and I don't feel like writing a special
				   # case just for that...
    &forward_char_upper;
    &downcase_word;		# all hail tcsh!
    1;
}


#	forward_word (ESC-f)
sub forward_word {
    if (substr($cur_line, $cur_pos, 1) =~ /\W/) {
	for (;;) {
	    last if ($cur_pos == $cur_len);
	    last if (substr($cur_line, $cur_pos, 1) =~ /\w/);
	    &$forward_char_func;
	}
    }
    
    for (;;) {
	last if ($cur_pos == $cur_len);
	last if (substr($cur_line, $cur_pos, 1) =~ /\W/);
	&$forward_char_func;
    }
    1;
}


#	backward_word (ESC-b)
#
#	gee, there's more to this one than I thought there would be.  Not
#	for the squeamish
sub backward_word {
    # never mind, we're at the beginning of the line
    if ($cur_pos == 0) {
	return 1;
    }

    # end of line?
    if ($cur_pos == $cur_len) {
	&backward_char;
    }

    # on the beginning of a word?
    if ((substr($cur_line, $cur_pos, 1) =~ /\w/) &&
	(substr($cur_line, $cur_pos - 1 , 1) =~ /\W/)) {
	&backward_char;
    }

    # head backwards to the previous word...
    if (substr($cur_line, $cur_pos, 1) =~ /\W/) {
	while ($cur_pos >= 1 &&
	       (substr($cur_line, $cur_pos - 1, 1) =~ /\W/)) {
	    &backward_char;
	}
    }

    # work backwards through a word
    while ($cur_pos >= 1 && (substr($cur_line, $cur_pos - 1, 1) =~ /\w/)) {
	&backward_char;
    }
    1;
}


#	kill_whole_line (C-u)
sub kill_whole_line {
    &beginning_of_line;
    &kill_line;
    1;
}


#	watch out, this is likely to get remapped in 4.0 so that we have
#	a ^X prefix...still mulling that one over (regions)

#	kill_to_beginning (C-x)
sub kill_to_beginning {
    $yank_str = '';
    $save_pos = $cur_pos;
    &beginning_of_line;
    foreach $i (1..($save_pos - $cur_pos)) {
	&forward_delete_char;
    }
    1;
}


#	kill_line (C-k)
sub kill_line {
    if ($cur_len > 1) {
	$yank_str = $cur_line;
	$cur_line = substr($cur_line, 0, $cur_pos);
	print TTYOUT " " x ($cur_len - $cur_pos);
	print TTYOUT "\b" x ($cur_len - $cur_pos);
	$cur_len = $cur_pos;
    }
    1;
}

#	kill_region (C-w)
sub kill_region {
    $yank_str = '';
    if ($mark_pos == $cur_pos) {
	&forward_delete_char;
    } elsif ($mark_pos > $cur_pos) {
	foreach $i (1..($mark_pos - $cur_pos)) {
	    &forward_delete_char;
	}
    } elsif ($mark_pos < $cur_pos) {
	foreach $i (1..($cur_pos - $mark_pos)) {
	    &backward_delete_char;
	}
    }
    1;
}


#	forward_delete_char (C-d)
sub forward_delete_char {
    if ($cur_len > $cur_pos) {
	$yank_str = $yank_str . substr($cur_line, $cur_pos, 1);
	$save = substr($cur_line, $cur_pos + 1);
	$cur_len--;
	$cur_line = substr($cur_line, 0, $cur_pos).$save;
	print TTYOUT $save." ";
	print TTYOUT "\b" x ($cur_len - $cur_pos + 1);
    }
    1;
}


#	end_of_line (C-e)
sub end_of_line {
    if ($cur_len > $cur_pos) {
	print TTYOUT substr($cur_line, $cur_pos);
	$cur_pos = $cur_len;
    }
    1;
}


#	run_shell (ESC-!)
sub run_shell {
    print TTYOUT "\npushing shell, \"exit\" will get you back here...\n";
    &quick_shell;
    &redraw_line;
}


#	backward_delete_char (DEL or BS)
sub backward_delete_char {
    if ($cur_pos > 0) {
	$yank_str =  substr($cur_line, $cur_pos - 1, 1) . $yank_str;
	if ($cur_len > $cur_pos) { #save rest of line...
	    $save = substr($cur_line, $cur_pos);
	}
	$cur_pos--;
	$cur_len--;
	$cur_line = substr($cur_line, 0, $cur_pos);
	print TTYOUT "\b \b";
	if ($cur_len > $cur_pos) { #save rest of line...
	    substr($cur_line, $cur_pos, 1) = $save;
	    print TTYOUT substr($cur_line, $cur_pos)." ";
	    print TTYOUT "\b" x ($cur_len - $cur_pos + 1);
	}
    }
    1;
}


#	self_insert
sub self_insert {
    $| = 1;
    substr($cur_line, $cur_pos, 0) = $ans;
    print TTYOUT substr($cur_line, $cur_pos);
    $cur_pos++;
    $cur_len++;
    if ($cur_len > $cur_pos) {
	print TTYOUT "\b" x ($cur_len - $cur_pos);
    }
    1;
}

#	added Sun Mar 15 17:12:08 PST 1992
#	cli_error - use to print out quick helpful messages
sub cli_error {
    local($cli_err_msg) = @_;

    foreach $ans (split(//, $cli_err_msg)) {
	&self_insert;
    }
    sleep 1;
    foreach $ans (split(//, $cli_err_msg)) {
	&backward_delete_char;
    }
    1;
}

sub yank {
    foreach $ans (split(//, $yank_str)) {
	&self_insert;
    }
    1;
}

#
#	end of command line editing functions
#
1;