?? RIGHT := 110 ??
MODULE ram$display_corrections_command;

*copyc osd$default_pragmats
?? PUSH (LISTEXT := ON) ??
*copyc rac$max_line_size
*copyc rac$status_id
*copyc rae$error_messages
*copyc clt$path_display_chunks
*copyc rat$correction_package_header
*copyc rat$correction_package
*copyc rat$single_correction_header
*copyc amp$get_segment_pointer
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$get_path_description
*copyc clp$get_value
*copyc clp$new_display_line
*copyc clp$open_display
*copyc clp$put_display
*copyc clp$reset_for_next_display_page
*copyc clp$scan_parameter_list
*copyc fsp$open_file
*copyc fsp$close_file
*copyc osp$set_status_abnormal
*copyc osv$control_codes_to_quest_mark
*copyc rav$class_types
?? POP ??

*copyc rah$display_corrections_command

  PROCEDURE [XDCL, #GATE] rap$display_corrections_command (parameter_list: clt$parameter_list;
    VAR status: ost$status);


{   pdt discp_pdt (
{     correction_package, cp: file = $required
{     output, o: file = $output
{     status)

?? PUSH (LISTEXT := ON) ??

    VAR
      discp_pdt: [STATIC, READ, cls$pdt] clt$parameter_descriptor_table := [^discp_pdt_names,
        ^discp_pdt_params];

    VAR
      discp_pdt_names: [STATIC, READ, cls$pdt_names_and_defaults] array [1 .. 5] of
        clt$parameter_name_descriptor := [['CORRECTION_PACKAGE', 1], ['CP', 1], ['OUTPUT', 2], ['O', 2], [
        'STATUS', 3]];

    VAR
      discp_pdt_params: [STATIC, READ, cls$pdt_parameters] array [1 .. 3] of clt$parameter_descriptor := [

{ CORRECTION_PACKAGE CP }
      [[clc$required], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$file_value]],

{ OUTPUT O }
      [[clc$optional_with_default, ^discp_pdt_dv2], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL,
        clc$file_value]],

{ STATUS }
      [[clc$optional], 1, 1, 1, 1, clc$value_range_not_allowed, [NIL, clc$variable_reference,
        clc$array_not_allowed, clc$status_value]]];

    VAR
      discp_pdt_dv2: [STATIC, READ, cls$pdt_names_and_defaults] string (7) := '$output';

?? POP ??

?? TITLE := 'display corrections command', EJECT ??

    VAR
      bcu: amt$segment_pointer,
      bcu_header: ^rat$correction_package_header,
      cd: boolean,
      correction: ^SEQ ( * ),
      correction_list: ^rat$correction_package,
      correction_location: ^SEQ ( * ),
      correction_package: amt$local_file_name,
      correction_package_fid: amt$file_identifier,
      correction_package_path: clt$path_name,
      cs: clt$cycle_selector,
      display_control: clt$display_control,
      display_line: ^string ( * ),
      file_reference: clt$file_reference,
      i: rat$element_index,
      ignore_status: ost$status,
      length: integer,
      lf: boolean,
      line: string (rac$max_line_size),
      ofn: boolean,
      op: clt$open_position,
      output: clt$file,
      p: ^pft$path,
      pc: clt$path_container,
      psr_list: ^array [1 .. *] of rat$psr_ident,
      read_only_attachment: array [1 .. 2] of fst$attachment_option,
      value: clt$value;

{   The following VAR declarations are used by clp$new_page_procedure.
{   Because the procedure is maintained by others its listing is supressed.
*copy clv$display_variables
?? PUSH (LISTEXT := ON) ??
*copyc clp$new_page_procedure
?? TITLE := '  display corrections command' ??

    PROCEDURE [INLINE] put_subtitle (display_control: clt$display_control;
      VAR status: ost$status);

      {   DISPLAY_CORRECTIONS_COMMAND uses no subtitles, this
      { is merely a dummy routine used to keep the module
      { consistent with those that do  produce subtitles.

    PROCEND put_subtitle;
?? POP ??

    status.normal := TRUE;

    clp$scan_parameter_list (parameter_list, discp_pdt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /display_correction_package/
    BEGIN

      clp$get_value ('CORRECTION_PACKAGE', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /display_correction_package/;
      IFEND;
      correction_package := value.file.local_file_name;

      clp$get_path_description (value.file, file_reference, pc, p, cs, op, status);
      IF NOT status.normal THEN
        EXIT /display_correction_package/;
      IFEND;
      correction_package_path := file_reference.path_name (1, file_reference.path_name_size);

      read_only_attachment [1].selector := fsc$access_and_share_modes;
      read_only_attachment [1].access_modes.selector := fsc$specific_access_modes;
      read_only_attachment [1].access_modes.value := $fst$file_access_options [fsc$read];
      read_only_attachment [1].share_modes.selector := fsc$determine_from_access_modes;
      read_only_attachment [2].selector := fsc$create_file;
      read_only_attachment [2].create_file := FALSE;

      fsp$open_file (correction_package, amc$segment, ^read_only_attachment, NIL, NIL, NIL, NIL,
            correction_package_fid, status);
      IF NOT status.normal THEN
        EXIT /display_correction_package/;
      IFEND;

      amp$get_segment_pointer (correction_package_fid, amc$sequence_pointer, bcu, status);
      IF NOT status.normal THEN
        EXIT /display_correction_package/;
      IFEND;

      RESET bcu.sequence_pointer;
      NEXT bcu_header IN bcu.sequence_pointer;

      IF (bcu_header = NIL) OR (bcu_header^.identification <> rac$correction_package_id) THEN
        osp$set_status_abnormal (rac$status_id, rae$file_not_correction_package, correction_package_path,
              status);
        EXIT /display_correction_package/;
      IFEND;
      IF bcu_header^.version <> rac$correction_package_version THEN
        osp$set_status_abnormal (rac$status_id, rae$invalid_cp_version, correction_package_path, status);
        EXIT /display_correction_package/;
      IFEND;


      clp$get_value ('OUTPUT', 1, 1, clc$low, value, status);
      IF NOT status.normal THEN
        EXIT /display_correction_package/;
      IFEND;
      output := value.file;

      clp$open_display (output, ^clp$new_page_procedure, display_control, status);
      IF NOT status.normal THEN
        EXIT /display_correction_package/;
      IFEND;

      clv$titles_built := FALSE;
      clv$command_name := 'display_correction_package';

      PUSH display_line: [display_control.page_width];


      NEXT correction_list: [1 .. bcu_header^.number_of_elements] IN bcu.sequence_pointer;
      IF correction_list = NIL THEN
        osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, correction_package_path,
              status);
        EXIT /display_correction_package/;
      IFEND;

      FOR i := 1 TO bcu_header^ .number_of_elements DO

        length := 1;
        display_line^ := ' ';
        clp$put_display (display_control, display_line^ (1, length), clc$trim, status);
        IF NOT status.normal THEN
          EXIT /display_correction_package/;
        IFEND;

        STRINGREP (line, length, ' ELEMENT: ', correction_list^ [i].name);
        #translate (osv$control_codes_to_quest_mark, line (1, length), display_line^ (1, length));
        clp$put_display (display_control, display_line^ (1, length), clc$trim, status);
        IF NOT status.normal THEN
          EXIT /display_correction_package/;
        IFEND;

        STRINGREP (line, length, ' VERSION: ', correction_list^ [i].user_info);
        #translate (osv$control_codes_to_quest_mark, line (1, length), display_line^ (1, length));
        clp$put_display (display_control, display_line^ (1, length), clc$trim, status);
        IF NOT status.normal THEN
          EXIT /display_correction_package/;
        IFEND;

        IF correction_list^ [i].number_of_psrs > 0 THEN
          psr_list := #PTR (correction_list^ [i].psr_info, bcu.sequence_pointer^);
          RESET bcu.sequence_pointer TO psr_list;
          NEXT psr_list: [1 .. correction_list^ [i].number_of_psrs] IN bcu.sequence_pointer;
          IF psr_list = NIL THEN
            osp$set_status_abnormal (rac$status_id, rae$accessed_beyond_segment, correction_package_path,
                  status);
            EXIT /display_correction_package/;
          IFEND;

          rap$display_psrs (display_control, psr_list, correction_list^ [i].number_of_psrs, status);
          IF NOT status.normal THEN
            EXIT /display_correction_package/;
          IFEND;
        IFEND;

      FOREND;

    END /display_correction_package/;


    IF status.normal THEN
      fsp$close_file (correction_package_fid, status);
    ELSE
      fsp$close_file (correction_package_fid, ignore_status);
    IFEND;

    IF status.normal THEN
      clp$close_display (display_control, status);
    ELSE
      clp$close_display (display_control, ignore_status);
    IFEND;

    IF NOT status.normal THEN
      RETURN;
    IFEND;

  PROCEND rap$display_corrections_command;

?? TITLE := 'display psrs', EJECT ??
*copyc rah$display_psrs

  PROCEDURE rap$display_psrs (VAR display_control: clt$display_control;
        psr_list: ^array [1 .. * ] OF rat$psr_ident;
        number_of_psrs: rat$psr_index;
    VAR status: ost$status);


    VAR
      display_line: ^string ( * ),
      i: rat$psr_index,
      marker: integer,
      length: 1 .. rac$max_line_size,
      line: string (rac$max_line_size),
      psr_ident_length: integer;


    status.normal := TRUE;

    PUSH display_line: [display_control.page_width];
    display_line^ := ' ';

    psr_ident_length := #SIZE (psr_list^ [1]);
    line (1, * ) := ' PSR''S: ';
    length := 8;
    marker := 9;

    FOR i := 1 TO number_of_psrs DO
      line (marker, * ) := psr_list^ [i];
      length := length + psr_ident_length;
      marker := marker + psr_ident_length;
      IF (i = number_of_psrs) OR (length + psr_ident_length > rac$max_line_size) THEN
        #translate (osv$control_codes_to_quest_mark, line (1, length), display_line^ (1, length));
        clp$put_display (display_control, display_line^ (1, length), clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

{   initialize the line values for the next line. }
        line (1, * ) := ' PSR''S: ';
        length := 8;
        marker := 9;
      IFEND;
    FOREND;

  PROCEND rap$display_psrs;

  MODEND ram$display_corrections_command

