# Perl forms system, version 1.0.

# Written by Dale R. Worley (drw@math.mit.edu).

# WARRANTY DISCLAIMER

# This software was created by Dale R. Worley and is
# distributed free of charge.  It is placed in the public domain and
# permission is granted to anyone to use, duplicate, modify and redistribute
# it provided that this notice is attached.

# Dale R. Worley provides absolutely NO WARRANTY OF ANY KIND
# with respect to this software.  The entire risk as to the quality and
# performance of this software is with the user.  IN NO EVENT WILL DALE
# R. WORLEY BE LIABLE TO ANYONE FOR ANY DAMAGES ARISING OUT THE
# USE OF THIS SOFTWARE, INCLUDING, WITHOUT LIMITATION, DAMAGES RESULTING FROM
# LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL
# DAMAGES.

package forms;

# The pattern to match field and attribute names
# Must match Perl qualified names, at least, and not match whitespace
$name_pat = '[^.=:\s]+';

# $debug Controls debugging:
#	1	print field values as installed by process_representation
#	2	print subroutine definitions that are evalled by 
#		process_representation

# The sequence number of generated names
$generated_name_seq = 0;

sub generate_name {
    "forms_generated_" . $generated_name_seq++;
}

sub process_representation {
    local(*form, @input) = @_;
    local(@fields, $i);

    # Clear the form array
    %form = ();
    # Process the input
    for ($i = 0; $i <= $#input; $i++) {
	$_ = $input[$i];
	# Trim leading and trailing whitespace
	s/^\s+//;
	s/\s+$//;
	if (/^$/ || /^#/) {
	    # Ignore comment lines
	} elsif (/^($name_pat)\s*:$/o) {
	    # This is a "field:" line, setting the default field name
	    $default_field = $1;
	} elsif (/^:$/) {
	    # This is a ":" line, setting the default to a constructed
	    # field name.
	    $default_field = &generate_name;
	} elsif (/^($name_pat)\s*\.\s*($name_pat)\s*=\s*(.*)$/o) {
	    # This is an attribute setting line
	    &set_attribute($1, $2, $3) || return undef;
	} elsif (/^\.\s*($name_pat)\s*=\s*(.*)$/o) {
	    # This is an attribute setting line for the form as a whole
	    &set_attribute('', $1, $2) || return undef;
	} elsif (/^($name_pat)\s*=\s*(.*)$/o) {
	    # This is an attribute setting line for the default field
	    &set_attribute($default_field, $1, $2) || return undef;
	} elsif (/^sub\s+($name_pat)\s+{$/) {
	    # This is a subroutine definition
	    &define_subroutine || return undef;
	} elsif (/^\*(.*)$/) {
	    # This is an expression to be evaluated
	    print STDERR "Evalling: *$1\n" if $debug & 2;
	    {
		package forms_user;
		eval($1);
	    }
	    if ($@) {
		# Error during eval
		$error = "Error in freestanding expression at line $i: $@";
		return undef;
	    }
	} else {
	    # Invalid format
	    $error = "Invalid format at line $i: $_";
	    return undef;
	}
    }
    # Perform the post-processing
    # Set attribute initially_invisible from attribute invisible
    grep(($form{$_, 'initially_invisible'} = $form{$_, 'invisible'}, 0),
	 @fields);
    # Set the fields global attribute
    $form{'', 'fields'} = join(',', @fields);
    # Return success
    1;
}

sub set_attribute {
    local($field, $attribute, $value) = @_;

    if ($value =~ /^&($name_pat)$/o) {
	# It is "&function"; transform it into symbol table pointer
        print STDERR "Evalling: *$1\n" if $debug & 2;
	{
	    package forms_user;
	    $forms'value = eval("*$1");
        }
	if ($@) {
	    # Error during eval
	    $error = "Error in function name at line $i: $@";
	    return undef;
        }
    } elsif ($value =~ /^@($name_pat)$/o) {
	# It is "@function"; transform it into symbol table pointer
        print STDERR "Evalling: *$1\n" if $debug & 2;
	$value = eval("*$1");
	if ($@) {
	    # Error during eval
	    $error = "Error in function name at line $i: $@";
	    return undef;
        }
    } elsif ($value =~ /^"(.*)"$/) {
	# It is a quoted string.  Extract the contents.
	$value =  $1;
    } elsif ($value eq '{') {
	# It is "{"; read and define the subroutine
	$name = &generate_name;
	$value = "sub $name {\n";
	# Get further input lines until end is seen
	for ($i++; $i <= $#input; $i++) {
	    $_ = $input[$i];
	    s/\n//;
	    last if /^\s*};\s*$/;
	    $value .= $_ . "\n";
        }
	$value .= "}\n*$name";
        print STDERR "Defining subroutine:\n", $value if $debug & 2;
	{
	    package forms_user;
	    $forms'value = eval($forms'value);
	}
	if ($@) {
	    # Error during eval
	    $error = "Error in subroutine definition at line $i: $@";
	    return undef;
        }
    } elsif ($value =~ /^\*(.*)$/) {
	# It is "*expression"; evaluate it
        print STDERR "Evalling: *$1\n" if $debug & 2;
	{
	    package forms_user;
	    $forms'value = eval($1);
	}
	if ($@) {
	    # Error during eval
	    $error = "Error in expression at line $i: $@";
	    return undef;
        }
    } else {
	# The value is to be taken literally
    }
    print STDERR "\$form{$field, $attribute} = ", $value, "\n" if $debug & 1;
    $form{$field, $attribute} = $value;
    # Add the field to the @forms array, if it is not already there
    push(@fields, $field) unless grep($_ eq $field, @fields);
    # Return success
    1;
}

sub define_subroutine {
    $value = $_ . "\n";
    # Get further input lines until end is seen
    for ($i++; $i <= $#input; $i++) {
	$_ = $input[$i];
	s/\n//;
	last if /^\s*};\s*$/;
	$value .= $_ . "\n";
    }
    $value .= "}\n";
    print STDERR "Defining subroutine:\n", $value if $debug & 2;
    {
	package forms_user;
	$forms'value = eval($forms'value);
    }
    if ($@) {
	# Error during eval
	$error = "Error in subroutine definition at line $i: $@";
	return undef;
    }
    1;
}

sub dump_form {
    local(*form, $filehandle) = @_;
    local($field, $attr);

    $filehandle = 'STDOUT' unless $filehandle;
    foreach (sort keys %form) {
	($field, $attr) = /^(.*)$;(.*)$/o;
	print $filehandle "$field.$attr = ", $form{$field, $attr}, "\n";
    }
    1;
}

sub clear_values {
    local(*form) = @_;

    foreach (split(',', $form{'', 'fields'})) {
	$form{$_, 'value'} = undef;
    }
}

sub clear_values_and_redisplay {
    foreach (split(',', $form{'', 'fields'})) {
	$form{$_, 'value'} = undef;
	&changed_value($_);
    }
}

sub reset_visibility {
    local(*form) = @_;

    foreach (split(',', $form{'', 'fields'})) {
	$form{$_, 'invisible'} = $form{$_, 'initially_invisible'};
    }
}

sub process_form {
    local(*form) = @_;
    local($exit_value, @fields, $x, $cursor_location, $y, $entered_field,
	$current_field_no, $last_c);

    # Check that it's not empty
    die "Empty form" unless $form{'', 'fields'};

    # Call initialize, if necessary
    $y = $form{'', 'initialize'};
    if ($y) {
	local(*x) = $y;
	&undefined_function('', 'initialize') unless defined(&x);
	&x;
    }	    
    # Construct displayed fields
    @fields = split(',', $form{'', 'fields'});
    foreach (@fields) {
	if ($form{$_, 'field_length'}) {
	    $y = $form{$_, 'construct_displayed_value'};
	    local(*x) = $y;
	    &undefined_function($_, 'construct_displayed_value')
		unless defined(&x);
	    $form{$_, 'displayed_value'} = &x($_, $form{$_, 'value'});
	    $y = $form{$_, 'initialize_displayed_field'};
	    local(*x) = $y;
	    &undefined_function($_, 'initialize_displayed_field')
		unless defined(&x);
	    $form{$_, 'displayed_field'} =
		&x($_, $form{$_, 'displayed_value'});
	}
    }
    # Initialize screen
    &'initscr;
    &'leaveok($'stdscr, 0);
    &'standend;
    # Set terminal in the mode we like
    &'nocbreak;
    &'raw;
    &'nonl;
    &'noecho;
    # Get the F keys loaded
    &load_function_keys unless $function_keys_loaded;
    # Redisplay screen
    &'clear;
    foreach (@fields) {
	if (!$form{$_, 'invisible'}) {
	    # Write the label of the field, if there is one
	    if ($form{$_, 'label_text'}) {
		local($r, $c) = split(',', $form{$_, 'label_location'});
		&'move($r, $c);
		&'addstr($form{$_, 'label_text'});
    }
	    # Write the contents of the field, if there is one
	    if ($form{$_, 'field_length'}) {
		local($r, $c) = split(',', $form{$_, 'field_location'});
		&'move($r, $c);
		&'standout;
		&'addstr($form{$_, 'displayed_field'});
		&'standend;
	    }
	}
    }
    # Set cursor on first field
    $entered_field = undef;
    $current_field_no = $[ - 1;
    &next_field;
    # Set cursor location
    if ($current_field_no >= $[) {
	# Get $cursor_location
	$_ = $fields[$current_field_no];
	$y = $form{$_, 'initialize_displayed_field'};
	local(*x) = $y;
	&undefined_function($_, 'initialize_displayed_field')
	    unless defined(&x);
	&x($_, $form{$_, 'displayed_value'});
	local($r, $c) = split(',', $form{$_, 'field_location'});
        &'move($r, $c + $cursor_location);
    } else {
	# No writable fields; put cursor in UL corner
        &'move(0, 0);
    }
    # Loop waiting for a character
    INPUT_LOOP: while (1) {
	# Refresh the screen
	&'refresh;
	# Get a character
	$c = &'getch;
	# If it is ESC, get the whole escape sequence
	if ($c eq "\e") {
	    local($d) = '0';
	    while ((length($c) < 6 && $d gt ' ' && $d lt '@') || 
		   (length($c) == 2 && ($d eq 'O' || $d eq '['))) {
		$d = &'getch;
		$c .= $d;
	    }
	    # Check if it is valid
	    $c = $function_key{$c};
	    if (!($c &&
		  ($form{'', $c} || ($current_field_no >= $[ &&
				    $form{$fields[$current_field_no], $c})))) {
		&report_error("Invalid escape sequence");
	        next INPUT_LOOP;
	    }
	}
	# Process it
	# Exit or enter the field as appropriate
	if ($c eq "\n" || $c eq "\r" || $c eq "\t" ||
	    (length($c) > 1 &&
 		!$form{$fields[$current_field_no], $c})) {
	    # LFD, RET, TAB, and function keys that are not local to
	    # the field exit the field first
	    next INPUT_LOOP if $entered_field && !&exit_field;
	} elsif ($c eq "\031" || $c eq "\026") {
	    # C-y and C-v require to be in field
 	    if (!$entered_field) {
	        &report_error("Must have entered field");
		next INPUT_LOOP;
	    }
	} elsif ($c eq "\f" || $c eq "\020" || $c eq "\003" || $c eq "\007" ||
		 $c eq "\e") {
	    # C-l, C-p, C-c, C-g, and ESC have no constraint
	} else {
	    # All others enter the field first
	     &enter_field if !$entered_field;
	}
	# Process the character
	if ($c eq "\n") {
	    # LFD - accept contents of form
	    # Call finalize, if necessary
	    $y = $form{'', 'finalize'};
	    if ($y) {
		local(*x) = $y;
		&undefined_function('', 'finalize') unless defined(&x);
	        # If finalize fails, it should have produced a message
	        next INPUT_LOOP if !&x;
		}
	    # Exit successfully
	    $exit_value = 1;
	    last INPUT_LOOP;
	} elsif ($c eq "\003" || $c eq "\007") {
	    # C-c, C-g - abort the form
	    if ($entered_field) {
		$entered_field = undef;
		$form{$entered_field, 'value'} = $previous_value;
		$form{$entered_field, 'displayed_value'} = 
		    $previous_displayed_value;
		$form{$entered_field, 'displayed_field'} =
		    $previous_displayed_field;
		$cursor_location= $previous_cursor_location;
		# Redisplay the field
		local($r, $c) =
		    split(',', $form{$entered_field, 'field_location'});
		&'move($r, $c);
		&'standout;
		&'addstr($form{$entered_field, 'displayed_field'});
		&'standend;
		&'move($r, $c + $cursor_location);
	    }
	    $exit_value = 0;
	    last INPUT_LOOP;
	} elsif ($c eq "\r") {
	    # RET - go to next field
	    &next_field;
	    # Set cursor location
	    if ($current_field_no >= $[) {
		# Get $cursor_location
		$_ = $fields[$current_field_no];
		$y = $form{$_, 'initialize_displayed_field'};
		local(*x) = $y;
		&undefined_function($_, 'initialize_displayed_field')
		    unless defined(&x);
		&x($_, $form{$_, 'displayed_value'});
		local($r, $c) = split(',', $form{$_, 'field_location'});
		&'move($r, $c + $cursor_location);
	    } else {
		# No writable fields; put cursor in UL corner
		&'move(0, 0);
	    }
	} elsif ($c eq "\t") {
	    # TAB - go to previous field
	    &previous_field;
	    # Set cursor location
	    if ($current_field_no >= $[) {
		# Get $cursor_location
		$_ = $fields[$current_field_no];
		$y = $form{$_, 'initialize_displayed_field'};
		local(*x) = $y;
		&undefined_function($_, 'initialize_displayed_field')
		    unless defined(&x);
		&x($_, $form{$_, 'displayed_value'});
		local($r, $c) = split(',', $form{$_, 'field_location'});
		&'move($r, $c + $cursor_location);
	    } else {
		# No writable fields; put cursor in UL corner
		&'move(0, 0);
	    }
	} elsif ($c eq "\031") {
	    # C-y - restore previous value of the field and exit from field
	    $form{$entered_field, 'value'} = $previous_value;
	    $form{$entered_field, 'displayed_value'} = 
		$previous_displayed_value;
	    $form{$entered_field, 'displayed_field'} =
		$previous_displayed_field;
	    $cursor_location= $previous_cursor_location;
	    # Redisplay the field
	    local($r, $c) =
		split(',', $form{$entered_field, 'field_location'});
	    &'move($r, $c);
	    &'standout;
	    &'addstr($form{$entered_field, 'displayed_field'});
	    &'standend;
            &'move($r, $c + $cursor_location);
	    # Only once we're done with all this, forget the field
	    $entered_field = undef;
	} elsif ($c eq "\026") {
	    if ($last_c eq "\026") {
		# C-v C-v - exit valid field
		&exit_field;
	    } else {
	        # C-v - perform validity check on field or exit field
		$y = $form{$entered_field, 'validate_displayed_value'};
		local(*x) = $y;
		&undefined_function($entered_field, 'validate_displayed_value')
		    unless defined(&x);
		if (&x($entered_field,
			$form{$entered_field, 'displayed_value'})) {
		    &report_message("Field OK");
		} else {
		    # validate_displayed_value routine should produce error
		    # message
		    # Do not give C-v C-v effect if he types C-v again.
		    $c = "\e";
		}
	    }
	} elsif ($c eq "\f") {
	    # C-l - redraw screen
	    &'clearok($'stdscr, 1);
	} elsif ($c eq "\020") {
	    # C-p - give help
	    local($message);
	    if ($current_field_no >= $[ &&
		($message = 
		    $form{$fields[$current_field_no], 'help_message'}) &&
		$last_c ne "\020" &&
		$form{'MSG', 'field_length'}) {
		# There is a current field, it has a help message, user
		# has not typed C-p twice in a row, and there is a MSG
		# field, so display field help message
		&report_message($message);
	    } else {
		# Display help screen
		&display_help_screen;
		# If he types C-p after this, he gets field help again.
		$c = "\e";
	    }
	} elsif ($c eq "\e") {
	    # ESC - invalid escape sequence
	} elsif (length($c) > 1) {
	    # function key - do the appropriate function
	    $y = $form{$entered_field || '', $c};
	    local(*x) = $y;
	    &undefined_function($entered_field, $c) unless defined(&x);
	    &x;
	} elsif (($c ge "\001" && $c lt " ") || $c gt "~") {
	    # Other control character
	    $y = $form{$_, 'edit'};
	    local(*x) = $y;
	    &undefined_function($_, 'edit') unless defined(&x);
	    &x($entered_field, $c);
	    # Redisplay the field
	    local($r, $c) =
		split(',', $form{$entered_field, 'field_location'});
	    &'move($r, $c);
	    &'standout;
	    &'addstr($form{$entered_field, 'displayed_field'});
	    &'standend;
            &'move($r, $c + $cursor_location);
        } else {
	    # It is a printing character
	    $y = $form{$_, 'insert'};
	    local(*x) = $y;
	    &undefined_function($_, 'insert') unless defined(&x);
	    &x($entered_field, $c);
	    # Redisplay the field
	    local($r, $c) =
		split(',', $form{$entered_field, 'field_location'});
	    &'move($r, $c);
	    &'standout;
	    &'addstr($form{$entered_field, 'displayed_field'});
	    &'standend;
            &'move($r, $c + $cursor_location);
        }
    } continue {
	# Record the last key
	$last_c = $c;
    }
    # Delete the help screen window if necessary
    if ($help_screen_window) {
	&'delwin($help_screen_window);
	$help_screen_window = undef;
    }
    # Move cursor to LL corner
    &'move($'LINES-1, 0);
    &'refresh;
    &'endwin;
    $exit_value;
}

# Find next field that is visible, has a data area, and is writable.
sub next_field {
    local($old_field_no) = $current_field_no;

    # Look for a field after the current field
    for ($current_field_no++; $current_field_no <= $#fields;
	 $current_field_no++) {
	$_ = $fields[$current_field_no];
	return if !$form{$_, 'invisible'} &&
	          $form{$_, 'field_length'} &&
		  !$form{$_, 'read_only'};
    }
    # Look for a field before the current field
    for ($current_field_no = $[; $current_field_no <= $old_field_no;
	 $current_field_no++) {
	$_ = $fields[$current_field_no];
	return if !$form{$_, 'invisible'} &&
	          $form{$_, 'field_length'} &&
		  !$form{$_, 'read_only'};
    }
    # No field was found at all
    $current_field_no = $[ - 1;
}

# Find previous field that is visible, has a data area, and is writable.
sub previous_field {
    local($old_field_no) = $current_field_no;

    # Look for a field before the current field
    for ($current_field_no--; $current_field_no >= $[; $current_field_no--) {
	$_ = $fields[$current_field_no];
	return if !$form{$_, 'invisible'} &&
	          $form{$_, 'field_length'} &&
		  !$form{$_, 'read_only'};
    }
    # Look for a field after the current field
    for ($current_field_no = $#fields; $current_field_no >= $old_field_no;
	 $current_field_no--) {
	$_ = $fields[$current_field_no];
	return if !$form{$_, 'invisible'} &&
	          $form{$_, 'field_length'} &&
		  !$form{$_, 'read_only'};
    }
    # No field was found at all
    $current_field_no = $[ - 1;
}

# Enter the current field
sub enter_field {
    $entered_field = $fields[$current_field_no];
    $previous_value = $form{$entered_field, 'value'};
    $previous_displayed_value = $form{$entered_field, 'displayed_value'};
    $previous_displayed_field = $form{$entered_field, 'displayed_field'};
    $previous_cursor_location = $cursor_location;
}

# Exit the current field
sub exit_field {
    local($y);

    # Perform validity checking
    $y = $form{$entered_field, 'validate_displayed_value'};
    local(*x) = $y;
    &undefined_function($entered_field, 'validate_displayed_value')
        unless defined(&x);
    return 0
	unless &x($entered_field, $form{$entered_field, 'displayed_value'});
    $y = $form{$entered_field, 'interpret_displayed_value'};

    # Interpret the value
    local(*x) = $y;
    &undefined_function($entered_field, 'interpret_displayed_value')
        unless defined(&x);
    $form{$entered_field, 'value'} =
	&x($entered_field, $form{$entered_field, 'displayed_value'});

    # Canonicalize the value, if necessary
    if ($form{$entered_field, 'canonicalize'}) {
	    local($cursor_location);
	    local($old_r, $old_c);

	    $y = $form{$entered_field, 'construct_displayed_value'};
	    local(*x) = $y;
	    &undefined_function($entered_field, 'construct_displayed_value')
		unless defined(&x);
	    $form{$entered_field, 'displayed_value'} =
		&x($entered_field, $form{$entered_field, 'value'});
	    $y = $form{$entered_field, 'initialize_displayed_field'};
	    local(*x) = $y;
	    &undefined_function($entered_field, 'initialize_displayed_field')
		unless defined(&x);
	    $form{$entered_field, 'displayed_field'} =
		&x($entered_field, $form{$entered_field, 'displayed_value'});

	    # Save the cursor position
	    &'getyx($'stdscr, $old_r, $old_c);
	    # Rewrite the field
	    local($r, $c) = 
		split(',', $form{$entered_field, 'field_location'});
	    &'move($r, $c);
	    &'standout;
	    &'addstr($form{$entered_field, 'displayed_field'});
	    &'standend;
	    # Restore the cursor
	    &'move($old_r, $old_c);
    }

    # Clean up and exit
    $entered_field = undef;
    return 1;
}

sub display_help_screen {
    # Create help screen window if necessary
    if (!$help_screen_window) {
	local($i);

	$help_screen_window = &'newwin(0, 0, 0, 0);
	$i = 0;
	foreach (split(/\n/, <<'EOF')) {
                        Forms 1.0 help screen

LFD or C-j   Accept contents of form    C-c or C-g   Abort the form
RET or C-m   Go to next field           TAB or C-i   Go to previous field

C-y          Restore previous value of the field and exit from field
C-v          Perform validity check on field
C-v C-v      Exit from valid field

C-u          Clear field
C-k          Clear to end of field
C-r          Clear to beginning of field

C-a          Go to beginning of field   C-e          Go to end of field
C-b          Go back one character      C-f          Go forward one character
C-d          Delete next character      DEL or C-h   Delete previous character

C-p          Give help on this field (or show help screen if no help for field)
C-p C-p      Show this help screen

Function keys 1 through 10 can be used as commands if allowed by the
particular form.

Hit any key (other than C-p) to continue...
EOF
	    &'wmove($help_screen_window, $i, 0);
	    &'waddstr($help_screen_window, $_);
	    $i++;
	}
    }

    # Write it to the terminal
    &'clearok($help_screen_window, 1);
    &'wrefresh($help_screen_window);
    # Wait for a character that is not C-p
    1 while &'getch eq "\020";
    # Refresh the form
    &'clearok($'stdscr, 1);
}

# Report an error
sub report_error {
    local($message) = @_;

    &report_message($message);
    print "\007";
}

sub report_message {
    local($message) = @_;
    local($length) = $form{'MSG', 'field_length'};

    if ($length) {
	$form{'MSG', 'value'} = substr($message, 0, $length) .
	    ' ' x ($length - length($message));
	&changed_value('MSG');
    }
}

sub undefined_function {
    local($field, $attr) = @_;
    local($package, $filename, $line) = caller;

    die sprintf("Bad value of attribute function %s.%s: %s at %s line %s\n",
		$field, $attr, $form{$field, $attr}, $filename, $line);
}

sub changed_visibility {
    local($_) = @_;
    local($r, $c);

    # Record where the cursor is
    &'getyx($'stdscr, $r, $c);
    # Update the screen
    if ($form{$_, 'invisible'}) {
	# Erase the field from the screen
	# Erase the label of the field, if there is one
	if ($form{$_, 'label_text'}) {
	    local($r, $c) = split(',', $form{$_, 'label_location'});
	    &'move($r, $c);
	    &'addstr(' ' x length($form{$_, 'label_text'}));
	}
	# Erase the contents of the field, if there is one
	if ($form{$_, 'field_length'}) {
	    local($r, $c) = split(',', $form{$_, 'field_location'});
	    &'move($r, $c);
	    &'addstr(' ' x length($form{$_, 'displayed_field'}));
	}
    } else {
        # Show the field on the screen
	# Write the label of the field, if there is one
	if ($form{$_, 'label_text'}) {
	    local($r, $c) = split(',', $form{$_, 'label_location'});
	    &'move($r, $c);
	    &'addstr($form{$_, 'label_text'});
	}
	# Write the contents of the field, if there is one
	# Assumes that the contents have already been calculated
	if ($form{$_, 'field_length'}) {
	    local($r, $c) = split(',', $form{$_, 'field_location'});
	    &'move($r, $c);
	    &'standout;
	    &'addstr($form{$_, 'displayed_field'});
	    &'standend;
	}
    }
    # Restore the cursor
    &'move($r, $c);
}

sub changed_value {
    local($_) = @_;
    local($y, $c);

    # Do nothing if the field has no data
    if ($form{$_, 'field_length'}) {
	$y = $form{$_, 'construct_displayed_value'};
	local(*x) = $y;
	&undefined_function($_, 'construct_displayed_value')
	    unless defined(&x);
	$form{$_, 'displayed_value'} = &x($_, $form{$_, 'value'});
	$y = $form{$_, 'initialize_displayed_field'};
	local(*x) = $y;
	&undefined_function($_, 'initialize_displayed_field')
	    unless defined(&x);
	{
	    local($cursor_location);
	    $form{$_, 'displayed_field'} =
		&x($_, $form{$_, 'displayed_value'});
	    $c = $cursor_location;
	}
	if ($_ eq $fields[$current_field_no]) {
	   # Have to move cursor to correct place
	   $cursor_location = $c;
	   local($r, $c) = split(',', $form{$_, 'field_location'});
	   &'move($r, $c + $cursor_location);
        }
	# Write the contents of the field, if it is visible
	if (!$form{$_, 'invisible'}) {
	    local($old_r, $old_c);

	    # Save the cursor position
	    &'getyx($'stdscr, $old_r, $old_c);
	    # Rewrite the field
	    local($r, $c) = split(',', $form{$_, 'field_location'});
	    &'move($r, $c);
	    &'standout;
	    &'addstr($form{$_, 'displayed_field'});
	    &'standend;
	    # Restore the cursor
	    &'move($old_r, $old_c);
	}
    }
}

# Field support routines

# Routines for ordinary text fields

# inititlize_displayed_field:  Put cursor after last nonblank character.
sub id_cursor_after {
    local($field, $value) = @_;

    $value =~ /(\s*)$/;
    $cursor_location = $form{$field, 'field_length'} - length($1);
    $value;
}

# construct_displayed_value:  Pad value to field length on right with spaces.
sub char_field {
    local($field, $value) = @_;
    local($length) = $form{$field, 'field_length'};

    $length < length($value) ? substr($value, 0, $length) :
	$length > length($value) ? $value . ' ' x ($length - length($value)) :
	    $value;
}

# validate_displayed_value:  Always return true.
sub true {
	1;
}

# interpret_displayed_value:  Truncate trailing spaces.
sub trim_trailing_space {
    local($field, $displayed) = @_;

    $displayed =~ s/\s+$//;
    $displayed;
}

# insert:  Insert character into string at current location.
sub text_insert {
    local($field, $c) = @_;
    local($v) = $form{$field, 'displayed_value'};

    substr($v, $cursor_location, 0) = $c;
    if (chop $v eq ' ') {
	$form{$field, 'displayed_field'} = $v;
	$form{$field, 'displayed_value'} = $v;
	$cursor_location++;
    } else {
	&forms'report_error("Character will not fit");
    }
}

# edit:  Edit character string
sub text_edit {
    local($field, $c) = @_;
    local($v) = $form{$field, 'displayed_value'};
    local($length) = $form{$field, 'field_length'};

    if ($c eq "\025") {
    	# C-u - clear field
    	$v = ' ' x $length;
	$cursor_location = 0;
    } elsif ($c eq "\013") {
	# C-k - clear to end of field
	substr($v, $cursor_location) = ' ' x ($length - $cursor_location);
    } elsif ($c eq "\022") {
	# C-r - clear to beginning of field
	substr($v, 0, $cursor_location) = '';
	$v .= ' ' x $cursor_location;
	$cursor_location = 0;
    } elsif ($c eq "\001") {
        # C-a - go to beginning of field
	$cursor_location = 0;
    } elsif ($c eq "\005") {
	# C-e - go to end of field
	$v =~ /(\s*)$/;
	$cursor_location = $length - length($1);
    } elsif ($c eq "\002") {
	# C-b - go back one character
	if ($cursor_location > 0) {
	    $cursor_location--;
        } else {
	    &forms'report_error("Beginning of field");
        }
    } elsif ($c eq "\006") {
	# C-f - go forward one character
	if ($cursor_location < $length) {
	    $cursor_location++;
	} else {
	    &forms'report_error("End of field");
        }
    } elsif ($c eq "\004") {
	# C-d - delete next character
	if ($cursor_location < $length) {
	    substr($v, $cursor_location, 1) = '';
	    $v .= ' ';
	}
    } elsif ($c eq "\177" || $c eq "\b") {
	# DEL, C-h - delete previous character
	if ($cursor_location > 0) {
	    substr($v, $cursor_location-1, 1) = '';
	    $v .= ' ';
	    $cursor_location--;
	}
    } else {
        &forms'report_error("Invalid editing character");
    }
    $form{$field, 'displayed_field'} = $v;
    $form{$field, 'displayed_value'} = $v;
}

# Routines for hidden fields

# inititlize_displayed_field:  Put cursor after last nonblank character.
sub id_cursor_after_hidden {
    local($value) = &id_cursor_after(@_);

    $value =~ /(\s*)$/;
    ('.' x length($`)) . (' ' x length($1));
}

# insert:  Insert character into string at current location.
sub text_insert_hidden {
    local($field, $c) = @_;

    &text_insert($field, $c);
    $form{$field, 'displayed_field'} =~ /(\s*)$/;
    $form{$field, 'displayed_field'} = ('.' x length($`)) . (' ' x length($1));
}

# edit:  Edit character string
sub text_edit_hidden {
    local($field, $c) = @_;

    &text_edit($field, $c);
    $form{$field, 'displayed_field'} =~ /(\s*)$/;
    $form{$field, 'displayed_field'} = ('.' x length($`)) . (' ' x length($1));
}

# Routines for enumerated fields

# construct_displayed_value:  Translate value from table
sub enum_field {
    local($field, $value) = @_;
    local($length) = $form{$field, 'field_length'};
    local($table) = $form{$field, 'translate_table'};
    
    $value = ($table =~ m#(^|\\)([^=\\]*)=$value($|\\)#)[$[+1];

    $length < length($value) ? substr($value, 0, $length) :
	$length > length($value) ? $value . ' ' x ($length - length($value)) :
	    $value;
}

# validate_displayed_value:  Check that value is in table
sub enum_validate {
    local($field, $value) = @_;
    local($table) = $form{$field, 'translate_table'};
    local($result);
    
    $value =~ s/\s+$//;
    if ($table =~ m#(^|\\)$value=([^=\\]*)($|\\)#i) {
	$result = 1;
	$enum_value_temporary = $2;
    } else {
	$result = 0;
	&report_error("Invalid value");
    }
    $result;
}

# interpret_displayed_value:  Retrieve value saved by enum_validate.
sub enum_interpret {
    $enum_value_temporary;
}

# Function key table

# Freestanding X window on Sun
$function_key{"\e[224z"} = 'F1';
$function_key{"\e[225z"} = 'F2';
$function_key{"\e[226z"} = 'F3';
$function_key{"\e[227z"} = 'F4';
$function_key{"\e[228z"} = 'F5';
$function_key{"\e[229z"} = 'F6';
$function_key{"\e[230z"} = 'F7';
$function_key{"\e[231z"} = 'F8';
$function_key{"\e[232z"} = 'F9';
$function_key{"\e[-1z"} = 'F10';

# X terminal on Sun
$function_key{"\e[11~"} = 'F1';
$function_key{"\e[12~"} = 'F2';
$function_key{"\e[13~"} = 'F3';
$function_key{"\e[14~"} = 'F4';
$function_key{"\e[15~"} = 'F5';
$function_key{"\e[17~"} = 'F6';
$function_key{"\e[18~"} = 'F7';
$function_key{"\e[19~"} = 'F8';
$function_key{"\e[20~"} = 'F9';
$function_key{"\e[21~"} = 'F10';

# VT100
$function_key{"\eOP"} = 'F1';
$function_key{"\eOQ"} = 'F2';
$function_key{"\eOR"} = 'F3';
$function_key{"\eOS"} = 'F4';

# Easy to type by hand
$function_key{"\e1f"} = 'F1';
$function_key{"\e2f"} = 'F2';
$function_key{"\e3f"} = 'F3';
$function_key{"\e4f"} = 'F4';
$function_key{"\e5f"} = 'F5';
$function_key{"\e6f"} = 'F6';
$function_key{"\e7f"} = 'F7';
$function_key{"\e8f"} = 'F8';
$function_key{"\e9f"} = 'F9';
$function_key{"\e0f"} = 'F10';
$function_key{"\e10f"} = 'F10';
$function_key{"\e1F"} = 'F1';
$function_key{"\e2F"} = 'F2';
$function_key{"\e3F"} = 'F3';
$function_key{"\e4F"} = 'F4';
$function_key{"\e5F"} = 'F5';
$function_key{"\e6F"} = 'F6';
$function_key{"\e7F"} = 'F7';
$function_key{"\e8F"} = 'F8';
$function_key{"\e9F"} = 'F9';
$function_key{"\e0F"} = 'F10';
$function_key{"\e10F"} = 'F10';

# Load the function key definitions provided by termcap, but only after
# curses has been intitialized.  Called during initialization the first
# time process_form is executed.
sub load_function_keys {
    $function_key{&'getcap('k1')} = 'F1';
    $function_key{&'getcap('k2')} = 'F2';
    $function_key{&'getcap('k3')} = 'F3';
    $function_key{&'getcap('k4')} = 'F4';
    $function_key{&'getcap('k5')} = 'F5';
    $function_key{&'getcap('k6')} = 'F6';
    $function_key{&'getcap('k7')} = 'F7';
    $function_key{&'getcap('k8')} = 'F8';
    $function_key{&'getcap('k9')} = 'F9';
    $function_key{&'getcap('k;') || &'getcap('k0')} = 'F10';
    $function_keys_loaded = 1;
}

1;