
?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Screen Formatting:  Create message form' ??
MODULE fdm$create_message_form;

{ PURPOSE:
{   This module creates the message form used to displaying help and error
{ messages.
{
{ DESIGN:
{   Use Screen Formatting procedures to define a form.

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

?? PUSH (LISTEXT := ON) ??
*copyc cyd$run_time_error_condition
?? POP ??

*copyc fdc$message_form_name
*copyc fdc$message_variable_length
*copyc fdc$message_visible_length

*copyc fdp$close_form
*copyc fdp$create_form
*copyc fdp$create_object
*copyc fdp$create_variable
*copyc fdp$end_form
*copyc fdv$message_variable_name
*copyc osp$set_status_abnormal

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

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

    VAR
      form_attributes: array [1 .. 8] of fdt$form_attribute,
      initial_value: string (1),
      local_status: ost$status,
      number_errors: fdt$number_errors,
      object_definition: fdt$object_definition,
      object_attributes: array [1 .. 1] of fdt$object_attribute,
      p_errors: ^SEQ ( * ),
      variable_attributes: array [1 .. 3] of fdt$variable_attribute;

    status.normal := TRUE;

{ Create form definition.  Define paging events so that terminal user
{ may see messages longer than the visible size of the variable text.
{ Specify a border around the form so that the terminal user easily
{ sees the context of the form and notes the message.

    form_attributes [1].key := fdc$form_area;
    form_attributes [1].form_area.key := fdc$defined_area;
    form_attributes [1].form_area.x_position := 2;
    form_attributes [1].form_area.y_position := 1;
    form_attributes [1].form_area.height := 3;
    form_attributes [1].form_area.width := 78;
    form_attributes [2].key := fdc$form_display_attribute;
    form_attributes [2].form_display_attribute := $fdt$display_attribute_set
          [fdc$medium_border, fdc$black_background, fdc$white_foreground];
    form_attributes [3].key := fdc$add_event;
    form_attributes [3].event_name := 'FWD';
    form_attributes [3].event_label := 'Fwd';
    form_attributes [3].event_trigger := fdc$forward;
    form_attributes [3].event_action := fdc$page_variable_forward;
    form_attributes [4].key := fdc$add_event;
    form_attributes [4].event_name := 'BKW';
    form_attributes [4].event_label := 'bkw';
    form_attributes [4].event_trigger := fdc$backward;
    form_attributes [4].event_action := fdc$page_variable_backward;
    form_attributes [5].key := fdc$add_event;
    form_attributes [5].event_name := 'FIRST';
    form_attributes [5].event_label := 'First';
    form_attributes [5].event_trigger := fdc$shift_backward;
    form_attributes [5].event_action := fdc$page_variable_first;
    form_attributes [6].key := fdc$add_event;
    form_attributes [6].event_name := 'LAST';
    form_attributes [6].event_label := 'Last';
    form_attributes [6].event_trigger := fdc$shift_forward;
    form_attributes [6].event_action := fdc$page_variable_last;
    form_attributes [7].key := fdc$add_event;
    form_attributes [7].event_name := 'BACK';
    form_attributes [7].event_label := 'Back';
    form_attributes [7].event_trigger := fdc$back;
    form_attributes [7].event_action := fdc$erase_help;
    form_attributes [8].key := fdc$form_name;
    form_attributes [8].form_name := fdc$message_form_name;
    fdp$create_form (form_identifier, form_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

{ Create variable for message.

    variable_attributes [1].key := fdc$program_data_type;
    variable_attributes [1].program_data_type := fdc$program_character_type;
    variable_attributes [2].key := fdc$io_mode;
    variable_attributes [2].io_mode := fdc$terminal_output;
    variable_attributes [3].key := fdc$variable_length;
    variable_attributes [3].variable_length := fdc$message_variable_length;
    fdp$create_variable (form_identifier, fdv$message_variable_name, variable_attributes, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'creating message form',
            status);
      fdp$close_form (form_identifier, local_status);
      RETURN;
    IFEND;

{ Create object for variable.

    object_attributes [1].key := fdc$object_name;
    object_attributes [1].object_name := fdv$message_variable_name;
    object_attributes [1].occurrence := 1;
    object_definition.key := fdc$variable_text;
    object_definition.variable_text_width := fdc$message_visible_length;
    initial_value := ' ';
    object_definition.p_variable_text := ^initial_value;
    fdp$create_object (form_identifier, 3, 2, object_definition, object_attributes, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'creating message form',
            status);
      fdp$close_form (form_identifier, local_status);
      RETURN;
    IFEND;

    fdp$end_form (form_identifier, NIL, number_errors, p_errors, status);
    IF NOT status.normal THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'creating message form',
            status);
      fdp$close_form (form_identifier, local_status);
      RETURN;
    IFEND;

    IF number_errors <> 0 THEN
      osp$set_status_abnormal (fdc$format_display_identifier, fde$system_error, 'creating message form',
            status);
      fdp$close_form (form_identifier, local_status);
    IFEND;
  PROCEND fdp$create_message_form;

MODEND fdm$create_message_form;
