
?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Screen Formatting: Process Form' ??
MODULE fdm$process_form;

{ PURPOSE:
{   This module creates, changes, and gets data about a form definition.
{
{ DESIGN:
{   Do not change a stored form definition if any changes are invalid.
{
{ NOTES:
{  All external procedures appear first in alphabetical order.  Then
{  procedures internal to this module appear in alphabetical order.


?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??

?? PUSH (LISTEXT := ON) ??
*copyc cyd$run_time_error_condition
*copyc fde$condition_identifiers
*copyc fdc$im_smart_capability
*copyc fdc$message_form_capability
*copyc fdc$reassign_event_capability
*copyc fdc$integer_length
*copyc fdc$real_length
*copyc fdc$screen_formatting_version
*copyc fdc$system_coordinate_system
*copyc fdc$system_design_variable_name
*copyc fdc$system_error_message
*copyc fdc$system_form_processor
*copyc fdc$system_help_message
*copyc fdc$system_record_type
*copyc fdt$error_header
*copyc fdt$error_input_conversion
*copyc fdt$error_invalid_value
*copyc fdt$error_no_table_variable
*copyc fdt$error_no_variable_def
*copyc fdt$error_no_variable_object
*copyc fdt$error_output_conversion
*copyc fdt$error_unequal_tbl_obj_width
*copyc fdt$comment_index
*copyc fdt$display_index
*copyc fdt$event_index
*copyc fdt$form_attribute_index
*copyc fdt$form_attributes
*copyc fdt$form_names
*copyc fdt$form_object_definition
*copyc fdt$form_object_key
*copyc fdt$form_objects
*copyc fdt$get_object_attributes
*copyc fdt$get_form_attributes
*copyc fdt$name_selections
*copyc fdt$number_errors
*copyc fdt$number_names
*copyc fdt$object_attributes
*copyc fdt$object_definition
*copyc fdt$table_attribute_index
*copyc fdt$table_attributes
*copyc fdt$table_variable_index
*copyc fdt$variable_index
*copyc ost$name
?? POP ??

*copyc fdv$colors

*copyc clp$validate_name
*copyc fdp$add_comment
*copyc fdp$add_object_to_form_image
*copyc fdp$allocate_object
*copyc fdp$check_object_inside_form
*copyc fdp$convert_to_program_variable
*copyc fdp$convert_to_screen_variable
*copyc fdp$convert_yymmdd_to_date_time
*copyc fdp$create_cobol_description
*copyc fdp$create_form_status
*copyc fdp$date_variable
*copyc fdp$find_change_form_definition
*copyc fdp$find_display_name
*copyc fdp$find_form_definition
*copyc fdp$find_form_status
*copyc fdp$find_object_definition
*copyc fdp$find_variable_definition
*copyc fdp$get_message
*copyc fdp$locate_added_variable_facts
*copyc fdp$move_to_program_variable
*copyc fdp$move_to_screen_variable
*copyc fdp$ptr_comments
*copyc fdp$ptr_displays
*copyc fdp$ptr_event_command
*copyc fdp$ptr_events
*copyc fdp$ptr_objects
*copyc fdp$ptr_record_definitions
*copyc fdp$ptr_tables
*copyc fdp$ptr_table_objects
*copyc fdp$ptr_table_variables
*copyc fdp$ptr_text
*copyc fdp$ptr_valid_reals
*copyc fdp$ptr_valid_strings
*copyc fdp$ptr_variable
*copyc fdp$ptr_variables
*copyc fdp$rel_comments
*copyc fdp$rel_displays
*copyc fdp$rel_event_command
*copyc fdp$rel_events
*copyc fdp$rel_objects
*copyc fdp$rel_tables
*copyc fdp$rel_table_objects
*copyc fdp$rel_table_variables
*copyc fdp$rel_text
*copyc fdp$rel_record_definitions
*copyc fdp$rel_variable
*copyc fdp$rel_variables
*copyc fdp$set_display_attributes
*copyc fdp$validate_cobol_data
*copyc fdp$validate_integer
*copyc fdp$validate_name
*copyc fdp$validate_real
*copyc fdp$validate_string
*copyc i#current_sequence_position
*copyc i#move
*copyc mmp$create_scratch_segment
*copyc mmp$delete_scratch_segment
*copyc pmp$continue_to_cause
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$disestablish_cond_handler
*copyc osp$establish_condition_handler
*copyc osp$set_status_abnormal

?? TITLE := 'Global Declarations Declared by This Module', EJECT ??

  CONST
    fdc$displays_to_expand = 3,
    fdc$events_to_expand = 8,
    fdc$initial_x_position = 1,
    fdc$initial_y_position = 1;

?? TITLE := 'fdp$change_form', EJECT ??
*copyc fdh$change_form

  PROCEDURE [XDCL] fdp$change_form
    (    form_identifier: fdt$form_identifier;
     VAR form_attributes: fdt$form_attributes;
     VAR status: ost$status);

    VAR
      form_attribute_index: fdt$form_attribute_index,
      new_form_definition: fdt$form_definition,
      p_form_status: ^fdt$form_status;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$change_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    FOR form_attribute_index := LOWERBOUND (form_attributes) TO UPPERBOUND (form_attributes) DO
      form_attributes [form_attribute_index].put_value_status := fdc$unprocessed_put_value;
    FOREND;

    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Use a copy of the stored form definition so that any invalid changes do not
{ affect it.

    new_form_definition := p_form_status^.p_form_definition^;
    change_form (p_form_status, ^new_form_definition, form_attributes, status);

{ Update stored form definition only when no errors occur.

    IF status.normal THEN
      p_form_status^.p_form_definition^ := new_form_definition;
    IFEND;
  PROCEND fdp$change_form;

?? TITLE := 'fdp$check_for_overlayed_objects', EJECT ??
*copyc fdh$check_for_overlayed_objects

  PROCEDURE [XDCL] fdp$check_for_overlayed_objects
    (    p_form_image: ^fdt$form_image;
         p_form_object_definition: ^fdt$form_object_definition;
         form_name: ost$name;
     VAR status: ost$status);

    VAR
      current_x_position: fdt$x_position,
      current_y_position: fdt$y_position,
      end_object_x_position: fdt$x_position,
      end_object_y_position: fdt$y_position,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

{ More than one object cannot occupy the same area on the form.
{ Objects are recorded in the form image, a character array of the form area.

    status.normal := TRUE;
    x_position := p_form_object_definition^.x_position;
    y_position := p_form_object_definition^.y_position;

{ Determine type of object.  Then examine area occupied by object.

    CASE p_form_object_definition^.key OF

    = fdc$form_box =
      end_object_x_position := x_position + p_form_object_definition^.box_width - 1;
      end_object_y_position := y_position + p_form_object_definition^.box_height - 1;

{ Check top line of box.

      FOR current_x_position := x_position TO end_object_x_position DO
        IF p_form_image^ [y_position] (current_x_position, 1) <> ' ' THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_x_position), 10, FALSE,
                status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position),
                10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
          RETURN;
        IFEND;
      FOREND;

{ Check bottom line of box.

      FOR current_x_position := x_position TO end_object_x_position DO
        IF p_form_image^ [end_object_y_position] (current_x_position, 1) <> ' ' THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_x_position), 10, FALSE,
                status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (end_object_y_position), 10,
                FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
          RETURN;
        IFEND;
      FOREND;

{ Check left vertical line of box.

      FOR current_y_position := y_position + 1 TO end_object_y_position - 1 DO
        IF p_form_image^ [current_y_position] (x_position, 1) <> ' ' THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position),
                10, FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_y_position), 10, FALSE,
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
          RETURN;
        IFEND;
      FOREND;

{ Check left right vertical line of box.

      FOR current_y_position := y_position + 1 TO end_object_y_position - 1 DO
        IF p_form_image^ [current_y_position] (end_object_x_position, 1) <> ' ' THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (end_object_x_position), 10,
                FALSE, status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_y_position), 10, FALSE,
                status);
          osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
          RETURN;
        IFEND;
      FOREND;

    = fdc$form_line =
      IF (p_form_object_definition^.y_increment = 0) THEN

{ Check horizontal line.

        FOR current_x_position := x_position TO x_position + p_form_object_definition^.x_increment DO
          IF p_form_image^ [y_position] (current_x_position, 1) <> ' ' THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_x_position), 10,
                  FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position), 10, FALSE,
                  status);
            osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
            RETURN;
          IFEND;
        FOREND;

      ELSE

{ Check vertical line.

        FOR current_y_position := y_position TO y_position + p_form_object_definition^.y_increment DO
          IF p_form_image^ [current_y_position] (x_position, 1) <> ' ' THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (x_position), 10, FALSE,
                  status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_y_position), 10,
                  FALSE, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
            RETURN;
          IFEND;
        FOREND;
      IFEND;

    = fdc$form_variable_text =
      FOR current_x_position := x_position TO x_position + p_form_object_definition^.text_variable_width -
            1 DO
        IF p_form_image^ [y_position] (current_x_position, 1) <> ' ' THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_x_position), 10, FALSE,
                status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position),
                10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
          RETURN;
        IFEND;
      FOREND;

    = fdc$form_variable_text_box =
      FOR current_y_position := y_position TO y_position + p_form_object_definition^.variable_box_height -
            1 DO
        FOR current_x_position := x_position TO x_position + p_form_object_definition^.variable_box_width -
              1 DO
          IF p_form_image^ [current_y_position] (current_x_position, 1) <> ' ' THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_x_position), 10,
                  FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_y_position), 10,
                  FALSE, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
            RETURN;
          IFEND;
        FOREND;
      FOREND;

    = fdc$form_constant_text =
      FOR current_x_position := x_position TO x_position + p_form_object_definition^.constant_text_width -
            1 DO
        IF p_form_image^ [y_position] (current_x_position, 1) <> ' ' THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_x_position), 10, FALSE,
                status);
          osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (y_position),
                10, FALSE, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
          RETURN;
        IFEND;
      FOREND;

    = fdc$form_constant_text_box =
      FOR current_y_position := y_position TO y_position + p_form_object_definition^.constant_box_height -
            1 DO
        FOR current_x_position := x_position TO x_position + p_form_object_definition^.constant_box_width -
              1 DO
          IF p_form_image^ [current_y_position] (current_x_position, 1) <> ' ' THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$object_overlays, '', status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_x_position), 10,
                  FALSE, status);
            osp$append_status_integer (osc$status_parameter_delimiter, $INTEGER (current_y_position), 10,
                  FALSE, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, form_name, status);
            RETURN;
          IFEND;
        FOREND;
      FOREND;

    ELSE { Ignore other objects.
    CASEND;

  PROCEND fdp$check_for_overlayed_objects;

?? TITLE := 'fdp$create_form', EJECT ??
*copyc fdh$create_form

  PROCEDURE [XDCL] fdp$create_form
    (VAR form_identifier: fdt$form_identifier;
     VAR form_attributes: fdt$form_attributes;
     VAR status: ost$status);

    VAR
      display_attribute_set: fdt$display_attribute_set,
      form_attribute_index: fdt$form_attribute_index,
      form_work_area: amt$segment_pointer,
      local_status: ost$status,
      p_form_definition: ^fdt$form_definition,
      p_form_image: ^fdt$form_image,
      p_form_module: ^fdt$form_module,
      p_form_status: ^fdt$form_status,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          clean_up;
          EXIT fdp$create_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          clean_up;
          EXIT fdp$create_form;
        IFEND;

      = pmc$block_exit_processing =
        handler_status.normal := TRUE;
        RETURN;
      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE ??
?? NEWTITLE := 'clean_up', EJECT ??

    PROCEDURE [INLINE] clean_up;

      IF form_work_area.sequence_pointer <> NIL THEN
        mmp$delete_scratch_segment (p_form_status^.segment_pointer, local_status);
      IFEND;
      IF p_form_status <> NIL THEN
        p_form_status^.entry_used := FALSE;
      IFEND;
      IF p_form_image <> NIL THEN
        FREE p_form_image;
      IFEND;
    PROCEND clean_up;

?? OLDTITLE, EJECT ??

{ Initialize variables used in condition handler.

    form_work_area.kind := amc$sequence_pointer;
    form_work_area.sequence_pointer := NIL;
    p_form_image := NIL;
    p_form_status := NIL;
    osp$establish_condition_handler (^condition_handler, TRUE);

    FOR form_attribute_index := LOWERBOUND (form_attributes) TO UPPERBOUND (form_attributes) DO
      form_attributes [form_attribute_index].put_value_status := fdc$unprocessed_put_value;
    FOREND;

    fdp$create_form_status (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      clean_up;
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;

{ The definition for the form will be placed in a sequence in a scratch segment.
{ All pointers in the sequence must  be  relative  pointers  so  that  the sequence
{ may later be saved in an object code library.

    mmp$create_scratch_segment (amc$sequence_pointer, mmc$as_sequential, form_work_area, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      clean_up;
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;

    p_form_status^.segment_pointer := form_work_area;
    RESET p_form_status^.segment_pointer.sequence_pointer;
    p_form_status^.p_form_module := p_form_status^.segment_pointer.sequence_pointer;
    NEXT p_form_definition IN p_form_status^.p_form_module;
    IF p_form_definition = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      clean_up;
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;

{ Set intial values for form status.  Values in form status change as the
{ application program and terminal user interact with a form. Values in the
{ form definition do not change after the form definition is ended.

    p_form_status^.p_form_definition := p_form_definition;
    p_form_status^.defined_dynamically := TRUE;
    p_form_status^.design_display_attribute := $fdt$display_attribute_set [];
    p_form_status^.design_variable_name := fdc$system_design_variable_name;
    p_form_status^.p_display_definitions := NIL;
    p_form_status^.p_event_definitions := NIL;
    p_form_status^.p_form_image := NIL;
    p_form_status^.p_form_object_definitions := NIL;
    p_form_status^.p_form_table_definitions := NIL;
    p_form_status^.p_form_record_definitions := NIL;
    p_form_status^.p_form_variable_definitions := NIL;
    p_form_status^.validate_variable_values := FALSE;
    p_form_status^.fast_form_creation := FALSE;

{ Set form default attributes.

    p_form_definition^.coordinate_system := fdc$system_coordinate_system;
    p_form_definition^.comment_definitions.active_number := 0;
    p_form_definition^.comment_definitions.total_number := 0;
    p_form_definition^.display_attribute := $fdt$display_attribute_set
          [fdc$black_background, fdc$white_foreground, fdc$protect, fdc$display_left_to_right];
    p_form_definition^.display_definitions.active_number := 0;
    p_form_definition^.display_definitions.total_number := 0;
    p_form_definition^.error_message_form := osc$null_name;
    p_form_definition^.event_definitions.active_number := 0;
    p_form_definition^.event_definitions.total_number := 0;
    p_form_definition^.event_form_definition.key := fdc$no_event_form;
    p_form_definition^.first_input_object_defined := FALSE;
    p_form_definition^.form_area.key := fdc$screen_area;
    p_form_definition^.form_ended := FALSE;
    p_form_definition^.form_name := osc$null_name;
    p_form_definition^.form_version := 1;
    p_form_definition^.form_has_errors := TRUE;
    p_form_definition^.form_object_definitions.total_number := 0;
    p_form_definition^.form_object_definitions.active_number := 0;
    p_form_definition^.form_table_definitions.total_number := 0;
    p_form_definition^.form_table_definitions.active_number := 0;
    p_form_definition^.form_variable_definitions.total_number := 0;
    p_form_definition^.form_variable_definitions.active_number := 0;
    p_form_definition^.help_definition.key := fdc$no_help_response;
    p_form_definition^.help_message_form := osc$null_name;
    p_form_definition^.invalid_data_character.defined := FALSE;
    p_form_definition^.language := osc$default_natural_language;
    p_form_definition^.hidden_editing := FALSE;
    p_form_definition^.processor := fdc$system_form_processor;
    p_form_definition^.program_record_length := 0;
    p_form_definition^.record_deck_name := osc$null_name;
    p_form_definition^.record_definitions.active_number := 0;
    p_form_definition^.record_definitions.total_number := 0;
    p_form_definition^.record_name := osc$null_name;
    p_form_definition^.record_type := fdc$system_record_type;
    p_form_definition^.record_version := 1;
    p_form_definition^.screen_formatting_version := fdc$screen_formatting_version;
    p_form_definition^.screen_record_length := 0;

{ Set user application form attributes.

    change_form (p_form_status, p_form_definition, form_attributes, status);
    IF NOT status.normal THEN
      clean_up;
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;

{ The form image is used to check for overlayed objects.
{ When an object is created, the character positions
{ occupied by the object are set non-space.

    IF NOT p_form_status^.fast_form_creation THEN
      ALLOCATE p_form_image;
      IF p_form_image = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        clean_up;
        RETURN;
      IFEND;

      p_form_status^.p_form_image := p_form_image;
      FOR y_position := 1 TO fdc$maximum_x_position DO
        p_form_image^ [y_position] := ' ';
      FOREND;
    IFEND;
  PROCEND fdp$create_form;

?? TITLE := 'fdp$edit_form', EJECT ??
*copyc fdh$edit_form

  PROCEDURE [XDCL] fdp$edit_form
    (    form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      current_x_position: fdt$x_position,
      current_y_position: fdt$y_position,
      end_object_x_position: fdt$x_position,
      end_object_y_position: fdt$y_position,
      object_index: fdt$object_index,
      p_form_image: ^fdt$form_image,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      x_position: fdt$x_position,
      y_position: fdt$y_position;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$edit_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$edit_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    p_form_image := NIL;
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_status^.p_form_definition^.form_ended := FALSE;
    IF p_form_status^.p_form_image <> NIL THEN
      RETURN;
    IFEND;

    IF p_form_status^.fast_form_creation THEN
      RETURN;
    IFEND;

{ The form image is used to check for overlayed objects.
{ When an object is created, the character positions
{ occupied by the object are set non-space.

    ALLOCATE p_form_image;
    IF p_form_image = NIL THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
      RETURN;
    IFEND;

    p_form_status^.p_form_image := p_form_image;
    FOR y_position := 1 TO fdc$maximum_y_position DO
      p_form_image^ [y_position] := ' ';
    FOREND;

{ Create character image from objects on form.

    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    FOR object_index := 1 TO p_form_status^.p_form_definition^.form_object_definitions.active_number DO
      fdp$add_object_to_form_image (p_form_image, ^p_form_object_definitions^ [object_index]);
    FOREND;

  PROCEND fdp$edit_form;

?? TITLE := 'fdp$end_form', EJECT ??
*copyc fdh$end_form

  PROCEDURE [XDCL] fdp$end_form
    (    form_identifier: fdt$form_identifier;
         p_sequence: ^SEQ ( * );
     VAR number_errors: fdt$number_errors;
     VAR p_errors: ^SEQ ( * );
     VAR status: ost$status);

    VAR
      error_size: integer,
      number_objects: fdt$number_objects,
      number_variables: fdt$number_variables,
      object_errors: fdt$number_errors,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      p_form_table_definitions: ^array [1 .. * ] of fdt$form_table_definition,
      p_form_variable_definitions: ^array [1 .. * ] of fdt$form_variable_definition,
      variable_status: fdt$variable_status;

?? NEWTITLE := 'check_for_dangling_objects', EJECT ??

    PROCEDURE check_for_dangling_objects;

      { Search the object definitions to make sure that all variable objects are linked to variables.

      VAR
        object_index: fdt$object_index,
        p_form_object_definition: ^fdt$form_object_definition,
        p_error_header: ^fdt$error_header,
        p_error_no_variable_def: ^fdt$error_no_variable_def;

    /examine_objects/
      FOR object_index := 1 TO number_objects DO
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_stored_variable =
          IF p_form_object_definition^.stored_variable_exists THEN
            CYCLE /examine_objects/;
          IFEND;

        = fdc$form_variable_text =
          IF p_form_object_definition^.text_variable_exists THEN
            CYCLE /examine_objects/;
          IFEND;

        = fdc$form_variable_text_box =
          IF p_form_object_definition^.variable_box_variable_exists THEN
            CYCLE /examine_objects/;
          IFEND;

        ELSE { Ignore object.
          CYCLE /examine_objects/;
        CASEND;

{ The object does not have a variable definition.

        IF p_errors <> NIL THEN
          NEXT p_error_header IN p_errors;
          IF p_error_header <> NIL THEN
            p_error_header^.key := fdc$no_variable_definition;
            NEXT p_error_no_variable_def IN p_errors;
            IF p_error_no_variable_def <> NIL THEN
              p_error_no_variable_def^.variable_name := p_form_object_definition^.name;
              p_error_no_variable_def^.occurrence := p_form_object_definition^.occurrence;
            IFEND;
          IFEND;
        IFEND;
        number_errors := number_errors + 1;
      FOREND /examine_objects/;

    PROCEND check_for_dangling_objects;

?? OLDTITLE ??
?? NEWTITLE := 'compute_form_area', EJECT ??

    PROCEDURE compute_form_area;

      VAR
        last_x_position: fdt$x_position,
        last_y_position: fdt$y_position,
        new_x_position: fdt$x_position,
        new_y_position: fdt$y_position,
        object_index: fdt$object_index,
        output_format_key: fdt$output_format_key,
        p_form_object_definition: ^fdt$form_object_definition,
        p_form_variable_definition: ^fdt$form_variable_definition,
        p_text: ^fdt$text,
        x_position: fdt$x_position,
        y_position: fdt$y_position;

      CASE p_form_definition^.form_area.key OF

      = fdc$defined_area =

{ The user has specified the area explicitly.

        p_form_definition^.width := p_form_definition^.form_area.width;
        p_form_definition^.height := p_form_definition^.form_area.height;
        p_form_definition^.x_position := p_form_definition^.form_area.x_position;
        p_form_definition^.y_position := p_form_definition^.form_area.y_position;
        p_form_status^.form_x_position := p_form_definition^.form_area.x_position;
        p_form_status^.form_y_position := p_form_definition^.form_area.y_position;

      = fdc$screen_area =

{ The user has specified the area implicitly. The area occupied by the objects
{ on the form determine the size of the screen the form needs for display.
{ Compute largest x, y positions used by objects on form. Use this as form size.

        p_form_definition^.x_position := fdc$initial_x_position;
        p_form_definition^.y_position := fdc$initial_y_position;

        IF p_form_object_definitions = NIL THEN
          p_form_definition^.width := 1;
          p_form_definition^.height := 1;
          RETURN;
        IFEND;

        last_x_position := 1;
        last_y_position := 1;
        FOR object_index := 1 TO p_form_definition^.form_object_definitions.active_number DO
          p_form_object_definition := ^p_form_object_definitions^ [object_index];
          x_position := p_form_object_definition^.x_position;
          y_position := p_form_object_definition^.y_position;
          CASE p_form_object_definition^.key OF

          = fdc$form_box =
            new_x_position := x_position + p_form_object_definition^.box_width - 1;
            IF new_x_position > last_x_position THEN
              last_x_position := new_x_position;
            IFEND;
            new_y_position := y_position + p_form_object_definition^.box_height - 1;
            IF new_y_position > last_y_position THEN
              last_y_position := new_y_position;
            IFEND;

          = fdc$form_constant_text =
            new_x_position := x_position + p_form_object_definition^.constant_text_width - 1;
            IF new_x_position > last_x_position THEN
              last_x_position := new_x_position;
            IFEND;
            IF y_position > last_y_position THEN
              last_y_position := y_position;
            IFEND;

          = fdc$form_constant_text_box =
            new_x_position := x_position + p_form_object_definition^.constant_box_width - 1;
            IF new_x_position > last_x_position THEN
              last_x_position := new_x_position;
            IFEND;
            new_y_position := y_position + p_form_object_definition^.constant_box_height - 1;
            IF new_y_position > last_y_position THEN
              last_y_position := new_y_position;
            IFEND;

          = fdc$form_table =
            new_x_position := p_form_object_definition^.table_width - 1 + x_position;
            new_y_position := p_form_object_definition^.table_height - 1 + y_position;
            IF new_x_position > last_x_position THEN
              last_x_position := new_x_position;
            IFEND;
            IF new_y_position > last_y_position THEN
              last_y_position := new_y_position;
            IFEND;

          = fdc$form_line =
            new_x_position := x_position + p_form_object_definition^.x_increment;
            IF new_x_position > last_x_position THEN
              last_x_position := new_x_position;
            IFEND;
            new_y_position := y_position + p_form_object_definition^.y_increment;
            IF new_y_position > last_y_position THEN
              last_y_position := new_y_position;
            IFEND;

          = fdc$form_variable_text =
            new_x_position := x_position + p_form_object_definition^.text_variable_width - 1;
            IF new_x_position > last_x_position THEN
              last_x_position := new_x_position;
            IFEND;

          = fdc$form_variable_text_box =
            new_x_position := x_position + p_form_object_definition^.variable_box_width - 1;
            IF new_x_position > last_x_position THEN
              last_x_position := new_x_position;
            IFEND;
            new_y_position := y_position + p_form_object_definition^.variable_box_height - 1;
            IF new_y_position > last_y_position THEN
              last_y_position := new_y_position;
            IFEND;

          ELSE { Ignore objects created by Screen Formatting internally.
          CASEND;
        FOREND;

        p_form_definition^.width := last_x_position;
        p_form_definition^.height := last_y_position;

      ELSE
      CASEND;
    PROCEND compute_form_area;

?? OLDTITLE ??
?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$end_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$end_form;
        IFEND;

      = pmc$block_exit_processing =
        handler_status.normal := TRUE;
        RETURN;
      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE ??
?? NEWTITLE := 'create_integer_output_format', EJECT ??

    PROCEDURE [INLINE] create_integer_output_format
      (    width: fdt$width;
       VAR output_format: fdt$output_format);

      CASE output_format.key OF

      = fdc$character_output_format, fdc$undefined_output_format =

{ Set default integer output format. Use minus sign if number is negative.
{ If number equals zero, output spaces.

        output_format.key := fdc$integer_output_format;
        output_format.integer_output_format.field_width := width;
        output_format.integer_output_format.sign_treatment := mlc$minus_if_negative;
        output_format.integer_output_format.minimum_output_digits := 0;

      ELSE { Ignore other output formats.
      CASEND;
    PROCEND create_integer_output_format;

?? OLDTITLE ??
?? NEWTITLE := 'create_real_output_format', EJECT ??

    PROCEDURE [INLINE] create_real_output_format
      (    width: fdt$width;
       VAR output_format: fdt$output_format);

      VAR
        n: integer;

      CASE output_format.key OF

      = fdc$character_output_format, fdc$undefined_output_format =

{ Set default real output format.  Use FORTRAN G format.
{ If number equals zero, output spaces.  Put decimal point in middle
{ of field.

        output_format.key := fdc$g_output_format;
        output_format.float_output_format.field_width := width;
        n := (width DIV 2) - 1;
        IF n < 0 THEN
          n := 0;
        IFEND;
        output_format.float_output_format.digits_right_decimal := n;
        output_format.float_output_format.sign_treatment := mlc$minus_if_negative;
        output_format.float_output_format.suppress_zero := TRUE;

      ELSE { Ignore other output formats.
      CASEND;
    PROCEND create_real_output_format;

?? OLDTITLE ??
?? NEWTITLE := 'create_stored_objects', EJECT ??

    PROCEDURE create_stored_objects;

      VAR
        name_exists: boolean,
        object_index: fdt$object_index,
        occurrence_exists: boolean,
        occurrence: fdt$occurrence,
        p_first_object_definition: ^fdt$form_object_definition,
        p_form_object_definition: ^fdt$form_object_definition,
        p_form_table_definition: ^fdt$form_table_definition,
        p_table_objects: ^array [1 .. * ] of fdt$table_object,
        p_table_variables: ^array [1 .. * ] of fdt$table_variable,
        p_table_variable: ^fdt$table_variable,
        stored_occurrence: fdt$occurrence,
        table_index: fdt$table_index,
        table_variable_index: fdt$table_variable_index,
        visible_occurrence: fdt$occurrence;

{ Create stored objects that the user did not specify during form definition.
{ Stored objects exist when a table has more stored objects than visible objects.

    /find_table/
      FOR table_index := 1 TO p_form_definition^.form_table_definitions.active_number DO
        p_form_table_definition := ^p_form_table_definitions^ [table_index];
        IF NOT p_form_table_definition^.visible_occurrence_defined THEN
          CYCLE /find_table/;
        IFEND;

        visible_occurrence := p_form_table_definition^.visible_occurrence;
        stored_occurrence := p_form_table_definition^.stored_occurrence;
        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_status^.p_form_module);
        IF p_table_variables = NIL THEN
          CYCLE /find_table/;
        IFEND;

        FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
          p_table_variable := ^p_table_variables^ [table_variable_index];

{ The default value for all Screen Formatting created stored objects is the value of first occurrence.

          fdp$find_object_definition (p_table_variable^.name, 1, p_form_status^.p_form_object_definitions,
                p_form_definition^.form_object_definitions.active_number, p_first_object_definition,
                object_index, name_exists, occurrence_exists);
          IF name_exists AND occurrence_exists THEN

          /find_table_objects/
            FOR occurrence := visible_occurrence + 1 TO stored_occurrence DO
              p_table_variable := ^p_table_variables^ [table_variable_index];
              fdp$find_object_definition (p_table_variable^.name, occurrence,
                    p_form_status^.p_form_object_definitions, p_form_definition^.form_object_definitions.
                    active_number, p_form_object_definition, object_index, name_exists, occurrence_exists);
              IF ((NOT name_exists) OR (NOT occurrence_exists)) THEN
                fdp$allocate_object (p_form_status, p_form_object_definition, object_index, status);
                IF NOT status.normal THEN
                  RETURN;
                IFEND;

                p_form_object_definition^ := p_first_object_definition^;
                p_form_object_definition^.occurrence := occurrence;
                p_form_object_definition^.key := fdc$form_stored_variable;
                p_form_object_definition^.stored_variable_text :=
                      p_first_object_definition^.text_variable_text;
              IFEND;
            FOREND /find_table_objects/;
          IFEND;
        FOREND;
      FOREND /find_table/;
    PROCEND create_stored_objects;

?? OLDTITLE ??
?? NEWTITLE := 'create_variable_display', EJECT ??

    PROCEDURE [INLINE] create_variable_display
      (    io_mode: fdt$io_mode;
       VAR variable_display_attributes: fdt$display_attribute_set);


      CASE io_mode OF

      = fdc$terminal_input =

{ The terminal user does not see what he/she types.  This is used for passwords.

        variable_display_attributes := variable_display_attributes - $fdt$display_attribute_set
              [fdc$protect] + $fdt$display_attribute_set [fdc$hidden];

      = fdc$terminal_input_output =

{ Input variables must not be protected.

        variable_display_attributes := variable_display_attributes - $fdt$display_attribute_set [fdc$protect];

      = fdc$terminal_output =

{ Output variables must be protected.

        variable_display_attributes := variable_display_attributes + $fdt$display_attribute_set [fdc$protect];

      ELSE { Ignore other io modes.
      CASEND;

    PROCEND create_variable_display;

?? OLDTITLE ??
?? NEWTITLE := 'create_variable_error', EJECT ??

{  PURPOSE:
{    This procedure sets defaults for displaying a variable when an error occurs.
{  DESIGN:
{    If no error attributes were set by the user, use Screen Formatting
{    default of inverse video.

    PROCEDURE [INLINE] create_variable_error
      (    p_form_variable_definition: {output} ^fdt$form_variable_definition);

          IF p_form_variable_definition^.error_displays = $fdt$display_attribute_set [] THEN
            CASE p_form_variable_definition^.io_mode OF

            = fdc$terminal_input, fdc$terminal_input_output =
              p_form_variable_definition^.error_displays := $fdt$display_attribute_set
                    [fdc$inverse_video, fdc$underline];

            = fdc$terminal_output =
              p_form_variable_definition^.error_displays := $fdt$display_attribute_set [fdc$inverse_video];

            ELSE { Ignore other io modes.
            CASEND;
          IFEND;

    PROCEND create_variable_error;

?? OLDTITLE ??
?? NEWTITLE := 'create_variable_format', EJECT ??

{  PURPOSE:
{    This procedure sets defaults for variable program and display formats.

    PROCEDURE create_variable_format
      (    p_form_variable_definition: {output} ^fdt$form_variable_definition;
           p_form_module: ^fdt$form_module);

      VAR
        cobol_description: fdt$cobol_description,
        ignore_status: ost$status,
        number: fdt$picture,
        number_length: integer,
        p_added_variable_definition: ^fdt$added_variable_definition,
        picture: fdt$picture,
        picture_length: integer;

      CASE p_form_variable_definition^.program_data_type OF

      = fdc$program_character_type, fdc$program_upper_case_type =

{ If the user did not define any program length use the length of the
{ object on the screen.

        IF p_form_variable_definition^.program_variable_length = 0 THEN
          p_form_variable_definition^.program_variable_length :=
                p_form_variable_definition^.screen_variable_length;
        IFEND;

{ The length of the record space for the object on the screen must be at least
{ as long as the length of the program variable.

        IF p_form_variable_definition^.program_variable_length >
              p_form_variable_definition^.screen_variable_length THEN
          p_form_variable_definition^.screen_variable_length :=
              p_form_variable_definition^.program_variable_length;
        IFEND;

      = fdc$program_real_type =
        create_real_output_format (p_form_variable_definition^.screen_variable_length,
              p_form_variable_definition^.output_format);

      = fdc$program_integer_type =
        create_integer_output_format (p_form_variable_definition^.screen_variable_length,
             p_form_variable_definition^.output_format);

      ELSE { fdc$program_cobol_type

        fdp$locate_added_variable_facts  (p_form_module, p_form_variable_definition,
             p_added_variable_definition);

{ If the user did not provide a COBOL definition, use a PICTURE clause with
{ alphanumeric characters as long as the length of the object on the screen.

        IF NOT p_added_variable_definition^.form_cobol_display_clause.defined THEN
          STRINGREP (number, number_length, p_form_variable_definition^.screen_variable_length);
          STRINGREP (picture, picture_length, 'X(', number (2, number_length - 1), ')');
          fdp$create_cobol_description (picture (1, picture_length),
                fdc$display_usage, cobol_description, ignore_status);

{ No errors can occur on this simple PICTURE clause.

          p_added_variable_definition^.form_cobol_display_clause.defined := TRUE;
           p_added_variable_definition^.form_cobol_display_clause.cobol_display_clause.picture :=
                picture (1, picture_length);
          p_added_variable_definition^.display_cobol_description := cobol_description;
        IFEND;

        IF NOT p_added_variable_definition^.form_cobol_program_clause.defined THEN

{ If the user did not define any program length use the length of the
{ object on the screen.

        IF p_form_variable_definition^.program_variable_length = 0 THEN
          p_form_variable_definition^.program_variable_length :=
                p_form_variable_definition^.screen_variable_length;
        IFEND;

          STRINGREP (number, number_length, p_form_variable_definition^.program_variable_length);
          STRINGREP (picture, picture_length, 'X(', number (2, number_length - 1), ')');
          fdp$create_cobol_description (picture (1, picture_length),
                fdc$display_usage, cobol_description, ignore_status);

{ No errors can occur on this simple PICTURE clause.

          p_added_variable_definition^.form_cobol_program_clause.defined := TRUE;
          p_added_variable_definition^.form_cobol_program_clause.cobol_program_clause.picture :=
                picture (1, picture_length);
          p_added_variable_definition^.form_cobol_program_clause.cobol_program_clause.usage :=
                fdc$display_usage;
          p_added_variable_definition^.program_cobol_description := cobol_description;
        IFEND;
      CASEND;

    PROCEND create_variable_format;

?? OLDTITLE ??
?? NEWTITLE := 'find_first_input_position', EJECT ??

    PROCEDURE find_first_input_position;

      VAR
        object_index: fdt$object_index,
        p_form_object_definition: ^fdt$form_object_definition;

      p_form_definition^.first_input_object_defined := FALSE;

{ Determine first position on the form to place the cursor by default.

    /find_input_object/
      FOR object_index := 1 TO p_form_definition^.form_object_definitions.active_number DO
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text_box =
          IF p_form_object_definition^.variable_box_variable_exists THEN
            IF ((p_form_variable_definitions^ [p_form_object_definition^.variable_box_variable_index].
                  io_mode = fdc$terminal_input) OR (p_form_variable_definitions^
                  [p_form_object_definition^.variable_box_variable_index].io_mode =
                  fdc$terminal_input_output)) THEN
              p_form_definition^.first_input_object_defined := TRUE;
              p_form_definition^.first_input_object_index := object_index;
              EXIT /find_input_object/;
            IFEND;
          IFEND;

        = fdc$form_variable_text =
          IF p_form_object_definition^.text_variable_exists THEN
            IF ((p_form_variable_definitions^ [p_form_object_definition^.text_variable_index].io_mode =
                  fdc$terminal_input) OR (p_form_variable_definitions^
                  [p_form_object_definition^.text_variable_index].io_mode = fdc$terminal_input_output)) THEN
              p_form_definition^.first_input_object_defined := TRUE;
              p_form_definition^.first_input_object_index := object_index;
              EXIT /find_input_object/;
            IFEND;
          IFEND;

        ELSE { Ignore objects that are not variables.
        CASEND;
      FOREND /find_input_object/;
    PROCEND find_first_input_position;

?? OLDTITLE ??
?? NEWTITLE := 'generate_form_record', EJECT ??

    PROCEDURE generate_form_record;

      VAR
        form_processor: fdt$form_processor,
        object_index: fdt$object_index,
        occurrence: fdt$occurrence,
        p_form_object_definition: ^fdt$form_object_definition,
        p_form_table_definition: ^fdt$form_table_definition,
        p_form_variable_definition: ^fdt$form_variable_definition,
        p_record_definitions: ^array [1 .. * ] of fdt$variable_record_definition,
        p_table_object: ^fdt$table_object,
        p_table_objects: ^array [1 .. * ] of fdt$table_object,
        p_table_variables: ^array [1 .. * ] of fdt$table_variable,
        p_table_variable: ^fdt$table_variable,
        program_record_length: fdt$record_length,
        program_record_position: fdt$record_position,
        record_index: fdt$object_index,
        record_count: fdt$number_objects,
        screen_record_length: fdt$record_length,
        screen_record_position: fdt$record_position,
        screen_variable_length: fdt$screen_variable_length,
        program_variable_length: fdt$program_variable_length,
        table_index: fdt$table_index,
        table_variable_index: fdt$table_variable_index,
        variable_index: fdt$variable_index;

?? NEWTITLE := 'compute_program_record_position', EJECT ??

      PROCEDURE [INLINE] compute_program_record_position
        (VAR record_position: fdt$record_position);

        VAR
          byte_offset: 0 .. 7,
          byte_increment: 0 .. 7,
          program_data_type: fdt$program_data_type;

        get_compatible_data_type (p_form_variable_definition, p_form_module, program_data_type);
        CASE program_data_type OF

        = fdc$program_integer_type, fdc$program_real_type =

{ For real or integer data type, adjust record position to a word boundary.

          byte_offset := (program_record_position - 1) MOD 8;
          IF byte_offset <> 0 THEN
            byte_increment := 8 - byte_offset;
          ELSE
            byte_increment := 0;
          IFEND;
        ELSE

{ Other data types do not need adjustment to word boundary.

          byte_increment := 0;
        CASEND;

        record_position := program_record_position + byte_increment;
        program_record_position := program_record_position + program_variable_length + byte_increment;
        program_record_length := program_record_length + program_variable_length + byte_increment;

      PROCEND compute_program_record_position;

?? OLDTITLE ??
?? NEWTITLE := 'generate_cobol_table', EJECT ??

      PROCEDURE generate_cobol_table;

{ Generate record definitions. Determine record  size  to  allocate when form is displayed.
{ Each record of table contains one occurrence of each variable in the table.
{ COBOL and CYBIL record definitions are fully compatible in their data structures.

        VAR
          program_data_type: fdt$program_data_type,
          table_offset: 0 .. 7,
          table_word_aligned: boolean;

      /generate_tables/
        FOR table_index := 1 TO p_form_definition^.form_table_definitions.active_number DO
          p_form_table_definition := ^p_form_table_definitions^ [table_index];

          p_record_definitions^ [record_count].key := fdc$record_table;
          p_record_definitions^ [record_count].table_index := table_index;
          record_count := record_count + 1;
          p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                p_form_module);
          table_word_aligned := FALSE;

        /generate_table_occurrences/
          FOR occurrence := 1 TO p_form_table_definition^.stored_occurrence DO

          /generate_table_variables/
            FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
              p_table_variable := ^p_table_variables^ [table_variable_index];
              p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];
              program_variable_length := p_form_variable_definition^.program_variable_length;
              p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);
              p_table_object := ^p_table_objects^ [occurrence];
              compute_program_record_position (p_table_object^.program_record_position);
              p_table_object^.screen_record_position := screen_record_position;
              screen_variable_length := p_form_variable_definition^.screen_variable_length;
              screen_record_position := screen_record_position + screen_variable_length;
              screen_record_length := screen_record_length + screen_variable_length;
              get_compatible_data_type (p_form_variable_definition, p_form_module, program_data_type);
              CASE program_data_type OF

              = fdc$program_integer_type, fdc$program_real_type =
                table_word_aligned := TRUE;

              ELSE {Other data types do not need adjustment to word boundary.
              CASEND;

            FOREND /generate_table_variables/;
          FOREND /generate_table_occurrences/;

          IF table_word_aligned THEN
            table_offset := (program_record_position - 1) MOD 8;
            IF table_offset <> 0 THEN
              program_record_position := program_record_position + 8 - table_offset;
              program_record_length := program_record_length + 8 - table_offset;
            IFEND;
          IFEND;

        FOREND /generate_tables/;

      PROCEND generate_cobol_table;

?? OLDTITLE ??
?? NEWTITLE := 'generate_fortran_table', EJECT ??

      PROCEDURE generate_fortran_table;

{ Generate record definitions. Determine record  size  to  allocate when form is displayed.
{ FORTRAN does not have a record data structure like COBOL and CYBIL.  Each element of an
{ array (DIMENSION statement) contains only one variable.

      /generate_tables/
        FOR table_index := 1 TO p_form_definition^.form_table_definitions.active_number DO
          p_form_table_definition := ^p_form_table_definitions^ [table_index];

          p_record_definitions^ [record_count].key := fdc$record_table;
          p_record_definitions^ [record_count].table_index := table_index;
          record_count := record_count + 1;
          p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
                p_form_module);

        /generate_table_variables/
          FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
            p_table_variable := ^p_table_variables^ [table_variable_index];
            p_form_variable_definition := ^p_form_variable_definitions^ [p_table_variable^.variable_index];

          /generate_table_occurrences/
            FOR occurrence := 1 TO p_form_table_definition^.stored_occurrence DO
              program_variable_length := p_form_variable_definition^.program_variable_length;
              p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects, p_form_module);
              p_table_object := ^p_table_objects^ [occurrence];
              compute_program_record_position (p_table_object^.program_record_position);
              p_table_object^.screen_record_position := screen_record_position;
              screen_variable_length := p_form_variable_definition^.screen_variable_length;
              screen_record_position := screen_record_position + screen_variable_length;
              screen_record_length := screen_record_length + screen_variable_length;
            FOREND /generate_table_occurrences/;
          FOREND /generate_table_variables/;
        FOREND /generate_tables/;
      PROCEND generate_fortran_table;

?? OLDTITLE, EJECT ??

{ Determine size of array for record definitions.
{ Count the number of tables and variables.

      record_count := p_form_definition^.form_table_definitions.active_number;

    /count_variables/
      FOR variable_index := 1 TO p_form_definition^.form_variable_definitions.active_number DO
        p_form_variable_definition := ^p_form_variable_definitions^ [variable_index];
        IF NOT p_form_variable_definition^.table_exists THEN
          record_count := record_count + 1;
        IFEND;
      FOREND /count_variables/;

{ Allocate space for record definitions. The upper bound of the array is
{ the number of tables plus the number of variables that  do not belong to
{ to a table.

      IF ((record_count = 0) OR (number_errors <> 0)) THEN
        fdp$rel_record_definitions (NIL, p_form_status);
        p_form_definition^.program_record_length := 0;
        p_form_definition^.screen_record_length := 0;
        RETURN;
      IFEND;

      form_processor := p_form_definition^.processor;
      program_record_length := 0;
      program_record_position := 1;
      screen_record_length := 0;
      screen_record_position := 1;

      NEXT p_record_definitions: [1 .. record_count] IN p_form_status^.p_form_module;
      IF p_record_definitions = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      fdp$rel_record_definitions (p_record_definitions, p_form_status);
      p_form_definition^.record_definitions.active_number := record_count;
      record_count := 1;
      CASE form_processor OF

      = fdc$ansi_fortran_processor, fdc$cdc_fortran_processor,
              fdc$extended_fortran_processor =
        generate_fortran_table;

      ELSE

{ A COBOL table also works for CYBIL, PASCAL, SCL and UNKNOWN.

        generate_cobol_table;

      CASEND;

{ Set record length for program and screen records.

    /generate_variables/
      FOR variable_index := 1 TO p_form_definition^.form_variable_definitions.active_number DO
        p_form_variable_definition := ^p_form_variable_definitions^ [variable_index];

        IF NOT p_form_variable_definition^.table_exists THEN
          program_variable_length := p_form_variable_definition^.program_variable_length;
          compute_program_record_position (p_form_variable_definition^.program_record_position);
          p_form_variable_definition^.screen_record_position := screen_record_position;
          screen_variable_length := p_form_variable_definition^.screen_variable_length;
          screen_record_position := screen_record_position + screen_variable_length;
          screen_record_length := screen_record_length + screen_variable_length;
          p_record_definitions^ [record_count].key := fdc$record_variable;
          p_record_definitions^ [record_count].variable_index := variable_index;
          record_count := record_count + 1;
        IFEND;
      FOREND /generate_variables/;

      p_form_definition^.program_record_length := program_record_length;
      p_form_definition^.screen_record_length := screen_record_length;
    PROCEND generate_form_record;

?? OLDTITLE ??
?? NEWTITLE := 'get_compatible_data_type', EJECT ??

{  PURPOSE:
{    Map a COBOL data type to a basic Screen Formatting data type.
{  DESIGN:
{    COBOL computational-1 is mapped to real.
{    COBOL computational with length of an integer is mapped to integer.
{    Otherwise the COBOL type is mapped to character.

  PROCEDURE [INLINE] get_compatible_data_type
    (    p_form_variable_definition: ^fdt$form_variable_definition;
         p_form_module: ^fdt$form_module;
     VAR program_data_type: fdt$program_data_type);

  VAR
    p_added_variable_definition:^fdt$added_variable_definition;

  IF p_form_variable_definition^.program_data_type <> fdc$program_cobol_type THEN
    program_data_type := p_form_variable_definition^.program_data_type;
    RETURN;
  IFEND;

  fdp$locate_added_variable_facts  (p_form_module, p_form_variable_definition,
             p_added_variable_definition);
  CASE p_added_variable_definition^.program_cobol_description.cobol_usage OF

  = fdc$cobol_usage_single =
    program_data_type := fdc$program_real_type;

  = fdc$cobol_usage_binary =
    IF p_added_variable_definition^.program_cobol_description.size = fdc$integer_length THEN
      program_data_type := fdc$program_integer_type;
    ELSE
      program_data_type := fdc$program_character_type;
    IFEND;

  ELSE
    program_data_type := fdc$program_character_type;
  CASEND;

PROCEND get_compatible_data_type;

?? OLDTITLE ??
?? NEWTITLE := 'link_text_boxes', EJECT ??

    PROCEDURE link_text_boxes;

      VAR
        current_height: fdt$height,
        fragment_object_index: fdt$object_index,
        p_fragment_object_definition: ^fdt$form_object_definition,
        p_last_fragment: ^fdt$form_object_definition,
        p_text_box_object_definition: ^fdt$form_object_definition,
        text_box_object_index: fdt$object_index,
        text_box_x_position: fdt$x_position,
        text_box_y_position: fdt$y_position;

{ Text boxes consists of a number of objects.  These objects are called fragments.
{ Their is one fragment for each line of the text box.  The first fragment is called
{ the parent.  Linking the fragments makes processing easy during terminal user interaction
{ with the form since no searches are needed.

    /find_text_boxes/
      FOR text_box_object_index := 1 TO number_objects DO
        p_text_box_object_definition := ^p_form_object_definitions^ [text_box_object_index];
        CASE p_text_box_object_definition^.key OF

        = fdc$form_constant_text_box =

          IF p_text_box_object_definition^.constant_box_height = 1 THEN
            p_text_box_object_definition^.constant_box_fragment_index := 0;

          ELSE
            text_box_x_position := p_text_box_object_definition^.x_position;
            current_height := 2;
            text_box_y_position := p_text_box_object_definition^.y_position + 1;
            p_last_fragment := NIL;

          /find_constant_fragments/

            FOR fragment_object_index := text_box_object_index + 1 TO number_objects DO
              p_fragment_object_definition := ^p_form_object_definitions^ [fragment_object_index];
              IF p_fragment_object_definition^.key = fdc$form_text_box_fragment THEN
                IF p_fragment_object_definition^.x_position = text_box_x_position THEN
                  IF p_fragment_object_definition^.y_position = text_box_y_position THEN
                    p_fragment_object_definition^.parent_text_box_object_index := text_box_object_index;
                    p_fragment_object_definition^.display_attribute :=
                          p_text_box_object_definition^.display_attribute;
                    IF p_last_fragment <> NIL THEN
                      p_last_fragment^.next_fragment_object_index := fragment_object_index;
                    ELSE
                      p_text_box_object_definition^.constant_box_fragment_index := fragment_object_index;
                    IFEND;
                    IF current_height = p_text_box_object_definition^.constant_box_height THEN
                      p_fragment_object_definition^.next_fragment_object_index := 0;
                      EXIT /find_constant_fragments/;
                    IFEND;
                    current_height := current_height + 1;
                    text_box_y_position := text_box_y_position + 1;
                    p_last_fragment := p_fragment_object_definition;
                  IFEND;
                IFEND;
              IFEND;
            FOREND /find_constant_fragments/;
          IFEND;

        = fdc$form_variable_text_box =
          IF p_text_box_object_definition^.variable_box_height = 1 THEN
            p_text_box_object_definition^.variable_box_fragment_index := 0;

          ELSE
            text_box_x_position := p_text_box_object_definition^.x_position;
            current_height := 2;
            text_box_y_position := p_text_box_object_definition^.y_position + 1;
            p_last_fragment := NIL;

          /find_variable_fragments/
            FOR fragment_object_index := text_box_object_index + 1 TO number_objects DO
              p_fragment_object_definition := ^p_form_object_definitions^ [fragment_object_index];
              IF p_fragment_object_definition^.key = fdc$form_text_box_fragment THEN
                IF p_fragment_object_definition^.x_position = text_box_x_position THEN
                  IF p_fragment_object_definition^.y_position = text_box_y_position THEN
                    p_fragment_object_definition^.parent_text_box_object_index := text_box_object_index;
                    p_fragment_object_definition^.display_attribute :=
                          p_text_box_object_definition^.display_attribute;
                    IF p_last_fragment <> NIL THEN
                      p_last_fragment^.next_fragment_object_index := fragment_object_index;
                    ELSE
                      p_text_box_object_definition^.variable_box_fragment_index := fragment_object_index;
                    IFEND;
                    IF current_height = p_text_box_object_definition^.variable_box_height THEN
                      p_fragment_object_definition^.next_fragment_object_index := 0;
                      EXIT /find_variable_fragments/;
                    IFEND;
                    current_height := current_height + 1;
                    text_box_y_position := text_box_y_position + 1;
                    p_last_fragment := p_fragment_object_definition;
                  IFEND;
                IFEND;
              IFEND;
            FOREND /find_variable_fragments/;
          IFEND;
        ELSE
        CASEND;
      FOREND /find_text_boxes/;
    PROCEND link_text_boxes;

?? OLDTITLE ??
?? NEWTITLE := 'link_tables', EJECT ??

    PROCEDURE link_tables;

      VAR
        display_attribute_set: fdt$display_attribute_set,
        io_mode: fdt$io_mode,
        name_exists: boolean,
        object_index: fdt$object_index,
        object_width: integer,
        occurrence_exists: boolean,
        occurrence: fdt$occurrence,
        p_error_bad_table_object: ^fdt$error_unequal_tbl_obj_width,
        p_error_header: ^fdt$error_header,
        p_error_no_table_variable: ^fdt$error_no_table_variable,
        p_error_no_variable_object: ^fdt$error_no_variable_object,
        p_form_object_definition: ^fdt$form_object_definition,
        p_form_table_definition: ^fdt$form_table_definition,
        p_form_variable_definition: ^fdt$form_variable_definition,
        p_table_objects: ^array [1 .. * ] of fdt$table_object,
        p_table_variables: ^array [1 .. * ] of fdt$table_variable,
        p_table_variable: ^fdt$table_variable,
        stored_occurrence: fdt$occurrence,
        table_index: fdt$table_index,
        table_variable_index: fdt$table_variable_index,
        variable_index: fdt$variable_index,
        visible_occurrence: fdt$occurrence;

{ Link tables to variable definitions and form image objects. Linking makes processing
{ during terminal user interaction with the form very efficient.  No searching is needed.
{ Check that all required variable definitions have been made.
{ Set default values for attributes not specified by the user.

      FOR variable_index := 1 TO p_form_definition^.form_variable_definitions.active_number DO
        p_form_variable_definition := ^p_form_variable_definitions^ [variable_index];
        p_form_variable_definition^.object_exists := FALSE;
        p_form_variable_definition^.table_exists := FALSE;
      FOREND;

    /link_table_variables/
      FOR table_index := 1 TO p_form_definition^.form_table_definitions.active_number DO
        p_form_table_definition := ^p_form_table_definitions^ [table_index];

        IF NOT p_form_table_definition^.visible_occurrence_defined THEN
          p_form_table_definition^.visible_occurrence := p_form_table_definition^.stored_occurrence;
        IFEND;

        visible_occurrence := p_form_table_definition^.visible_occurrence;
        stored_occurrence := p_form_table_definition^.stored_occurrence;
        p_form_table_definition^.valid := TRUE;
        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_status^.p_form_module);
        IF p_table_variables = NIL THEN

{ No variable definitions exist for the table.

          IF p_errors <> NIL THEN
            NEXT p_error_header IN p_errors;
            IF p_error_header <> NIL THEN
              p_error_header^.key := fdc$no_table_variable;
              NEXT p_error_no_table_variable IN p_errors;
              IF p_error_no_table_variable <> NIL THEN
                p_error_no_table_variable^.table_name := p_form_table_definition^.name;
                p_error_no_table_variable^.variable_name := osc$null_name;
              IFEND;
            IFEND;
          IFEND;
          number_errors := number_errors + 1;
          p_form_table_definition^.valid := FALSE;
          CYCLE /link_table_variables/;
        IFEND;

      /find_table_variables/
        FOR table_variable_index := 1 TO p_form_table_definition^.table_variables.active_number DO
          p_table_variable := ^p_table_variables^ [table_variable_index];
          object_width := 0;

{ A variable definition must exist for a variable belonging to a table.

          fdp$find_variable_definition (p_table_variable^.name, p_form_variable_definitions, number_variables,
                p_form_variable_definition, variable_index, name_exists);
          IF NOT name_exists THEN

{ The variable definition does not exist for the  table.

            IF p_errors <> NIL THEN
              NEXT p_error_header IN p_errors;
              IF p_error_header <> NIL THEN
                p_error_header^.key := fdc$no_table_variable;
                NEXT p_error_no_table_variable IN p_errors;
                IF p_error_no_table_variable <> NIL THEN
                  p_error_no_table_variable^.table_name := p_form_table_definition^.name;
                  p_error_no_table_variable^.variable_name := p_table_variable^.name;
                IFEND;
              IFEND;
            IFEND;
            number_errors := number_errors + 1;
            p_form_table_definition^.valid := FALSE;
            CYCLE /find_table_variables/;
          IFEND;

          p_table_variable^.variable_exists := TRUE;
          p_table_variable^.variable_index := variable_index;
          p_form_variable_definition^.table_exists := TRUE;
          p_form_variable_definition^.table_index := table_index;
          io_mode := p_form_variable_definition^.io_mode;
          p_form_variable_definition^.valid := TRUE;
          create_variable_error (p_form_variable_definition);

{ Allocate space for occurrences of variable objects.

          NEXT p_table_objects: [1 .. stored_occurrence] IN p_form_status^.p_form_module;
          fdp$rel_table_objects (p_table_objects, p_form_module, p_table_variable^.table_objects);
          p_table_variable^.table_objects.active_number := stored_occurrence;
          IF p_table_objects = NIL THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
            RETURN;
          IFEND;

          FOR occurrence := 1 TO stored_occurrence DO
            p_table_objects^ [occurrence].object_exists := FALSE;
            p_table_objects^ [occurrence].object_index := 1;
          FOREND;

{ A variable that is used for input/output to the terminal screen must have
{ an associated object on the form image.

          IF io_mode <> fdc$program_input_output THEN

          /link_variable_occurrences/
            FOR occurrence := 1 TO visible_occurrence DO
              fdp$find_object_definition (p_table_variable^.name, occurrence, p_form_object_definitions,
                    number_objects, p_form_object_definition, object_index, name_exists, occurrence_exists);
              IF (name_exists AND occurrence_exists) THEN
                CASE p_form_object_definition^.key OF

                = fdc$form_variable_text =
                  p_table_objects^ [occurrence].object_exists := TRUE;
                  p_table_objects^ [occurrence].object_index := object_index;
                  p_form_object_definition^.text_variable_exists := TRUE;
                  p_form_object_definition^.text_variable_index := variable_index;
                  p_form_variable_definition^.screen_variable_length :=
                        p_form_object_definition^.text_variable_width;
                  IF (object_width = 0) THEN { First object_definition for this variable.
                    object_width := p_form_object_definition^.text_variable_width;
                  ELSE
                    IF (object_width <> p_form_object_definition^.text_variable_width) THEN

{ All objects for a table variable must have the same width.

                      IF p_errors <> NIL THEN
                        NEXT p_error_header IN p_errors;
                        IF p_error_header <> NIL THEN
                          p_error_header^.key := fdc$unequal_tbl_obj_width;
                          NEXT p_error_bad_table_object IN p_errors;
                          IF p_error_bad_table_object <> NIL THEN
                            p_error_bad_table_object^.table_name := p_form_table_definition^.name;
                            p_error_bad_table_object^.variable_name := p_table_variable^.name;
                            p_error_bad_table_object^.occurrence := occurrence;
                          IFEND;
                        IFEND;
                      IFEND;
                      number_errors := number_errors + 1;
                      p_form_table_definition^.valid := FALSE;
                      CYCLE /link_variable_occurrences/;
                    IFEND;
                  IFEND;

                  create_variable_format (p_form_variable_definition, p_form_module);
                  create_variable_display (io_mode, p_form_object_definition^.display_attribute);

                = fdc$form_variable_text_box =
                  p_table_objects^ [occurrence].object_exists := TRUE;
                  p_table_objects^ [occurrence].object_index := object_index;
                  p_form_object_definition^.variable_box_variable_exists := TRUE;
                  p_form_object_definition^.variable_box_variable_index := variable_index;
                  p_form_variable_definition^.screen_variable_length :=
                        p_form_object_definition^.variable_box_width *
                        p_form_object_definition^.variable_box_height;

                  create_variable_format (p_form_variable_definition, p_form_module);
                  create_variable_display (io_mode, p_form_object_definition^.display_attribute);

                = fdc$form_box, fdc$form_line, fdc$form_constant_text, fdc$form_constant_text_box,
                      fdc$form_table =
                  IF p_errors <> NIL THEN
                    NEXT p_error_header IN p_errors;
                    IF p_error_header <> NIL THEN
                      p_error_header^.key := fdc$no_variable_object;
                      NEXT p_error_no_variable_object IN p_errors;
                      IF p_error_no_variable_object <> NIL THEN
                        p_error_no_variable_object^.variable_name := p_form_variable_definition^.name;
                        p_error_no_variable_object^.occurrence := occurrence;
                      IFEND;
                    IFEND;
                  IFEND;
                  number_errors := number_errors + 1;
                  p_form_table_definition^.valid := FALSE;
                  p_form_variable_definition^.valid := FALSE;

                ELSE
                CASEND;

              ELSE

{ The variable does not have a matching image object.

                IF p_errors <> NIL THEN
                  NEXT p_error_header IN p_errors;
                  IF p_error_header <> NIL THEN
                    p_error_header^.key := fdc$no_variable_object;
                    NEXT p_error_no_variable_object IN p_errors;
                    IF p_error_no_variable_object <> NIL THEN
                      p_error_no_variable_object^.variable_name := p_form_variable_definition^.name;
                      p_error_no_variable_object^.occurrence := occurrence;
                    IFEND;
                  IFEND;
                IFEND;
                number_errors := number_errors + 1;
                p_form_table_definition^.valid := FALSE;
                p_form_variable_definition^.valid := FALSE;
              IFEND;
            FOREND /link_variable_occurrences/;

{ Link stored objects.

          /link_stored_occurrences/
            FOR occurrence := visible_occurrence + 1 TO stored_occurrence DO
              fdp$find_object_definition (p_table_variable^.name, occurrence, p_form_object_definitions,
                    number_objects, p_form_object_definition, object_index, name_exists, occurrence_exists);
              IF (name_exists AND occurrence_exists) THEN
                CASE p_form_object_definition^.key OF

                = fdc$form_stored_variable =
                  p_table_objects^ [occurrence].object_exists := TRUE;
                  p_table_objects^ [occurrence].object_index := object_index;
                  p_form_object_definition^.stored_variable_exists := TRUE;
                  p_form_object_definition^.stored_variable_index := variable_index;
                  create_variable_display (io_mode, p_form_object_definition^.display_attribute);

                ELSE

{ Invalid object.

                  IF p_errors <> NIL THEN
                    NEXT p_error_header IN p_errors;
                    IF p_error_header <> NIL THEN
                      p_error_header^.key := fdc$no_variable_object;
                      NEXT p_error_no_variable_object IN p_errors;
                      IF p_error_no_variable_object <> NIL THEN
                        p_error_no_variable_object^.variable_name := p_form_variable_definition^.name;
                        p_error_no_variable_object^.occurrence := occurrence;
                      IFEND;
                    IFEND;
                  IFEND;

                  number_errors := number_errors + 1;
                  p_form_table_definition^.valid := FALSE;
                  p_form_variable_definition^.valid := FALSE;
                CASEND;
              IFEND;
            FOREND /link_stored_occurrences/;
          IFEND;
        FOREND /find_table_variables/;
      FOREND /link_table_variables/;
    PROCEND link_tables;

?? OLDTITLE ??
?? NEWTITLE := 'link_variables', EJECT ??

    PROCEDURE link_variables;

      VAR
        display_attribute_set: fdt$display_attribute_set,
        io_mode: fdt$io_mode,
        name_exists: boolean,
        object_index: fdt$object_index,
        occurrence: fdt$occurrence,
        occurrence_exists: boolean,
        p_error_header: ^fdt$error_header,
        p_error_no_variable_object: ^fdt$error_no_variable_object,
        p_form_variable_definition: ^fdt$form_variable_definition,
        variable_index: fdt$variable_index;

    /process_variables/
      FOR variable_index := 1 TO number_variables DO
        p_form_variable_definition := ^p_form_variable_definitions^ [variable_index];

{ Variables belonging to a table are processed already.

        IF p_form_variable_definition^.table_exists THEN
          CYCLE /process_variables/;
        IFEND;

        io_mode := p_form_variable_definition^.io_mode;
        p_form_variable_definition^.valid := TRUE;
        create_variable_error (p_form_variable_definition);

{ A variable that does input/output to a terminal screen must have  a
{ a form image object.

        IF io_mode <> fdc$program_input_output THEN
          fdp$find_object_definition (p_form_variable_definition^.name, 1, p_form_object_definitions,
                number_objects, p_form_object_definition, object_index, name_exists, occurrence_exists);
          IF (name_exists AND occurrence_exists) THEN
            CASE p_form_object_definition^.key OF

            = fdc$form_variable_text =
              p_form_object_definition^.text_variable_exists := TRUE;
              p_form_object_definition^.text_variable_index := variable_index;
              p_form_variable_definition^.object_exists := TRUE;
              p_form_variable_definition^.object_index := object_index;
              p_form_variable_definition^.screen_variable_length :=
                    p_form_object_definition^.text_variable_width;
              create_variable_format (p_form_variable_definition, p_form_module);
              create_variable_display (io_mode, p_form_object_definition^.display_attribute);

            = fdc$form_variable_text_box =
              p_form_object_definition^.variable_box_variable_exists := TRUE;
              p_form_object_definition^.variable_box_variable_index := variable_index;
              p_form_variable_definition^.object_exists := TRUE;
              p_form_variable_definition^.object_index := object_index;
              p_form_variable_definition^.screen_variable_length :=
                    p_form_object_definition^.variable_box_width *
                    p_form_object_definition^.variable_box_height;
              create_variable_format (p_form_variable_definition, p_form_module);
              create_variable_display (io_mode, p_form_object_definition^.display_attribute);

            = fdc$form_box, fdc$form_line, fdc$form_constant_text, fdc$form_constant_text_box,
                  fdc$form_table =

{ These objects cannot have a variable definition.

              IF p_errors <> NIL THEN
                NEXT p_error_header IN p_errors;
                IF p_error_header <> NIL THEN
                  p_error_header^.key := fdc$no_variable_object;
                  NEXT p_error_no_variable_object IN p_errors;
                  IF p_error_no_variable_object <> NIL THEN
                    p_error_no_variable_object^.variable_name := p_form_variable_definition^.name;
                    p_error_no_variable_object^.occurrence := 1;
                  IFEND;
                IFEND;
              IFEND;
              number_errors := number_errors + 1;
              p_form_variable_definition^.valid := FALSE;

            ELSE
            CASEND;

          ELSE

{ The variable does not have a matching object.

            IF p_errors <> NIL THEN
              NEXT p_error_header IN p_errors;
              IF p_error_header <> NIL THEN
                p_error_header^.key := fdc$no_variable_object;
                NEXT p_error_no_variable_object IN p_errors;
                IF p_error_no_variable_object <> NIL THEN
                  p_error_no_variable_object^.variable_name := p_form_variable_definition^.name;
                  p_error_no_variable_object^.occurrence := 1;
                IFEND;
              IFEND;
            IFEND;
            number_errors := number_errors + 1;
            p_form_variable_definition^.valid := FALSE;
          IFEND;
        IFEND;
      FOREND /process_variables/;
    PROCEND link_variables;

?? OLDTITLE ??
?? NEWTITLE := 'sort_events', EJECT ??

    PROCEDURE sort_events;

      TYPE
        fdt$event_sort_array = array [fdc$next .. fdc$variable_trigger] of fdt$event_sort_record,
        fdt$event_sort_record = record
          event_exists: boolean,
          event_definition: fdt$event_definition,
        recend;

      VAR
        event_index: fdt$event_index,
        event_priorities: [READ] array [fdc$next .. fdc$variable_trigger] of fdt$event_trigger :=
              [fdc$next, fdc$shift_next, fdc$help, fdc$shift_help, fdc$stop, fdc$shift_stop, fdc$back,
              fdc$shift_back, fdc$up, fdc$shift_up, fdc$down, fdc$shift_down, fdc$forward, fdc$shift_forward,
              fdc$backward, fdc$shift_backward, fdc$undo, fdc$redo, fdc$quit, fdc$exit, fdc$first, fdc$last,
              fdc$edit, fdc$shift_edit, fdc$data, fdc$shift_data, fdc$function_1, fdc$shift_function_1,
              fdc$function_2, fdc$shift_function_2, fdc$function_3, fdc$shift_function_3, fdc$function_4,
              fdc$shift_function_4, fdc$function_5, fdc$shift_function_5, fdc$function_6,
              fdc$shift_function_6, fdc$function_7, fdc$shift_function_7, fdc$function_8,
              fdc$shift_function_8, fdc$function_9, fdc$shift_function_9, fdc$function_10,
              fdc$shift_function_10, fdc$function_11, fdc$shift_function_11, fdc$function_12,
              fdc$shift_function_12, fdc$function_13, fdc$shift_function_13, fdc$function_14,
              fdc$shift_function_14, fdc$function_15, fdc$shift_function_15, fdc$function_16,
              fdc$shift_function_16, fdc$pick, fdc$insert_line, fdc$delete_line, fdc$home_cursor,
              fdc$clear_screen, fdc$time_out, fdc$variable_trigger],

        event_priority: fdt$event_trigger,
        event_priority_index: fdt$event_trigger,
        event_trigger: fdt$event_trigger,
        p_event_definitions: ^array [1 .. * ] of fdt$event_definition,
        p_event_sort_array: ^fdt$event_sort_array;

{ Sort events in the order that they should be assigned when the form is opened.

      PUSH p_event_sort_array;
      FOR event_trigger := LOWERVALUE (fdt$event_trigger) TO UPPERVALUE (fdt$event_trigger) DO
        p_event_sort_array^ [event_trigger].event_exists := FALSE;
      FOREND;

      p_event_definitions := p_form_status^.p_event_definitions;

    /assign_event_priority/
      FOR event_index := 1 TO p_form_definition^.event_definitions.active_number DO
        event_trigger := p_event_definitions^ [event_index].event_trigger;
        FOR event_priority_index := LOWERVALUE (fdt$event_trigger) TO UPPERVALUE (fdt$event_trigger) DO
          IF event_priorities [event_priority_index] = event_trigger THEN
            event_priority := event_priorities [event_priority_index];
            p_event_sort_array^ [event_priority_index].event_definition := p_event_definitions^ [event_index];
            p_event_sort_array^ [event_priority_index].event_exists := TRUE;
            CYCLE /assign_event_priority/;
          IFEND;
        FOREND;
      FOREND /assign_event_priority/;

      event_index := 1;
      FOR event_trigger := LOWERVALUE (fdt$event_trigger) TO UPPERVALUE (fdt$event_trigger) DO
        IF p_event_sort_array^ [event_trigger].event_exists THEN
          p_event_definitions^ [event_index] := p_event_sort_array^ [event_trigger].event_definition;
          event_index := event_index + 1;
        IFEND;
      FOREND;
    PROCEND sort_events;

?? OLDTITLE ??
?? NEWTITLE := 'sort_objects', EJECT ??

    PROCEDURE sort_objects;

      VAR
        form_object_definition: fdt$form_object_definition,
        least_object_index: fdt$object_index,
        new_object_index: fdt$object_index,
        next_object_index: fdt$object_index,
        object_index: fdt$object_index,
        p_form_object_definition: ^fdt$form_object_definition,
        x_position: fdt$x_position,
        y_position: fdt$y_position;

{ Sort objects to make object display and tabbing
{ efficient during terminal user interaction with the form efficient.
{ Use a simple shell sort.

      new_object_index := 0;

    /choose_next_object/
      FOR object_index := 1 TO number_objects DO
        p_form_object_definition := ^p_form_object_definitions^ [object_index];
        CASE p_form_object_definition^.key OF

        = fdc$form_unused_object =
          CYCLE /choose_next_object/;

        = fdc$form_stored_variable =
          new_object_index := new_object_index + 1;
          p_form_object_definitions^ [object_index].stored_variable_exists := FALSE;
          p_form_object_definitions^ [new_object_index] := p_form_object_definitions^ [object_index];
          CYCLE /choose_next_object/;

        = fdc$form_variable_text =
          p_form_object_definitions^ [object_index].text_variable_exists := FALSE;

        = fdc$form_variable_text_box =
          p_form_object_definitions^ [object_index].variable_box_variable_exists := FALSE;

        ELSE { Other objects do not need to have variable exists set false.
        CASEND;

        y_position := p_form_object_definition^.y_position;
        x_position := p_form_object_definition^.x_position;
        least_object_index := object_index;

      /find_smallest_position/
        FOR next_object_index := object_index + 1 TO number_objects DO
          p_form_object_definition := ^p_form_object_definitions^ [next_object_index];
          CASE p_form_object_definition^.key OF

          = fdc$form_unused_object, fdc$form_stored_variable =

          ELSE
            IF p_form_object_definition^.y_position = y_position THEN
              IF p_form_object_definition^.x_position < x_position THEN
                x_position := p_form_object_definition^.x_position;
                least_object_index := next_object_index;
              IFEND;

            ELSEIF p_form_object_definition^.y_position < y_position THEN
              y_position := p_form_object_definition^.y_position;
              x_position := p_form_object_definition^.x_position;
              least_object_index := next_object_index;
            IFEND;
          CASEND;
        FOREND /find_smallest_position/;

        IF least_object_index <> object_index THEN
          form_object_definition := p_form_object_definitions^ [object_index];
          p_form_object_definitions^ [object_index] := p_form_object_definitions^ [least_object_index];
          p_form_object_definitions^ [least_object_index] := form_object_definition;
        IFEND;
        new_object_index := new_object_index + 1;
        p_form_object_definitions^ [new_object_index] := p_form_object_definitions^ [object_index];
      FOREND /choose_next_object/;
      number_objects := new_object_index;
    PROCEND sort_objects;

?? OLDTITLE ??
?? NEWTITLE := 'sort_record', EJECT ??


{ Purpose : Sort the various form_record components after creating the
{           form and before linking tables and variables.
{ Technique : the procedure sorts 3 different elements.
{             1) Form_variable_definitions are sorted
{                according to type (in the following order : integers,
{                reals, strings), and each type is sorted according to
{                variable name.
{             2) Form_table_definitions are sorted according to table name.
{             3) Table_variables are sorted according to type (in the
{                mentioned above order) and according to variable name
{                within each type.

    PROCEDURE sort_record;

      VAR
        base: integer,
        i: integer,
        j: integer,
        limit: integer,
        name_exists: boolean,
        num_int_vars: fdt$number_variables,
        num_real_vars: fdt$number_variables,
        num_string_vars: fdt$number_variables,
        num_tables: fdt$number_tables,
        num_tbl_vars: fdt$number_variables,
        num_vars: fdt$number_variables,
        p_form_table_definition: ^fdt$form_table_definition,
        p_form_variable_definition: ^fdt$form_variable_definition,
        p_table_variable: ^fdt$table_variable,
        p_table_variables: ^array [1 .. * ] of fdt$table_variable,
        p_vec_tbl_int: ^array [1 .. * ] of fdt$table_variable,
        p_vec_tbl_real: ^array [1 .. * ] of fdt$table_variable,
        p_vec_tbl_str: ^array [1 .. * ] of fdt$table_variable,
        p_vec_int_vars: ^array [1 .. * ] of fdt$form_variable_definition,
        p_vec_real_vars: ^array [1 .. * ] of fdt$form_variable_definition,
        p_vec_str_vars: ^array [1 .. * ] of fdt$form_variable_definition,
        program_data_type: fdt$program_data_type,
        table_index: fdt$table_index,
        table_variable_index: fdt$variable_index,
        temp_form_table_definition: fdt$form_table_definition,
        temp_table_variable: fdt$table_variable,
        temp_form_variable_definition: fdt$form_variable_definition,
        variable_index: fdt$variable_index;

{ Sort variable definitions according to variable name.

      PROCEDURE sort_variable_definitions
        (    p_vec: ^array [1 .. * ] of fdt$form_variable_definition;
             num_vars: fdt$number_variables);

        VAR
          temp: fdt$form_variable_definition;

        limit := num_vars;
        FOR j := 1 TO (num_vars - 1) DO
          limit := limit - 1;
          FOR i := 1 TO limit DO
            IF p_vec^ [i].name > p_vec^ [i + 1].name THEN
              temp := p_vec^ [i];
              p_vec^ [i] := p_vec^ [i + 1];
              p_vec^ [i + 1] := temp;
            IFEND;
          FOREND;
        FOREND;
        RETURN;
      PROCEND sort_variable_definitions;

{ Sort table definitions by table name.

      PROCEDURE sort_table_definitions
        (    p_vec: ^array [1 .. * ] of fdt$form_table_definition;
             num_tables: fdt$number_tables);

        VAR
          temp: fdt$form_table_definition;

        limit := num_tables;
        FOR j := 1 TO (num_tables - 1) DO
          limit := limit - 1;
          FOR i := 1 TO limit DO
            IF p_vec^ [i].name > p_vec^ [i + 1].name THEN
              temp := p_vec^ [i];
              p_vec^ [i] := p_vec^ [i + 1];
              p_vec^ [i + 1] := temp;
            IFEND;
          FOREND;
        FOREND;
        RETURN;
      PROCEND sort_table_definitions;

{ Sort table variables by variable name.

      PROCEDURE sort_table_variables
        (    p_vec: ^array [1 .. * ] of fdt$table_variable;
             num_vars: fdt$number_variables);

        VAR
          temp: fdt$table_variable;

        limit := num_vars;
        FOR j := 1 TO (num_vars - 1) DO
          limit := limit - 1;
          FOR i := 1 TO limit DO
            IF p_vec^ [i].name > p_vec^ [i + 1].name THEN
              temp := p_vec^ [i];
              p_vec^ [i] := p_vec^ [i + 1];
              p_vec^ [i + 1] := temp;
            IFEND;
          FOREND;
        FOREND;
        RETURN;
      PROCEND sort_table_variables;

      num_int_vars := 0;
      num_real_vars := 0;
      num_string_vars := 0;
      num_tables := p_form_definition^.form_table_definitions.active_number;
      num_vars := p_form_definition^.form_variable_definitions.active_number;
      IF (num_vars = 0) THEN
        RETURN;
      IFEND;

      PUSH p_vec_int_vars: [1 .. num_vars];
      PUSH p_vec_real_vars: [1 .. num_vars];
      PUSH p_vec_str_vars: [1 .. num_vars];

{ Sort variables.

      FOR variable_index := 1 TO num_vars DO
        p_form_variable_definition := ^p_form_variable_definitions^ [variable_index];

{ Sort variables into three groups.
{ 1) Integer variables
{ 2) Real variables
{ 3) String variables

        get_compatible_data_type (p_form_variable_definition, p_form_module, program_data_type);
        CASE program_data_type OF

        = fdc$program_integer_type =
          num_int_vars := num_int_vars + 1;
          p_vec_int_vars^ [num_int_vars] := p_form_variable_definition^;

        = fdc$program_real_type =
          num_real_vars := num_real_vars + 1;
          p_vec_real_vars^ [num_real_vars] := p_form_variable_definition^;

        ELSE {fdc$program_character_type, fdc$program_upper_case_type
          num_string_vars := num_string_vars + 1;
          p_vec_str_vars^ [num_string_vars] := p_form_variable_definition^;

        CASEND;
      FOREND;

{ Sort variables according to name.

      IF (num_int_vars > 1) THEN
        sort_variable_definitions (p_vec_int_vars, num_int_vars);
      IFEND;
      IF (num_real_vars > 1) THEN
        sort_variable_definitions (p_vec_real_vars, num_real_vars);
      IFEND;
      IF (num_string_vars > 1) THEN
        sort_variable_definitions (p_vec_str_vars, num_string_vars);
      IFEND;

{ Move the sorted variables back into the variable definition array.

      base := 0;

      i := 1;
      FOR variable_index := (base + 1) TO (base + num_int_vars) DO
        p_form_variable_definitions^ [variable_index] := p_vec_int_vars^ [i];
        i := i + 1;
      FOREND;
      base := base + num_int_vars;
      i := 1;
      FOR variable_index := (base + 1) TO (base + num_real_vars) DO
        p_form_variable_definitions^ [variable_index] := p_vec_real_vars^ [i];
        i := i + 1;
      FOREND;
      base := base + num_real_vars;
      i := 1;
      FOR variable_index := (base + 1) TO num_vars DO
        p_form_variable_definitions^ [variable_index] := p_vec_str_vars^ [i];
        i := i + 1;
      FOREND;

{ Sort tables.

      IF (num_tables = 0) THEN
        RETURN;
      IFEND;
      IF (num_tables > 1) THEN
        sort_table_definitions (p_form_table_definitions, num_tables);
      IFEND;

{ Sort table variables.
{ For each table, the variables are sorted into groups according to
{ variable type and variable name.

      PUSH p_vec_tbl_int: [1 .. num_vars];
      PUSH p_vec_tbl_real: [1 .. num_vars];
      PUSH p_vec_tbl_str: [1 .. num_vars];

    /table_loop/
      FOR table_index := 1 TO num_tables DO
        p_form_table_definition := ^p_form_table_definitions^ [table_index];
        num_tbl_vars := p_form_table_definition^.table_variables.active_number;
        IF (num_tbl_vars < 2) THEN
          CYCLE /table_loop/;
        IFEND;
        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_module);
        num_int_vars := 0;
        num_real_vars := 0;
        num_string_vars := 0;
        FOR table_variable_index := 1 TO num_tbl_vars DO
          p_table_variable := ^p_table_variables^ [table_variable_index];
          fdp$find_variable_definition (p_table_variable^.name, p_form_variable_definitions, num_vars,
                p_form_variable_definition, variable_index, name_exists);
          IF NOT name_exists THEN

{ The user did not specify a variable definition.  The record cannot be sorted.

            RETURN;
          IFEND;

{ Sort table variables according to data type.

          get_compatible_data_type (p_form_variable_definition, p_form_module, program_data_type);
          CASE program_data_type OF

          = fdc$program_integer_type =
            num_int_vars := num_int_vars + 1;
            p_vec_tbl_int^ [num_int_vars] := p_table_variable^;

          = fdc$program_real_type =
            num_real_vars := num_real_vars + 1;
            p_vec_tbl_real^ [num_real_vars] := p_table_variable^;

          ELSE {fdc$program_character_type, fdc$program_upper_case_type
            num_string_vars := num_string_vars + 1;
            p_vec_tbl_str^ [num_string_vars] := p_table_variable^;

          CASEND;
        FOREND;

{ Sort table variables according to variable name.

        IF (num_int_vars > 1) THEN
          sort_table_variables (p_vec_tbl_int, num_int_vars);
        IFEND;
        IF (num_real_vars > 1) THEN
          sort_table_variables (p_vec_tbl_real, num_real_vars);
        IFEND;
        IF (num_string_vars > 1) THEN
          sort_table_variables (p_vec_tbl_str, num_string_vars);
        IFEND;

{ Move sorted table variables back to the table variables array.

        base := 0;
        i := 1;
        FOR table_variable_index := (base + 1) TO (base + num_int_vars) DO
          p_table_variables^ [table_variable_index] := p_vec_tbl_int^ [i];
          i := i + 1;
        FOREND;
        base := base + num_int_vars;
        i := 1;
        FOR table_variable_index := (base + 1) TO (base + num_real_vars) DO
          p_table_variables^ [table_variable_index] := p_vec_tbl_real^ [i];
          i := i + 1;
        FOREND;
        base := base + num_real_vars;
        i := 1;
        FOR table_variable_index := (base + 1) TO (base + num_string_vars) DO
          p_table_variables^ [table_variable_index] := p_vec_tbl_str^ [i];
          i := i + 1;
        FOREND;
      FOREND /table_loop/;
      RETURN;
    PROCEND sort_record;

?? OLDTITLE ??
?? NEWTITLE := 'validate_variable_values', EJECT ??
    PROCEDURE validate_variable_values;

    VAR
      p_base_text: ^fdt$text,
      p_form_table_definition: ^fdt$form_table_definition,
      p_form_variable_definition: ^fdt$form_variable_definition,
      p_table_object: ^fdt$table_object,
      p_table_objects: ^array [1 .. *] of fdt$table_object,
      p_table_variable: ^fdt$table_variable,
      p_table_variables: ^array [1 .. *] of fdt$table_variable,
      table_index: fdt$table_index,
      table_object_index: fdt$object_index,
      table_variable_index: fdt$table_variable_index,
      variable_index: fdt$variable_index;

?? NEWTITLE := 'validate_object' ??

   PROCEDURE validate_object;

      VAR
        ignore_date_time: clt$date_time,
        integer_number: integer,
        p_error_header: ^fdt$error_header,
        p_error_input_conversion: ^fdt$error_input_conversion,
        p_error_output_conversion: ^fdt$error_output_conversion,
        p_error_invalid_value: ^fdt$error_invalid_value,
        p_program_variable: ^array [1 .. *] OF cell,
        p_screen_variable: ^fdt$text,
        p_text: ^fdt$text,
        p_valid_string: ^fdt$valid_string,
        program_data_type: fdt$program_data_type,
        program_variable_length: fdt$program_variable_length,
        real_number: real,
        screen_variable_length: fdt$text_length,
        variable_status: fdt$variable_status;

        CASE p_form_object_definition^.key OF

        = fdc$form_variable_text =
          p_text := fdp$ptr_text (p_form_object_definition^.text_variable_text,
                p_form_module);

        = fdc$form_variable_text_box =
          p_text := fdp$ptr_text (p_form_object_definition^.
                variable_box_text, p_form_module);

        = fdc$form_stored_variable =
          p_text := fdp$ptr_text (p_form_object_definition^.
                stored_variable_text, p_form_module);

        ELSE
          RETURN;
        CASEND;

        IF ((p_base_text <> NIL) AND (p_text^ = p_base_text^)) THEN
          RETURN;
        IFEND;

        p_base_text := p_text;

{ Validate that input and output formatting work for initial value of object.

        program_data_type := p_form_variable_definition^.program_data_type;
        program_variable_length := p_form_variable_definition^.program_variable_length;
        screen_variable_length := p_form_variable_definition^.screen_variable_length;
        PUSH p_program_variable: [1 .. program_variable_length];
        PUSH p_screen_variable: [screen_variable_length];
        p_screen_variable^ := p_text^;
        fdp$move_to_program_variable (p_form_status, p_form_variable_definition,
              p_screen_variable, p_program_variable, variable_status, status);
        IF (NOT status.normal OR (variable_status <> fdc$no_error)) THEN
          number_errors := number_errors + 1;
          p_form_variable_definition^.valid := FALSE;
          IF p_errors <> NIL THEN
            NEXT p_error_header IN p_errors;
            IF p_error_header <> NIL THEN
              p_error_header^.key := fdc$error_input_conversion;
              NEXT p_error_input_conversion IN p_errors;
              IF  p_error_input_conversion <> NIL THEN
                p_error_input_conversion^.variable_name :=
                      p_form_object_definition^.name;
                p_error_input_conversion^.occurrence :=
                      p_form_object_definition^.occurrence;
              IFEND;
            IFEND;
          IFEND;
          RETURN;
        IFEND;

        fdp$move_to_screen_variable (p_form_status, p_form_variable_definition,
              p_program_variable, p_screen_variable, variable_status, status);
        IF (NOT status.normal OR (variable_status <> fdc$no_error)) THEN
          number_errors := number_errors + 1;
          p_form_variable_definition^.valid := FALSE;
          IF p_errors <> NIL THEN
            NEXT p_error_header IN p_errors;
            IF p_error_header <> NIL THEN
              p_error_header^.key := fdc$error_output_conversion;
              NEXT p_error_output_conversion IN p_errors;
              IF  p_error_output_conversion <> NIL THEN
                p_error_output_conversion^.variable_name :=
                      p_form_object_definition^.name;
                p_error_output_conversion^.occurrence :=
                      p_form_object_definition^.occurrence;
              IFEND;
            IFEND;
          IFEND;
          RETURN;
        IFEND;

{ Do not validate value for object with must enter to allow
{ entry of such values as passwords.  The application does not want to show
{ the terminal user any password on the initial display.

        IF (fdc$must_enter IN
              p_form_variable_definition^.terminal_user_entry) THEN
          RETURN;
        IFEND;

{ Check initial value against specified valid values.

        CASE program_data_type OF

        = fdc$program_character_type, fdc$program_upper_case_type =
          fdp$validate_string (p_screen_variable, program_variable_length,
                p_form_variable_definition^.valid_strings, p_form_status,
                p_valid_string, variable_status);

        = fdc$program_integer_type =
          i#move (p_program_variable, ^integer_number, fdc$integer_length);
          IF fdp$date_variable (p_form_variable_definition) THEN
            fdp$convert_yymmdd_to_date_time (integer_number, ignore_date_time, variable_status);
          ELSE
          fdp$validate_integer (integer_number,  p_form_variable_definition^.
                valid_integer_ranges, p_form_status, variable_status);
          IFEND;

        = fdc$program_real_type =
          i#move (p_program_variable, ^real_number, fdc$real_length);
          fdp$validate_real (real_number,  p_form_variable_definition^.
                valid_real_ranges, p_form_status, variable_status);

       ELSE {fdc$program_cobol_type
         fdp$validate_cobol_data (p_form_status, p_form_variable_definition,
            p_program_variable, p_valid_string, variable_status);
       CASEND;

        IF (variable_status <> fdc$no_error) THEN
          number_errors := number_errors + 1;
          p_form_variable_definition^.valid := FALSE;
          IF p_errors <> NIL THEN
            NEXT p_error_header IN p_errors;
            IF p_error_header <> NIL THEN
              p_error_header^.key := fdc$error_invalid_value;
              NEXT p_error_invalid_value IN p_errors;
              IF  p_error_invalid_value <> NIL THEN
                p_error_invalid_value^.variable_name :=
                      p_form_object_definition^.name;
                p_error_invalid_value^.occurrence :=
                      p_form_object_definition^.occurrence;
              IFEND;
            IFEND;
          IFEND;
          RETURN;
        IFEND;
    PROCEND validate_object;

?? OLDTITLE, EJECT ??

    /get_next_variable/
      FOR variable_index := 1 TO number_variables DO
        p_form_variable_definition := ^p_form_variable_definitions^ [variable_index];

        IF p_form_variable_definition^.table_exists THEN
          CYCLE /get_next_variable/;
        IFEND;

        IF NOT p_form_variable_definition^.object_exists THEN
          CYCLE /get_next_variable/;
        IFEND;

        p_form_object_definition := ^p_form_object_definitions^
              [p_form_variable_definition^.object_index];
        p_base_text := NIL;
        validate_object;
      FOREND /get_next_variable/;

      /get_next_table/
      FOR table_index := 1 TO p_form_definition^.form_table_definitions.active_number DO
        p_form_table_definition := ^p_form_table_definitions^ [table_index];
        p_table_variables := fdp$ptr_table_variables (p_form_table_definition^.table_variables,
              p_form_module);

        /get_next_table_variable/
        FOR table_variable_index := 1 TO p_form_table_definition^.
              table_variables.active_number DO
          p_table_variable := ^p_table_variables^ [table_variable_index];
          p_table_objects := fdp$ptr_table_objects (p_table_variable^.table_objects,
                p_form_module);
          IF NOT p_table_variable^.variable_exists THEN
            CYCLE /get_next_table_variable/;
          IFEND;

          p_form_variable_definition :=
                ^p_form_variable_definitions^ [p_table_variable^.variable_index];

{ Validate first object of table, then try to avoid validation of other objects
{ with the same text.

          p_table_object := ^p_table_objects^ [1];
          p_form_object_definition := ^p_form_object_definitions^
                [p_table_object^.object_index];
          p_base_text := NIL;
          validate_object;

          /get_next_object/
          FOR table_object_index := 2 TO p_form_table_definition^.stored_occurrence DO
            p_table_object := ^p_table_objects^ [table_object_index];
            IF NOT p_table_object^.object_exists THEN
              CYCLE /get_next_object/;
            IFEND;

            p_form_object_definition := ^p_form_object_definitions^
                  [p_table_object^.object_index];
            validate_object;
          FOREND /get_next_object/;
        FOREND /get_next_table_variable/;
      FOREND /get_next_table/;
    PROCEND validate_variable_values;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_change_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    number_errors := 0;
    p_errors := p_sequence;
    IF p_errors <> NIL THEN
      RESET p_errors;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    p_form_module := p_form_status^.p_form_module;
    p_form_table_definitions := p_form_status^.p_form_table_definitions;
    p_form_variable_definitions := p_form_status^.p_form_variable_definitions;

{ Create non-visible (stored objects) which the user has not created.

    create_stored_objects;

    p_form_object_definitions := p_form_status^.p_form_object_definitions;
    number_objects := p_form_definition^.form_object_definitions.active_number;
    number_variables := p_form_definition^.form_variable_definitions.active_number;

{ Sort events in order of assignment to terminal keys.

    sort_events;

{ Sort record so that changes in object locations on the form do not change the
{ record definition.

    sort_record;

{ Sort objects on form top left to bottom right.
{ This makes display and tabbing efficient during form interactions.
{ Delete unused objects.
{ Set variable definition does not yet exist.

    sort_objects;
    p_form_definition^.form_object_definitions.active_number := number_objects;

{ Link objects belonging to text boxes.

    link_text_boxes;

{ Link tables to associated variables and objects on the  form.
{ Tables are linked to their variables to make processing efficient
{ for form interaction with a terminal user.

    link_tables;

{ Link variables that do not belong to tables to objects on the form.
{ Variables are linked to their object to make processing efficient
{ for form interaction with a terminal user.

    link_variables;

{ Record variable objects that do not have a variable definition.

    IF NOT p_form_status^.fast_form_creation THEN
      check_for_dangling_objects;
    IFEND;

{ Validate that initial values of variable text objects work with defined
{ input and ouput formats and have valid values.  This is a very time
{ consuming process so do it only if the user has specified it.

    IF p_form_status^.validate_variable_values THEN
      validate_variable_values;
    IFEND;

{ Compute the terminal screen area required to contain the form.

    compute_form_area;

{ Find first input variable.  The cursor is set here when the
{ form is first displayed.

    find_first_input_position;

{ Generate the record used to communicate with the application program
{ during form interaction.

    generate_form_record;

    IF number_errors = 0 THEN
      p_form_definition^.form_has_errors := FALSE;
    IFEND;

    p_form_definition^.form_ended := TRUE;

{ Set size of sequence of errors.

    IF p_sequence <> NIL THEN
      error_size := i#current_sequence_position (p_errors);
      RESET p_errors;
      IF error_size <> 0 THEN
        NEXT p_errors: [[REP error_size OF cell]] IN p_errors;
      IFEND;
    IFEND;

{ Free storage used for checking for overlayed form objects.
{ It is not used during terminal user interaction with the form.

    IF p_form_status^.p_form_image <> NIL THEN
      FREE p_form_status^.p_form_image;
    IFEND;

  PROCEND fdp$end_form;

?? TITLE := 'fdp$get_form_attributes', EJECT ??
*copyc fdh$get_form_attributes

  PROCEDURE [XDCL] fdp$get_form_attributes
    (    form_identifier: fdt$form_identifier;
     VAR get_form_attributes: fdt$get_form_attributes;
     VAR status: ost$status);

    VAR
      comment_index: fdt$comment_index,
      current_comment_index: fdt$comment_index,
      current_comment_length_index: fdt$comment_index,
      current_display_index: fdt$display_index,
      current_event_index: fdt$event_index,
      display_index: fdt$display_index,
      event_index: fdt$event_index,
      n: fdt$form_attribute_index,
      name_is_valid: boolean,
      number_comments: fdt$number_comments,
      number_displays: fdt$number_object_displays,
      number_events: fdt$number_events,
      number_objects: fdt$number_objects,
      number_tables: fdt$number_tables,
      number_variables: fdt$number_variables,
      object_index: fdt$object_index,
      p_comment: ^fdt$comment,
      p_comment_definitions: ^array [1 .. * ] of fdt$comment_definition,
      p_comment_definition: ^fdt$comment_definition,
      p_display_definition: ^fdt$display_definition,
      p_display_definitions: ^array [1 .. * ] of fdt$display_definition,
      p_event_command: ^fdt$event_command,
      p_event_definition: ^fdt$event_definition,
      p_form_definition: ^fdt$form_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status,
      p_help_message: ^fdt$help_message,
      table_index: fdt$table_index,
      variable_index: fdt$variable_index,
      valid_name: ost$name;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_form_attributes;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_form_attributes;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);

    FOR n := LOWERBOUND (get_form_attributes) TO UPPERBOUND (get_form_attributes) DO
      get_form_attributes [n].get_value_status := fdc$unprocessed_get_value;
    FOREND;

    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    p_form_module := p_form_status^.p_form_module;
    current_event_index := 1;
    current_comment_index := 1;
    current_comment_length_index := 1;
    current_display_index := 1;

    FOR n := LOWERBOUND (get_form_attributes) TO UPPERBOUND (get_form_attributes) DO

    /process_form_attributes/
      BEGIN
        CASE get_form_attributes [n].key OF

        = fdc$get_form_display_attribute =
          get_form_attributes [n].form_display_attribute := p_form_definition^.display_attribute;
          IF (p_form_definition^.display_attribute = $fdt$display_attribute_set
                [fdc$black_background, fdc$white_foreground, fdc$protect]) THEN
            get_form_attributes [n].get_value_status := fdc$system_default_value;
          ELSE
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;

        = fdc$get_event_command =
          fdp$validate_name (get_form_attributes [n].event_command_name, p_form_definition^.processor,
                valid_name, name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_event_name,
                  get_form_attributes [n].event_command_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

        /find_event_command/
          FOR event_index := 1 TO p_form_definition^.event_definitions.active_number DO
            p_event_definition := ^p_form_status^.p_event_definitions^ [event_index];
            IF p_event_definition^.event_name = valid_name THEN
              p_event_command := fdp$ptr_event_command (p_event_definition^.command, p_form_module);
              IF p_event_command <> NIL THEN
                IF STRLENGTH (get_form_attributes [n].p_event_command^) >= STRLENGTH (p_event_command^) THEN
                  get_form_attributes [n].p_event_command^ := p_event_command^;
                  get_form_attributes [n].get_value_status := fdc$user_defined_value;
                  EXIT /process_form_attributes/;

                ELSE

{ The user did not allocate enough space for the command string.

                  osp$set_status_abnormal (fdc$format_display_identifier, fde$string_too_small, '', status);
                  RETURN;
                IFEND;

             ELSE

{ No command for event.

                get_form_attributes [n].get_value_status := fdc$undefined_value;
                EXIT /process_form_attributes/;
              IFEND;
            IFEND;
          FOREND /find_event_command/;

          osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_event_name,
                get_form_attributes [n].event_command_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name, status);
          RETURN;

        = fdc$get_event_form =
          get_form_attributes [n].event_form_definition := p_form_definition^.event_form_definition;
          CASE p_form_definition^.event_form_definition.key OF

          = fdc$user_event_form, fdc$system_default_event_form =
            get_form_attributes [n].get_value_status := fdc$user_defined_value;

          = fdc$no_event_form =
            get_form_attributes [n].get_value_status := fdc$system_default_value;


          ELSE { Invalid event key.
            osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, '', status);
            RETURN;

          CASEND;

        = fdc$get_event_form_identifier =
          IF p_form_status^.event_form_defined THEN
            get_form_attributes [n].event_form_identifier := p_form_status^.event_form_identifier;
            get_form_attributes [n].get_value_status := fdc$system_computed_value;
          ELSE
            get_form_attributes [n].get_value_status := fdc$undefined_value;
          IFEND;

        = fdc$get_form_area =
          get_form_attributes [n].form_area := p_form_definition^.form_area;
          IF p_form_definition^.form_area.key = fdc$screen_area THEN
            get_form_attributes [n].get_value_status := fdc$system_default_value;
          ELSE
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;

        = fdc$get_form_comment_length =
          get_form_attributes [n].get_value_status := fdc$undefined_value;
          p_comment_definitions := fdp$ptr_comments (p_form_definition^.comment_definitions, p_form_module);

        /find_comment_length/
          FOR comment_index := current_comment_length_index TO p_form_definition^.comment_definitions.
                active_number DO
            p_comment_definition := ^p_comment_definitions^ [comment_index];
            current_comment_length_index := comment_index + 1;
            p_comment := #PTR (p_comment_definition^.p_comment, p_form_module^);
            get_form_attributes [n].form_comment_length := STRLENGTH (p_comment^);
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
            EXIT /find_comment_length/;
          FOREND /find_comment_length/;

        = fdc$get_form_help =
          CASE p_form_definition^.help_definition.key OF

          = fdc$help_form =
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
            get_form_attributes [n].form_help.key := fdc$get_help_form;
            get_form_attributes [n].form_help.help_form := p_form_definition^.help_definition.help_form;

          = fdc$help_message =
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
            get_form_attributes [n].form_help.key := fdc$get_help_message;
            p_help_message := #PTR (p_form_definition^.help_definition.p_help_message, p_form_module^);
            get_form_attributes [n].form_help.help_message_length := STRLENGTH (p_help_message^);

          = fdc$no_help_response =
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
            get_form_attributes [n].form_help.key := fdc$get_no_help_response;

          = fdc$system_default_help =
            get_form_attributes [n].get_value_status := fdc$system_default_value;
            get_form_attributes [n].form_help.key := fdc$get_system_default_help;
            get_form_attributes [n].form_help.help_message_length := fdc$message_variable_length;

          ELSE

{ Invalid help key.

            osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, '', status);
            RETURN;

          CASEND;

        = fdc$get_form_help_message =
          CASE p_form_definition^.help_definition.key OF

          = fdc$help_form =
            get_form_attributes [n].get_value_status := fdc$undefined_value;

          = fdc$help_message =
            p_help_message := #PTR (p_form_definition^.help_definition.p_help_message, p_form_module^);
            IF STRLENGTH (get_form_attributes [n].p_form_help_message^) >= STRLENGTH (p_help_message^) THEN
              get_form_attributes [n].p_form_help_message^ := p_help_message^;
              get_form_attributes [n].get_value_status := fdc$user_defined_value;

            ELSE

{ The user's area will not hold the help message.

              osp$set_status_abnormal (fdc$format_display_identifier, fde$string_too_small, '', status);
              RETURN;
            IFEND;

          = fdc$no_help_response =
            get_form_attributes [n].get_value_status := fdc$undefined_value;

          = fdc$system_default_help =
            IF STRLENGTH (get_form_attributes [n].p_form_help_message^) >=
                  fdc$message_variable_length THEN
              fdp$get_message (fde$system_help_message,
                    get_form_attributes [n].p_form_help_message^);
              get_form_attributes [n].get_value_status := fdc$system_default_value;

            ELSE

{ The user's area will not hold the help message.

              osp$set_status_abnormal (fdc$format_display_identifier, fde$string_too_small, '', status);
              RETURN;
            IFEND;
          CASEND;

        = fdc$get_form_language =
          get_form_attributes [n].form_language := p_form_definition^.language;
          IF p_form_definition^.language = osc$default_natural_language THEN
            get_form_attributes [n].get_value_status := fdc$system_default_value;
          ELSE
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;

        = fdc$get_form_name =
          get_form_attributes [n].form_name := p_form_definition^.form_name;
          IF p_form_definition^.form_name = osc$null_name THEN
            get_form_attributes [n].get_value_status := fdc$system_default_value;
          ELSE
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;

        = fdc$get_form_processor =
          get_form_attributes [n].form_processor := p_form_definition^.processor;
          IF p_form_definition^.processor = fdc$system_form_processor THEN
            get_form_attributes [n].get_value_status := fdc$system_default_value;
          ELSE
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;

        = fdc$get_help_message_form =
          IF p_form_definition^.screen_formatting_version < fdc$message_form_capability THEN
            get_form_attributes [n].get_value_status := fdc$undefined_value;
            get_form_attributes [n].help_message_form := osc$null_name;
          ELSE
            get_form_attributes [n].help_message_form := p_form_definition^.help_message_form;
            IF p_form_definition^.help_message_form = osc$null_name THEN
              get_form_attributes [n].get_value_status := fdc$undefined_value;
            ELSE
              get_form_attributes [n].get_value_status := fdc$user_defined_value;
            IFEND;
           IFEND;

         = fdc$get_hidden_editing =
           get_form_attributes [n].hidden_editing := p_form_definition^.hidden_editing;
          IF p_form_definition^.hidden_editing THEN
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
          ELSE
            get_form_attributes [n].get_value_status := fdc$system_default_value;
          IFEND;

        = fdc$get_invalid_data_character =
          IF p_form_definition^.screen_formatting_version < fdc$im_smart_capability THEN
            get_form_attributes [n].invalid_data_character.defined := FALSE;
            get_form_attributes [n].get_value_status := fdc$system_default_value;
          ELSE
            get_form_attributes [n].invalid_data_character := p_form_definition^.invalid_data_character;
            IF p_form_definition^.invalid_data_character.defined THEN
              get_form_attributes [n].get_value_status := fdc$user_defined_value;
            ELSE
              get_form_attributes [n].get_value_status := fdc$system_default_value;
            IFEND;
          IFEND;

        = fdc$get_message_form, fdc$get_error_message_form =
          get_form_attributes [n].error_message_form := p_form_definition^.error_message_form;
          IF p_form_definition^.error_message_form = osc$null_name THEN
            get_form_attributes [n].get_value_status := fdc$undefined_value;
          ELSE
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
          IFEND;


        = fdc$get_next_event =
          get_form_attributes [n].get_value_status := fdc$undefined_value;

        /find_event/
          FOR event_index := current_event_index TO p_form_definition^.event_definitions.active_number DO
            p_event_definition := ^p_form_status^.p_event_definitions^ [event_index];
            current_event_index := event_index + 1;
            get_form_attributes [n].event_action := p_event_definition^.event_action;
            get_form_attributes [n].event_name := p_event_definition^.event_name;
            get_form_attributes [n].event_label := p_event_definition^.event_label;
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
            IF p_form_status^.p_form_event_statuses = NIL THEN
              get_form_attributes [n].event_trigger := p_event_definition^.event_trigger;
            ELSE
              IF p_form_status^.p_form_event_statuses^ [event_index].event_exists THEN
                get_form_attributes [n].event_trigger := p_form_status^.p_form_event_statuses^ [event_index].
                      event_trigger;
              ELSE
                get_form_attributes [n].get_value_status := fdc$undefined_value;
              IFEND;
            IFEND;

            p_event_command := fdp$ptr_event_command (p_event_definition^.command, p_form_module);
            IF p_event_command <> NIL THEN
              get_form_attributes [n].event_command_length := STRLENGTH (p_event_command^);
            ELSE
              get_form_attributes [n].event_command_length := 0;
            IFEND;
            EXIT /find_event/;
          FOREND /find_event/;

        = fdc$get_next_event_v1 =
          get_form_attributes [n].get_value_status := fdc$undefined_value;

        /find_event_v1/
          FOR event_index := current_event_index TO p_form_definition^.event_definitions.active_number DO
            p_event_definition := ^p_form_status^.p_event_definitions^ [event_index];
            current_event_index := event_index + 1;
            get_form_attributes [n].event_action_v1 := p_event_definition^.event_action;
            get_form_attributes [n].event_name_v1 := p_event_definition^.event_name;
            get_form_attributes [n].event_label_v1 := p_event_definition^.event_label;
            IF p_form_definition^.screen_formatting_version < fdc$reassign_event_capability THEN
              get_form_attributes [n].event_trigger_reassignment_v1 := TRUE;
            ELSE
              get_form_attributes [n].event_trigger_reassignment_v1 :=
                    p_event_definition^.event_trigger_reassignment;
            IFEND;
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
            IF p_form_status^.p_form_event_statuses = NIL THEN
              get_form_attributes [n].event_trigger_v1 := p_event_definition^.event_trigger;
            ELSE
              IF p_form_status^.p_form_event_statuses^ [event_index].event_exists THEN
                get_form_attributes [n].event_trigger_v1 :=
                      p_form_status^.p_form_event_statuses^ [event_index].event_trigger;
              ELSE
                get_form_attributes [n].get_value_status := fdc$undefined_value;
              IFEND;
            IFEND;
            p_event_command := fdp$ptr_event_command (p_event_definition^.command, p_form_module);
            IF p_event_command <> NIL THEN
              get_form_attributes [n].event_command_length_v1 := STRLENGTH (p_event_command^);
            ELSE
              get_form_attributes [n].event_command_length_v1 := 0;
            IFEND;
            EXIT /find_event_v1/;
          FOREND /find_event_v1/;

        = fdc$get_next_form_comment =
          get_form_attributes [n].get_value_status := fdc$undefined_value;
          p_comment_definitions := fdp$ptr_comments (p_form_definition^.comment_definitions, p_form_module);

        /find_comment/
          FOR comment_index := current_comment_index TO p_form_definition^.comment_definitions.
                active_number DO
            p_comment_definition := ^p_comment_definitions^ [comment_index];
            current_comment_index := comment_index + 1;
            p_comment := #PTR (p_comment_definition^.p_comment, p_form_module^);
            IF STRLENGTH (get_form_attributes [n].p_form_comment^) >= STRLENGTH (p_comment^) THEN
              get_form_attributes [n].p_form_comment^ := p_comment^;
              get_form_attributes [n].get_value_status := fdc$user_defined_value;
              EXIT /find_comment/;

            ELSE
              osp$set_status_abnormal (fdc$format_display_identifier, fde$string_too_small, '', status);
              RETURN;
            IFEND;
          FOREND /find_comment/;

        = fdc$get_next_display =
          get_form_attributes [n].get_value_status := fdc$undefined_value;
          p_display_definitions := fdp$ptr_displays (p_form_status);

        /find_display/
          FOR display_index := current_display_index TO p_form_definition^.display_definitions.
                active_number DO
            p_display_definition := ^p_form_status^.p_display_definitions^ [display_index];
            current_display_index := display_index + 1;
            get_form_attributes [n].display_name := p_display_definition^.name;
            get_form_attributes [n].display_attribute := p_display_definition^.attribute;
            get_form_attributes [n].get_value_status := fdc$user_defined_value;
            EXIT /find_display/;
          FOREND /find_display/;

        = fdc$get_number_events =
          get_form_attributes [n].number_events := p_form_definition^.event_definitions.active_number;
          get_form_attributes [n].get_value_status := fdc$user_defined_value;

        = fdc$get_number_form_comments =
          get_form_attributes [n].number_form_comments := p_form_definition^.comment_definitions.
                active_number;
          get_form_attributes [n].get_value_status := fdc$user_defined_value;

        = fdc$get_number_displays =
          get_form_attributes [n].number_form_displays := p_form_definition^.display_definitions.
                active_number;
          get_form_attributes [n].get_value_status := fdc$user_defined_value;

        = fdc$get_number_objects =
          p_form_object_definitions := p_form_status^.p_form_object_definitions;
          number_objects := 0;
          FOR object_index := 1 TO p_form_definition^.form_object_definitions.active_number DO
            CASE p_form_object_definitions^ [object_index].key OF

            = fdc$form_box, fdc$form_line, fdc$form_constant_text_box, fdc$form_constant_text, fdc$form_table,
                  fdc$form_variable_text, fdc$form_variable_text_box =
              number_objects := number_objects + 1;

            ELSE { This is an object that the user did not create.
            CASEND;
          FOREND;

          get_form_attributes [n].number_objects := number_objects;
          get_form_attributes [n].get_value_status := fdc$user_defined_value;

        = fdc$get_number_tables =
          get_form_attributes [n].number_tables := p_form_definition^.form_table_definitions.active_number;
          get_form_attributes [n].get_value_status := fdc$user_defined_value;

        = fdc$get_number_variables =
          get_form_attributes [n].number_variables := p_form_definition^.form_variable_definitions.
                active_number;
          get_form_attributes [n].get_value_status := fdc$user_defined_value;


        = fdc$get_unused_form_entry =
          get_form_attributes [n].get_value_status := fdc$undefined_value;

        ELSE

{ Invalid form attribute.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_attribute,
                p_form_definition^.form_name, status);
          RETURN;

        CASEND;
      END /process_form_attributes/;
    FOREND;
  PROCEND fdp$get_form_attributes;

?? TITLE := 'fdp$get_form_names', EJECT ??
*copyc fdh$get_form_names

  PROCEDURE [XDCL] fdp$get_form_names
    (    form_identifier: fdt$form_identifier;
         name_selections: fdt$name_selections;
     VAR form_names: fdt$form_names;
     VAR number_names: fdt$number_names;
     VAR status: ost$status);

    VAR
      n: integer,
      total_number_names: integer,
      p_form_definition: ^fdt$form_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_form_status: ^fdt$form_status;

?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_form_names;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT fdp$get_form_names;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE, EJECT ??
    osp$establish_condition_handler (^condition_handler, FALSE);
    fdp$find_form_definition (form_identifier, p_form_status, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    p_form_definition := p_form_status^.p_form_definition;
    number_names := 0;
    total_number_names := UPPERBOUND (form_names);

    IF fdc$select_variable IN name_selections THEN

{ Return variable names in form.

      FOR n := 1 TO p_form_definition^.form_variable_definitions.active_number DO
        IF number_names < total_number_names THEN
          number_names := number_names + 1;
          form_names [number_names].name := p_form_status^.p_form_variable_definitions^ [n].name;
          form_names [number_names].name_selection := fdc$select_variable;

        ELSE

{ The user has not allocated enough space to hold all the form names.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$too_many_form_names,
                p_form_definition^.form_name, status);
          RETURN;
        IFEND;
      FOREND;
    IFEND;

    IF fdc$select_table IN name_selections THEN

{ Return table names in

      FOR n := 1 TO p_form_definition^.form_table_definitions.active_number DO
        IF number_names < total_number_names THEN
          number_names := number_names + 1;
          form_names [number_names].name := p_form_status^.p_form_table_definitions^ [n].name;
          form_names [number_names].name_selection := fdc$select_table;

        ELSE

{ The user has not allocated enough space to hold all the form names.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$too_many_form_names,
                p_form_definition^.form_name, status);
          RETURN;
        IFEND;
      FOREND;
    IFEND;

    IF fdc$select_object IN name_selections THEN

{ Return object names in form. Only return name of first occurrence of object.

      p_form_object_definitions := p_form_status^.p_form_object_definitions;

    /get_object_names/
      FOR n := 1 TO p_form_definition^.form_object_definitions.active_number DO
        IF p_form_object_definitions^ [n].name <> osc$null_name THEN
          IF p_form_object_definitions^ [n].occurrence = 1 THEN
            CASE p_form_object_definitions^ [n].key OF


            = fdc$form_text_box_fragment, fdc$form_table =
              CYCLE /get_object_names/;

            ELSE
              IF number_names < total_number_names THEN
                number_names := number_names + 1;
                form_names [number_names].name := p_form_object_definitions^ [n].name;
                form_names [number_names].name_selection := fdc$select_object;

              ELSE

{ The user has not allocated enough space to hold all the form names.

                osp$set_status_abnormal (fdc$format_display_identifier, fde$too_many_form_names,
                      p_form_definition^.form_name, status);
                RETURN;
              IFEND;
            CASEND;
          IFEND;
        IFEND;
      FOREND /get_object_names/;
    IFEND;
  PROCEND fdp$get_form_names;

?? TITLE := 'change_form', EJECT ??

  PROCEDURE change_form
    (    p_form_status: ^fdt$form_status;
         p_form_definition: ^fdt$form_definition;
     VAR form_attributes: fdt$form_attributes;
     VAR status: ost$status);

    VAR
      comment_index: fdt$comment_index,
      event_action: fdt$event_action,
      event_index: fdt$event_index,
      event_label: fdt$event_label_v1,
      event_name: ost$name,
      event_trigger: fdt$event_trigger,
      event_trigger_reassignment: boolean,
      j: fdt$event_index,
      n: fdt$form_attribute_index,
      name_exists: boolean,
      name_is_valid: boolean,
      object_display_colors: fdt$display_attribute_set,
      object_index: fdt$object_index,
      old_colors: fdt$display_attribute_set,
      new_colors: fdt$display_attribute_set,
      p_comment_definitions: ^array [1 .. * ] of fdt$comment_definition,
      p_display_definition: ^fdt$display_definition,
      p_event_command: ^fdt$event_command,
      p_event_definition: ^fdt$event_definition,
      p_event_definitions: ^array [1 .. * ] of fdt$event_definition,
      p_form_module: ^fdt$form_module,
      p_form_object_definition: ^fdt$form_object_definition,
      p_form_object_definitions: ^array [1 .. * ] of fdt$form_object_definition,
      p_help_message: ^fdt$help_message,
      valid_label: ost$name,
      valid_name: ost$name,
      variable_index: fdt$variable_index;

?? NEWTITLE := 'add_event', EJECT ??

    PROCEDURE add_event;

      VAR
        p_command: ^fdt$event_command;

          fdp$validate_name (event_name, p_form_definition^.processor, valid_name,
                name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_event_name,
                  form_attributes [n].event_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            EXIT change_form;
          IFEND;

          p_event_definitions := p_form_status^.p_event_definitions;

        /find_duplicate_event/
          FOR event_index := 1 TO p_form_definition^.event_definitions.active_number DO
            p_event_definition := ^p_event_definitions^ [event_index];
            IF p_event_definition^.event_name = valid_name THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$event_name_exists,
                    form_attributes [n].event_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                    status);
              EXIT change_form;
            IFEND;

            IF p_event_definition^.event_trigger = event_trigger THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$event_trigger_exists,
                    p_form_definition^.form_name, status);
              EXIT change_form;
            IFEND;
          FOREND /find_duplicate_event/;

          allocate_event_definition (p_event_definition);
          IF NOT status.normal THEN
            EXIT change_form;
          IFEND;

          p_event_definition^.event_action := event_action;
          p_event_definition^.event_trigger := event_trigger;

{ Convert old event triggers to new event triggers.

          CASE p_event_definition^.event_trigger OF

          = fdc$quit =
            p_event_definition^.event_trigger := fdc$stop;

          = fdc$exit =
            p_event_definition^.event_trigger := fdc$shift_stop;

          = fdc$first =
            p_event_definition^.event_trigger := fdc$shift_backward;

          = fdc$last =
            p_event_definition^.event_trigger := fdc$shift_forward;

          ELSE { Event trigger needs no conversion.
          CASEND;

          p_event_definition^.event_name := valid_name;
          p_event_definition^.event_label := event_label;
          p_event_definition^.event_trigger_reassignment := event_trigger_reassignment;

          IF event_action = fdc$execute_command THEN
            IF (p_event_command = NIL) THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_address, '', status);
              p_form_definition^.event_definitions.active_number :=
                    p_form_definition^.event_definitions.active_number - 1;
               EXIT change_form;
            IFEND;

           NEXT p_command: [STRLENGTH (p_event_command^)] IN
                  p_form_status^.p_form_module;
            IF p_command <> NIL THEN
              p_command^ := p_event_command^;
              fdp$rel_event_command (p_command, p_form_module, p_event_definition^.command);

            ELSE

{ No space can be allocated for events.

           p_form_definition^.event_definitions.active_number :=
                    p_form_definition^.event_definitions.active_number - 1;
              osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
               EXIT change_form;
            IFEND;
          IFEND;

          form_attributes [n].put_value_status := fdc$put_value_accepted;

     PROCEND add_event;

?? OLDTITLE ??
?? NEWTITLE := 'allocate_display_definition', EJECT ??

    PROCEDURE allocate_display_definition
      (VAR display_definitions: fdt$display_definitions;
       VAR p_display_definition: ^fdt$display_definition);

      VAR
        i: fdt$display_index,
        number_object_displays: fdt$number_object_displays,
        p_new_display_definitions: ^array [1 .. * ] of fdt$display_definition,
        p_old_display_definitions: ^array [1 .. * ] of fdt$display_definition;

      p_old_display_definitions := p_form_status^.p_display_definitions;
      IF p_old_display_definitions = NIL THEN

{ Allocate the first array for display definitions.

        NEXT p_new_display_definitions: [1 .. fdc$displays_to_expand] IN p_form_status^.p_form_module;
        IF p_new_display_definitions = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
          RETURN;
        IFEND;

        p_display_definition := ^p_new_display_definitions^ [1];
        p_form_definition^.display_definitions.active_number := 1;
        fdp$rel_displays (p_new_display_definitions, p_form_status);
        RETURN;
      IFEND;

{ An array for displays exists. Try to use an inactive entry.

      number_object_displays := p_form_definition^.display_definitions.active_number;
      IF number_object_displays < p_form_definition^.display_definitions.total_number THEN
        number_object_displays := number_object_displays + 1;
        p_form_definition^.display_definitions.active_number := number_object_displays;
        p_display_definition := ^p_old_display_definitions^ [number_object_displays];
        RETURN;
      IFEND;

{ Expand the array for displays.

      NEXT p_new_display_definitions: [1 .. fdc$displays_to_expand + number_object_displays] IN
            p_form_status^.p_form_module;
      IF p_new_display_definitions = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

{ Copy old displays to new array.

      fdp$rel_displays (p_new_display_definitions, p_form_status);
      FOR i := 1 TO number_object_displays DO
        p_new_display_definitions^ [i] := p_old_display_definitions^ [i];
      FOREND;

      number_object_displays := number_object_displays + 1;
      p_display_definition := ^p_new_display_definitions^ [number_object_displays];
      p_form_definition^.display_definitions.active_number := number_object_displays;
    PROCEND allocate_display_definition;

?? OLDTITLE ??
?? NEWTITLE := 'allocate_event_definition', EJECT ??

    PROCEDURE allocate_event_definition
      (VAR p_event_definition: ^fdt$event_definition);

      VAR
        i: fdt$event_index,
        number_events: fdt$number_events,
        p_new_event_definitions: ^array [1 .. * ] of fdt$event_definition,
        p_old_event_definitions: ^array [1 .. * ] of fdt$event_definition;

      p_old_event_definitions := p_form_status^.p_event_definitions;
      IF p_old_event_definitions = NIL THEN

{ Allocate initial array for events.

        NEXT p_new_event_definitions: [1 .. fdc$events_to_expand] IN p_form_status^.p_form_module;
        IF p_new_event_definitions = NIL THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
          RETURN;
        IFEND;

        fdp$rel_events (p_new_event_definitions, p_form_status);
        p_event_definition := ^p_new_event_definitions^ [1];
        p_form_definition^.event_definitions.active_number := 1;
        RETURN;
      IFEND;

{ Try to find an inactive entry.

      number_events := p_form_definition^.event_definitions.active_number;
      IF number_events < p_form_definition^.event_definitions.total_number THEN
        number_events := number_events + 1;
        p_form_definition^.event_definitions.active_number := number_events;
        p_event_definition := ^p_old_event_definitions^ [number_events];
        RETURN;
      IFEND;

{ Expand the array for events.

      NEXT p_new_event_definitions: [1 .. fdc$events_to_expand + number_events] IN
            p_form_status^.p_form_module;
      IF p_new_event_definitions = NIL THEN
        osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
        RETURN;
      IFEND;

      FOR i := 1 TO number_events DO
        p_new_event_definitions^ [i] := p_old_event_definitions^ [i];
      FOREND;

      fdp$rel_events (p_new_event_definitions, p_form_status);
      number_events := number_events + 1;
      p_form_definition^.event_definitions.active_number := number_events;
      p_event_definition := ^p_new_event_definitions^ [number_events];
    PROCEND allocate_event_definition;

?? OLDTITLE ??
?? NEWTITLE := 'condition_handler', EJECT ??

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_information: ^pmt$condition_information;
           stack_frame_save_area: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      CASE condition.selector OF

      = pmc$system_conditions =
        IF (condition.system_conditions * $pmt$system_conditions
              [pmc$instruction_specification, pmc$address_specification, pmc$access_violation,
              pmc$invalid_segment_ring_0, pmc$divide_fault, pmc$arithmetic_overflow, pmc$exponent_overflow,
              pmc$exponent_underflow, pmc$fp_significance_loss, pmc$fp_indefinite,
              pmc$arithmetic_significance, pmc$invalid_bdp_data]) <> $pmt$system_conditions [] THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT change_form;
        IFEND;

      = pmc$user_defined_condition =
        IF condition.user_condition_name = cye$run_time_condition THEN
          osp$set_status_abnormal (fdc$format_display_identifier, fde$bad_data_value, '', status);
          EXIT change_form;
        IFEND;

      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

?? OLDTITLE ??
?? NEWTITLE := 'find_event_name', EJECT ??

    PROCEDURE [INLINE] find_event_name
      (    event_name: ost$name;
           p_event_definitions: ^array [1 .. * ] of fdt$event_definition;
       VAR number_events: fdt$number_events;
       VAR p_event_definition: ^fdt$event_definition;
       VAR event_index: fdt$event_index;
       VAR name_exists: boolean);

      name_exists := FALSE;

    /find_event/
      FOR event_index := 1 TO number_events DO
        p_event_definition := ^p_event_definitions^ [event_index];
        IF p_event_definition^.event_name = event_name THEN
          name_exists := TRUE;
          EXIT /find_event/;
        IFEND;
      FOREND /find_event/;
    PROCEND find_event_name;

?? OLDTITLE, EJECT ??

    osp$establish_condition_handler (^condition_handler, FALSE);
    status.normal := TRUE;
    p_form_module := p_form_status^.p_form_module;

  /change_form_attributes/
    FOR n := LOWERBOUND (form_attributes) TO UPPERBOUND (form_attributes) DO

    /process_form_attribute/
      BEGIN
        CASE form_attributes [n].key OF

        = fdc$add_event =
          event_name := form_attributes [n].event_name;
          event_label := form_attributes [n].event_label;
          event_trigger := form_attributes [n].event_trigger;
          event_action := form_attributes [n].event_action;
          event_trigger_reassignment := TRUE;
          IF event_action = fdc$execute_command THEN
            p_event_command := form_attributes [n].p_event_command;
          IFEND;
          add_event;

{ If status is set abnormal, an exit occurs to change_form.

        = fdc$add_event_v1 =
          event_name := form_attributes [n].event_name_v1;
          event_label := form_attributes [n].event_label_v1;
          event_trigger := form_attributes [n].event_trigger_v1;
          event_action := form_attributes [n].event_action_v1;
          event_trigger_reassignment := form_attributes [n].event_trigger_reassignment_v1;
          IF event_action = fdc$execute_command THEN
            p_event_command := form_attributes [n].p_event_command_v1;
          IFEND;
          add_event;

{ If status is set abnormal, an exit occurs to change_form.

        = fdc$add_form_comment =
          IF (form_attributes [n].p_form_comment = NIL) THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_address,
                  p_form_definition^.form_name, status);
            RETURN;
          IFEND;

          fdp$add_comment (p_form_status, p_form_definition, form_attributes [n].p_form_comment,
                p_form_definition^.comment_definitions, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$add_display_definition =
          fdp$validate_name (form_attributes [n].display_name, p_form_definition^.processor, valid_name,
                name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_display_name,
                  form_attributes [n].display_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          fdp$find_display_name (valid_name, p_form_status^.p_display_definitions,
                p_form_definition^.display_definitions.active_number, p_display_definition, name_exists);
          IF name_exists THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$display_name_exists,
                  form_attributes [n].display_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          allocate_display_definition (p_form_definition^.display_definitions, p_display_definition);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          p_display_definition^.name := valid_name;
          fdp$set_display_attributes (p_form_definition^.display_attribute,
                form_attributes [n].display_attribute, p_display_definition^.attribute);
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$delete_all_displays =
          p_form_definition^.display_definitions.active_number := 0;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$delete_all_events =
          p_form_definition^.event_definitions.active_number := 0;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$delete_event =
          fdp$validate_name (form_attributes [n].name, p_form_definition^.processor, valid_name,
                name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_event_name,
                  form_attributes [n].name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          find_event_name (valid_name, p_form_status^.p_event_definitions,
                p_form_definition^.event_definitions.active_number, p_event_definition, event_index,
                name_exists);
          IF NOT name_exists THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_event_name,
                  form_attributes [n].name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          p_form_definition^.event_definitions.active_number :=
                p_form_definition^.event_definitions.active_number - 1;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$delete_form_comments =
          p_comment_definitions := fdp$ptr_comments (p_form_definition^.comment_definitions, p_form_module);
          IF p_comment_definitions = NIL THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$no_comments_to_delete,
                  p_form_definition^.form_name, status);
            RETURN;
          IFEND;

          fdp$rel_comments (NIL, p_form_module, p_form_definition^.comment_definitions);
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$delete_display_definition =
          fdp$validate_name (form_attributes [n].display_name, p_form_definition^.processor, valid_name,
                name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_display_name,
                  form_attributes [n].display_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          fdp$find_display_name (valid_name, p_form_status^.p_display_definitions,
                p_form_definition^.display_definitions.active_number, p_display_definition, name_exists);
          IF NOT name_exists THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$unknown_display_name,
                  form_attributes [n].display_name, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          p_display_definition^ := p_form_status^.p_display_definitions^
                [p_form_definition^.display_definitions.active_number];
          p_form_definition^.display_definitions.active_number :=
                p_form_definition^.display_definitions.active_number - 1;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$design_display_attribute =
          p_form_status^.design_display_attribute := form_attributes [n].design_display_attribute;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$design_variable_name =
          fdp$validate_name (form_attributes [n].design_variable_name, p_form_definition^.processor,
                valid_name, name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_variable_name,
                  form_attributes [n].form_name, status);
            RETURN;
          IFEND;

          p_form_status^.design_variable_name := valid_name;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$event_form =
          CASE form_attributes [n].event_form_definition.key OF

          = fdc$no_event_form, fdc$system_default_event_form =
            p_form_definition^.event_form_definition.key := form_attributes [n].event_form_definition.key;
            form_attributes [n].put_value_status := fdc$put_value_accepted;

          = fdc$user_event_form =
            clp$validate_name (form_attributes [n].event_form_definition.event_form_name, valid_name,
                  name_is_valid);
            IF NOT name_is_valid THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_event_form_name,
                    p_form_definition^.form_name, status);
              osp$append_status_parameter (osc$status_parameter_delimiter,
                    form_attributes [n].event_form_definition.event_form_name, status);
              RETURN;
            IFEND;

            p_form_definition^.event_form_definition.key := fdc$user_event_form;
            p_form_definition^.event_form_definition.event_form_name := valid_name;
            form_attributes [n].put_value_status := fdc$put_value_accepted;

          ELSE

{ Invalid event form key.

            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_event_form_key,
                  p_form_definition^.form_name, status);
            RETURN;
          CASEND;

        = fdc$fast_form_creation =
          form_attributes [n].put_value_status := fdc$put_value_accepted;
          p_form_status^.fast_form_creation :=
                form_attributes [n].fast_form_creation;

        = fdc$form_area =
          CASE form_attributes [n].form_area.key OF

          = fdc$screen_area =
            p_form_definition^.form_area := form_attributes [n].form_area;
            form_attributes [n].put_value_status := fdc$put_value_accepted;

          = fdc$defined_area =
            IF ((form_attributes [n].form_area.x_position < 1) OR
                  (form_attributes [n].form_area.x_position > fdc$maximum_x_position)) THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_x_position, '', status);
              osp$append_status_integer (osc$status_parameter_delimiter,
                    $INTEGER (form_attributes [n].form_area.x_position), 10, FALSE, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                    status);
              RETURN;
            IFEND;

            IF ((form_attributes [n].form_area.y_position < 1) OR
                  (form_attributes [n].form_area.y_position > fdc$maximum_y_position)) THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_y_position, '', status);
              osp$append_status_integer (osc$status_parameter_delimiter,
                    $INTEGER (form_attributes [n].form_area.y_position), 10, FALSE, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                    status);
              RETURN;
            IFEND;

            IF ((form_attributes [n].form_area.width < 1) OR ((form_attributes [n].form_area.width +
                  form_attributes [n].form_area.x_position - 1) > fdc$maximum_x_position)) THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_width, '', status);
              osp$append_status_integer (osc$status_parameter_delimiter,
                    $INTEGER (form_attributes [n].form_area.width), 10, FALSE, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                    status);
              RETURN;
            IFEND;

            IF ((form_attributes [n].form_area.height < 1) OR
                  ((form_attributes [n].form_area.height + form_attributes [n].form_area.y_position - 1) >
                  fdc$maximum_y_position)) THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_height, '', status);
              osp$append_status_integer (osc$status_parameter_delimiter,
                    $INTEGER (form_attributes [n].form_area.height), 10, FALSE, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                    status);
              RETURN;
            IFEND;

{ Make sure all objects are inside form area.

            p_form_definition^.form_area := form_attributes [n].form_area;
            p_form_object_definitions := p_form_status^.p_form_object_definitions;

            FOR object_index := 1 TO p_form_definition^.form_object_definitions.active_number DO
              fdp$check_object_inside_form (p_form_definition^.form_area,
                    ^p_form_object_definitions^ [object_index], p_form_definition^.form_name, status);
              IF NOT status.normal THEN
                RETURN;
              IFEND;
            FOREND;

            form_attributes [n].put_value_status := fdc$put_value_accepted;

          ELSE

{ The form area key is invalid.

            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_area_key,
                  p_form_definition^.form_name, status);
            RETURN;
          CASEND;

        = fdc$form_display_attribute =
          old_colors := p_form_definition^.display_attribute * fdv$colors;
          fdp$set_display_attributes (p_form_definition^.display_attribute,
                form_attributes [n].form_display_attribute, p_form_definition^.display_attribute);
          p_form_definition^.display_attribute := p_form_definition^.display_attribute +
                $fdt$display_attribute_set [fdc$protect];
          form_attributes [n].put_value_status := fdc$put_value_accepted;
          new_colors := p_form_definition^.display_attribute * fdv$colors;
          IF new_colors = old_colors THEN
            CYCLE /change_form_attributes/;
          IFEND;

{ Change default colors of objects to match new color of form.

          p_form_object_definitions := p_form_status^.p_form_object_definitions;

        /change_object_display/
          FOR object_index := 1 TO p_form_definition^.form_object_definitions.active_number DO
            p_form_object_definition := ^p_form_object_definitions^ [object_index];
            IF p_form_object_definition^.key <> fdc$form_unused_object THEN
              object_display_colors := p_form_object_definition^.display_attribute * fdv$colors;
              IF object_display_colors = old_colors THEN
                p_form_object_definition^.display_attribute := (p_form_object_definition^.display_attribute -
                      fdv$colors) + new_colors;
              IFEND;
            IFEND;
          FOREND /change_object_display/;

        = fdc$form_help =
          CASE form_attributes [n].form_help.key OF

          = fdc$no_help_response, fdc$system_default_help =
            p_form_definition^.help_definition.key := form_attributes [n].form_help.key;
            form_attributes [n].put_value_status := fdc$put_value_accepted;

          = fdc$help_form =
            clp$validate_name (form_attributes [n].form_help.help_form, valid_name, name_is_valid);
            IF NOT name_is_valid THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_help_form_name,
                    form_attributes [n].form_help.help_form, status);
              RETURN;
            IFEND;

            p_form_definition^.help_definition.key := fdc$help_form;
            p_form_definition^.help_definition.help_form := valid_name;
            form_attributes [n].put_value_status := fdc$put_value_accepted;

          = fdc$help_message =
            IF (form_attributes [n].form_help.p_help_message = NIL) THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_address,
                    p_form_definition^.form_name, status);
              RETURN;
            IFEND;

            NEXT p_help_message: [STRLENGTH (form_attributes [n].form_help.p_help_message^)] IN
                  p_form_status^.p_form_module;
            IF p_help_message = NIL THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$no_space_available, '', status);
              RETURN;
            IFEND;

            p_form_definition^.help_definition.key := fdc$help_message;
            p_form_definition^.help_definition.p_help_message := #REL (p_help_message, p_form_module^);
            p_help_message^ := form_attributes [n].form_help.p_help_message^;
            form_attributes [n].put_value_status := fdc$put_value_accepted;

          ELSE

{ Invalid help key.

            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_help_key,
                  p_form_definition^.form_name, status);
            RETURN;
          CASEND;

        = fdc$form_language =
          clp$validate_name (form_attributes [n].form_language, valid_name, name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_language,
                  form_attributes [n].form_language, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                  status);
            RETURN;
          IFEND;

          p_form_definition^.language := valid_name;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_name =
          clp$validate_name (form_attributes [n].form_name, valid_name, name_is_valid);
          IF NOT name_is_valid THEN
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_name,
                  form_attributes [n].form_name, status);
            RETURN;
          IFEND;

          p_form_definition^.form_name := valid_name;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$form_processor =
          CASE form_attributes [n].form_processor OF

          = fdc$ansi_fortran_processor, fdc$cdc_fortran_processor, fdc$cybil_processor,
                fdc$scl_processor, fdc$pascal_processor, fdc$unknown_processor,
                fdc$extended_fortran_processor =

{ A non COBOL processor cannot have any variables with a program COBOL data type.

          /search_for_cobol_data_type/
            FOR variable_index := 1 to p_form_definition^.form_variable_definitions.active_number DO
              IF p_form_status^.p_form_variable_definitions^ [variable_index].program_data_type =
                    fdc$program_cobol_type THEN
                osp$set_status_abnormal (fdc$format_display_identifier,
                       fde$invalid_cobol_data_type,
                       p_form_status^.p_form_variable_definitions^ [variable_index].name, status);
                osp$append_status_parameter (osc$status_parameter_delimiter,
                       p_form_definition^.form_name,  status);
                RETURN;
              IFEND;
            FOREND /search_for_cobol_data_type/;

            p_form_definition^.processor := form_attributes [n].form_processor;
            form_attributes [n].put_value_status := fdc$put_value_accepted;

          = fdc$cobol_processor =
            p_form_definition^.processor := form_attributes [n].form_processor;
            form_attributes [n].put_value_status := fdc$put_value_accepted;

          ELSE
            osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_processor,
                  p_form_definition^.form_name, status);
            RETURN;
          CASEND;

        = fdc$help_message_form =
          IF form_attributes [n].help_message_form <> osc$null_name THEN
            clp$validate_name (form_attributes [n].help_message_form, valid_name, name_is_valid);
            IF NOT name_is_valid THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_message_form_name,
                    form_attributes [n].help_message_form, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                    status);
              RETURN;
            IFEND;
            p_form_definition^.help_message_form := valid_name;
          ELSE
            p_form_definition^.help_message_form := osc$null_name;
          IFEND;

          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$hidden_editing =
          p_form_definition^.hidden_editing := form_attributes [n].hidden_editing;
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$invalid_data_character =
          form_attributes [n].put_value_status := fdc$put_value_accepted;
          p_form_definition^.invalid_data_character := form_attributes [n].invalid_data_character;

        = fdc$message_form, fdc$error_message_form =
          IF form_attributes [n].error_message_form <> osc$null_name THEN
            clp$validate_name (form_attributes [n].error_message_form, valid_name, name_is_valid);
            IF NOT name_is_valid THEN
              osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_message_form_name,
                    form_attributes [n].error_message_form, status);
              osp$append_status_parameter (osc$status_parameter_delimiter, p_form_definition^.form_name,
                    status);
              RETURN;
            IFEND;
            p_form_definition^.error_message_form := valid_name;
          ELSE
            p_form_definition^.error_message_form := osc$null_name;
          IFEND;

          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$unused_form_entry =
          form_attributes [n].put_value_status := fdc$put_value_accepted;

        = fdc$validate_variable_values =
          form_attributes [n].put_value_status := fdc$put_value_accepted;
          p_form_status^.validate_variable_values :=
                form_attributes [n].validate_variable_values;
        ELSE

{ Invalid change form key.

          osp$set_status_abnormal (fdc$format_display_identifier, fde$invalid_form_attribute,
                p_form_definition^.form_name, status);
          RETURN;

        CASEND;
      END /process_form_attribute/;
    FOREND /change_form_attributes/;

  PROCEND change_form;

MODEND fdm$process_form;
