: to unbundle, "sh" this file -- DO NOT use csh
:  SHAR archive format.  Archive created Mon Jun 14 14:56:32 CDT 1993
echo x - forms
sed 's/^X//' > forms <<'+FUNKY+STUFF+'
X# Perl forms system, version 1.0.
X
X# Written by Dale R. Worley (drw@math.mit.edu).
X
X# WARRANTY DISCLAIMER
X
X# This software was created by Dale R. Worley and is
X# distributed free of charge.  It is placed in the public domain and
X# permission is granted to anyone to use, duplicate, modify and redistribute
X# it provided that this notice is attached.
X
X# Dale R. Worley provides absolutely NO WARRANTY OF ANY KIND
X# with respect to this software.  The entire risk as to the quality and
X# performance of this software is with the user.  IN NO EVENT WILL DALE
X# R. WORLEY BE LIABLE TO ANYONE FOR ANY DAMAGES ARISING OUT THE
X# USE OF THIS SOFTWARE, INCLUDING, WITHOUT LIMITATION, DAMAGES RESULTING FROM
X# LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL
X# DAMAGES.
X
Xpackage forms;
X
X# The pattern to match field and attribute names
X# Must match Perl qualified names, at least, and not match whitespace
X$name_pat = '[^.=:\s]+';
X
X# $debug Controls debugging:
X#	1	print field values as installed by process_representation
X#	2	print subroutine definitions that are evalled by 
X#		process_representation
X
X# The sequence number of generated names
X$generated_name_seq = 0;
X
Xsub generate_name {
X    "forms_generated_" . $generated_name_seq++;
X}
X
Xsub process_representation {
X    local(*form, @input) = @_;
X    local(@fields, $i);
X
X    # Clear the form array
X    %form = ();
X    # Process the input
X    for ($i = 0; $i <= $#input; $i++) {
X	$_ = $input[$i];
X	# Trim leading and trailing whitespace
X	s/^\s+//;
X	s/\s+$//;
X	if (/^$/ || /^#/) {
X	    # Ignore comment lines
X	} elsif (/^($name_pat)\s*:$/o) {
X	    # This is a "field:" line, setting the default field name
X	    $default_field = $1;
X	} elsif (/^:$/) {
X	    # This is a ":" line, setting the default to a constructed
X	    # field name.
X	    $default_field = &generate_name;
X	} elsif (/^($name_pat)\s*\.\s*($name_pat)\s*=\s*(.*)$/o) {
X	    # This is an attribute setting line
X	    &set_attribute($1, $2, $3) || return undef;
X	} elsif (/^\.\s*($name_pat)\s*=\s*(.*)$/o) {
X	    # This is an attribute setting line for the form as a whole
X	    &set_attribute('', $1, $2) || return undef;
X	} elsif (/^($name_pat)\s*=\s*(.*)$/o) {
X	    # This is an attribute setting line for the default field
X	    &set_attribute($default_field, $1, $2) || return undef;
X	} elsif (/^sub\s+($name_pat)\s+{$/) {
X	    # This is a subroutine definition
X	    &define_subroutine || return undef;
X	} elsif (/^\*(.*)$/) {
X	    # This is an expression to be evaluated
X	    print STDERR "Evalling: *$1\n" if $debug & 2;
X	    {
X		package forms_user;
X		eval($1);
X	    }
X	    if ($@) {
X		# Error during eval
X		$error = "Error in freestanding expression at line $i: $@";
X		return undef;
X	    }
X	} else {
X	    # Invalid format
X	    $error = "Invalid format at line $i: $_";
X	    return undef;
X	}
X    }
X    # Perform the post-processing
X    # Set attribute initially_invisible from attribute invisible
X    grep(($form{$_, 'initially_invisible'} = $form{$_, 'invisible'}, 0),
X	 @fields);
X    # Set the fields global attribute
X    $form{'', 'fields'} = join(',', @fields);
X    # Return success
X    1;
X}
X
Xsub set_attribute {
X    local($field, $attribute, $value) = @_;
X
X    if ($value =~ /^&($name_pat)$/o) {
X	# It is "&function"; transform it into symbol table pointer
X        print STDERR "Evalling: *$1\n" if $debug & 2;
X	{
X	    package forms_user;
X	    $forms'value = eval("*$1");
X        }
X	if ($@) {
X	    # Error during eval
X	    $error = "Error in function name at line $i: $@";
X	    return undef;
X        }
X    } elsif ($value =~ /^@($name_pat)$/o) {
X	# It is "@function"; transform it into symbol table pointer
X        print STDERR "Evalling: *$1\n" if $debug & 2;
X	$value = eval("*$1");
X	if ($@) {
X	    # Error during eval
X	    $error = "Error in function name at line $i: $@";
X	    return undef;
X        }
X    } elsif ($value =~ /^"(.*)"$/) {
X	# It is a quoted string.  Extract the contents.
X	$value =  $1;
X    } elsif ($value eq '{') {
X	# It is "{"; read and define the subroutine
X	$name = &generate_name;
X	$value = "sub $name {\n";
X	# Get further input lines until end is seen
X	for ($i++; $i <= $#input; $i++) {
X	    $_ = $input[$i];
X	    s/\n//;
X	    last if /^\s*};\s*$/;
X	    $value .= $_ . "\n";
X        }
X	$value .= "}\n*$name";
X        print STDERR "Defining subroutine:\n", $value if $debug & 2;
X	{
X	    package forms_user;
X	    $forms'value = eval($forms'value);
X	}
X	if ($@) {
X	    # Error during eval
X	    $error = "Error in subroutine definition at line $i: $@";
X	    return undef;
X        }
X    } elsif ($value =~ /^\*(.*)$/) {
X	# It is "*expression"; evaluate it
X        print STDERR "Evalling: *$1\n" if $debug & 2;
X	{
X	    package forms_user;
X	    $forms'value = eval($1);
X	}
X	if ($@) {
X	    # Error during eval
X	    $error = "Error in expression at line $i: $@";
X	    return undef;
X        }
X    } else {
X	# The value is to be taken literally
X    }
X    print STDERR "\$form{$field, $attribute} = ", $value, "\n" if $debug & 1;
X    $form{$field, $attribute} = $value;
X    # Add the field to the @forms array, if it is not already there
X    push(@fields, $field) unless grep($_ eq $field, @fields);
X    # Return success
X    1;
X}
X
Xsub define_subroutine {
X    $value = $_ . "\n";
X    # Get further input lines until end is seen
X    for ($i++; $i <= $#input; $i++) {
X	$_ = $input[$i];
X	s/\n//;
X	last if /^\s*};\s*$/;
X	$value .= $_ . "\n";
X    }
X    $value .= "}\n";
X    print STDERR "Defining subroutine:\n", $value if $debug & 2;
X    {
X	package forms_user;
X	$forms'value = eval($forms'value);
X    }
X    if ($@) {
X	# Error during eval
X	$error = "Error in subroutine definition at line $i: $@";
X	return undef;
X    }
X    1;
X}
X
Xsub dump_form {
X    local(*form, $filehandle) = @_;
X    local($field, $attr);
X
X    $filehandle = 'STDOUT' unless $filehandle;
X    foreach (sort keys %form) {
X	($field, $attr) = /^(.*)$;(.*)$/o;
X	print $filehandle "$field.$attr = ", $form{$field, $attr}, "\n";
X    }
X    1;
X}
X
Xsub clear_values {
X    local(*form) = @_;
X
X    foreach (split(',', $form{'', 'fields'})) {
X	$form{$_, 'value'} = undef;
X    }
X}
X
Xsub clear_values_and_redisplay {
X    foreach (split(',', $form{'', 'fields'})) {
X	$form{$_, 'value'} = undef;
X	&changed_value($_);
X    }
X}
X
Xsub reset_visibility {
X    local(*form) = @_;
X
X    foreach (split(',', $form{'', 'fields'})) {
X	$form{$_, 'invisible'} = $form{$_, 'initially_invisible'};
X    }
X}
X
Xsub process_form {
X    local(*form) = @_;
X    local($exit_value, @fields, $x, $cursor_location, $y, $entered_field,
X	$current_field_no, $last_c);
X
X    # Check that it's not empty
X    die "Empty form" unless $form{'', 'fields'};
X
X    # Call initialize, if necessary
X    $y = $form{'', 'initialize'};
X    if ($y) {
X	local(*x) = $y;
X	&undefined_function('', 'initialize') unless defined(&x);
X	&x;
X    }	    
X    # Construct displayed fields
X    @fields = split(',', $form{'', 'fields'});
X    foreach (@fields) {
X	if ($form{$_, 'field_length'}) {
X	    $y = $form{$_, 'construct_displayed_value'};
X	    local(*x) = $y;
X	    &undefined_function($_, 'construct_displayed_value')
X		unless defined(&x);
X	    $form{$_, 'displayed_value'} = &x($_, $form{$_, 'value'});
X	    $y = $form{$_, 'initialize_displayed_field'};
X	    local(*x) = $y;
X	    &undefined_function($_, 'initialize_displayed_field')
X		unless defined(&x);
X	    $form{$_, 'displayed_field'} =
X		&x($_, $form{$_, 'displayed_value'});
X	}
X    }
X    # Initialize screen
X    &'initscr;
X    &'leaveok($'stdscr, 0);
X    &'standend;
X    # Set terminal in the mode we like
X    &'nocbreak;
X    &'raw;
X    &'nonl;
X    &'noecho;
X    # Get the F keys loaded
X    &load_function_keys unless $function_keys_loaded;
X    # Redisplay screen
X    &'clear;
X    foreach (@fields) {
X	if (!$form{$_, 'invisible'}) {
X	    # Write the label of the field, if there is one
X	    if ($form{$_, 'label_text'}) {
X		local($r, $c) = split(',', $form{$_, 'label_location'});
X		&'move($r, $c);
X		&'addstr($form{$_, 'label_text'});
X    }
X	    # Write the contents of the field, if there is one
X	    if ($form{$_, 'field_length'}) {
X		local($r, $c) = split(',', $form{$_, 'field_location'});
X		&'move($r, $c);
X		&'standout;
X		&'addstr($form{$_, 'displayed_field'});
X		&'standend;
X	    }
X	}
X    }
X    # Set cursor on first field
X    $entered_field = undef;
X    $current_field_no = $[ - 1;
X    &next_field;
X    # Set cursor location
X    if ($current_field_no >= $[) {
X	# Get $cursor_location
X	$_ = $fields[$current_field_no];
X	$y = $form{$_, 'initialize_displayed_field'};
X	local(*x) = $y;
X	&undefined_function($_, 'initialize_displayed_field')
X	    unless defined(&x);
X	&x($_, $form{$_, 'displayed_value'});
X	local($r, $c) = split(',', $form{$_, 'field_location'});
X        &'move($r, $c + $cursor_location);
X    } else {
X	# No writable fields; put cursor in UL corner
X        &'move(0, 0);
X    }
X    # Loop waiting for a character
X    INPUT_LOOP: while (1) {
X	# Refresh the screen
X	&'refresh;
X	# Get a character
X	$c = &'getch;
X	# If it is ESC, get the whole escape sequence
X	if ($c eq "\e") {
X	    local($d) = '0';
X	    while ((length($c) < 6 && $d gt ' ' && $d lt '@') || 
X		   (length($c) == 2 && ($d eq 'O' || $d eq '['))) {
X		$d = &'getch;
X		$c .= $d;
X	    }
X	    # Check if it is valid
X	    $c = $function_key{$c};
X	    if (!($c &&
X		  ($form{'', $c} || ($current_field_no >= $[ &&
X				    $form{$fields[$current_field_no], $c})))) {
X		&report_error("Invalid escape sequence");
X	        next INPUT_LOOP;
X	    }
X	}
X	# Process it
X	# Exit or enter the field as appropriate
X	if ($c eq "\n" || $c eq "\r" || $c eq "\t" ||
X	    (length($c) > 1 &&
X 		!$form{$fields[$current_field_no], $c})) {
X	    # LFD, RET, TAB, and function keys that are not local to
X	    # the field exit the field first
X	    next INPUT_LOOP if $entered_field && !&exit_field;
X	} elsif ($c eq "\031" || $c eq "\026") {
X	    # C-y and C-v require to be in field
X 	    if (!$entered_field) {
X	        &report_error("Must have entered field");
X		next INPUT_LOOP;
X	    }
X	} elsif ($c eq "\f" || $c eq "\020" || $c eq "\003" || $c eq "\007" ||
X		 $c eq "\e") {
X	    # C-l, C-p, C-c, C-g, and ESC have no constraint
X	} else {
X	    # All others enter the field first
X	     &enter_field if !$entered_field;
X	}
X	# Process the character
X	if ($c eq "\n") {
X	    # LFD - accept contents of form
X	    # Call finalize, if necessary
X	    $y = $form{'', 'finalize'};
X	    if ($y) {
X		local(*x) = $y;
X		&undefined_function('', 'finalize') unless defined(&x);
X	        # If finalize fails, it should have produced a message
X	        next INPUT_LOOP if !&x;
X		}
X	    # Exit successfully
X	    $exit_value = 1;
X	    last INPUT_LOOP;
X	} elsif ($c eq "\003" || $c eq "\007") {
X	    # C-c, C-g - abort the form
X	    if ($entered_field) {
X		$entered_field = undef;
X		$form{$entered_field, 'value'} = $previous_value;
X		$form{$entered_field, 'displayed_value'} = 
X		    $previous_displayed_value;
X		$form{$entered_field, 'displayed_field'} =
X		    $previous_displayed_field;
X		$cursor_location= $previous_cursor_location;
X		# Redisplay the field
X		local($r, $c) =
X		    split(',', $form{$entered_field, 'field_location'});
X		&'move($r, $c);
X		&'standout;
X		&'addstr($form{$entered_field, 'displayed_field'});
X		&'standend;
X		&'move($r, $c + $cursor_location);
X	    }
X	    $exit_value = 0;
X	    last INPUT_LOOP;
X	} elsif ($c eq "\r") {
X	    # RET - go to next field
X	    &next_field;
X	    # Set cursor location
X	    if ($current_field_no >= $[) {
X		# Get $cursor_location
X		$_ = $fields[$current_field_no];
X		$y = $form{$_, 'initialize_displayed_field'};
X		local(*x) = $y;
X		&undefined_function($_, 'initialize_displayed_field')
X		    unless defined(&x);
X		&x($_, $form{$_, 'displayed_value'});
X		local($r, $c) = split(',', $form{$_, 'field_location'});
X		&'move($r, $c + $cursor_location);
X	    } else {
X		# No writable fields; put cursor in UL corner
X		&'move(0, 0);
X	    }
X	} elsif ($c eq "\t") {
X	    # TAB - go to previous field
X	    &previous_field;
X	    # Set cursor location
X	    if ($current_field_no >= $[) {
X		# Get $cursor_location
X		$_ = $fields[$current_field_no];
X		$y = $form{$_, 'initialize_displayed_field'};
X		local(*x) = $y;
X		&undefined_function($_, 'initialize_displayed_field')
X		    unless defined(&x);
X		&x($_, $form{$_, 'displayed_value'});
X		local($r, $c) = split(',', $form{$_, 'field_location'});
X		&'move($r, $c + $cursor_location);
X	    } else {
X		# No writable fields; put cursor in UL corner
X		&'move(0, 0);
X	    }
X	} elsif ($c eq "\031") {
X	    # C-y - restore previous value of the field and exit from field
X	    $form{$entered_field, 'value'} = $previous_value;
X	    $form{$entered_field, 'displayed_value'} = 
X		$previous_displayed_value;
X	    $form{$entered_field, 'displayed_field'} =
X		$previous_displayed_field;
X	    $cursor_location= $previous_cursor_location;
X	    # Redisplay the field
X	    local($r, $c) =
X		split(',', $form{$entered_field, 'field_location'});
X	    &'move($r, $c);
X	    &'standout;
X	    &'addstr($form{$entered_field, 'displayed_field'});
X	    &'standend;
X            &'move($r, $c + $cursor_location);
X	    # Only once we're done with all this, forget the field
X	    $entered_field = undef;
X	} elsif ($c eq "\026") {
X	    if ($last_c eq "\026") {
X		# C-v C-v - exit valid field
X		&exit_field;
X	    } else {
X	        # C-v - perform validity check on field or exit field
X		$y = $form{$entered_field, 'validate_displayed_value'};
X		local(*x) = $y;
X		&undefined_function($entered_field, 'validate_displayed_value')
X		    unless defined(&x);
X		if (&x($entered_field,
X			$form{$entered_field, 'displayed_value'})) {
X		    &report_message("Field OK");
X		} else {
X		    # validate_displayed_value routine should produce error
X		    # message
X		    # Do not give C-v C-v effect if he types C-v again.
X		    $c = "\e";
X		}
X	    }
X	} elsif ($c eq "\f") {
X	    # C-l - redraw screen
X	    &'clearok($'stdscr, 1);
X	} elsif ($c eq "\020") {
X	    # C-p - give help
X	    local($message);
X	    if ($current_field_no >= $[ &&
X		($message = 
X		    $form{$fields[$current_field_no], 'help_message'}) &&
X		$last_c ne "\020" &&
X		$form{'MSG', 'field_length'}) {
X		# There is a current field, it has a help message, user
X		# has not typed C-p twice in a row, and there is a MSG
X		# field, so display field help message
X		&report_message($message);
X	    } else {
X		# Display help screen
X		&display_help_screen;
X		# If he types C-p after this, he gets field help again.
X		$c = "\e";
X	    }
X	} elsif ($c eq "\e") {
X	    # ESC - invalid escape sequence
X	} elsif (length($c) > 1) {
X	    # function key - do the appropriate function
X	    $y = $form{$entered_field || '', $c};
X	    local(*x) = $y;
X	    &undefined_function($entered_field, $c) unless defined(&x);
X	    &x;
X	} elsif (($c ge "\001" && $c lt " ") || $c gt "~") {
X	    # Other control character
X	    $y = $form{$_, 'edit'};
X	    local(*x) = $y;
X	    &undefined_function($_, 'edit') unless defined(&x);
X	    &x($entered_field, $c);
X	    # Redisplay the field
X	    local($r, $c) =
X		split(',', $form{$entered_field, 'field_location'});
X	    &'move($r, $c);
X	    &'standout;
X	    &'addstr($form{$entered_field, 'displayed_field'});
X	    &'standend;
X            &'move($r, $c + $cursor_location);
X        } else {
X	    # It is a printing character
X	    $y = $form{$_, 'insert'};
X	    local(*x) = $y;
X	    &undefined_function($_, 'insert') unless defined(&x);
X	    &x($entered_field, $c);
X	    # Redisplay the field
X	    local($r, $c) =
X		split(',', $form{$entered_field, 'field_location'});
X	    &'move($r, $c);
X	    &'standout;
X	    &'addstr($form{$entered_field, 'displayed_field'});
X	    &'standend;
X            &'move($r, $c + $cursor_location);
X        }
X    } continue {
X	# Record the last key
X	$last_c = $c;
X    }
X    # Delete the help screen window if necessary
X    if ($help_screen_window) {
X	&'delwin($help_screen_window);
X	$help_screen_window = undef;
X    }
X    # Move cursor to LL corner
X    &'move($'LINES-1, 0);
X    &'refresh;
X    &'endwin;
X    $exit_value;
X}
X
X# Find next field that is visible, has a data area, and is writable.
Xsub next_field {
X    local($old_field_no) = $current_field_no;
X
X    # Look for a field after the current field
X    for ($current_field_no++; $current_field_no <= $#fields;
X	 $current_field_no++) {
X	$_ = $fields[$current_field_no];
X	return if !$form{$_, 'invisible'} &&
X	          $form{$_, 'field_length'} &&
X		  !$form{$_, 'read_only'};
X    }
X    # Look for a field before the current field
X    for ($current_field_no = $[; $current_field_no <= $old_field_no;
X	 $current_field_no++) {
X	$_ = $fields[$current_field_no];
X	return if !$form{$_, 'invisible'} &&
X	          $form{$_, 'field_length'} &&
X		  !$form{$_, 'read_only'};
X    }
X    # No field was found at all
X    $current_field_no = $[ - 1;
X}
X
X# Find previous field that is visible, has a data area, and is writable.
Xsub previous_field {
X    local($old_field_no) = $current_field_no;
X
X    # Look for a field before the current field
X    for ($current_field_no--; $current_field_no >= $[; $current_field_no--) {
X	$_ = $fields[$current_field_no];
X	return if !$form{$_, 'invisible'} &&
X	          $form{$_, 'field_length'} &&
X		  !$form{$_, 'read_only'};
X    }
X    # Look for a field after the current field
X    for ($current_field_no = $#fields; $current_field_no >= $old_field_no;
X	 $current_field_no--) {
X	$_ = $fields[$current_field_no];
X	return if !$form{$_, 'invisible'} &&
X	          $form{$_, 'field_length'} &&
X		  !$form{$_, 'read_only'};
X    }
X    # No field was found at all
X    $current_field_no = $[ - 1;
X}
X
X# Enter the current field
Xsub enter_field {
X    $entered_field = $fields[$current_field_no];
X    $previous_value = $form{$entered_field, 'value'};
X    $previous_displayed_value = $form{$entered_field, 'displayed_value'};
X    $previous_displayed_field = $form{$entered_field, 'displayed_field'};
X    $previous_cursor_location = $cursor_location;
X}
X
X# Exit the current field
Xsub exit_field {
X    local($y);
X
X    # Perform validity checking
X    $y = $form{$entered_field, 'validate_displayed_value'};
X    local(*x) = $y;
X    &undefined_function($entered_field, 'validate_displayed_value')
X        unless defined(&x);
X    return 0
X	unless &x($entered_field, $form{$entered_field, 'displayed_value'});
X    $y = $form{$entered_field, 'interpret_displayed_value'};
X
X    # Interpret the value
X    local(*x) = $y;
X    &undefined_function($entered_field, 'interpret_displayed_value')
X        unless defined(&x);
X    $form{$entered_field, 'value'} =
X	&x($entered_field, $form{$entered_field, 'displayed_value'});
X
X    # Canonicalize the value, if necessary
X    if ($form{$entered_field, 'canonicalize'}) {
X	    local($cursor_location);
X	    local($old_r, $old_c);
X
X	    $y = $form{$entered_field, 'construct_displayed_value'};
X	    local(*x) = $y;
X	    &undefined_function($entered_field, 'construct_displayed_value')
X		unless defined(&x);
X	    $form{$entered_field, 'displayed_value'} =
X		&x($entered_field, $form{$entered_field, 'value'});
X	    $y = $form{$entered_field, 'initialize_displayed_field'};
X	    local(*x) = $y;
X	    &undefined_function($entered_field, 'initialize_displayed_field')
X		unless defined(&x);
X	    $form{$entered_field, 'displayed_field'} =
X		&x($entered_field, $form{$entered_field, 'displayed_value'});
X
X	    # Save the cursor position
X	    &'getyx($'stdscr, $old_r, $old_c);
X	    # Rewrite the field
X	    local($r, $c) = 
X		split(',', $form{$entered_field, 'field_location'});
X	    &'move($r, $c);
X	    &'standout;
X	    &'addstr($form{$entered_field, 'displayed_field'});
X	    &'standend;
X	    # Restore the cursor
X	    &'move($old_r, $old_c);
X    }
X
X    # Clean up and exit
X    $entered_field = undef;
X    return 1;
X}
X
Xsub display_help_screen {
X    # Create help screen window if necessary
X    if (!$help_screen_window) {
X	local($i);
X
X	$help_screen_window = &'newwin(0, 0, 0, 0);
X	$i = 0;
X	foreach (split(/\n/, <<'EOF')) {
X                        Forms 1.0 help screen
X
XLFD or C-j   Accept contents of form    C-c or C-g   Abort the form
XRET or C-m   Go to next field           TAB or C-i   Go to previous field
X
XC-y          Restore previous value of the field and exit from field
XC-v          Perform validity check on field
XC-v C-v      Exit from valid field
X
XC-u          Clear field
XC-k          Clear to end of field
XC-r          Clear to beginning of field
X
XC-a          Go to beginning of field   C-e          Go to end of field
XC-b          Go back one character      C-f          Go forward one character
XC-d          Delete next character      DEL or C-h   Delete previous character
X
XC-p          Give help on this field (or show help screen if no help for field)
XC-p C-p      Show this help screen
X
XFunction keys 1 through 10 can be used as commands if allowed by the
Xparticular form.
X
XHit any key (other than C-p) to continue...
XEOF
X	    &'wmove($help_screen_window, $i, 0);
X	    &'waddstr($help_screen_window, $_);
X	    $i++;
X	}
X    }
X
X    # Write it to the terminal
X    &'clearok($help_screen_window, 1);
X    &'wrefresh($help_screen_window);
X    # Wait for a character that is not C-p
X    1 while &'getch eq "\020";
X    # Refresh the form
X    &'clearok($'stdscr, 1);
X}
X
X# Report an error
Xsub report_error {
X    local($message) = @_;
X
X    &report_message($message);
X    print "\007";
X}
X
Xsub report_message {
X    local($message) = @_;
X    local($length) = $form{'MSG', 'field_length'};
X
X    if ($length) {
X	$form{'MSG', 'value'} = substr($message, 0, $length) .
X	    ' ' x ($length - length($message));
X	&changed_value('MSG');
X    }
X}
X
Xsub undefined_function {
X    local($field, $attr) = @_;
X    local($package, $filename, $line) = caller;
X
X    die sprintf("Bad value of attribute function %s.%s: %s at %s line %s\n",
X		$field, $attr, $form{$field, $attr}, $filename, $line);
X}
X
Xsub changed_visibility {
X    local($_) = @_;
X    local($r, $c);
X
X    # Record where the cursor is
X    &'getyx($'stdscr, $r, $c);
X    # Update the screen
X    if ($form{$_, 'invisible'}) {
X	# Erase the field from the screen
X	# Erase the label of the field, if there is one
X	if ($form{$_, 'label_text'}) {
X	    local($r, $c) = split(',', $form{$_, 'label_location'});
X	    &'move($r, $c);
X	    &'addstr(' ' x length($form{$_, 'label_text'}));
X	}
X	# Erase the contents of the field, if there is one
X	if ($form{$_, 'field_length'}) {
X	    local($r, $c) = split(',', $form{$_, 'field_location'});
X	    &'move($r, $c);
X	    &'addstr(' ' x length($form{$_, 'displayed_field'}));
X	}
X    } else {
X        # Show the field on the screen
X	# Write the label of the field, if there is one
X	if ($form{$_, 'label_text'}) {
X	    local($r, $c) = split(',', $form{$_, 'label_location'});
X	    &'move($r, $c);
X	    &'addstr($form{$_, 'label_text'});
X	}
X	# Write the contents of the field, if there is one
X	# Assumes that the contents have already been calculated
X	if ($form{$_, 'field_length'}) {
X	    local($r, $c) = split(',', $form{$_, 'field_location'});
X	    &'move($r, $c);
X	    &'standout;
X	    &'addstr($form{$_, 'displayed_field'});
X	    &'standend;
X	}
X    }
X    # Restore the cursor
X    &'move($r, $c);
X}
X
Xsub changed_value {
X    local($_) = @_;
X    local($y, $c);
X
X    # Do nothing if the field has no data
X    if ($form{$_, 'field_length'}) {
X	$y = $form{$_, 'construct_displayed_value'};
X	local(*x) = $y;
X	&undefined_function($_, 'construct_displayed_value')
X	    unless defined(&x);
X	$form{$_, 'displayed_value'} = &x($_, $form{$_, 'value'});
X	$y = $form{$_, 'initialize_displayed_field'};
X	local(*x) = $y;
X	&undefined_function($_, 'initialize_displayed_field')
X	    unless defined(&x);
X	{
X	    local($cursor_location);
X	    $form{$_, 'displayed_field'} =
X		&x($_, $form{$_, 'displayed_value'});
X	    $c = $cursor_location;
X	}
X	if ($_ eq $fields[$current_field_no]) {
X	   # Have to move cursor to correct place
X	   $cursor_location = $c;
X	   local($r, $c) = split(',', $form{$_, 'field_location'});
X	   &'move($r, $c + $cursor_location);
X        }
X	# Write the contents of the field, if it is visible
X	if (!$form{$_, 'invisible'}) {
X	    local($old_r, $old_c);
X
X	    # Save the cursor position
X	    &'getyx($'stdscr, $old_r, $old_c);
X	    # Rewrite the field
X	    local($r, $c) = split(',', $form{$_, 'field_location'});
X	    &'move($r, $c);
X	    &'standout;
X	    &'addstr($form{$_, 'displayed_field'});
X	    &'standend;
X	    # Restore the cursor
X	    &'move($old_r, $old_c);
X	}
X    }
X}
X
X# Field support routines
X
X# Routines for ordinary text fields
X
X# inititlize_displayed_field:  Put cursor after last nonblank character.
Xsub id_cursor_after {
X    local($field, $value) = @_;
X
X    $value =~ /(\s*)$/;
X    $cursor_location = $form{$field, 'field_length'} - length($1);
X    $value;
X}
X
X# construct_displayed_value:  Pad value to field length on right with spaces.
Xsub char_field {
X    local($field, $value) = @_;
X    local($length) = $form{$field, 'field_length'};
X
X    $length < length($value) ? substr($value, 0, $length) :
X	$length > length($value) ? $value . ' ' x ($length - length($value)) :
X	    $value;
X}
X
X# validate_displayed_value:  Always return true.
Xsub true {
X	1;
X}
X
X# interpret_displayed_value:  Truncate trailing spaces.
Xsub trim_trailing_space {
X    local($field, $displayed) = @_;
X
X    $displayed =~ s/\s+$//;
X    $displayed;
X}
X
X# insert:  Insert character into string at current location.
Xsub text_insert {
X    local($field, $c) = @_;
X    local($v) = $form{$field, 'displayed_value'};
X
X    substr($v, $cursor_location, 0) = $c;
X    if (chop $v eq ' ') {
X	$form{$field, 'displayed_field'} = $v;
X	$form{$field, 'displayed_value'} = $v;
X	$cursor_location++;
X    } else {
X	&forms'report_error("Character will not fit");
X    }
X}
X
X# edit:  Edit character string
Xsub text_edit {
X    local($field, $c) = @_;
X    local($v) = $form{$field, 'displayed_value'};
X    local($length) = $form{$field, 'field_length'};
X
X    if ($c eq "\025") {
X    	# C-u - clear field
X    	$v = ' ' x $length;
X	$cursor_location = 0;
X    } elsif ($c eq "\013") {
X	# C-k - clear to end of field
X	substr($v, $cursor_location) = ' ' x ($length - $cursor_location);
X    } elsif ($c eq "\022") {
X	# C-r - clear to beginning of field
X	substr($v, 0, $cursor_location) = '';
X	$v .= ' ' x $cursor_location;
X	$cursor_location = 0;
X    } elsif ($c eq "\001") {
X        # C-a - go to beginning of field
X	$cursor_location = 0;
X    } elsif ($c eq "\005") {
X	# C-e - go to end of field
X	$v =~ /(\s*)$/;
X	$cursor_location = $length - length($1);
X    } elsif ($c eq "\002") {
X	# C-b - go back one character
X	if ($cursor_location > 0) {
X	    $cursor_location--;
X        } else {
X	    &forms'report_error("Beginning of field");
X        }
X    } elsif ($c eq "\006") {
X	# C-f - go forward one character
X	if ($cursor_location < $length) {
X	    $cursor_location++;
X	} else {
X	    &forms'report_error("End of field");
X        }
X    } elsif ($c eq "\004") {
X	# C-d - delete next character
X	if ($cursor_location < $length) {
X	    substr($v, $cursor_location, 1) = '';
X	    $v .= ' ';
X	}
X    } elsif ($c eq "\177" || $c eq "\b") {
X	# DEL, C-h - delete previous character
X	if ($cursor_location > 0) {
X	    substr($v, $cursor_location-1, 1) = '';
X	    $v .= ' ';
X	    $cursor_location--;
X	}
X    } else {
X        &forms'report_error("Invalid editing character");
X    }
X    $form{$field, 'displayed_field'} = $v;
X    $form{$field, 'displayed_value'} = $v;
X}
X
X# Routines for hidden fields
X
X# inititlize_displayed_field:  Put cursor after last nonblank character.
Xsub id_cursor_after_hidden {
X    local($value) = &id_cursor_after(@_);
X
X    $value =~ /(\s*)$/;
X    ('.' x length($`)) . (' ' x length($1));
X}
X
X# insert:  Insert character into string at current location.
Xsub text_insert_hidden {
X    local($field, $c) = @_;
X
X    &text_insert($field, $c);
X    $form{$field, 'displayed_field'} =~ /(\s*)$/;
X    $form{$field, 'displayed_field'} = ('.' x length($`)) . (' ' x length($1));
X}
X
X# edit:  Edit character string
Xsub text_edit_hidden {
X    local($field, $c) = @_;
X
X    &text_edit($field, $c);
X    $form{$field, 'displayed_field'} =~ /(\s*)$/;
X    $form{$field, 'displayed_field'} = ('.' x length($`)) . (' ' x length($1));
X}
X
X# Routines for enumerated fields
X
X# construct_displayed_value:  Translate value from table
Xsub enum_field {
X    local($field, $value) = @_;
X    local($length) = $form{$field, 'field_length'};
X    local($table) = $form{$field, 'translate_table'};
X    
X    $value = ($table =~ m#(^|\\)([^=\\]*)=$value($|\\)#)[$[+1];
X
X    $length < length($value) ? substr($value, 0, $length) :
X	$length > length($value) ? $value . ' ' x ($length - length($value)) :
X	    $value;
X}
X
X# validate_displayed_value:  Check that value is in table
Xsub enum_validate {
X    local($field, $value) = @_;
X    local($table) = $form{$field, 'translate_table'};
X    local($result);
X    
X    $value =~ s/\s+$//;
X    if ($table =~ m#(^|\\)$value=([^=\\]*)($|\\)#i) {
X	$result = 1;
X	$enum_value_temporary = $2;
X    } else {
X	$result = 0;
X	&report_error("Invalid value");
X    }
X    $result;
X}
X
X# interpret_displayed_value:  Retrieve value saved by enum_validate.
Xsub enum_interpret {
X    $enum_value_temporary;
X}
X
X# Function key table
X
X# Freestanding X window on Sun
X$function_key{"\e[224z"} = 'F1';
X$function_key{"\e[225z"} = 'F2';
X$function_key{"\e[226z"} = 'F3';
X$function_key{"\e[227z"} = 'F4';
X$function_key{"\e[228z"} = 'F5';
X$function_key{"\e[229z"} = 'F6';
X$function_key{"\e[230z"} = 'F7';
X$function_key{"\e[231z"} = 'F8';
X$function_key{"\e[232z"} = 'F9';
X$function_key{"\e[-1z"} = 'F10';
X
X# X terminal on Sun
X$function_key{"\e[11~"} = 'F1';
X$function_key{"\e[12~"} = 'F2';
X$function_key{"\e[13~"} = 'F3';
X$function_key{"\e[14~"} = 'F4';
X$function_key{"\e[15~"} = 'F5';
X$function_key{"\e[17~"} = 'F6';
X$function_key{"\e[18~"} = 'F7';
X$function_key{"\e[19~"} = 'F8';
X$function_key{"\e[20~"} = 'F9';
X$function_key{"\e[21~"} = 'F10';
X
X# VT100
X$function_key{"\eOP"} = 'F1';
X$function_key{"\eOQ"} = 'F2';
X$function_key{"\eOR"} = 'F3';
X$function_key{"\eOS"} = 'F4';
X
X# Easy to type by hand
X$function_key{"\e1f"} = 'F1';
X$function_key{"\e2f"} = 'F2';
X$function_key{"\e3f"} = 'F3';
X$function_key{"\e4f"} = 'F4';
X$function_key{"\e5f"} = 'F5';
X$function_key{"\e6f"} = 'F6';
X$function_key{"\e7f"} = 'F7';
X$function_key{"\e8f"} = 'F8';
X$function_key{"\e9f"} = 'F9';
X$function_key{"\e0f"} = 'F10';
X$function_key{"\e10f"} = 'F10';
X$function_key{"\e1F"} = 'F1';
X$function_key{"\e2F"} = 'F2';
X$function_key{"\e3F"} = 'F3';
X$function_key{"\e4F"} = 'F4';
X$function_key{"\e5F"} = 'F5';
X$function_key{"\e6F"} = 'F6';
X$function_key{"\e7F"} = 'F7';
X$function_key{"\e8F"} = 'F8';
X$function_key{"\e9F"} = 'F9';
X$function_key{"\e0F"} = 'F10';
X$function_key{"\e10F"} = 'F10';
X
X# Load the function key definitions provided by termcap, but only after
X# curses has been intitialized.  Called during initialization the first
X# time process_form is executed.
Xsub load_function_keys {
X    $function_key{&'getcap('k1')} = 'F1';
X    $function_key{&'getcap('k2')} = 'F2';
X    $function_key{&'getcap('k3')} = 'F3';
X    $function_key{&'getcap('k4')} = 'F4';
X    $function_key{&'getcap('k5')} = 'F5';
X    $function_key{&'getcap('k6')} = 'F6';
X    $function_key{&'getcap('k7')} = 'F7';
X    $function_key{&'getcap('k8')} = 'F8';
X    $function_key{&'getcap('k9')} = 'F9';
X    $function_key{&'getcap('k;') || &'getcap('k0')} = 'F10';
X    $function_keys_loaded = 1;
X}
X
X1;
X
+FUNKY+STUFF+
echo '-rwxr-xr-x   1 wjm      admin      31139 Apr  6 15:45 forms    (as sent)'
chmod u=rwx,g=rx,o=rx forms
ls -l forms
echo x - readme
sed 's/^X//' > readme <<'+FUNKY+STUFF+'
XNewsgroups: comp.lang.perl
XPath: cis.ohio-state.edu!zaphod.mps.ohio-state.edu!qt.cs.utexas.edu!cs.utexas.edu!uunet!snorkelwacker.mit.edu!bloom-picayune.mit.edu!math.mit.edu!drw
XFrom: drw@kronecker.mit.edu (Dale R. Worley)
X#Subject: Forms-oriented input system, documentation
XMessage-ID: <DRW.92Apr14115354@kronecker.mit.edu>
XSender: news@athena.mit.edu (News system)
XNntp-Posting-Host: kronecker.mit.edu
XOrganization: MIT Dept. of Tetrapilotomy, Cambridge, MA, USA
XDate: Tue, 14 Apr 1992 16:53:54 GMT
XLines: 578
X
X				Forms system
X				version 1.0
X				  Design
X
X1. Form
X
XA "form" consists of a sequence of "fields".  Each field contains the
Xinformation necessary to display and input one value.
X
X2. Input commands
X
XAt any time, form input is either editing the value of a particular field
X("in a field"), or it is transitting between fields ("out of a field").
XEntry into a field is done only when a command is executed which would change
Xthe value of the field; bringing the cursor to rest on a particular field is
Xnot sufficient to enter the field.  Conversely, exiting a field is done only
Xwhen some command is executed which would transit to another field, or exit
Xthe form entirely.  However, exiting a field causes its value to be checked 
Xfor validity, and if the validity check fails, the command that caused exiting
Xof the field is not performed.
X
XThe commands which are executed out of a field are:
X
X	LFD	accept contents of form
X		(also C-j)
X	C-c	abort the form
X		(exits the current field, if any, with C-y, and thus never
X		fails)
X	RET	go to next field
X	TAB	go to previous field
X
XThe commands which are executed in a field are:
X
X	C-y	restore previous value of the field and exit from field
X		(bypasses validity check on previous value)
X	C-v	perform validity check on field
X	C-v C-v exit from field, if it is valid
X
X	C-u	clear field
X	C-k	clear to end of field
X	C-r	clear to beginning of field
X
X	C-a	go to beginning of field
X	C-e	go to end of field
X
X	C-b	go back one character
X	C-f	go forward one character
X
X	C-d	delete next character
X	DEL	delete previous character
X		(also C-h)
X
XThe help commands are:
X
X	C-p	give help on current field
X	C-p C-p	show help screen describing all commands
X
XThe help command (C-p) gives help on the field the cursor is in
X(whether or not it has been entered) by displaying its help_message
Xattribute value in the field named MSG.  However, if there is no such
Xattribute or no field named MSG, or if there is no current field
X(because no visible field is writeable), it behaves like C-p C-p.
X
XIn addition, all printing characters (SPC through ~) are commands to insert
Xthe character into the field value.  Note, however, that the exact meaning
Xof the in-field commands is determined by the field definition.
X
XThe function keys can also be used as commands.  See the section
Xtitled "function keys".
X
X3.  Attributes
X
XEach field is described by a set of "attributes".  A form is stored in
Xan associative array, and the attributes of the fields are stored in
Xelements of the associative array: The value of the attribute $attr of
Xfield $field in form $form is stored in $form{$field,$attr}.  Certain
Xattributes are used by the forms system as a whole, and are stored with
Xthe null string as field name. 
X
XThe forms system reserves the package name "forms" for its data and
Xsubroutines.  In addition, the package "forms_user" is used for storing
Xcode and data used by user-written routines.  Names of the form
X"forms_generated_0000" are generated by the forms system, and so should
Xbe avoided, both in the two packages and as field names. 
X
X4.  Values
X
XA value is represented in three distinct ways.  While this may seem
Xexcessively complicated, it appears to be the only general framework
Xthat handles the myriad possible ways of displaying and inputting field
Xvalues in a reasonably extensible way.  The forms of a value are:
X
XAttribute "value": The actual value of the field, considered the output
Xof the form when it is successfully executed, and the input, when the
Xfields are pre-loaded before the form is executed.  This value can be
Xany Perl value that can be stored in a scalar. 
X
XAttribute "displayed_value": The field, interpreted as a set of
Xcharacters.  For example, if the value is to be a number, the displayed
Xvalue may be a character representation of the number.  In addition, if,
Xsay, -1 is a special value of the number, the displayed value may code
Xit as a particular character string, say, "Unknown". 
X
XAttribute "displayed_field": The field, as displayed on the screen. 
XThis attribute is always exactly as long as the field length (attribute
X"field"length"), and is what is displayed on the screen.
X
XThe translation between these forms is as follows:
X
XThe translation value -> displayed_value is done by the function stored
Xin attribute construct_displayed_value.  It is called with two
Xarguments, the field name and the value, and returns the displayed
Xvalue.
X
XThe translation displayed_value -> displayed_field is done by the
Xfunction stored in attribute initialize_displayed_field.  It is called
Xwith two arguments, the field name and the displayed value, and
Xreturns the displayed_field.  In addition, it sets the variable
X$forms'cursor_location to the correct initial location of the cursor.
X(Cursor locations are relative to the beginning of the field, which is
Xlocation 0.)  This function is always called upon entry to a field,
Xthus it may set additional attributes for the field for the user of
Xthe editing functions for the field.
X
XThe displayed value and displayed field are both edited by the
Xfunction stored in attributes "edit" and "insert".  They are called
Xwith two arguments, the field name and the character typed.  The
Xcharacter is either a printing character (in which case "insert" is
Xcalled) or a non-printing character that is not one of the out-field
Xinput command characters listed above (in which case "edit" is
Xcalled).  The functions are responsible for updating the displayed
Xvalue, the displayed field, and $forms'cursor_location appropriately,
Xand must also report erroneous input characters.
X
XWhen the field is exited, two further attribute functions are called:
XThe attribute "validate_displayed_value" is called with two arguments,
Xthe field name and the displayed value.  It returns true if the value of
Xthe field is considered valid, and false if it is not.  If it returns
Xfalse, exit from the field is blocked.  If it returns true, the function
Xstored in attribute "interpret_displayed_value" is called with the field
Xname and the displayed value as arguments.  It returns the value.  Since
Xinterpret_displayed_value is always called immediately after a
Xsuccessful call to validate_displayed_value, the latter may set global
Xvariables for the former.  (This is the only circumstance where user
Xfunctions can safely set its own global variables.)
X
X5.  Formatting attributes
X
XAttribute "label": The text of the label to be applied to the field.
X
XAttribute "label_location": Two numbers, seperated by commas, giving the
Xlocation of the first character of the label.  (Locations are always given
Xin the order "row,column", both of which are 0-origin, with the 0 row being
Xthe top row and the 0 column the leftmost column.)
X
XAttribute "field_length": The number of characters to be allocated to
Xthe field.  If this attribute is undefined or 0, the field has no
Xinput area, and only its label is relevant.
X
XAttribute "field_location": The location of the field.
X
XAttribute "read_only": If true, the field may not be entered in.  The
XRET and TAB commands skip over the field. 
X
XAttribute "invisible": If true, the field and its label are not displayed
Xand cannot be altered.
X
XAttribute "initially_invisible":  Set from attribute "invisible" when
Xthe form array is constructed, and used to restore attribute "invisible".
X
XAttribute "canonicalize": If true, when the field is exited, the value
Xthat was created is used to re-calculate the displayed value and the
Xdisplayed field. 
X
XAttribute "help_message": Displayed by the C-p command when the cursor
Xis in the field.
X
XIn addition, there are several attributes that apply to the form as a whole:
X
XAttribute "fields": A comma-separated list of the field names, in
Xtheir natural order.  A field's position in the natural order is
Xdetermined by the location in which it was first given an attribute.
XRET cycles through the fields in the natural order, and TAB cycles
Xthrough them in the reverse of the natural order.
X
XAttribute "initialize": A function to be executed once the form is set up
Xbut before any forms processing is performed.
X
XAttribute "finalize": A function to be executed when the form is accepted
Xwith LFD.  If it returns false, the accept is rejected.
X
XAttribute "forms_version": This attribute declares that the form
Xstructure conforms to a particular version of the forms package, and
Xall upward-compatible extensions of it.  If provided, the forms system
Xchecks that it is capable of processing the given version of the forms
Xstructure.  This document describes version 1.0.
X
XThe field MSG is used to display help messages for fields (via the C-p
Xcommand and the help_message attribute) and other messages (via the
Xreport_error and report_message functions).  If it is not present,
Xthese messages are not displayed.
X
X6.  Manipulating other fields
X
XThe edit_field function or other functions of a field may need to alter
Xthe value or visibility of a field.  If it does so, it should call the
Xappropriate function:
X
X$forms'changed_value($field) is used to signal that the value attribute of
Xthe given field has been changed, and the displayed value and displayed
Xfield should be updated.
X
X$forms'changed_visibility($field) is used to signal that the invisible
Xattribute of the given field has been changed, and the screen should
Xbe updated appropriately.  (It should not be called if the invisible
Xattribute has not been changed, unless the user makes sure that no
Xoverlapping fields are visible.)  The user is responsible for making
Xsure that the fields that are visible at a given moment do not
Xoverlap.  If a field that is being made invisible and a field that is
Xbeing made visible overlap, the user should be sure to make the one
Xfield invisible before making the other field visible.
X
X7.  Input representation
X
XA form can be represented as a sequence of lines of text, or more
Xexactly, as an array of strings.  (Ending linefeeds on the strings are
Xignored.) The representation gives the values of the attributes in a
Xstraightforward way:
X
X	field.attribute = value
X
XWhitespace around the field and attribute names and the "=" are ignored; 
Xleading and trailing whitespace around the value is also ignored.
XLines that are entirely whitespace, or whose first non-whitespace character
Xis "#" are ignored.
X
XAttributes of the form as a whole are set in the expected manner:
X
X	.attribute = value
X
XA line of the form
X
X	field:
X
Xis used to provide a default field name for succeeding attributes.  The
Xdefault field name is invoked by omitting the "field." part of the
Xattribute setting line:
X
X	user_name:
X	    field_location = 2,5
X	    field_length = 8
X
XA line of the form
X
X	:
X
Xprovides a generated field name as the default field name.  It is most often
Xused for fields that have labels but no value.
X
XValues are usually interpreted as character strings.  However, certain
Xvalues are interpreted differently:
X
X	&name
X
XThis value is interpreted as "*forms_user'name", which is the correct
Xway to represent functions as attributes. 
X
X	&package'name
X
XThis value is interpreted as "*package'name".
X
X	@name
X
XThis value is interpreted as "*forms'name".  (More exactly, the three
Xabove forms are evaluated directly, after replacing the first
Xcharacter with "*".  If the first character is "&", it is evaluated in
Xpackage forms_user; if it is "@", it is evaluated in package forms.
XThus, "&" is used for functions defined by the user, and "@" is used
Xfor functions supplied by forms.
X
X	* expression
X
XThis value is interpreted by evaluating "expression", in the package
Xforms_user.
X
X	"text"
X
XThis value is interpreted as "text", allowing characters that would
Xotherwise be interpreted specially.
X
X	field.attribute = {
X		text
X		};
X
XThis value is used to construct a subroutine in the forms_user package.
XThe value itself is interpreted as "*forms_user'<subroutine_name>".
XThe text of the subroutine is terminated by a line consisting of "};",
Xpossibly with leading and trailing whitespace.
X
XInterspersed with the attribute values can be sets of lines with the format
X
X	sub name {
X		text
X		};
X
XThese forms are used to define subroutines.  They are evaluated in the
Xforms_user package. 
X
XIn addition, there can be lines with the format
X
X	* expression
X
XThe expression is evaluated in the package forms_user.
X
XNote that "* expression" constructions and subroutines defined in the
Xforms description are evaluated in the order that they are in the
Xforms description, at the time that the representation is processed by
X&forms'process_representation.
X
XThe input representation of a form is transformed into an array with
Xthe function:
X
X	&forms'process_representation(*array, @representation)
X
Xwhere the form attributes will be stored in the associative array %array, 
Xand the representation is taken from @representation.  The function returns
Xtrue if no error is found and false if an error was found.  The error message
Xis stored in $forms'error.
X
XThe function can be used to process input representations from files:
X
X	&forms'process_representation(*array, <FILE>);
X
Xand from here-documents:
X
X	&forms'process_representation(*array, split(/\n/, <<'EOF'))
X	text...
X	EOF
X
XIf the input representation is in a file, a more convenient form can be used:
X
X	&forms'process_representation_from_file(*array, $file_name, $inc)
X
XThis function reads the representation from the given file and processes it.
XIn addition, if $inc is true, @INC is searched for $file_name, just as require
Xdoes.  If the file does not exist, the function aborts execution.
X
XThese functions set certain attributes in addition to those that are mentioned
Xin the input representation:  "initially_invisible" is set from "invisible",
Xand "fields" is set to be the list of fields in the form.
X
X8.  Processing forms
X
XSeveral functions are used to process forms:
X
X	&forms'clear_values(*array)
X
XThis function clears (sets to undef) all of the value attributes of the given
Xform.  It is used to clear a form in preparation for further input.
X
X	&forms'clear_values_and_redisplay
X
XThis function is used during forms input to clear all of the value
Xattributes and force redisplay of all the fields (via
X&forms'changed_value).
X
X	&forms'reset_visibility(*array)
X
XThis function sets the invisible attributes from the initially_invisible
Xattributes. 
X
X	&forms'process_form(*array)
X
XThis form displays the given form and gets the user's input.  Initially
Xdisplayed values are obtained from the value attributes of the form, and
Xthe returned values are returned in the value attributes.  The function
Xreturns true if the form as accepted and false if it was aborted.  During
Xexecution of the form, %forms'form is aliased to %array.  &forms'process_form
Xis not intended to be executed recursively.
X
X	&forms'dump_form(*array, filehandle)
X
XPrints out all of the attributes in a form.  If filehandle is omitted,
XSTDOUT is used.
X
X9.  Service routines
X
X	&forms'report_message(text)
X
Xis used to display a message in the field named MSG (if there is one).
X
X	&forms'report_error(text)
X
Xis used to display an error message in the MSG field.  (It performs a
Xreport_message and then rings the bell.)
X
X10.  Function keys
X
XThe function keys can be used as commands if they are defined by a
Xform.  Function keys are typed as:
X
X	ESC
X	single optional 'O' or '['
X	zero or more characters in the range '!' to '?'
X	one character '@' or greater
X
X(This should probably be changed to a more flexible system.)  They are
Xtranslated into function key identifications (F1 through F10) by the
Xtable %forms'function_key.  The function key identifications for F1 to
XF9 are loaded from the 'k1' through 'k9' capabilities from the termcap
Xentry, and the F10 identification is taken from the 'k;' capability
X(or if it is not present, the 'k0' capability).  In addition, several
Xstandard function key codes are loaded:
X
X	Key     Sun     Sun     VT100   Manual typing	Termcap
X
X	F1      \e[224z \e[11~  \eOP    \e1f    \e1F	k1
X	F2      \e[225z \e[12~  \eOQ    \e2f    \e2F 	k2
X	F3      \e[226z \e[13~  \eOR    \e3f    \e3F 	k3
X	F4      \e[227z \e[14~  \eOS    \e4f    \e4F 	k4
X	F5      \e[228z \e[15~          \e5f    \e5F 	k5
X	F6      \e[229z \e[17~          \e6f    \e6F 	k6
X	F7      \e[230z \e[18~          \e7f    \e7F 	k7
X	F8      \e[231z \e[19~          \e8f    \e8F 	k8
X	F9      \e[232z \e[20~          \e9f    \e9F 	k9
X	F10     \e[-1z  \e[21~          \e0f    \e0F 	k; or k0
X					\e10f   \e10F
X
XA function key is considered "local" if the cursor is sitting in a
Xfield and that field has an attribute "F1" (or whatever).  A function
Xkey is considered "global" if it is not local and there is a global
Xattribute "F1" (or whatever).  Escape sequences that are neither local
Xnor global produce an error message.  If a local function key is
Xgiven, the field is enterd (if it has not been) and the function named
Xby the attribute is executed.  If a global function key is given, the
Xfield is exited (if it has not been) and the function named by the
Xattribute is executed.
X
X11. Problem with curseperl
X
XCurseperl has an ugly problem.  The following program does not do what
Xis expected (clear the screen) when $ARGV[0] is true:
X
X    $ENV{'TERM'} = 'vt100';
X    &initscr;
X    if ($ARGV[0]) {
X	    &getcap('k1');
X	    &getcap('k2');
X	    &getcap('k3');
X	    &getcap('k4');
X    }
X
X    &clear;
X    &refresh;
X    &getch;
X
X(This is using BSD curseperl on a Sun4 with SunOS 4.1.1)
X
Xgetcap is just a wrapper for termcap's tgetstr, *using a fixed
Xinternal buffer to collect the results from tgetstr*.  It appears that
Xthis internal buffer has a finite size, and each successive return
Xvalue is written after the previous one, so if you do a few too many
Xgetcap's, you write off the end of the buffer...
X
XA solution which appears to work is to change the interface for
X&getcap to call tgetstr directly, but to supply a new buffer each
Xtime.  The patch for this is follows.  It is necessary to install this
Xpatch, because forms.pl uses getcap() when it is loaded.  If this
Xpatch can't be installed, you have to comment out the calls to
X&'getcap in subroutine load_function_keys.  This may disable the
Xfunction keys defined in the termcap entry for the user's terminal.
X
X*** bsdcurses.mus.old	Thu Apr  9 16:40:41 1992
X--- bsdcurses.mus	Thu Apr  9 16:41:18 1992
X***************
X*** 476,484 ****
X  CASE int erasechar
X  END
X  
X! CASE char* getcap
X! I	char*		str
X! END
X  
X      case US_getyx:
X  	if (items != 3)
X--- 476,493 ----
X  CASE int erasechar
X  END
X  
X!     case US_getcap:
X! 	if (items != 1)
X! 	    fatal("Usage: &getcap($str)");
X! 	else {
X! 	    char* retval;
X! 	    char*	str =		(char*)		str_get(st[1]);
X! 	    char output[50], *outputp = output;
X! 
X! 	    retval = tgetstr(str, &outputp);
X! 	    str_set(st[0], (char*) retval);
X! 	}
X! 	return sp;
X  
X      case US_getyx:
X  	if (items != 3)
X
X12. Standard field types
X
XThe forms system contains routines for inputting various standard
Xfield types.
X
X- Ordinary text fields
X
XOrdinary text fields can be implemented with the attributes:
X
X	construct_displayed_value = @char_field
X	initialize_displayed_field = @id_cursor_after
X	validate_displayed_value = @true
X	interpret_displayed_value = @trim_trailing_space
X	insert = @text_insert
X	edit = @text_edit
X
XWhen the field is entered, the cursor is placed after the first
Xnon-blank character of the value.  When the field is exited, the
Xcontents of the field have trailing spaces removed, and the remainder
Xis the field vbalue.
X
X- Hidden text fields
X
XHidden text fields are just like ordinary text fields, except that the
Xfield value is not displayed -- the characters of the value (up to the
Xlast non-blank character) are displayed as periods (".").  Hidden text
Xfields are good for inputting passwords and similar things.  They can
Xbe implemented with the attributes:
X
X	construct_displayed_value = @char_field
X	initialize_displayed_field = @id_cursor_after_hidden
X	validate_displayed_value = @true
X	interpret_displayed_value = @trim_trailing_space
X	insert = @text_insert_hidden
X	edit = @text_edit_hidden
X
X- Enumerated fields
X
XEnumerated fields allow one of a set of values to be selected.  Each
Xvalue is represented by one of a set of "representations", which are
Xwhat is displayed to the user and what the user types in the field to
Xspecify a value.  The set of permissible values and their
Xrepresentations are specified by the attribute "translate_table",
Xwhich is a list of items of the form "representation=value", separated
Xby backslashes ("\").  The representations and values are searched for
Xin translate_table, so they may not contain backslashes or equal
Xsigns.  In addition, representations are recognized
Xcase-insensitively, while values are represented case-sensitively.
XWhen a value is translated to a representation, the first
Xrepresentation listed is chosen.  A value that does not have a
Xrepresentation should not be present.  A representation that does not
Xhave a value will be rejected as invalid.  An example of an enumerated
Xfield with the translation table
X
X	Value	Representation
X	1	Yes	(preferred representation)
X	1	Y
X	0	No	(preferred representation)
X	0	N
X
Xis constructed by:
X
X	construct_displayed_value = @enum_field
X	initialize_displayed_field = @id_cursor_after
X	validate_displayed_value = @enum_validate
X	interpret_displayed_value = @enum_interpret
X	translate_table = Yes=1\Y=1\No=0\N=0\=0
X	insert = @text_insert
X	edit = @text_edit
X	canonicalize = 1
X
XIn this case, "canonicalize" is set, so that upon field exit the
Xvalue is displayed in the preferred representation.
X
+FUNKY+STUFF+
echo '-rwxr-xr-x   1 wjm      admin      21927 Apr  6 15:45 readme    (as sent)'
chmod u=rwx,g=rx,o=rx readme
ls -l readme
exit 0

.