
?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Screen Formatting : Generate Form Module' ??
MODULE fdm$generate_form_module;

{ PURPOSE:
{   This module contains the procedures to generate the form definition language
{   and program types or variables for a form residing on an object code library.
{
{ DESIGN:
{   The form definition language is SCL. Attempt to generate as much as the form
{   language as possible in spite of errors.  This may be the only way
{   the user can recover a form that has been damaged in some way.
{   Try to avoid generating commands and parameters that represent defaults.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$page_widths
*copyc cyd$run_time_error_condition
*copyc fdc$basic_capability
*copyc fdc$integer_length
*copyc fdc$system_currency_sign
*copyc fdc$system_decimal_point
*copyc fdc$system_thousands_separator
*copyc fdt$form_definition
*copyc fdt$form_status
*copyc fdt$input_format_key_set
?? POP ??

*copyc amp$fetch
*copyc amp$put_next

*copyc clp$trimmed_string_size

*copyc i#move

*copyc fdp$close_form
*copyc fdp$convert_to_cobol_name
*copyc fdp$convert_to_fortran_name
*copyc fdp$create_form_status
*copyc fdp$get_form_attributes
*copyc fdp$get_form_names
*copyc fdp$get_form_objects
*copyc fdp$get_object_attributes
*copyc fdp$get_record_attributes
*copyc fdp$get_table_attributes
*copyc fdp$get_variable_attributes
*copyc fdp$ptr_displays
*copyc fdp$ptr_events
*copyc fdp$ptr_objects
*copyc fdp$ptr_record_definitions
*copyc fdp$ptr_tables
*copyc fdp$ptr_variables
*copyc fdp$write_record_definition

*copyc osp$establish_condition_handler
*copyc osp$generate_error_message
*copyc osp$set_status_abnormal

*copyc pmp$continue_to_cause

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

  CONST
    max_command_line_size = 8192,
    min_page_width = 64;

    SECTION
    global_storage: READ;

  VAR
    display_attribute_set: fdt$display_attribute_set,
    file_attributes: array [1 .. 1] of amt$fetch_item,
    form_display_attribute_set: fdt$display_attribute_set,
    form_identifier: fdt$form_identifier,
    line: string (max_command_line_size),
    line_length: integer,
    object_display_attribute_set: fdt$display_attribute_set,
    page_width: amt$page_width;


?? OLDTITLE ??
?? NEWTITLE := '[XDCL] fdp$generate_form_module', EJECT ??
*copy fdh$generate_form_module

  PROCEDURE [XDCL] fdp$generate_form_module
    (    file_identifier: amt$file_identifier;
         form_name: ost$name;
     VAR form_module_p: ^fdt$form_module;
     VAR status: ost$status);

?? NEWTITLE := 'add_attributes', EJECT ??

    PROCEDURE add_attributes
      (    display_attribute_set: fdt$display_attribute_set;
           attribute_parameter: string ( * ));

      VAR
        attribute_present: boolean;

?? NEWTITLE := 'add_attribute_text', EJECT ??

{ PURPOSE:
{   This procedure starts or adds the text for a display attribute parameter.

      PROCEDURE add_attribute_text
        (    attribute: string ( * ));

        IF attribute_present THEN

{ Add to existing list of display attributes.

          STRINGREP (line, line_length, line (1, line_length), ', ', attribute);
        ELSE

{ Start list of display attributes.

          STRINGREP (line, line_length, line (1, line_length), ' ', attribute_parameter, '=(', attribute);
          attribute_present := TRUE;
        IFEND;

      PROCEND add_attribute_text;

?? OLDTITLE, EJECT ??

{ PURPOSE:
{   This procedure maps Screen Formatting ordinals for display attributes to
{   text for a command parameter.

      attribute_present := FALSE;
      IF fdc$inverse_video IN display_attribute_set THEN
        add_attribute_text ('inverse');
      IFEND;
      IF fdc$low_intensity IN display_attribute_set THEN
        add_attribute_text ('low_intensity');
      IFEND;
      IF fdc$high_intensity IN display_attribute_set THEN
        add_attribute_text ('high_intensity');
      IFEND;
      IF fdc$blink IN display_attribute_set THEN
        add_attribute_text ('blink');
      IFEND;
      IF fdc$underline IN display_attribute_set THEN
        add_attribute_text ('underline');
      IFEND;
      IF fdc$protect IN display_attribute_set THEN
        add_attribute_text ('protect');
      IFEND;
      IF fdc$hidden IN display_attribute_set THEN
        add_attribute_text ('hidden');
      IFEND;
      IF fdc$black_foreground IN display_attribute_set THEN
        add_attribute_text ('black_foreground');
      IFEND;
      IF fdc$black_background IN display_attribute_set THEN
        add_attribute_text ('black_background');
      IFEND;
      IF fdc$blue_foreground IN display_attribute_set THEN
        add_attribute_text ('blue_foreground');
      IFEND;
      IF fdc$blue_background IN display_attribute_set THEN
        add_attribute_text ('blue_background');
      IFEND;
      IF fdc$green_foreground IN display_attribute_set THEN
        add_attribute_text ('green_background');
      IFEND;
      IF fdc$green_background IN display_attribute_set THEN
        add_attribute_text ('green_background');
      IFEND;
      IF fdc$magenta_foreground IN display_attribute_set THEN
        add_attribute_text ('magenta_foreground');
      IFEND;
      IF fdc$magenta_background IN display_attribute_set THEN
        add_attribute_text ('magenta_background');
      IFEND;
      IF fdc$red_foreground IN display_attribute_set THEN
        add_attribute_text ('red_foreground');
      IFEND;
      IF fdc$red_background IN display_attribute_set THEN
        add_attribute_text ('red_background');
      IFEND;
      IF fdc$cyan_foreground IN display_attribute_set THEN
        add_attribute_text ('cyan_foreground');
      IFEND;
      IF fdc$cyan_background IN display_attribute_set THEN
        add_attribute_text ('cyan_background');
      IFEND;
      IF fdc$yellow_foreground IN display_attribute_set THEN
        add_attribute_text ('yellow_foreground');
      IFEND;
      IF fdc$yellow_background IN display_attribute_set THEN
        add_attribute_text ('yellow_background');
      IFEND;
      IF fdc$white_foreground IN display_attribute_set THEN
        add_attribute_text ('white_foreground');
      IFEND;
      IF fdc$white_background IN display_attribute_set THEN
        add_attribute_text ('white_background');
      IFEND;
      IF fdc$fine_line IN display_attribute_set THEN
        add_attribute_text ('fine_line');
      IFEND;
      IF fdc$medium_line IN display_attribute_set THEN
        add_attribute_text ('medium_line');
      IFEND;
      IF fdc$bold_line IN display_attribute_set THEN
        add_attribute_text ('bold_line');
      IFEND;
      IF fdc$fine_border IN display_attribute_set THEN
        add_attribute_text ('fine_border');
      IFEND;
      IF fdc$medium_border IN display_attribute_set THEN
        add_attribute_text ('medium_border');
      IFEND;
      IF fdc$bold_border IN display_attribute_set THEN
        add_attribute_text ('bold_border');
      IFEND;
      IF fdc$italic_display_attribute IN display_attribute_set THEN
        add_attribute_text ('italic');
      IFEND;
      IF fdc$title_display_attribute IN display_attribute_set THEN
        add_attribute_text ('title');
      IFEND;
      IF fdc$input_display_attribute IN display_attribute_set THEN
        add_attribute_text ('input');
      IFEND;
      IF fdc$error_display_attribute IN display_attribute_set THEN
        add_attribute_text ('error');
      IFEND;
      IF fdc$message_display_attribute IN display_attribute_set THEN
        add_attribute_text ('message');
      IFEND;
      IF fdc$display_left_to_right IN display_attribute_set THEN
        add_attribute_text ('display_left_to_right');
      IFEND;
      IF fdc$display_right_to_left IN display_attribute_set THEN
        add_attribute_text ('display_right_to_left');
      IFEND;
      IF fdc$push_input_character IN display_attribute_set THEN
        add_attribute_text ('push_input_character');
      IFEND;
      IF fdc$user_attribute_1 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_1');
      IFEND;
      IF fdc$user_attribute_2 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_2');
      IFEND;
      IF fdc$user_attribute_3 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_3');
      IFEND;
      IF fdc$user_attribute_4 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_4');
      IFEND;
      IF fdc$user_attribute_5 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_5');
      IFEND;
      IF fdc$user_attribute_6 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_6');
      IFEND;
      IF fdc$user_attribute_7 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_7');
      IFEND;
      IF fdc$user_attribute_8 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_8');
      IFEND;
      IF fdc$user_attribute_9 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_9');
      IFEND;
      IF fdc$user_attribute_10 IN display_attribute_set THEN
        add_attribute_text ('user_attribute_10');
      IFEND;

{ If any display attributes were processed, end the list.

      IF attribute_present THEN
        STRINGREP (line, line_length, line (1, line_length), ')');
      IFEND;

    PROCEND add_attributes;

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

{ PURPOSE:
{   This procedure does the add_box command.

    PROCEDURE add_box
      (    x_position: fdt$x_position;
           y_position: fdt$y_position;
       VAR status: ost$status);

      CONST
        object_definition_attribute = 1,
        object_name_attribute = 2,
        object_display_attribute = 3;

      VAR
        get_object_attributes: array [object_definition_attribute .. object_display_attribute] of
              fdt$get_object_attribute,
        get_object_definition: fdt$get_object_definition;

{ Get attributes.

      status.normal := TRUE;
      get_object_attributes [object_definition_attribute].key := fdc$get_object_definition;
      get_object_attributes [object_name_attribute].key := fdc$get_object_name;
      get_object_attributes [object_display_attribute].key := fdc$get_object_display;
      fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      get_object_definition := get_object_attributes [object_definition_attribute].get_object_definition;

      STRINGREP (line, line_length, 'ADD_BOX column=', x_position, ' line=', y_position, ' width=',
            get_object_definition.box_width, ' height=', get_object_definition.box_height);

{ Process NAME and OCCURRENCE parameters.

      IF get_object_attributes [object_name_attribute].get_value_status <> fdc$undefined_value THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' name=', get_object_attributes [object_name_attribute].
              object_name (1, clp$trimmed_string_size (get_object_attributes [object_name_attribute].
              object_name)), ' occurrence=', get_object_attributes [object_name_attribute].occurrence);
      IFEND;

{ Remove display attributes common to the entire form.

      add_attributes (get_object_attributes [object_display_attribute].display_attribute -
            object_display_attribute_set, 'display');

      put_command_line (line (1, line_length));

    PROCEND add_box;

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

{ PURPOSE:
{   This procedure does the add_constant_text command.

    PROCEDURE add_constant_text
      (    x_position: fdt$x_position;
           y_position: fdt$y_position;
       VAR status: ost$status);

      CONST
        object_definition_attribute = 1,
        object_display_attribute = 2,
        object_name_attribute = 3;

      VAR
        get_object_attributes: array [object_definition_attribute .. object_name_attribute] of
              fdt$get_object_attribute,
        get_object_text: array [1 .. 1] of fdt$get_object_attribute,
        get_object_definition: fdt$get_object_definition;

      status.normal := TRUE;
      get_object_attributes [object_definition_attribute].key := fdc$get_object_definition;
      get_object_attributes [object_display_attribute].key := fdc$get_object_display;
      get_object_attributes [object_name_attribute].key := fdc$get_object_name;
      fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      get_object_definition := get_object_attributes [object_definition_attribute].get_object_definition;

      STRINGREP (line, line_length, 'ADD_CONSTANT_TEXT column=', x_position, ' line=', y_position);

{ Process TEXT parameter.

      IF get_object_definition.constant_text_length > 0 THEN
        get_object_text [1].key := fdc$get_object_text;
        PUSH get_object_text [1].p_text: [get_object_definition.constant_text_length];
        fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_text, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        STRINGREP (line, line_length, line (1, line_length), ' text=''');
        add_text (get_object_text [1].p_text^);
        STRINGREP (line, line_length, line (1, line_length), '''');

      ELSE { No text for object.}
        STRINGREP (line, line_length, line (1, line_length), ' text=''''');
      IFEND;

{ Process NAME and OCCURRENCE parameter.

      IF get_object_attributes [object_name_attribute].get_value_status <> fdc$undefined_value THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' name=', get_object_attributes [object_name_attribute].
              object_name (1, clp$trimmed_string_size (get_object_attributes [object_name_attribute].
              object_name)), ' occurrence=', get_object_attributes [object_name_attribute].occurrence);
      IFEND;

{ Remove display attributes common to the entire form.

      add_attributes (get_object_attributes [object_display_attribute].display_attribute -
            object_display_attribute_set, 'display');

{ Process WIDTH parameter.

      IF get_object_definition.constant_text_length > 0 THEN
        IF ((get_object_definition.constant_text_width <> STRLENGTH (get_object_text [1].p_text^)) OR
              (get_object_text [1].p_text^ (STRLENGTH (get_object_text [1].p_text^)) = ' ') OR
              (get_object_text [1].p_text^ = '')) THEN
          STRINGREP (line, line_length, line (1, line_length), ' width=',
                get_object_definition.constant_text_width);
        IFEND;

      ELSE { No text specified for object, so specify the width of the object.}
        STRINGREP (line, line_length, line (1, line_length), ' width=',
              get_object_definition.constant_text_width);

      IFEND;

      put_command_line (line (1, line_length));

    PROCEND add_constant_text;

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

{ PURPOSE:
{   This procedure does the add_constant_text_box command.

    PROCEDURE add_constant_text_box
      (    x_position: fdt$x_position,
           y_position: fdt$y_position;
       VAR status: ost$status);

      CONST
        object_definition_attribute = 1,
        object_display_attribute = 2,
        object_name_attribute = 3;

      VAR
        get_object_attributes: array [object_definition_attribute .. object_name_attribute] of
              fdt$get_object_attribute,
        get_object_text: array [1 .. 1] of fdt$get_object_attribute,
        get_object_definition: fdt$get_object_definition,
        text_length: fdt$text_length;

{ Get object attributes.

      status.normal := TRUE;
      get_object_attributes [object_definition_attribute].key := fdc$get_object_definition;
      get_object_attributes [object_display_attribute].key := fdc$get_object_display;
      get_object_attributes [object_name_attribute].key := fdc$get_object_name;
      fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      get_object_definition := get_object_attributes [object_definition_attribute].get_object_definition;
      STRINGREP (line, line_length, 'ADD_CONSTANT_TEXT_BOX column=', x_position, ' line=', y_position,
            ' width=', get_object_definition.constant_box_width, ' height=',
            get_object_definition.constant_box_height);

{ Process TEXT parameter.

      text_length := get_object_definition.constant_box_text_length;
      IF text_length > 0 THEN
        get_object_text [1].key := fdc$get_object_text;
        PUSH get_object_text [1].p_text: [text_length];
        fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_text, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        STRINGREP (line, line_length, line (1, line_length), ' text=''');
        add_text (get_object_text [1].p_text^);
        STRINGREP (line, line_length, line (1, line_length), '''');

      ELSE {No text for object.}
        STRINGREP (line, line_length, line (1, line_length), ' text=''''');
      IFEND;

{ Process NAME and OCCURRENCE parameter.

      IF get_object_attributes [object_name_attribute].get_value_status <> fdc$undefined_value THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' name=', get_object_attributes [object_name_attribute].
              object_name (1, clp$trimmed_string_size (get_object_attributes [object_name_attribute].
              object_name)), ' occurrence=', get_object_attributes [object_name_attribute].occurrence);
      IFEND;

{ Remove display attributes common to the entire form.

      add_attributes (get_object_attributes [object_display_attribute].display_attribute -
            object_display_attribute_set, 'display');

{ Process TEXT_FORMAT parameter.

      CASE get_object_attributes [object_definition_attribute].get_object_definition.
            constant_box_processing OF

      = fdc$center_characters =
        STRINGREP (line, line_length, line (1, line_length), ' text_format=center_characters');

      = fdc$wrap_characters =
        STRINGREP (line, line_length, line (1, line_length), ' text_format=wrap_characters');

      ELSE

{ Wrap words is the default. Do not output the default.

      CASEND;

      put_command_line (line (1, line_length));

    PROCEND add_constant_text_box;

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

{ PURPOSE:
{   This procedure does the add_display command.

    PROCEDURE add_display
      (    display_attribute: fdt$display_attribute_set;
           display_name: ost$name);

      STRINGREP (line, line_length, 'ADD_DISPLAY', ' name=',
            display_name (1, clp$trimmed_string_size (display_name)));

{ If the specified display attributes are the same as the display attributes of
{ the form minus protection, then output all the specified displayed attributes. Otherwise
{ output only the display attributes that are different from the display
{ attributes of the form. Some display attributes must always be output.

      IF ((display_attribute - display_attribute_set) = $fdt$display_attribute_set []) THEN
        add_attributes (display_attribute, 'display');
      ELSE
        add_attributes (display_attribute - display_attribute_set, 'display');
      IFEND;

      put_command_line (line (1, line_length));

    PROCEND add_display;

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

{ PURPOSE:
{   This procedure does the add_event command.

    PROCEDURE add_event
      (    get_form_attribute: fdt$get_form_attribute);

      VAR
        event_action_name: ost$name,
        event_trigger_name: ost$name;

?? NEWTITLE := 'set_event_action_name', EJECT ??

{ PURPOSE:
{   This procedure maps a Screen Formating event action ordinal to text for
{   the command.

      PROCEDURE set_event_action_name
        (    event_action: fdt$event_action;
         VAR event_action_name: ost$name);

        CASE event_action OF
        = fdc$return_program_normal =
          event_action_name := 'return_normal';
        = fdc$return_program_abnormal =
          event_action_name := 'return_abnormal';
        = fdc$page_table_forward =
          event_action_name := 'page_table_forward';
        = fdc$page_table_backward =
          event_action_name := 'page_table_backward';
        = fdc$scroll_table_forward =
          event_action_name := 'scroll_table_forward';
        = fdc$scroll_table_backward =
          event_action_name := 'scroll_table_backward';
        = fdc$display_help =
          event_action_name := 'display_help';
        = fdc$erase_help =
          event_action_name := 'erase_help';
        = fdc$execute_command =
          event_action_name := 'execute_command';
        = fdc$ignore_event =
          event_action_name := 'ignore';
        = fdc$tab_to_next_form_field =
          event_action_name := 'tab_next';
        = fdc$tab_to_previous_form_field =
          event_action_name := 'tab_previous';
        = fdc$scroll_variable_forward =
          event_action_name := 'scroll_variable_forward';
        = fdc$scroll_variable_backward =
          event_action_name := 'scroll_variable_backward';
        = fdc$page_variable_forward =
          event_action_name := 'page_variable_forward';
        = fdc$page_variable_backward =
          event_action_name := 'page_variable_backward';
        = fdc$page_variable_first =
          event_action_name := 'page_variable_first';
        = fdc$page_variable_last =
          event_action_name := 'page_variable_last';
        = fdc$page_table_first =
          event_action_name := 'page_table_first';
        = fdc$page_table_last =
          event_action_name := 'page_table_last';
        = fdc$insert_variable_line =
          event_action_name := 'insert_variable_line';
        = fdc$delete_variable_line =
          event_action_name := 'delete_variable_line';
        ELSE
          event_action_name := 'unknown';
        CASEND;
      PROCEND set_event_action_name;

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

{ PURPOSE:
{   This procedure maps Screen Formatting ordinal for event trigger
{   to text for the command.

      PROCEDURE set_event_trigger_name
        (    event_trigger: fdt$event_trigger;
         VAR event_trigger_name: ost$name);

        CASE event_trigger OF
        = fdc$next =
          event_trigger_name := 'next';
        = fdc$help =
          event_trigger_name := 'help';
        = fdc$stop =
          event_trigger_name := 'stop';
        = fdc$back =
          event_trigger_name := 'back';
        = fdc$up =
          event_trigger_name := 'up';
        = fdc$down =
          event_trigger_name := 'down';
        = fdc$forward =
          event_trigger_name := 'forward';
        = fdc$backward =
          event_trigger_name := 'backward';
        = fdc$undo =
          event_trigger_name := 'undo';
        = fdc$redo =
          event_trigger_name := 'redo';
        = fdc$quit =
          event_trigger_name := 'quit';
        = fdc$exit =
          event_trigger_name := 'exit';
        = fdc$first =
          event_trigger_name := 'first';
        = fdc$last =
          event_trigger_name := 'last';
        = fdc$edit =
          event_trigger_name := 'edit';
        = fdc$data =
          event_trigger_name := 'data';
        = fdc$function_1 =
          event_trigger_name := 'f1';
        = fdc$function_2 =
          event_trigger_name := 'f2';
        = fdc$function_3 =
          event_trigger_name := 'f3';
        = fdc$function_4 =
          event_trigger_name := 'f4';
        = fdc$function_5 =
          event_trigger_name := 'f5';
        = fdc$function_6 =
          event_trigger_name := 'f6';
        = fdc$function_7 =
          event_trigger_name := 'f7';
        = fdc$function_8 =
          event_trigger_name := 'f8';
        = fdc$function_9 =
          event_trigger_name := 'f9';
        = fdc$function_10 =
          event_trigger_name := 'f10';
        = fdc$function_11 =
          event_trigger_name := 'f11';
        = fdc$function_12 =
          event_trigger_name := 'f12';
        = fdc$function_13 =
          event_trigger_name := 'f13';
        = fdc$function_14 =
          event_trigger_name := 'f14';
        = fdc$function_15 =
          event_trigger_name := 'f15';
        = fdc$function_16 =
          event_trigger_name := 'f16';
        = fdc$shift_next =
          event_trigger_name := 'shift_next';
        = fdc$shift_help =
          event_trigger_name := 'shift_help';
        = fdc$shift_stop =
          event_trigger_name := 'shift_stop';
        = fdc$shift_back =
          event_trigger_name := 'shift_back';
        = fdc$shift_up =
          event_trigger_name := 'shift_up';
        = fdc$shift_down =
          event_trigger_name := 'shift_down';
        = fdc$shift_forward =
          event_trigger_name := 'shift_forward';
        = fdc$shift_backward =
          event_trigger_name := 'shift_backward';
        = fdc$shift_edit =
          event_trigger_name := 'shift_edit';
        = fdc$shift_data =
          event_trigger_name := 'shift_data';
        = fdc$shift_function_1 =
          event_trigger_name := 'shift_f1';
        = fdc$shift_function_2 =
          event_trigger_name := 'shift_f2';
        = fdc$shift_function_3 =
          event_trigger_name := 'shift_f3';
        = fdc$shift_function_4 =
          event_trigger_name := 'shift_f4';
        = fdc$shift_function_5 =
          event_trigger_name := 'shift_f5';
        = fdc$shift_function_6 =
          event_trigger_name := 'shift_f6';
        = fdc$shift_function_7 =
          event_trigger_name := 'shift_f7';
        = fdc$shift_function_8 =
          event_trigger_name := 'shift_f8';
        = fdc$shift_function_9 =
          event_trigger_name := 'shift_f9';
        = fdc$shift_function_10 =
          event_trigger_name := 'shift_f10';
        = fdc$shift_function_11 =
          event_trigger_name := 'shift_f11';
        = fdc$shift_function_12 =
          event_trigger_name := 'shift_f12';
        = fdc$shift_function_13 =
          event_trigger_name := 'shift_f13';
        = fdc$shift_function_14 =
          event_trigger_name := 'shift_f14';
        = fdc$shift_function_15 =
          event_trigger_name := 'shift_f15';
        = fdc$shift_function_16 =
          event_trigger_name := 'shift_f16';
        = fdc$pick =
          event_trigger_name := 'pick';
        = fdc$insert_line =
          event_trigger_name := 'insert_line';
        = fdc$delete_line =
          event_trigger_name := 'delete_line';
        = fdc$home_cursor =
          event_trigger_name := 'home';
        = fdc$clear_screen =
          event_trigger_name := 'clear_screen';
        = fdc$time_out =
          event_trigger_name := 'time_out';
        = fdc$variable_trigger =
          event_trigger_name := 'variable_trigger';
        ELSE
        CASEND;

      PROCEND set_event_trigger_name;

?? OLDTITLE, EJECT ??

      set_event_trigger_name (get_form_attribute.event_trigger_v1, event_trigger_name);
      set_event_action_name (get_form_attribute.event_action_v1, event_action_name);
      STRINGREP (line, line_length, 'ADD_EVENT ', 'program_event=', get_form_attribute.
            event_name_v1 (1, clp$trimmed_string_size (get_form_attribute.event_name_v1)), ' terminal_event=',
            event_trigger_name (1, clp$trimmed_string_size (event_trigger_name)), ' action=',
            event_action_name (1, clp$trimmed_string_size (event_action_name)));

{ If no text is specified for event label, do not output label.

      IF get_form_attribute.event_label_v1 <> '' THEN
        STRINGREP (line, line_length, line (1, line_length), ' label=''');
        add_text (get_form_attribute.event_label_v1);
        STRINGREP (line, line_length, line (1, line_length), '''');
      IFEND;

{ If terminal event may be reassigned, do not output terminal_event_reassignment.

      IF NOT get_form_attribute.event_trigger_reassignment_v1 THEN
        STRINGREP (line, line_length, line (1, line_length), ' reassign_terminal_event=FALSE');
      IFEND;

      put_command_line (line (1, line_length));

    PROCEND add_event;
?? OLDTITLE ??
?? NEWTITLE := 'add_line', EJECT ??

{ PURPOSE:
{   This procedure does the add_line command.

    PROCEDURE add_line
      (    x_position: fdt$x_position,
           y_position: fdt$y_position;
       VAR status: ost$status);

      CONST
        object_definition_attribute = 1,
        object_display_attribute = 2,
        object_name_attribute = 3;

      VAR
        end_column: fdt$x_position,
        end_line: fdt$y_position,
        get_object_attributes: array [object_definition_attribute .. object_name_attribute] of
              fdt$get_object_attribute,
        get_object_definition: fdt$get_object_definition;

{ Get object attributes.

      status.normal := TRUE;
      get_object_attributes [object_definition_attribute].key := fdc$get_object_definition;
      get_object_attributes [object_display_attribute].key := fdc$get_object_display;
      get_object_attributes [object_name_attribute].key := fdc$get_object_name;
      fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      get_object_definition := get_object_attributes [object_definition_attribute].get_object_definition;

      STRINGREP (line, line_length, 'ADD_LINE start_column=', x_position, ' start_line=', y_position,
            ' end_column=', get_object_definition.x_increment + x_position, ' end_line=',
            get_object_definition.y_increment + y_position);

{ If NAME and OCCURRENCE parameter defined, output them.

      IF get_object_attributes [object_name_attribute].get_value_status <> fdc$undefined_value THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' name=', get_object_attributes [object_name_attribute].
              object_name (1, clp$trimmed_string_size (get_object_attributes [object_name_attribute].
              object_name)), ' occurrence=', get_object_attributes [object_name_attribute].occurrence);
      IFEND;

{ Remove display attributes that apply to the entire form.

      add_attributes (get_object_attributes [object_display_attribute].display_attribute -
            object_display_attribute_set, 'display');

      put_command_line (line (1, line_length));

    PROCEND add_line;

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

{ PURPOSE:
{   This procedure does the add_table command.

    PROCEDURE add_table
      (    table_name: ost$name);

      VAR
        get_table_attributes: array [1 .. 3] of fdt$get_table_attribute,
        number_table_variables: fdt$number_table_variables,
        get_table_attributes_p: ^array [1 .. * ] of fdt$get_table_attribute,
        stored_occurrence: fdt$occurrence,
        variable_index: fdt$number_table_variables,
        visible_occurrence: fdt$occurrence;

{ Get table attributes.

      get_table_attributes [1].key := fdc$get_number_table_variables;
      get_table_attributes [2].key := fdc$get_stored_occurrence;
      get_table_attributes [3].key := fdc$get_visible_occurrence;
      fdp$get_table_attributes (form_identifier, table_name, get_table_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      number_table_variables := get_table_attributes [1].number_table_variables;
      stored_occurrence := get_table_attributes [2].stored_occurrence;

      IF get_table_attributes [3].get_value_status = fdc$undefined_value THEN
        visible_occurrence := get_table_attributes [2].stored_occurrence;
      ELSE
        visible_occurrence := get_table_attributes [3].visible_occurrence;
      IFEND;

{ Get variables associated with table.

      IF number_table_variables > 0 THEN
        PUSH get_table_attributes_p: [1 .. number_table_variables];
        FOR variable_index := 1 TO number_table_variables DO
          get_table_attributes_p^ [variable_index].key := fdc$get_next_table_variable;
        FOREND;

        fdp$get_table_attributes (form_identifier, table_name, get_table_attributes_p^, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;
      IFEND;

      STRINGREP (line, line_length, 'ADD_TABLE table_name=',
            table_name (1, clp$trimmed_string_size (table_name)));

{ Process VARIABLE_NAME parameter. Start list of variables.

      IF number_table_variables > 0 THEN
        STRINGREP (line, line_length, line (1, line_length), ' variable_name=(');

{ Add variable to list.

        FOR variable_index := 1 TO number_table_variables DO
          STRINGREP (line, line_length, line (1, line_length),
                get_table_attributes_p^ [variable_index].variable_name
                (1, clp$trimmed_string_size (get_table_attributes_p^ [variable_index].variable_name)), ' ');
        FOREND;

        STRINGREP (line, line_length, line (1, line_length), ')');
      IFEND;

{ Complete list of variables.

      STRINGREP (line, line_length, line (1, line_length), ' stored_occurrence =', stored_occurrence,
            ' visible_occurrence=', visible_occurrence);
      put_command_line (line (1, line_length));

    PROCEND add_table;

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

{ PURPOSE:
{   This procedure processes text that may have a quote.
{ DESIGN:
{ If a quote appears in the text, the quote must be replaced with two quotes.

    PROCEDURE add_text
      (    text: string ( * ));

      VAR
        character_index: 1 .. max_command_line_size;

      FOR character_index := 1 TO clp$trimmed_string_size (text) DO
        line_length := line_length + 1;
        line (line_length, 1) := text (character_index, 1);

        IF text (character_index, 1) = '''' THEN
          line_length := line_length + 1;
          line (line_length, 1) := '''';
        IFEND;

      FOREND;

    PROCEND add_text;

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

{ PURPOSE:
{   This procedure does the add_variable command.

    PROCEDURE add_variable
      (    variable_name: ost$name);

      CONST
        io_mode_attribute = 1,
        program_data_attribute = 2,
        error_processing_attribute = 3,
        help_attribute = 4,
        length_attribute = 5,
        error_display_attribute = 6,
        user_entry_attribute = 7,
        comments_attribute = 8;

      VAR
        comment_length: fdt$comment_length,
        exponent_output_format: fdt$exponent_output_format,
        format: string (2),
        float_output_format: fdt$float_output_format,
        get_variable_attributes: array [io_mode_attribute .. comments_attribute] of
              fdt$get_variable_attribute,
        get_variable_attributes_p: ^array [1 .. * ] of fdt$get_variable_attribute,
        integer_output_format: fdt$integer_output_format,
        io_mode: fdt$io_mode,
        number_comments: fdt$number_comments,
        output_currency_format: fdt$output_currency_format,
        program_data_type: fdt$program_data_type,
        terminal_user_entry: fdt$terminal_user_entry,
        text_attribute: array [1 .. 1] of fdt$get_variable_attribute;

?? NEWTITLE := 'set_character_input', EJECT ??

{ PURPOSE:
{   This procedure does the set_character_input command.

      PROCEDURE set_character_input;

        VAR
          get_variable_attributes: array [1 .. 3] of fdt$get_variable_attribute,
          input_format_key: fdt$input_format_key,
          get_variable_attributes_p: ^array [1 .. * ] of fdt$get_variable_attribute,
          number_valid_strings: fdt$number_valid_strings,
          valid_string_length: fdt$valid_string_length;

{ Get attributes that apply to program character data type.

        get_variable_attributes [1].key := fdc$get_number_valid_strings;
        get_variable_attributes [2].key := fdc$get_string_compare_rules;
        get_variable_attributes [3].key := fdc$get_input_format;
        fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

{ Output only non default attributes.

        line_length := 0;
        IF get_variable_attributes [1].number_valid_strings > 0 THEN

{ Process valid values.

          STRINGREP (line, line_length, 'SET_CHARACTER_INPUT', ' variable_name=',
                variable_name (1, clp$trimmed_string_size (variable_name)), ' valid_value=(');
          PUSH get_variable_attributes_p: [1 .. get_variable_attributes [1].number_valid_strings];

{ Learn the space needed to obtain the valid string values.

          FOR number_valid_strings := 1 TO get_variable_attributes [1].number_valid_strings DO
            get_variable_attributes_p^ [number_valid_strings].key := fdc$get_valid_string_length;
          FOREND;

          fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes_p^, status);
          IF NOT status.normal THEN
            EXIT fdp$generate_form_module;
          IFEND;

{ Obtain space for valid strings.

          FOR number_valid_strings := 1 TO get_variable_attributes [1].number_valid_strings DO
            valid_string_length := get_variable_attributes_p^ [number_valid_strings].valid_string_length;
            get_variable_attributes_p^ [number_valid_strings].key := fdc$get_next_valid_string;
            PUSH get_variable_attributes_p^ [number_valid_strings].p_valid_string: [valid_string_length];
          FOREND;

          fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes_p^, status);
          IF NOT status.normal THEN
            EXIT fdp$generate_form_module;
          IFEND;

{ Start list of valid strings.

          STRINGREP (line, line_length, line (1, line_length), '''');
          add_text (get_variable_attributes_p^ [1].p_valid_string^);
          STRINGREP (line, line_length, line (1, line_length), '''');

{ Output list of valid strings.

          FOR number_valid_strings := 2 TO get_variable_attributes [1].number_valid_strings DO
            STRINGREP (line, line_length, line (1, line_length), ' ', '''');
            add_text (get_variable_attributes_p^ [number_valid_strings].p_valid_string^);
            STRINGREP (line, line_length, line (1, line_length), '''');
          FOREND;

{ Complete list of valid strings.

          STRINGREP (line, line_length, line (1, line_length), ')');
        IFEND;

{ Process COMPARE_TO_SUBSTRING parameter.

          IF line_length = 0 THEN
            STRINGREP (line, line_length, 'SET_CHARACTER_INPUT', ' variable_name=',
                  variable_name (1, clp$trimmed_string_size (variable_name)));
          IFEND;
          IF get_variable_attributes [2].compare_to_unique_substring THEN
            STRINGREP (line, line_length, line (1, line_length), ' compare_to_substring=true');
          ELSE
            STRINGREP (line, line_length, line (1, line_length), ' compare_to_substring=false');
          IFEND;

{ Process ENTRY_FORMAT parameter.

        IF get_variable_attributes [3].get_value_status <> fdc$undefined_value THEN

          CASE get_variable_attributes [3].input_format.key OF


          = fdc$alphabetic_input_format =

            IF line_length = 0 THEN
              STRINGREP (line, line_length, 'SET_CHARACTER_INPUT', ' variable_name=',
                    variable_name (1, clp$trimmed_string_size (variable_name)), ' entry_format=alphabetic');
            ELSE
              STRINGREP (line, line_length, line (1, line_length), ' entry_format=alphabetic');
            IFEND;

          = fdc$digits_input_format =
            IF line_length = 0 THEN
              STRINGREP (line, line_length, 'SET_CHARACTER_INPUT', ' variable_name=',
                    variable_name (1, clp$trimmed_string_size (variable_name)), ' entry_format=digits');
            ELSE
              STRINGREP (line, line_length, line (1, line_length), ' entry_format=digits');
            IFEND;

          = fdc$signed_input_format =
            IF line_length = 0 THEN
              STRINGREP (line, line_length, 'SET_CHARACTER_INPUT', ' variable_name=',
                    variable_name (1, clp$trimmed_string_size (variable_name)), ' entry_format=signed');
            ELSE
              STRINGREP (line, line_length, line (1, line_length), ' entry_format=signed');
            IFEND;

          ELSE {fdc$character_input_format}

{ Do not output the default.

          CASEND;
        IFEND;

        IF line_length > 0 THEN
          put_command_line (line (1, line_length));
        IFEND;

      PROCEND set_character_input;

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

{ PURPOSE :
{   Procedure to create 'set_cobol_data' command.

      PROCEDURE set_cobol_data;

        VAR
          cobol_program_clause : fdt$cobol_program_clause,
          get_variable_attributes: array [1 .. 1] of
                fdt$get_variable_attribute,
          usage: fdt$usage,
          usage_string: string (15);

        status.normal := TRUE;
        line_length := 0;
        get_variable_attributes [1].key := fdc$get_cobol_program_clause;
        get_variable_attributes [1].p_cobol_program_clause :=
              ^cobol_program_clause;
        fdp$get_variable_attributes (form_identifier, variable_name,
              get_variable_attributes, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

{ Output SET_COBOL_DATA command.

        IF NOT ((get_variable_attributes[1].get_value_status =
                                      fdc$undefined_value) OR
                (get_variable_attributes[1].get_value_status =
                                      fdc$unprocessed_get_value)) THEN

{ Output PICTURE parameter.

          IF (cobol_program_clause.picture <> '') THEN
            STRINGREP(line, line_length, 'SET_COBOL_DATA', ' variable_name=',
                      variable_name(1, clp$trimmed_string_size(variable_name)),
                      ' picture=''',
                      cobol_program_clause.picture(1,clp$trimmed_string_size(
                      cobol_program_clause.picture)), '''');
          IFEND;

{ Output USAGE parameter.

         CASE cobol_program_clause.usage OF

         = fdc$binary_usage =
           usage_string := 'BINARY';
         = fdc$computational_usage =
           usage_string := 'COMPUTATIONAL';
         = fdc$comp_usage =
           usage_string := 'COMP';
         = fdc$computational_1_usage =
           usage_string := 'COMPUTATIONAL_1';
         = fdc$comp_1_usage=
           usage_string := 'COMP_1';
         = fdc$computational_2_usage =
           usage_string := 'COMPUTATIONAL_2';
         = fdc$comp_2_usage =
           usage_string := 'COMP_2';
         = fdc$computational_3_usage =
           usage_string := 'COMPUTATIONAL_3';
         = fdc$comp_3_usage =
           usage_string := 'COMP_3';
         = fdc$packed_decimal_usage =
           usage_string := 'PACKED_DECIMAL';
         ELSE

{ Do not output default for fdc$display_usage }
           usage_string := '';
         CASEND;
         IF usage_string  <> '' THEN
           IF line_length > 0 THEN
              STRINGREP(line, line_length, line (1,line_length), ' usage=',
                    usage_string (1, clp$trimmed_string_size(usage_string )));
           ELSE
             STRINGREP(line, line_length,'SET_COBOL_DATA', ' variable_name=',
                    variable_name(1, clp$trimmed_string_size(variable_name)), ' usage=',
                    usage_string (1, clp$trimmed_string_size(usage_string)));
           IFEND;
         IFEND;

         IF line_length > 0 THEN
           put_command_line (line (1,line_length));
         IFEND;
        IFEND;

      PROCEND set_cobol_data;

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

{ PURPOSE :
{   Procedure to create 'set_cobol_output' command.

      PROCEDURE set_cobol_output;
        VAR
          cobol_display_clause : fdt$cobol_display_clause,
          get_variable_attributes: array [1 .. 1] of
                fdt$get_variable_attribute;

        status.normal := TRUE;
        line_length := 0;
        get_variable_attributes [1].key := fdc$get_cobol_display_clause;
        get_variable_attributes [1].p_cobol_display_clause :=
              ^cobol_display_clause;
        fdp$get_variable_attributes (form_identifier, variable_name,
              get_variable_attributes, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

{ Output SET_COBOL_OUTPUT command.

        IF NOT ((get_variable_attributes[1].get_value_status =
                                      fdc$undefined_value) OR
                (get_variable_attributes[1].get_value_status =
                                      fdc$unprocessed_get_value)) THEN

{ Output PICTURE parameter.

          IF (cobol_display_clause.picture <> '') THEN
            STRINGREP(line, line_length, 'SET_COBOL_OUTPUT', ' variable_name=',
                      variable_name(1, clp$trimmed_string_size(variable_name)),
                     ' picture=''',
                      cobol_display_clause.picture(1,clp$trimmed_string_size(
                      cobol_display_clause.picture)),'''');
            put_command_line (line (1,line_length));
          IFEND;
        IFEND;

      PROCEND set_cobol_output;

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

{ PURPOSE:
{   This procedure does the set_date_input command.

      PROCEDURE set_date_input
        (    get_variable_attributes: array [1 .. 2] of fdt$get_variable_attribute);

        VAR
          format: string (5);


        CASE get_variable_attributes [2].input_format.key OF

        = fdc$dmy_format =
          format := 'dmy';

        = fdc$mdy_format =
          format := 'mdy';

        = fdc$ydm_format =
          format := 'ydm';

        = fdc$iso_date_format =
          format := 'isod';

        ELSE{fdc$month_dd_yyyy_format =
          format := 'month';
        CASEND;

        STRINGREP (line, line_length, 'SET_DATE_INPUT', ' variable_name=',
              variable_name (1, clp$trimmed_string_size (variable_name)), ' format=', format);

        put_command_line (line (1, line_length));

      PROCEND set_date_input;

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

{ PURPOSE:
{   This procedure does the set_date_output command.

      PROCEDURE set_date_output
        (    format: string (*));


        STRINGREP (line, line_length, 'SET_DATE_OUTPUT', ' variable_name=',
              variable_name (1, clp$trimmed_string_size (variable_name)), ' format=', format);

        put_command_line (line (1, line_length));

      PROCEND set_date_output;

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

{ PURPOSE:
{   This procedure does the set_exponent_output command.

      PROCEDURE set_exponent_output;

        STRINGREP (line, line_length, 'SET_EXPONENT_OUTPUT', ' variable_name=',
              variable_name (1, clp$trimmed_string_size (variable_name)), ' format=', format, ' width=',
              exponent_output_format.field_width, ' digits_right_of_decimal=',
              exponent_output_format.digits_right_decimal, ' digits_in_exponent=',
              exponent_output_format.digits_in_exponent);

{ Process SIGN parameter. Do not output the default: minus if negative.

        IF exponent_output_format.sign_treatment <> mlc$minus_if_negative THEN
          STRINGREP (line, line_length, line (1, line_length), ' sign=always_signed');
        IFEND;

{ Process SUPPRESS_ZERO parameter.  Do  not output the default:
{ suppress zero TRUE.

        IF NOT exponent_output_format.suppress_zero THEN
          STRINGREP (line, line_length, line (1, line_length), ' suppress_zero=false');
        IFEND;

        put_command_line (line (1, line_length));

      PROCEND set_exponent_output;

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

{ PURPOSE:
{   This procedure does the set_float_output command.

      PROCEDURE set_float_output;

        STRINGREP (line, line_length, 'SET_FLOAT_OUTPUT', ' variable_name=',
              variable_name (1, clp$trimmed_string_size (variable_name)), ' format=', format(1), ' width=',
              float_output_format.field_width, ' digits_right_of_decimal = ',
              float_output_format.digits_right_decimal);

{ Process SIGN parameter.  Do not output the default: always signed.

        IF float_output_format.sign_treatment <> mlc$minus_if_negative THEN
          STRINGREP (line, line_length, line (1, line_length), ' sign=always_signed');
        IFEND;

{ Process SUPPRESS_ZERO parameter.  Do not output the default:
{ suppress zero TRUE.

        IF NOT float_output_format.suppress_zero THEN
          STRINGREP (line, line_length, line (1, line_length), ' suppress_zero=false');
        IFEND;

        put_command_line (line (1, line_length));

      PROCEND set_float_output;

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

{ PURPOSE:
{   This procedure does the set_integer_input command.

      PROCEDURE set_integer_input;

        VAR
          get_variable_attributes: array [1 .. 2] of fdt$get_variable_attribute,
          number_valid_integers: fdt$number_valid_integers,
          get_variable_attributes_p: ^array [1 .. * ] of fdt$get_variable_attribute;

{ Get attributes for integer program data type.

        get_variable_attributes [1].key := fdc$get_number_valid_integers;
        get_variable_attributes [2].key := fdc$get_input_format;
        fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        IF (get_variable_attributes [2].get_value_status <> fdc$undefined_value) AND
              (get_variable_attributes [2].input_format.key IN $fdt$input_format_key_set [fdc$ydm_format,
              fdc$dmy_format, fdc$mdy_format, fdc$iso_date_format, fdc$month_dd_yyyy_format]) THEN
          set_date_input (get_variable_attributes);
          RETURN;
        IFEND;

{ Only output command and parameter if non defaults occur.

        line_length := 0;
        IF get_variable_attributes [1].number_valid_integers > 0 THEN

{ Get list  of valid integers.

          PUSH get_variable_attributes_p: [1 .. get_variable_attributes [1].number_valid_integers];
          FOR number_valid_integers := 1 TO get_variable_attributes [1].number_valid_integers DO
            get_variable_attributes_p^ [number_valid_integers].key := fdc$get_valid_integer_range;
          FOREND;

          fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes_p^, status);
          IF NOT status.normal THEN
            EXIT fdp$generate_form_module;
          IFEND;

{ Start list of range of integer.


          IF get_variable_attributes_p^ [1].minimum_integer <>
                get_variable_attributes_p^ [1].maximum_integer THEN
            STRINGREP (line, line_length, 'SET_INTEGER_INPUT', ' variable_name= ',
                  variable_name (1, clp$trimmed_string_size (variable_name)), ' valid_value=(',
                  get_variable_attributes_p^ [1].minimum_integer, ' .. ',
                  get_variable_attributes_p^ [1].maximum_integer);
          ELSE
            STRINGREP (line, line_length, 'SET_INTEGER_INPUT', ' variable_name= ',
                  variable_name (1, clp$trimmed_string_size (variable_name)), ' valid_value=(',
                  get_variable_attributes_p^ [1].minimum_integer);
          IFEND;

{ Add to list of range of integer.

          FOR number_valid_integers := 2 TO get_variable_attributes [1].number_valid_integers DO
            IF get_variable_attributes_p^ [number_valid_integers].minimum_integer <>
                get_variable_attributes_p^ [number_valid_integers].maximum_integer THEN
              STRINGREP (line, line_length, line (1, line_length),
                    ' ', get_variable_attributes_p^ [number_valid_integers].minimum_integer, ' .. ',
                    get_variable_attributes_p^ [number_valid_integers].maximum_integer);
            ELSE
              STRINGREP (line, line_length, line (1, line_length),
                  ' ', get_variable_attributes_p^ [number_valid_integers].minimum_integer);
            IFEND;
          FOREND;

{ Complete list of range of integer.

          STRINGREP (line, line_length, line (1, line_length), ')');
        IFEND;

{ Process ENTRY_FORMAT parameter.

        IF get_variable_attributes [2].get_value_status <> fdc$undefined_value THEN

          CASE get_variable_attributes [2].input_format.key OF

          = fdc$digits_input_format =

            IF line_length = 0 THEN
              STRINGREP (line, line_length, 'SET_INTEGER_INPUT', ' variable_name= ',
                    variable_name (1, clp$trimmed_string_size (variable_name)), ' entry_format=digits');
            ELSE
              STRINGREP (line, line_length, line (1, line_length), ' entry_format=digits');
            IFEND;

          ELSE

{ Signed input is the default. Do not output the default.

          CASEND;
        IFEND;

        IF line_length > 0 THEN
          put_command_line (line (1, line_length));
        IFEND;

      PROCEND set_integer_input;

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

{ PURPOSE:
{   This procedure does the set_integer_output command.

      PROCEDURE set_integer_output;

        STRINGREP (line, line_length, 'SET_INTEGER_OUTPUT', ' variable_name=',
              variable_name (1, clp$trimmed_string_size (variable_name)), ' width=',
              integer_output_format.field_width);

{ Process MINIMUM_DIGITS parameter.

        IF integer_output_format.minimum_output_digits <> 0 THEN
          STRINGREP (line, line_length, line (1, line_length), ' minimum_digits=',
                integer_output_format.minimum_output_digits);
        IFEND;

{ Process SIGN parameter.

        IF integer_output_format.sign_treatment <> mlc$minus_if_negative THEN
          STRINGREP (line, line_length, line (1, line_length), ' sign=always_signed');
        IFEND;

        put_command_line (line (1, line_length));

      PROCEND set_integer_output;

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

{ PURPOSE:
{   This procedure does the set_money_input command.

      PROCEDURE set_money_input;

        VAR
          get_variable_attributes: array [1 .. 1] of fdt$get_variable_attribute,
          input_currency_format: fdt$input_currency_format;

        get_variable_attributes [1].key := fdc$get_input_format;
        fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;


        CASE get_variable_attributes [1].input_format.key OF

        = fdc$currency_input_format =
          input_currency_format := get_variable_attributes [1].input_format.input_currency_format;

{ If form definition uses all the defaults, do not generate a command.

          IF ((input_currency_format.currency_sybmol <> fdc$system_currency_sign) OR
                (input_currency_format.thousands_separator <> fdc$system_thousands_separator) OR
                (input_currency_format.decimal_point <> fdc$system_decimal_point)) THEN
            STRINGREP (line, line_length, 'SET_MONEY_INPUT', ' variable_name=',
                  variable_name (1, clp$trimmed_string_size (variable_name)));

            IF input_currency_format.currency_sybmol <> fdc$system_currency_sign THEN
              STRINGREP (line, line_length, line (1, line_length), ' money_symbol=''',
                    input_currency_format.currency_sybmol {sic} , '''');
            IFEND;

            IF input_currency_format.thousands_separator <> fdc$system_thousands_separator THEN
              STRINGREP (line, line_length, line (1, line_length), ' thousands_separator=''',
                    input_currency_format.thousands_separator, '''');
            IFEND;

            IF input_currency_format.decimal_point <> fdc$system_decimal_point THEN
              STRINGREP (line, line_length, line (1, line_length), ' decimal_point=''',
                    input_currency_format.decimal_point, '''');
            IFEND;

            put_command_line (line (1, line_length));
          IFEND;

        ELSE
        CASEND;

      PROCEND set_money_input;

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

{ PURPOSE:
{   This procedure does the set_money_output command.

      PROCEDURE set_money_output;

{ If form definition uses all the defaults, do not generate a command.

        IF ((output_currency_format.currency_sybmol <> fdc$system_currency_sign) OR
              (output_currency_format.thousands_separator <> fdc$system_thousands_separator) OR
              (output_currency_format.decimal_point <> fdc$system_decimal_point)) THEN
          STRINGREP (line, line_length, 'SET_MONEY_OUTPUT', ' variable_name=',
                variable_name (1, clp$trimmed_string_size (variable_name)));

          IF output_currency_format.currency_sybmol <> fdc$system_currency_sign THEN
            STRINGREP (line, line_length, line (1, line_length), ' money_symbol=''',
                  output_currency_format.currency_sybmol {sic} , '''');
          IFEND;

          IF output_currency_format.thousands_separator <> fdc$system_thousands_separator THEN
            STRINGREP (line, line_length, line (1, line_length), ' thousands_separator=''',
                  output_currency_format.thousands_separator, '''');
          IFEND;

          IF output_currency_format.decimal_point <> fdc$system_decimal_point THEN
            STRINGREP (line, line_length, line (1, line_length), ' decimal_point=''',
                  output_currency_format.decimal_point, '''');
          IFEND;

          put_command_line (line (1, line_length));
        IFEND;

      PROCEND set_money_output;

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

{ PURPOSE:
{   This procedure makes changes to input processing.

      PROCEDURE set_input;


{ Process attributes that apply to program data type. Both integers and reals
{ can be used for money.

        CASE program_data_type OF

        = fdc$program_character_type, fdc$program_upper_case_type =
          set_character_input;

        = fdc$program_integer_type =
          set_integer_input;
          set_money_input;

        = fdc$program_real_type =
          set_real_input;
          set_money_input;

       ELSE { fdc$program_cobol_type
         set_money_input;
         set_cobol_data;
         set_character_input;
         set_integer_input;
         set_real_input;
        CASEND;

      PROCEND set_input;

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

{ PURPOSE:
{   This procedure makes changes to output processing.

      PROCEDURE set_output;

        VAR
          get_variable_attributes: array [1 .. 1] of fdt$get_variable_attribute;

        get_variable_attributes [1].key := fdc$get_output_format;
        fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        IF program_data_type = fdc$program_cobol_type THEN
          IF get_variable_attributes [1].output_format.key = fdc$currency_output_format THEN
            output_currency_format := get_variable_attributes [1].output_format.output_currency_format;
            set_money_output;
          IFEND;
          set_cobol_output;
          RETURN;
        IFEND;

        CASE get_variable_attributes [1].output_format.key OF

        = fdc$character_output_format =

{ Do nothing.  Character output format can not be changed.

        = fdc$currency_output_format =
          output_currency_format := get_variable_attributes [1].output_format.output_currency_format;
          set_money_output;

        = fdc$e_e_output_format =
          format := 'EE';
          exponent_output_format := get_variable_attributes [1].output_format.exponent_output_format;
          set_exponent_output;

        = fdc$g_e_output_format =
          format := 'GE';
          exponent_output_format := get_variable_attributes [1].output_format.exponent_output_format;
          set_exponent_output;

        = fdc$e_output_format =
          format := 'E';
          float_output_format := get_variable_attributes [1].output_format.float_output_format;
          set_float_output;

        = fdc$f_output_format =
          format := 'F';
          float_output_format := get_variable_attributes [1].output_format.float_output_format;
          set_float_output;

        = fdc$g_output_format =
          format := 'G';
          float_output_format := get_variable_attributes [1].output_format.float_output_format;
          set_float_output;

        = fdc$integer_output_format =
          integer_output_format := get_variable_attributes [1].output_format.integer_output_format;
          set_integer_output;

        = fdc$dmy_output_format =
          set_date_output ('dmy');

        = fdc$mdy_output_format =
          set_date_output ('mdy');

        = fdc$ydm_output_format =
          set_date_output ('ydm');

        = fdc$iso_output_format =
          set_date_output ('isod');

        = fdc$month_dd_yyyy_out_format =
          set_date_output ('month');

        ELSE
        CASEND;

      PROCEND set_output;

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

{ PURPOSE:
{   This procedure does the set_real_input command.

      PROCEDURE set_real_input;

        VAR
          get_variable_attributes: array [1 .. 1] of fdt$get_variable_attribute,
          number_valid_reals: fdt$number_valid_reals,
          get_variable_attributes_p: ^array [1 .. * ] of fdt$get_variable_attribute;

        get_variable_attributes [1].key := fdc$get_number_valid_reals;
        fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        IF get_variable_attributes [1].number_valid_reals < 1 THEN
          RETURN;
        IFEND;

{ Get space to receive valid reals.

        PUSH get_variable_attributes_p: [1 .. get_variable_attributes [1].number_valid_reals];
        FOR number_valid_reals := 1 TO get_variable_attributes [1].number_valid_reals DO
          get_variable_attributes_p^ [number_valid_reals].key := fdc$get_next_valid_real_range;
        FOREND;

{ Get valid reals.

        fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes_p^, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

{ Start list of range of reals.

        IF get_variable_attributes_p^ [1].minimum_real <>
              get_variable_attributes_p^ [1].maximum_real THEN
          STRINGREP (line, line_length, 'SET_REAL_INPUT', ' variable_name= ',
                variable_name (1, clp$trimmed_string_size (variable_name)), ' valid_value=(',
                get_variable_attributes_p^ [1].minimum_real, ' .. ', get_variable_attributes_p^ [1].
                maximum_real);
        ELSE
          STRINGREP (line, line_length, 'SET_REAL_INPUT', ' variable_name= ',
                variable_name (1, clp$trimmed_string_size (variable_name)), ' valid_value=(',
                get_variable_attributes_p^ [1].minimum_real);
        IFEND;

{ Add to list of range of reals.

        FOR number_valid_reals := 2 TO get_variable_attributes [1].number_valid_reals DO
          IF get_variable_attributes_p^ [number_valid_reals].minimum_real <>
              get_variable_attributes_p^ [number_valid_reals].maximum_real THEN
            STRINGREP (line, line_length, line (1, line_length),
                  ' ', get_variable_attributes_p^ [number_valid_reals].minimum_real, ' .. ',
                  get_variable_attributes_p^ [number_valid_reals].maximum_real);
          ELSE
            STRINGREP (line, line_length, line (1, line_length),
                  ' ', get_variable_attributes_p^ [number_valid_reals].minimum_real);
          IFEND;
        FOREND;

{ Complete list of range of reals.

        STRINGREP (line, line_length, line (1, line_length), ')');

        put_command_line (line (1, line_length));

      PROCEND set_real_input;

?? OLDTITLE, EJECT ??

{ Get variable attributes.

      get_variable_attributes [io_mode_attribute].key := fdc$get_io_mode;
      get_variable_attributes [program_data_attribute].key := fdc$get_program_data_type;
      get_variable_attributes [error_processing_attribute].key := fdc$get_variable_error;
      get_variable_attributes [help_attribute].key := fdc$get_variable_help;
      get_variable_attributes [length_attribute].key := fdc$get_variable_length;
      get_variable_attributes [error_display_attribute].key := fdc$get_error_display;
      get_variable_attributes [user_entry_attribute].key := fdc$get_terminal_user_entry;
      get_variable_attributes [comments_attribute].key := fdc$get_number_var_comments;
      fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

{ Process VARIABLE_NAME parameter.

      STRINGREP (line, line_length, 'ADD_VARIABLE', ' variable_name=',
            variable_name (1, clp$trimmed_string_size (variable_name)));

{ Process IO_MODE parameter.

      CASE get_variable_attributes [io_mode_attribute].io_mode OF

      = fdc$program_input_output =
        STRINGREP (line, line_length, line (1, line_length), ' io_mode=program');

      = fdc$terminal_input =
        STRINGREP (line, line_length, line (1, line_length), ' io_mode=input');

      = fdc$terminal_output =
        STRINGREP (line, line_length, line (1, line_length), ' io_mode=output');

      ELSE

{ Input/output is the default.  Do not output the default.

      CASEND;

{ Process DATA_TYPE parameter.

      program_data_type := get_variable_attributes [program_data_attribute].program_data_type;

      CASE program_data_type OF

      = fdc$program_character_type =
        STRINGREP (line, line_length, line (1, line_length), ' data_type=character');

      = fdc$program_integer_type =
        STRINGREP (line, line_length, line (1, line_length), ' data_type=integer');

      = fdc$program_real_type =
        STRINGREP (line, line_length, line (1, line_length), ' data_type=real');

      = fdc$program_upper_case_type =
        STRINGREP (line, line_length, line (1, line_length), ' data_type=uppercase');

      = fdc$program_cobol_type =
        STRINGREP (line, line_length, line (1, line_length), ' data_type=cobol');
      ELSE
      CASEND;

{ Process ERROR_PROCESSING parameter.

      CASE get_variable_attributes [error_processing_attribute].variable_error.key OF

      = fdc$get_error_form =
        STRINGREP (line, line_length, line (1, line_length),
              ' error_processing=', get_variable_attributes [error_processing_attribute].variable_error.
              error_form (1, clp$trimmed_string_size (get_variable_attributes [error_processing_attribute].
              variable_error.error_form)));

      = fdc$get_error_message =
        PUSH text_attribute [1].p_error_message: [get_variable_attributes [error_processing_attribute].
              variable_error.error_message_length];
        text_attribute [1].key := fdc$get_var_error_message;
        fdp$get_variable_attributes (form_identifier, variable_name, text_attribute, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        STRINGREP (line, line_length, line (1, line_length), ' error_processing=''');
        add_text (text_attribute [1].p_error_message^);
        STRINGREP (line, line_length, line (1, line_length), '''');

      = fdc$get_system_default_error =
        STRINGREP (line, line_length, line (1, line_length), ' error_processing=system');

      ELSE {fdc$get_no_error_response}

{ No error processing is the default.  Do not output the default.

      CASEND;

{ Process HELP_PROCESSING parameter.

      CASE get_variable_attributes [help_attribute].variable_help.key OF

      = fdc$get_help_form =
        STRINGREP (line, line_length, line (1, line_length),
              ' help_processing=', get_variable_attributes [help_attribute].
              variable_help.help_form (1, clp$trimmed_string_size
              (get_variable_attributes [help_attribute].variable_help.help_form)));

      = fdc$get_help_message =
        PUSH text_attribute [1].p_help_message: [get_variable_attributes [help_attribute].variable_help.
              help_message_length];
        text_attribute [1].key := fdc$get_var_help_message;
        fdp$get_variable_attributes (form_identifier, variable_name, text_attribute, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        STRINGREP (line, line_length, line (1, line_length), ' help_processing=''');
        add_text (text_attribute [1].p_help_message^);
        STRINGREP (line, line_length, line (1, line_length), '''');

      = fdc$get_system_default_help =
        STRINGREP (line, line_length, line (1, line_length), ' help_processing=system');

      ELSE {fdc$get_no_help_response}

{ No help processing is the default.  Do  not output the default.

      CASEND;

{ Process LENGTH parameter. For the COBOL data type the PICTURE clause gives
{ length of the program variable.

      IF program_data_type <> fdc$program_cobol_type THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' length=', get_variable_attributes [length_attribute].variable_length);
      IFEND;
{ Process ERROR_DISPLAY parameter.  Remove the defaults, the display
{ attributes of that apply to entire form.

      add_attributes (get_variable_attributes [error_display_attribute].display_attribute -
            object_display_attribute_set, 'error_display');

{ Process USER_ENTRY parameter.

      terminal_user_entry := get_variable_attributes [user_entry_attribute].terminal_user_entry;

{ The default is fdc$entry_optional.  Do not output the default.

      IF fdc$must_enter IN terminal_user_entry THEN
        STRINGREP (line, line_length, line (1, line_length), ' user_entry=must_enter');
      IFEND;

{ Process COMMENT parameter.

      IF get_variable_attributes [comments_attribute].number_var_comments > 0 THEN
        PUSH get_variable_attributes_p: [1 .. get_variable_attributes [comments_attribute].
              number_var_comments];

{ Learn the space needed to obtain the comments.

        FOR number_comments := 1 TO get_variable_attributes [comments_attribute].number_var_comments DO
          get_variable_attributes_p^ [number_comments].key := fdc$get_var_comment_length;
        FOREND;

        fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes_p^, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

{ Obtain space for the comments.

        FOR number_comments := 1 TO get_variable_attributes [comments_attribute].number_var_comments DO
          comment_length := get_variable_attributes_p^ [number_comments].var_comment_length;
          get_variable_attributes_p^ [number_comments].key := fdc$get_next_var_comment;
          PUSH get_variable_attributes_p^ [number_comments].p_var_comment: [comment_length];
        FOREND;

        fdp$get_variable_attributes (form_identifier, variable_name, get_variable_attributes_p^, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

{ Start list of comments.

        STRINGREP (line, line_length, line (1, line_length), ' comment=(', '''');
        add_text (get_variable_attributes_p^ [1].p_var_comment^);
        STRINGREP (line, line_length, line (1, line_length), '''');

{ Output list of comments.

        FOR number_comments := 2 TO get_variable_attributes [comments_attribute].number_var_comments DO
          STRINGREP (line, line_length, line (1, line_length), ' ', '''');
          add_text (get_variable_attributes_p^ [number_comments].p_var_comment^);
          STRINGREP (line, line_length, line (1, line_length), '''');
        FOREND;

{ Complete list of comments.

        STRINGREP (line, line_length, line (1, line_length), ')');
      IFEND;

      put_command_line (line (1, line_length));

      set_input;
      set_output;

    PROCEND add_variable;

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

{ PURPOSE:
{   This procedure does the add_variable_text command.

    PROCEDURE add_variable_text
      (    x_position: fdt$x_position,
           y_position: fdt$y_position;
       VAR status: ost$status);

      CONST
        object_definition_attribute = 1,
        object_name_attribute = 2,
        object_display_attribute = 3;

      VAR
        get_object_attributes: array [object_definition_attribute .. object_display_attribute] of
              fdt$get_object_attribute,
        get_object_definition: fdt$get_object_definition,
        get_object_text: array [1 .. 1] of fdt$get_object_attribute;

{ Get attributes.

      status.normal := TRUE;
      get_object_attributes [object_definition_attribute].key := fdc$get_object_definition;
      get_object_attributes [object_name_attribute].key := fdc$get_object_name;
      get_object_attributes [object_display_attribute].key := fdc$get_object_display;
      fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      get_object_definition := get_object_attributes [object_definition_attribute].get_object_definition;

      STRINGREP (line, line_length, 'ADD_VARIABLE_TEXT', ' column=', x_position, ' line=', y_position);

{ Process TEXT parameter.

      IF get_object_definition.variable_text_length > 0 THEN
        PUSH get_object_text [1].p_text: [get_object_definition.variable_text_length];
        get_object_text [1].key := fdc$get_object_text;
        fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_text, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        STRINGREP (line, line_length, line (1, line_length), ' text=''');
        add_text (get_object_text [1].p_text^);
        STRINGREP (line, line_length, line (1, line_length), '''');

      ELSE {No text.}
        STRINGREP (line, line_length, line (1, line_length), ' text=''''');
      IFEND;

{ Process NAME and OCCURRENCE parameter.

      IF get_object_attributes [object_name_attribute].get_value_status <> fdc$undefined_value THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' variable_name=', get_object_attributes [object_name_attribute].
              object_name (1, clp$trimmed_string_size (get_object_attributes [object_name_attribute].
              object_name)), ' occurrence=', get_object_attributes [object_name_attribute].occurrence);
      IFEND;

{ Process ATTRIBUTE parameter.  Remove the defaults, the display attributes of
{ the entire form.

      add_attributes (get_object_attributes [object_display_attribute].display_attribute -
            object_display_attribute_set, 'display');

{ Process WIDTH parameter. If the text specifies the length, do not output
{ width.

      IF get_object_definition.variable_text_length > 0 THEN
        IF ((get_object_definition.variable_text_width <> STRLENGTH (get_object_text [1].p_text^)) OR
              (get_object_text [1].p_text^ (STRLENGTH (get_object_text [1].p_text^)) = ' ') OR
              (get_object_text [1].p_text^ = '')) THEN
          STRINGREP (line, line_length, line (1, line_length), ' width=',
                get_object_definition.variable_text_width);
        IFEND;

      ELSE { No text, so use the width.}
        STRINGREP (line, line_length, line (1, line_length), ' width=',
              get_object_definition.variable_text_width);

      IFEND;

      put_command_line (line (1, line_length));

    PROCEND add_variable_text;

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

{ PURPOSE:
{   This procedure does the add_variable_text_box command.

    PROCEDURE add_variable_text_box
      (    x_position: fdt$x_position;
           y_position: fdt$y_position;
       VAR status: ost$status);

      CONST
        object_definition_attribute = 1,
        object_name_attribute = 2,
        object_display_attribute = 3;

      VAR
        get_object_attributes: array [object_definition_attribute .. object_display_attribute] of
              fdt$get_object_attribute,
        get_object_definition: fdt$get_object_definition,
        get_object_text: array [1 .. 1] of fdt$get_object_attribute;

      status.normal := TRUE;
      get_object_attributes [object_definition_attribute].key := fdc$get_object_definition;
      get_object_attributes [object_name_attribute].key := fdc$get_object_name;
      get_object_attributes [object_display_attribute].key := fdc$get_object_display;
      fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      get_object_definition := get_object_attributes [object_definition_attribute].get_object_definition;

      STRINGREP (line, line_length, 'ADD_VARIABLE_TEXT_BOX', ' column=', x_position, ' line=', y_position);

{ Process TEXT parameter.

      IF get_object_definition.variable_box_text_length > 0 THEN
        get_object_text [1].key := fdc$get_object_text;
        PUSH get_object_text [1].p_text: [get_object_definition.variable_box_text_length];
        fdp$get_object_attributes (form_identifier, x_position, y_position, get_object_text, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        STRINGREP (line, line_length, line (1, line_length), ' text=''');
        add_text (get_object_text [1].p_text^);
        STRINGREP (line, line_length, line (1, line_length), '''');

      ELSE {Object has no text.}
        STRINGREP (line, line_length, line (1, line_length), ' text=''''');
      IFEND;

{ Process HEIGHT and WIDTH parameters.

      STRINGREP (line, line_length, line (1, line_length), ' width=',
            get_object_definition.variable_box_width, ' height=', get_object_definition.variable_box_height);

{ Process NAME and OCCURRENCE parameters.

      IF get_object_attributes [object_name_attribute].get_value_status <> fdc$undefined_value THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' variable_name=', get_object_attributes [object_name_attribute].
              object_name (1, clp$trimmed_string_size (get_object_attributes [object_name_attribute].
              object_name)), ' occurrence=', get_object_attributes [object_name_attribute].occurrence);
      IFEND;

{ Process ATTRIBUTE parameter.  Remove the defaults: the display attributes of
{ the form.

      add_attributes (get_object_attributes [object_display_attribute].display_attribute -
            object_display_attribute_set, 'display');

{ Process TEXT_FORMAT parameter.

      CASE get_object_definition.variable_box_processing OF

      = fdc$center_characters =
        STRINGREP (line, line_length, line (1, line_length), ' text_format=center_characters');

      = fdc$wrap_characters =
        STRINGREP (line, line_length, line (1, line_length), ' text_format=wrap_characters');

      ELSE {fdc$wrap_words}

{ Wrap words is the default.  Do not output the default.

      CASEND;

      put_command_line (line (1, line_length));

    PROCEND add_variable_text_box;

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

{ PURPOSE:
{   This procedure process conditions.

    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);

      VAR
        local_status: ost$status;

      CASE condition.selector OF

      = pmc$block_exit_processing =
        fdp$close_form (form_identifier, local_status);
        RETURN;
      ELSE
        ;
      CASEND;
      pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
    PROCEND condition_handler;

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

{ PURPOSE:
{   This procedure converts a name to a name valid for the form processor.

    PROCEDURE convert_name
      (    processor: fdt$form_processor;
       VAR name: ost$name);

       CASE processor OF
         = fdc$ansi_fortran_processor, fdc$cdc_fortran_processor,fdc$extended_fortran_processor =
           fdp$convert_to_fortran_name (processor, name);

         = fdc$cobol_processor =
           fdp$convert_to_cobol_name (name);
       ELSE
{  The existing name is valid. }
       CASEND;
    PROCEND convert_name;

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

{ PURPOSE:
{   This procedure generates all the add_display commands.

    PROCEDURE generate_displays;

      VAR
        get_form_attributes: array [1 .. 1] of fdt$get_form_attribute,
        get_form_attributes_p: ^array [1 .. * ] of fdt$get_form_attribute,
        number_object_displays: fdt$number_object_displays;

      get_form_attributes [1].key := fdc$get_number_displays;
      fdp$get_form_attributes (form_identifier, get_form_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      IF get_form_attributes [1].number_form_displays = 0 THEN
        RETURN;
      IFEND;

      PUSH get_form_attributes_p: [1 .. get_form_attributes [1].number_form_displays];

      FOR number_object_displays := LOWERBOUND (get_form_attributes_p^) TO
            UPPERBOUND (get_form_attributes_p^) DO
        get_form_attributes_p^ [number_object_displays].key := fdc$get_next_display;
      FOREND;

      fdp$get_form_attributes (form_identifier, get_form_attributes_p^, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      FOR number_object_displays := LOWERBOUND (get_form_attributes_p^)
            TO UPPERBOUND (get_form_attributes_p^) DO
        add_display (get_form_attributes_p^ [number_object_displays].display_attribute,
              get_form_attributes_p^ [number_object_displays].display_name);
      FOREND;

    PROCEND generate_displays;

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

{ PURPOSE:
{   This procedure generates all the add_event commands.

    PROCEDURE generate_events;

      VAR
        get_form_attributes: array [1 .. 1] of fdt$get_form_attribute,
        get_form_attributes_p: ^array [1 .. * ] of fdt$get_form_attribute,
        form_names_p: ^fdt$form_names,
        number_events: fdt$number_events;

      get_form_attributes [1].key := fdc$get_number_events;
      fdp$get_form_attributes (form_identifier, get_form_attributes, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF get_form_attributes [1].number_events = 0 THEN
        RETURN;
      IFEND;

      PUSH get_form_attributes_p: [1 .. get_form_attributes [1].number_events];
      FOR number_events := LOWERBOUND (get_form_attributes_p^) TO UPPERBOUND (get_form_attributes_p^) DO
        get_form_attributes_p^ [number_events].key := fdc$get_next_event_v1;
      FOREND;

      fdp$get_form_attributes (form_identifier, get_form_attributes_p^, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      FOR number_events := LOWERBOUND (get_form_attributes_p^) TO UPPERBOUND (get_form_attributes_p^) DO
        add_event (get_form_attributes_p^ [number_events]);
      FOREND;

    PROCEND generate_events;

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

{ PURPOSE:
{   This procedure generates the commands for a form.

    PROCEDURE generate_form;

      CONST
        form_name_attribute = 1,
        form_processor_attribute = 2,
        form_area_attribute = 3,
        form_display_attribute = 4,
        event_form_attribute = 5,
        form_help_attribute = 6,
        error_message_form_attribute = 7,
        invalid_data_attribute = 8,
        help_message_form_attribute = 9,
        hidden_editing_attribute = 10,
        comments_attribute = 11;

      VAR
        comment_length: fdt$comment_length,
        get_form_attributes: array [form_name_attribute .. comments_attribute] of fdt$get_form_attribute,
        get_form_attributes_p: ^array [1 .. * ] of fdt$get_form_attribute,
        get_record_attributes: array [1 .. 2] of fdt$get_record_attribute,
        help_message: array [1 .. 1] of fdt$get_form_attribute,
        help_message_length: fdt$help_message_length,
        name: ost$name,
        number_comments: fdt$number_comments;

{ Get form attributes in order to generate commands to define form.

      get_form_attributes [form_name_attribute].key := fdc$get_form_name;
      get_form_attributes [form_processor_attribute].key := fdc$get_form_processor;
      get_form_attributes [form_area_attribute].key := fdc$get_form_area;
      get_form_attributes [form_display_attribute].key := fdc$get_form_display_attribute;
      get_form_attributes [event_form_attribute].key := fdc$get_event_form;
      get_form_attributes [form_help_attribute].key := fdc$get_form_help;
      get_form_attributes [invalid_data_attribute].key := fdc$get_invalid_data_character;
      get_form_attributes [error_message_form_attribute].key := fdc$get_error_message_form;
      get_form_attributes [help_message_form_attribute].key := fdc$get_help_message_form;
      get_form_attributes [hidden_editing_attribute].key := fdc$get_hidden_editing;
      get_form_attributes [comments_attribute].key := fdc$get_number_form_comments;
      fdp$get_form_attributes (form_identifier, get_form_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

{ Process FORM_NAME parameter.

      name := get_form_attributes [form_name_attribute].form_name;
      STRINGREP (line, line_length, 'CREATE_FORM_MODULE form_name=',
            name (1, clp$trimmed_string_size (name)));
      put_command_line (line (1, line_length));

{ Process PROCESSOR parameter.

      STRINGREP (line, line_length, 'SET_FORM');

      CASE get_form_attributes [form_processor_attribute].form_processor OF

      = fdc$ansi_fortran_processor =
        STRINGREP (line, line_length, line (1, line_length), ' processor=ansi_fortran');

      = fdc$cdc_fortran_processor =
        STRINGREP (line, line_length, line (1, line_length), ' processor=cdc_fortran');

      = fdc$cybil_processor =
        STRINGREP (line, line_length, line (1, line_length), ' processor=cybil');

      = fdc$extended_fortran_processor =
        STRINGREP (line, line_length, line (1, line_length), ' processor=extended_fortran');

      = fdc$pascal_processor =
        STRINGREP (line, line_length, line (1, line_length), ' processor=pascal');

      = fdc$scl_processor =
        STRINGREP (line, line_length, line (1, line_length), ' processor=scl');

      = fdc$unknown_processor =
        STRINGREP (line, line_length, line (1, line_length), ' processor=unknown');

      ELSE {fdc$cobol_processor}

{ COBOL is the default.  Do not output the default.

      CASEND;

{ Process COLUMN, LINE, WIDTH, and HEIGHT parameters.  The default is the area
{ of
{ the terminal screen.  Do not generate a parameter for the default.

      IF get_form_attributes [form_area_attribute].form_area.key = fdc$defined_area THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' column=', get_form_attributes [form_area_attribute].form_area.x_position, ' line= ',
              get_form_attributes [form_area_attribute].form_area.y_position, ' width=',
              get_form_attributes [form_area_attribute].form_area.width, ' height=',
              get_form_attributes [form_area_attribute].form_area.height);
      IFEND;

{ Process ATTRIBUTE parameter.

      form_display_attribute_set := get_form_attributes [form_display_attribute].form_display_attribute;
      display_attribute_set := form_display_attribute_set - $fdt$display_attribute_set
            [fdc$protect, fdc$fine_border, fdc$medium_border, fdc$bold_border];
      object_display_attribute_set := form_display_attribute_set - $fdt$display_attribute_set
            [fdc$fine_border, fdc$medium_border, fdc$bold_border];
      add_attributes (form_display_attribute_set - $fdt$display_attribute_set
            [fdc$protect, fdc$black_background, fdc$white_foreground, fdc$display_left_to_right],
            'display');

{ Process EVENT_FORM parameter.

      CASE get_form_attributes [event_form_attribute].event_form_definition.key OF

      = fdc$no_event_form =
        STRINGREP (line, line_length, line (1, line_length), ' event_form=none');

      = fdc$user_event_form =
        STRINGREP (line, line_length, line (1, line_length),
              ' event_form=', get_form_attributes [event_form_attribute].event_form_definition.
              event_form_name (1, clp$trimmed_string_size (get_form_attributes [event_form_attribute].
              event_form_definition.event_form_name)));

      ELSE {fdc$system_default_event_form}

{ System is the default. Do not output the default.

      CASEND;

{ Process HELP_PROCESSING parameter.

      CASE get_form_attributes [form_help_attribute].form_help.key OF

      = fdc$get_help_form =
        STRINGREP (line, line_length, line (1, line_length),
              ' help_processing=', get_form_attributes [form_help_attribute].
              form_help.help_form (1, clp$trimmed_string_size (get_form_attributes [form_help_attribute].
              form_help.help_form)));

      = fdc$get_system_default_help =
        STRINGREP (line, line_length, line (1, line_length), ' help_processing=system');

      = fdc$get_help_message =
        help_message_length := get_form_attributes [form_help_attribute].form_help.help_message_length;
        help_message [1].key := fdc$get_form_help_message;
        PUSH help_message [1].p_form_help_message: [help_message_length];
        fdp$get_form_attributes (form_identifier, help_message, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

        STRINGREP (line, line_length, line (1, line_length), ' help_processing=''');
        add_text (help_message [1].p_form_help_message^);
        STRINGREP (line, line_length, line (1, line_length), '''');

      ELSE {fdc$get_no_help_response}

{ No help is the default. Do not output the default.

      CASEND;

{ Process ERROR_MESSAGE_FORM parameter.

      IF get_form_attributes [error_message_form_attribute].error_message_form <> osc$null_name THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' error_message_form=', get_form_attributes [error_message_form_attribute].
              error_message_form (1, clp$trimmed_string_size
              (get_form_attributes [error_message_form_attribute].error_message_form)));
      IFEND;


{ Process HELP_MESSAGE_FORM parameter.

      IF get_form_attributes [help_message_form_attribute].help_message_form <> osc$null_name THEN
        STRINGREP (line, line_length, line (1, line_length),
             ' help_message_form=', get_form_attributes [help_message_form_attribute].
              help_message_form (1, clp$trimmed_string_size
              (get_form_attributes [help_message_form_attribute].help_message_form)));
      IFEND;

{ Process VARIABLE_DECK_NAME parameter.

      get_record_attributes [1].key := fdc$get_record_deck_name;
      get_record_attributes [2].key := fdc$get_record_name;
      fdp$get_record_attributes (form_identifier, get_record_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      IF get_record_attributes [1].get_value_status <> fdc$undefined_value THEN
        STRINGREP (line, line_length, line (1, line_length),
              ' variable_deck_name=', get_record_attributes [1].
              record_deck_name (1, clp$trimmed_string_size (get_record_attributes
              [1].record_deck_name)));
      IFEND;

      IF get_record_attributes [2].get_value_status <> fdc$undefined_value THEN
        IF get_record_attributes [1].get_value_status <> fdc$undefined_value THEN
          IF get_record_attributes [2].record_name <> get_record_attributes [1].record_deck_name THEN
            convert_name (get_form_attributes [form_processor_attribute].form_processor,
                  get_record_attributes [2].record_name);
            STRINGREP (line, line_length, line (1, line_length),
                  ' variable_record_name=', get_record_attributes [2].
                  record_name (1, clp$trimmed_string_size (get_record_attributes [2].record_name)));
          IFEND;
        ELSE

{ The deck name is not defined. If the record name equals the form name, the record name
{ uses the default.  Do not output the default for the record name.

          IF (name <> get_record_attributes [2].record_name) THEN

{ Convert the record name to a name valid for the form processor.  Old versions of forms
{ allowed a record name that was not valid for the processor.

            convert_name (get_form_attributes [form_processor_attribute].form_processor,
                  get_record_attributes [2].record_name);
            STRINGREP (line, line_length, line (1, line_length),
                  ' variable_record_name=', get_record_attributes [2].
                  record_name (1, clp$trimmed_string_size (get_record_attributes [2].record_name)));
          IFEND;
        IFEND;
      IFEND;

{ Process INVALID_DATA_CHARACTER parameter.

      IF get_form_attributes[invalid_data_attribute].
                           invalid_data_character.defined THEN
        STRINGREP(line,line_length,line(1,line_length),
                  ' invalid_data_character=''',
                  get_form_attributes[invalid_data_attribute].
                  invalid_data_character.character, '''');
      IFEND;

{ Process HIDDEN_EDITING parameter.

      IF get_form_attributes [hidden_editing_attribute].hidden_editing THEN
        STRINGREP (line, line_length, line (1, line_length), ' hidden_editing=TRUE');
      IFEND;

{  Process COMMENT parameter.

      IF get_form_attributes [comments_attribute].number_form_comments > 0 THEN
        PUSH get_form_attributes_p: [1 .. get_form_attributes [comments_attribute].number_form_comments];

{ Learn the space needed to obtain the comments.

        FOR number_comments := 1 TO get_form_attributes [comments_attribute].number_form_comments DO
          get_form_attributes_p^ [number_comments].key := fdc$get_form_comment_length;
        FOREND;

        fdp$get_form_attributes (form_identifier, get_form_attributes_p^, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

{ Obtain space for the comments.

        FOR number_comments := 1 TO get_form_attributes [comments_attribute].number_form_comments DO
          comment_length := get_form_attributes_p^ [number_comments].form_comment_length;
          get_form_attributes_p^ [number_comments].key := fdc$get_next_form_comment;
          PUSH get_form_attributes_p^ [number_comments].p_form_comment: [comment_length];
        FOREND;

        fdp$get_form_attributes (form_identifier, get_form_attributes_p^, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

{ Start list of comments.

        STRINGREP (line, line_length, line (1, line_length), ' comment=(', '''');
        add_text (get_form_attributes_p^ [1].p_form_comment^);
        STRINGREP (line, line_length, line (1, line_length), '''');

{ Output list of comments.

        FOR number_comments := 2 TO get_form_attributes [comments_attribute].number_form_comments DO
          STRINGREP (line, line_length, line (1, line_length), ' ', '''');
          add_text (get_form_attributes_p^ [number_comments].p_form_comment^);
          STRINGREP (line, line_length, line (1, line_length), '''');
        FOREND;

{ Complete list of comments.

        STRINGREP (line, line_length, line (1, line_length), ')');
      IFEND;

      put_command_line (line (1, line_length));

    PROCEND generate_form;

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

{ PURPOSE:
{   This procedure generates commands for all the objects on the form.

    PROCEDURE generate_objects;

      VAR
        get_form_attributes: array [1 .. 1] of fdt$get_form_attribute,
        form_objects_p: ^fdt$form_objects,
        number_objects: fdt$number_objects,
        x_position: fdt$x_position,
        y_position: fdt$y_position;

{ Get number of objects on form to learn the space required to obtain the
{ objects.

      get_form_attributes [1].key := fdc$get_number_objects;
      fdp$get_form_attributes (form_identifier, get_form_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      IF get_form_attributes [1].number_objects = 0 THEN
        RETURN;
      IFEND;

{ Get all the objects on the form.

      PUSH form_objects_p: [1 .. get_form_attributes [1].number_objects];
      fdp$get_form_objects (form_identifier, form_objects_p^, number_objects, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

{ Generate commands to add objects.

      FOR number_objects := LOWERBOUND (form_objects_p^) TO UPPERBOUND (form_objects_p^) DO
        x_position := form_objects_p^ [number_objects].x_position;
        y_position := form_objects_p^ [number_objects].y_position;

        CASE form_objects_p^ [number_objects].object OF

        = fdc$constant_text =
          add_constant_text (x_position, y_position, status);

        = fdc$constant_text_box =
          add_constant_text_box (x_position, y_position, status);

        = fdc$variable_text =
          add_variable_text (x_position, y_position, status);

        = fdc$variable_text_box =
          add_variable_text_box (x_position, y_position, status);

        = fdc$box =
          add_box (x_position, y_position, status);

        = fdc$line =
          add_line (x_position, y_position, status);

        ELSE {Ignore object.}
        CASEND;
      FOREND;

    PROCEND generate_objects;

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

{ PURPOSE:
{   This procedure generates the add_table commands.

    PROCEDURE generate_tables;

      VAR
        get_form_attributes: array [1 .. 1] of fdt$get_form_attribute,
        form_names_p: ^fdt$form_names,
        number_names: fdt$number_names;

{ Get number of tables in form in order to learn the space required
{ to get the table names.

      get_form_attributes [1].key := fdc$get_number_tables;
      fdp$get_form_attributes (form_identifier, get_form_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      IF get_form_attributes [1].number_tables = 0 THEN
        RETURN;
      IFEND;

{ Get the names of the tables on the form.

      PUSH form_names_p: [1 .. get_form_attributes [1].number_tables];
      fdp$get_form_names (form_identifier, $fdt$name_selections [fdc$select_table], form_names_p^,
            number_names, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

{ Generate the commands to add tables.

      FOR number_names := LOWERBOUND (form_names_p^) TO UPPERBOUND (form_names_p^) DO
        add_table (form_names_p^ [number_names].name);
      FOREND;

    PROCEND generate_tables;

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

{ PURPOSE:
{   This procedure generates the add_variable commands.

    PROCEDURE generate_variables;

      VAR
        get_form_attributes: array [1 .. 1] of fdt$get_form_attribute,
        form_names_p: ^fdt$form_names,
        number_names: fdt$number_names;

{ Get number of variables in form in order to learn the space required
{ to get the variable names.

      get_form_attributes [1].key := fdc$get_number_variables;
      fdp$get_form_attributes (form_identifier, get_form_attributes, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

      IF get_form_attributes [1].number_variables = 0 THEN
        RETURN;
      IFEND;

{ Get the names of the variables on the form.

      PUSH form_names_p: [1 .. get_form_attributes [1].number_variables];
      fdp$get_form_names (form_identifier, $fdt$name_selections [fdc$select_variable], form_names_p^,
            number_names, status);
      IF NOT status.normal THEN
        EXIT fdp$generate_form_module;
      IFEND;

{ Generate the commands to add variables.

      FOR number_names := LOWERBOUND (form_names_p^) TO UPPERBOUND (form_names_p^) DO
        add_variable (form_names_p^ [number_names].name);
      FOREND;

    PROCEND generate_variables;

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

{ PURPOSE:
{   This procedure write the command line or lines.

    PROCEDURE put_command_line
      (    line: string ( * ));

      CONST

{ The following constant adds space on the print line for continuation characters
{ ('..) - 3 characters, and quote mark inbedded in string ('') - 2 characters.

        added_text_length = 5,
        continuation = 6,
        indentation = 2;

      VAR
        command: string (max_command_line_size),
        command_size: integer,
        command_length: integer,
        command_line: string (max_command_line_size),
        indentation_string: string (10),
        terminate_string: string (2);

?? NEWTITLE := 'put_chunks', EJECT ??

{ PURPOSE:
{   This procedure process a command that requires more than one line.

      PROCEDURE put_chunks
        (    line: string ( * );
             length: 1 .. max_command_line_size;
             width: amt$page_width);

        VAR
          break_found: boolean,
          break_position: 0 .. max_command_line_size,
          concatenating_string: boolean,
          current_character_position: 0 .. max_command_line_size,
          current_length: 0 .. max_command_line_size,
          first_line: boolean,
          processing_string: boolean,
          remaining_text: 0 .. max_command_line_size,
          starting_position: 1 .. max_command_line_size;

        current_character_position := 0;
        processing_string := FALSE;
        break_position := 0;
        remaining_text := length;
        first_line := TRUE;
        starting_position := 1;
        concatenating_string := FALSE;

{ Do first/next line.

        WHILE remaining_text > 0 DO
          break_found := FALSE;
          IF remaining_text <= width THEN
            IF concatenating_string THEN
              STRINGREP (command_line, command_length, '//''', line (starting_position, remaining_text));
            ELSE
              STRINGREP (command_line, command_length, indentation_string (1, indentation + continuation),
                    line (starting_position, remaining_text));
            IFEND;
            put_line (command_line (1, command_length));
            RETURN;
          IFEND;

{ Find a good place to break line.

        /find_line_break/
          REPEAT
            current_character_position := current_character_position + 1;

{ Do not break a line inside a string if possible.

            IF line (current_character_position) = '''' THEN
              IF NOT processing_string THEN
                processing_string := TRUE;
                CYCLE /find_line_break/;
              IFEND;

{ Processing a string. Check for double quotes.

              IF ((current_character_position < length) AND (line (current_character_position + 1) = ''''))
                    THEN
                current_character_position := current_character_position + 1;
                CYCLE /find_line_break/;
              IFEND;

{ End of string found.

              processing_string := FALSE;
              CYCLE /find_line_break/;
            IFEND;

            IF ((NOT processing_string) AND (line (current_character_position) = ' ')) THEN
              break_found := TRUE;
              break_position := current_character_position;
            IFEND;
          UNTIL ((line (current_character_position) <> '''') AND
                (current_character_position - starting_position >= width));

{ Output line.

          IF break_found THEN
            IF NOT first_line AND (NOT concatenating_string) THEN
              WHILE line (starting_position) = ' ' DO
                starting_position := starting_position + 1;
              WHILEND;
            IFEND;

            current_length := break_position - starting_position;
            IF first_line THEN
              first_line := FALSE;
              STRINGREP (command_line, command_length, indentation_string (1, indentation),
                    line (starting_position, current_length), terminate_string);

            ELSE { This is not first line. }
              IF concatenating_string THEN
                STRINGREP (command_line, command_length, '//''', line (starting_position, current_length),
                      terminate_string);
              ELSE
                STRINGREP (command_line, command_length, indentation_string (1, indentation + continuation),
                      line (starting_position, current_length), terminate_string);
              IFEND;
            IFEND;

            put_line (command_line (1, command_length));
            starting_position := break_position;
            current_character_position := break_position;
            processing_string := FALSE;
            concatenating_string := FALSE;
            remaining_text := length - starting_position + 1;

          ELSE

{ A breaking point was not found. Concatenate string to next line.

            current_length := current_character_position - starting_position + 1;
            IF concatenating_string THEN
              STRINGREP (command_line, command_length, '//''', line (starting_position, current_length), '''',
                    terminate_string);
            ELSE
              concatenating_string := TRUE;
              IF first_line THEN
                first_line := FALSE;
                STRINGREP (command_line, command_length, indentation_string (1, indentation),
                      line (starting_position, current_length), '''', terminate_string);
              ELSE { This is not first line. }
                STRINGREP (command_line, command_length, indentation_string (1, indentation + continuation),
                      line (starting_position, current_length), '''', terminate_string);
                first_line := FALSE;
              IFEND;
            IFEND;

            put_line (command_line (1, command_length));
            starting_position := current_character_position + 1;
            remaining_text := length - starting_position + 1;
          IFEND;
        WHILEND;

      PROCEND put_chunks;

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

      PROCEDURE [INLINE] put_line
        (    line: string ( * ));

        VAR
          file_byte_address: amt$file_byte_address;

        amp$put_next (file_identifier, ^line, clp$trimmed_string_size (line), file_byte_address, status);
        IF NOT status.normal THEN
          EXIT fdp$generate_form_module;
        IFEND;

      PROCEND put_line;

?? OLDTITLE, EJECT ??

      terminate_string := '..';
      indentation_string := ' ';
      command_size := STRLENGTH (line);

      IF command_size <= (page_width - indentation) THEN
        STRINGREP (command_line, command_length, indentation_string (1, indentation), line (1, command_size));
        put_line (command_line (1, command_length));
        RETURN;
      IFEND;

{ The command is longer than the page width of the file.  Break command into
{ chunks and output to line.

      put_chunks (line, command_size, (page_width - (indentation + continuation + added_text_length)));

    PROCEND put_command_line;

?? OLDTITLE, EJECT ??

    file_attributes [1].key := amc$page_width;
    amp$fetch (file_identifier, file_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF file_attributes [1].page_width < min_page_width THEN
      page_width := min_page_width;
    ELSEIF file_attributes [1].page_width > clc$wide_page_width THEN
      page_width := clc$wide_page_width;
    ELSE
      page_width := file_attributes [1].page_width;
    IFEND;

    fdp$open_form_module (form_module_p, form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    osp$establish_condition_handler (^condition_handler, TRUE);

{ Generate SCL commands for form.

    generate_form;
    generate_displays;
    generate_events;
    generate_tables;
    generate_variables;
    generate_objects;

    STRINGREP (line, line_length, 'END_FORM_MODULE');
    put_command_line (line (1, line_length));

  PROCEND fdp$generate_form_module;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] fdp$generate_form_variable', EJECT ??
*copy fdh$generate_form_variable

  PROCEDURE [XDCL] fdp$generate_form_variable
    (    file_identifier: amt$file_identifier;
         form_name: ost$name;
     VAR form_module_p: ^fdt$form_module;
     VAR status: ost$status);

    VAR
      get_form_attributes: array [1 .. 1] of fdt$get_form_attribute,
      local_status: ost$status;

    fdp$open_form_module (form_module_p, form_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    get_form_attributes [1].key := fdc$get_form_processor;
    fdp$get_form_attributes (form_identifier, get_form_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    fdp$write_record_definition (form_identifier, file_identifier, get_form_attributes [1].form_processor,
          status);
    IF ((NOT status.normal) AND (status.condition = fde$form_has_no_variables)) THEN
      osp$generate_error_message (status, local_status);
      status.normal := TRUE;
    IFEND;

  PROCEND fdp$generate_form_variable;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] fdp$open_form_module', EJECT ??
*copy fdh$open_form_module

  PROCEDURE [XDCL] fdp$open_form_module
    (VAR form_module_p: ^fdt$form_module;
     VAR form_identifier: fdt$form_identifier;
     VAR status: ost$status);

    VAR
      form_definition_p: ^fdt$form_definition,
      form_status_p: ^fdt$form_status,
      screen_formatting_version: integer;

?? OLDTITLE, EJECT ??
    status.normal := TRUE;
    RESET form_module_p;
    i#move (^form_module_p^, ^screen_formatting_version, fdc$integer_length);
    IF (screen_formatting_version < fdc$basic_capability) THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$form_requires_conversion, '', status);
      RETURN;
    IFEND;

    fdp$create_form_status (form_identifier, form_status_p, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Create pointers to frequently used data to obtain efficient  access during
{ form interaction with the terminal user.

    form_status_p^.p_form_module := form_module_p;
    NEXT form_definition_p IN form_module_p;
    form_status_p^.p_form_definition := form_definition_p;
    form_status_p^.p_form_variable_definitions := fdp$ptr_variables (form_status_p);
    form_status_p^.p_form_object_definitions := fdp$ptr_objects (form_status_p);
    form_status_p^.p_form_table_definitions := fdp$ptr_tables (form_status_p);
    form_status_p^.p_form_record_definitions := fdp$ptr_record_definitions (form_status_p);
    form_status_p^.p_event_definitions := fdp$ptr_events (form_status_p);
    form_status_p^.p_display_definitions := fdp$ptr_displays (form_status_p);
    form_status_p^.opened := TRUE;
    form_status_p^.opened_for_query_only := TRUE;

  PROCEND fdp$open_form_module;

MODEND fdm$generate_form_module;

