?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter: Permanent File Display Commands' ??
MODULE clm$pf_display_commands;

{
{ PURPOSE:
{   This module contains the processors for permanent file commands that display information about
{   catalogs and files.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_file_reference
*copyc clt$path_display_chunks
*copyc clt$parameter_list
*copyc fsc$local
*copyc fse$path_exception_conditions
*copyc nfe$ptf_condition_codes
*copyc oss$job_paged_literal
*copyc ost$status
*copyc pmt$os_name
?? POP ??
*copyc amp$get_file_attributes
*copyc amp$return
*copyc clp$build_path_subtitle
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_rjstring
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_file_reference
*copyc clp$evaluate_parameters
*copyc clp$find_current_block
*copyc clp$get_list_of_$local_files
*copyc clp$get_work_area
*copyc clp$horizontal_tab_display
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$right_justify_string
*copyc clp$trimmed_string_size
*copyc clv$nil_display_control
*copyc fsp$convert_fs_structure_to_pf
*copyc fsp$path_element
*copyc mmp$create_segment
*copyc mmp$delete_segment
*copyc nfp$check_implicit_access
*copyc nfp$perform_implicit_access
*copyc osp$append_status_file
*copyc osp$append_status_integer
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc osv$upper_to_lower
*copyc pfe$external_archive_conditions
*copyc pfp$find_archive_info
*copyc pfp$find_catalog_description
*copyc pfp$find_cycle_array_extended
*copyc pfp$find_cycle_array_version_2
*copyc pfp$find_cycle_directory
*copyc pfp$find_cycle_entry
*copyc pfp$find_direct_info_record
*copyc pfp$find_directory_array
*copyc pfp$find_file_description
*copyc pfp$find_log_array
*copyc pfp$find_next_archive_entry
*copyc pfp$find_next_info_record
*copyc pfp$find_permit_array
*copyc pfp$get_item_info
*copyc pfp$get_multi_item_info
*copyc pfp$utility_attach
*copyc pmp$continue_to_cause
*copyc pmp$date_time_compare
*copyc pmp$format_compact_date
*copyc pmp$format_compact_time
*copyc pmp$get_unique_name


  CONST
    highest_cycle_size = 5, { number of digits in pfc$highest_cycle
    max_class_size = 15; {INTERSTATE_LINK, MEMORY_RESIDENT

  VAR
    class: [STATIC, READ, oss$job_paged_literal] array [rmt$device_class] of record
      size: 1 .. max_class_size,
      value: string (max_class_size),
    recend := [[14, 'CONNECTED_FILE'], [15, 'INTERSTATE_LINK'], [11, 'LOCAL_QUEUE'], [3, 'LOG'],
          [13, 'MAGNETIC_TAPE'], [12, 'MASS_STORAGE'], [15, 'MEMORY_RESIDENT'], [7, 'NETWORK'], [4, 'NULL'],
          [8, 'PIPELINE'], [5, 'RHFAM'], [8, 'TERMINAL']];

?? TITLE := 'Types for display_items scratch segment', EJECT ??

  TYPE
    clt$display_catalog_item_kind = (clc$display_catalog_item, clc$display_file_item, clc$display_cycle_item);

  TYPE
    clt$display_catalog_item = record
      level: pft$array_index,
      name_tab: pft$array_index,
      name: pft$name,
      name_size: ost$name_size,
      size: integer,
      size_completely_known: boolean,
      case kind: clt$display_catalog_item_kind of
      = clc$display_catalog_item =
        number_of_files: integer,
        number_of_catalogs: integer,
      = clc$display_file_item =
        number_of_cycles: 0 .. pfc$maximum_cycle_number,
        highest_cycle_number: fst$cycle_number,
      = clc$display_cycle_item =
        cycle_archive_identification: pft$archive_identification,
        cycle_archived: boolean,
        cycle_data_not_defined: boolean,
        cycle_data_released: boolean,
        cycle_device_class: rmt$device_class,
        cycle_has_been_opened: boolean,
        cycle_number: fst$cycle_number,
        cycles_media_missing: boolean,
        cycles_respf_mod_mismatch: boolean,
        media_image_inconsistent: boolean,
        parent_catalog_restored: boolean,
        volume_unavailable: boolean,
      casend,
    recend;

  TYPE
    clt$display_catalog_items = SEQ ( * );

?? TITLE := 'clp$_display_catalog', EJECT ??

  PROCEDURE [XDCL] clp$_display_catalog
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (clm$disc) display_catalog, disc (
{   catalog, c: file = $working_catalog
{   display_options, display_option, do: key
{       (identifier, id, i)
{       (file, f)
{       (permits, permit, p)
{       (contents, content, c)
{     keyend = identifier
{   output, o: file = $output
{   depth, d: any of
{       key
{         all
{       keyend
{       integer 1..100
{     anyend = 2
{   include_exception_conditions, include_exception_condition, iec: (BY_NAME) key
{       all
{       none
{     keyend = none
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 6] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        default_value: string (16),
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 11] of clt$keyword_specification,
        default_value: string (10),
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        default_value: string (1),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (4),
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 27, 15, 47, 48, 955],
    clc$command, 13, 6, 0, 0, 0, 0, 6, 'CLM$DISC'], [
    ['C                              ',clc$abbreviation_entry, 1],
    ['CATALOG                        ',clc$nominal_entry, 1],
    ['D                              ',clc$abbreviation_entry, 4],
    ['DEPTH                          ',clc$nominal_entry, 4],
    ['DISPLAY_OPTION                 ',clc$alias_entry, 2],
    ['DISPLAY_OPTIONS                ',clc$nominal_entry, 2],
    ['DO                             ',clc$abbreviation_entry, 2],
    ['IEC                            ',clc$abbreviation_entry, 5],
    ['INCLUDE_EXCEPTION_CONDITION    ',clc$alias_entry, 5],
    ['INCLUDE_EXCEPTION_CONDITIONS   ',clc$nominal_entry, 5],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 6]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 16],
{ PARAMETER 2
    [6, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 414,
  clc$optional_default_parameter, 0, 10],
{ PARAMETER 3
    [12, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 4
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 84,
  clc$optional_default_parameter, 0, 1],
{ PARAMETER 5
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 81,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 6
    [13, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type],
    '$working_catalog'],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [11], [
    ['C                              ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
    ['CONTENT                        ', clc$alias_entry, clc$normal_usage_entry, 4],
    ['CONTENTS                       ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['F                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FILE                           ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['I                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ID                             ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['IDENTIFIER                     ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['P                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['PERMIT                         ', clc$alias_entry, clc$normal_usage_entry, 3],
    ['PERMITS                        ', clc$nominal_entry, clc$normal_usage_entry, 3]]
    ,
    'identifier'],
{ PARAMETER 3
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    20, [[1, 0, clc$integer_type], [1, 100, 10]]
    ,
    '2'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [2], [
    ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'none'],
{ PARAMETER 6
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$catalog = 1,
    p$display_options = 2,
    p$output = 3,
    p$depth = 4,
    p$include_exception_conditions = 5,
    p$status = 6;

  VAR
    pvt: array [1 .. 6] of clt$parameter_value;

*copy clv$display_variables
?? NEWTITLE := 'abort_handler', EJECT ??

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


      IF info_segment_pointer.seq_pointer <> NIL THEN
        mmp$delete_segment (info_segment_pointer, 1, handler_status);
        info_segment_pointer.seq_pointer := NIL;
      IFEND;

      IF items_segment_pointer.seq_pointer <> NIL THEN
        mmp$delete_segment (items_segment_pointer, 1, handler_status);
        items_segment_pointer.seq_pointer := NIL;
      IFEND;

      clp$close_display (display_control, handler_status);

      handler_status.normal := TRUE;

    PROCEND abort_handler;
*copy clp$new_page_procedure
?? TITLE := 'put_subtitle', EJECT ??

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


      clp$put_path_reference_subtitle (pvt [p$catalog].value^.file_value^, 'CATALOG ', status);

    PROCEND put_subtitle;
*copy clp$put_path_reference_subtitle
?? OLDTITLE, EJECT ??

    VAR
      cycle_lfn: ost$name,
      default_ring_attributes: amt$ring_attributes,
      depth: pft$array_index,
      directory: pft$p_directory_array,
      display_control: clt$display_control,
      display_item: ^clt$display_catalog_item,
      display_items: ^clt$display_catalog_items,
      evaluated_file_reference: fst$evaluated_file_reference,
      first_path_element_is_$local: boolean,
      group: pft$group,
      include_exception_conditions: boolean,
      info: pft$p_info,
      info_record: pft$p_info_record,
      info_segment_pointer: mmt$segment_pointer,
      info_tab: pft$array_index,
      items_segment_pointer: mmt$segment_pointer,
      local_status: ost$status,
      permits: pft$p_permit_array,
      pf_path: ^pft$path,
      remote: boolean;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    evaluate_path_and_handle_remote ('DISPLAY_CATALOG', pvt [p$output].value^.file_value^,
          pvt [p$catalog].value^.file_value^, ^pvt, evaluated_file_reference, first_path_element_is_$local,
          remote, status);
    IF (NOT status.normal) OR remote THEN
      RETURN;
    IFEND;

    IF evaluated_file_reference.cycle_reference.specification <> fsc$cycle_omitted THEN
      osp$set_status_abnormal ('CL', fse$catalogs_do_not_have_cycles, '', status);
      osp$append_status_file (osc$status_parameter_delimiter, pvt [p$catalog].value^.file_value^, status);
      RETURN;
    IFEND;

    IF evaluated_file_reference.path_handle_info.path_handle.open_position.specified THEN
      osp$set_status_abnormal ('CL', cle$file_position_not_allowed, '', status);
      RETURN;
    IFEND;

    IF first_path_element_is_$local AND (evaluated_file_reference.number_of_path_elements > 1) THEN
      osp$set_status_abnormal ('CL', cle$not_permitted_on_loc_file, '', status);
      RETURN;
    IFEND;

    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    items_segment_pointer.kind := mmc$sequence_pointer;
    items_segment_pointer.seq_pointer := NIL;
    #SPOIL (items_segment_pointer);
    info_segment_pointer.kind := mmc$sequence_pointer;
    info_segment_pointer.seq_pointer := NIL;
    #SPOIL (info_segment_pointer);
    osp$establish_block_exit_hndlr (^abort_handler);

    default_ring_attributes.r1 := #RING (^default_ring_attributes);
    default_ring_attributes.r2 := #RING (^default_ring_attributes);
    default_ring_attributes.r3 := #RING (^default_ring_attributes);
    clp$open_display_reference (pvt [p$output].value^.file_value^, ^clp$new_page_procedure, fsc$list,
          default_ring_attributes, display_control, status);
    IF NOT status.normal THEN
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    clv$titles_built := FALSE;
    clv$subtitles_built := FALSE;
    clv$command_name := 'display_catalog';

    group.group_type := pfc$member;
    group.member_description.family := osc$null_name;
    group.member_description.account := osc$null_name;
    group.member_description.project := osc$null_name;
    group.member_description.user := osc$null_name;

    PUSH pf_path: [1 .. evaluated_file_reference.number_of_path_elements];
    fsp$convert_fs_structure_to_pf (evaluated_file_reference, pf_path);

  /main/
    BEGIN
      mmp$create_segment (NIL, mmc$sequence_pointer, 1, info_segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      info := info_segment_pointer.seq_pointer;
      RESET info;

      include_exception_conditions := pvt [p$include_exception_conditions].value^.keyword_value = 'ALL';

      IF (pvt [p$display_options].value^.keyword_value = 'CONTENTS') AND
            (NOT first_path_element_is_$local) THEN

        mmp$create_segment (NIL, mmc$sequence_pointer, 1, items_segment_pointer, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        display_items := items_segment_pointer.seq_pointer;
        RESET display_items;

        IF pvt [p$depth].value^.kind = clc$integer THEN
          depth := pvt [p$depth].value^.integer_value.value;
        ELSE
          depth := UPPERVALUE (depth);
        IFEND;

        pmp$get_unique_name (cycle_lfn, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        info_tab := 1;
        get_catalog_info (depth, 1, 1, cycle_lfn, pf_path^, group, info, include_exception_conditions,
              info_tab, display_items, display_item, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        put_display_items (display_items, info_tab, depth, display_control, status);

      ELSEIF (pvt [p$display_options].value^.keyword_value = 'IDENTIFIER') OR
            (pvt [p$display_options].value^.keyword_value = 'CONTENTS') THEN

        IF first_path_element_is_$local THEN
          clp$get_list_of_$local_files (info, status);
        ELSE
          pfp$get_multi_item_info (pf_path^, group, $pft$catalog_info_selections [pfc$catalog_directory],
                $pft$file_info_selections [pfc$file_directory], info, status);
        IFEND;
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        RESET info;
        pfp$find_next_info_record (info, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_directory_array (info_record, directory, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        display_catalog_id (directory, display_control, status);

      ELSEIF pvt [p$display_options].value^.keyword_value = 'PERMITS' THEN

        IF first_path_element_is_$local THEN
          osp$set_status_abnormal ('CL', cle$not_permitted_on_loc_cat, '', status);
        ELSE
          pfp$get_item_info (pf_path^, group, $pft$catalog_info_selections
                [pfc$catalog_directory, pfc$catalog_permits, pfc$indirect_catalog_permits],
                $pft$file_info_selections [], info, status);
        IFEND;
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        RESET info;
        pfp$find_next_info_record (info, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_directory_array (info_record, directory, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        IF directory = NIL THEN
          IF UPPERBOUND (pf_path^) = pfc$master_catalog_name_index THEN
            osp$set_status_abnormal ('CL', pfe$unknown_master_catalog, pf_path^ [UPPERBOUND (pf_path^)],
                  status);
          ELSE
            osp$set_status_abnormal ('CL', pfe$unknown_last_subcatalog, pf_path^ [UPPERBOUND (pf_path^)],
                  status);
            osp$append_status_integer (osc$status_parameter_delimiter,
                  UPPERBOUND (pf_path^) - pfc$master_catalog_name_index, 10, FALSE, status);
          IFEND;
          EXIT /main/;
        IFEND;
        pfp$find_direct_info_record (^info_record^.body, directory^ [1].info_offset, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_permit_array (info_record, permits, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        display_permits (permits, display_control, status);

      ELSE

        IF first_path_element_is_$local THEN
          osp$set_status_abnormal ('CL', cle$not_permitted_on_loc_cat, '', status);
        ELSE
          pfp$get_multi_item_info (pf_path^, group, $pft$catalog_info_selections [],
                $pft$file_info_selections [pfc$file_directory, pfc$file_description,
                pfc$file_cycles_version_2, pfc$archive_descriptors], info, status);
        IFEND;
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        RESET info;
        pfp$find_next_info_record (info, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_directory_array (info_record, directory, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        display_file_description (FALSE, ^info_record^.body, directory, display_control, status);

      IFEND;
    END /main/;

    IF items_segment_pointer.seq_pointer <> NIL THEN
      mmp$delete_segment (items_segment_pointer, 1, local_status);
      items_segment_pointer.seq_pointer := NIL;
      #SPOIL (items_segment_pointer.seq_pointer);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    IF info_segment_pointer.seq_pointer <> NIL THEN
      mmp$delete_segment (info_segment_pointer, 1, local_status);
      info_segment_pointer.seq_pointer := NIL;
      #SPOIL (info_segment_pointer.seq_pointer);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    clp$close_display (display_control, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND clp$_display_catalog;
?? TITLE := 'clp$_display_catalog_entry', EJECT ??

  PROCEDURE [XDCL] clp$_display_catalog_entry
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (clm$disce) display_catalog_entry, disce (
{   file, f: file = $required
{   display_options, display_option, do: key
{       (descriptor, d)
{       (log, l)
{       (permits, permit, p)
{       (cycles, cycle, c)
{     keyend = descriptor
{   output, o: file = $output
{   depth, d: any of
{       key
{         all
{       keyend
{       integer 1..2
{     anyend = all
{   include_exception_conditions, include_exception_condition, iec: (BY_NAME) key
{       all
{       none
{     keyend = none
{   status)

?? PUSH (LISTEXT := ON) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 6] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 10] of clt$keyword_specification,
        default_value: string (10),
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$integer_type_qualifier,
        recend,
        default_value: string (3),
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
        default_value: string (4),
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [88, 9, 26, 13, 13, 35, 583],
    clc$command, 13, 6, 1, 0, 0, 0, 6, 'CLM$DISCE'], [
    ['D                              ',clc$abbreviation_entry, 4],
    ['DEPTH                          ',clc$nominal_entry, 4],
    ['DISPLAY_OPTION                 ',clc$alias_entry, 2],
    ['DISPLAY_OPTIONS                ',clc$nominal_entry, 2],
    ['DO                             ',clc$abbreviation_entry, 2],
    ['F                              ',clc$abbreviation_entry, 1],
    ['FILE                           ',clc$nominal_entry, 1],
    ['IEC                            ',clc$abbreviation_entry, 5],
    ['INCLUDE_EXCEPTION_CONDITION    ',clc$alias_entry, 5],
    ['INCLUDE_EXCEPTION_CONDITIONS   ',clc$nominal_entry, 5],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 6]],
    [
{ PARAMETER 1
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$required_parameter, 0
  , 0],
{ PARAMETER 2
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 377,
  clc$optional_default_parameter, 0, 10],
{ PARAMETER 3
    [12, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_default_parameter, 0, 7],
{ PARAMETER 4
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 84,
  clc$optional_default_parameter, 0, 3],
{ PARAMETER 5
    [10, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 81,
  clc$optional_default_parameter, 0, 4],
{ PARAMETER 6
    [13, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [10], [
    ['C                              ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
    ['CYCLE                          ', clc$alias_entry, clc$normal_usage_entry, 4],
    ['CYCLES                         ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['D                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['DESCRIPTOR                     ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['L                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['LOG                            ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['P                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['PERMIT                         ', clc$alias_entry, clc$normal_usage_entry, 3],
    ['PERMITS                        ', clc$nominal_entry, clc$normal_usage_entry, 3]]
    ,
    'descriptor'],
{ PARAMETER 3
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$integer_type, clc$keyword_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
      ],
    20, [[1, 0, clc$integer_type], [1, 2, 10]]
    ,
    'all'],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [2], [
    ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ,
    'none'],
{ PARAMETER 6
    [[1, 0, clc$status_type]]];

?? POP ??

  CONST
    p$file = 1,
    p$display_options = 2,
    p$output = 3,
    p$depth = 4,
    p$include_exception_conditions = 5,
    p$status = 6;

  VAR
    pvt: array [1 .. 6] of clt$parameter_value;

*copy clv$display_variables
?? NEWTITLE := 'abort_handler', EJECT ??

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

      VAR
        ignore_status: ost$status;

      IF info_segment_pointer.seq_pointer <> NIL THEN
        mmp$delete_segment (info_segment_pointer, 1, ignore_status);
        info_segment_pointer.seq_pointer := NIL;
      IFEND;
      IF items_segment_pointer.seq_pointer <> NIL THEN
        mmp$delete_segment (items_segment_pointer, 1, ignore_status);
        items_segment_pointer.seq_pointer := NIL;
      IFEND;
      clp$close_display (display_control, ignore_status);

    PROCEND abort_handler;
*copy clp$new_page_procedure
?? TITLE := 'put_subtitle', EJECT ??

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


      clp$put_path_reference_subtitle (pvt [p$file].value^.file_value^, 'FILE ', status);

    PROCEND put_subtitle;
*copy clp$put_path_reference_subtitle
?? OLDTITLE, EJECT ??

    VAR
      cycle_lfn: ost$name,
      default_ring_attributes: amt$ring_attributes,
      depth: pft$array_index,
      directory: pft$p_directory_array,
      display_control: clt$display_control,
      display_item: ^clt$display_catalog_item,
      display_items: ^clt$display_catalog_items,
      evaluated_file_reference: fst$evaluated_file_reference,
      first_path_element_is_$local: boolean,
      group: pft$group,
      include_exception_conditions: boolean,
      info: pft$p_info,
      info_record: pft$p_info_record,
      info_segment_pointer: mmt$segment_pointer,
      info_tab: pft$array_index,
      items_segment_pointer: mmt$segment_pointer,
      local_status: ost$status,
      logs: pft$p_log_array,
      permits: pft$p_permit_array,
      pf_path: ^pft$path,
      remote: boolean;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    evaluate_path_and_handle_remote ('DISPLAY_CATALOG_ENTRY', pvt [p$output].value^.file_value^,
          pvt [p$file].value^.file_value^, ^pvt, evaluated_file_reference, first_path_element_is_$local,
          remote, status);
    IF (NOT status.normal) OR remote THEN
      RETURN;
    IFEND;

    IF first_path_element_is_$local AND (evaluated_file_reference.number_of_path_elements = 1) THEN
      osp$set_status_abnormal ('CL', cle$not_permitted_on_loc_cat, '', status);
      RETURN;
    IFEND;

    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    items_segment_pointer.kind := mmc$sequence_pointer;
    items_segment_pointer.seq_pointer := NIL;
    #SPOIL (items_segment_pointer);
    info_segment_pointer.kind := mmc$sequence_pointer;
    info_segment_pointer.seq_pointer := NIL;
    #SPOIL (info_segment_pointer);
    osp$establish_block_exit_hndlr (^abort_handler);

    default_ring_attributes.r1 := #RING (^default_ring_attributes);
    default_ring_attributes.r2 := #RING (^default_ring_attributes);
    default_ring_attributes.r3 := #RING (^default_ring_attributes);
    clp$open_display_reference (pvt [p$output].value^.file_value^, ^clp$new_page_procedure, fsc$list,
          default_ring_attributes, display_control, status);
    IF NOT status.normal THEN
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    clv$titles_built := FALSE;
    clv$subtitles_built := FALSE;
    clv$command_name := 'display_catalog_entry';

    group.group_type := pfc$member;
    group.member_description.family := osc$null_name;
    group.member_description.account := osc$null_name;
    group.member_description.project := osc$null_name;
    group.member_description.user := osc$null_name;

    PUSH pf_path: [1 .. evaluated_file_reference.number_of_path_elements];
    fsp$convert_fs_structure_to_pf (evaluated_file_reference, pf_path);

  /main/
    BEGIN
      mmp$create_segment (NIL, mmc$sequence_pointer, 1, info_segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /main/;
      IFEND;
      info := info_segment_pointer.seq_pointer;
      RESET info;

      IF first_path_element_is_$local THEN
        osp$set_status_abnormal ('CL', cle$not_permitted_on_loc_file, '', status);
        EXIT /main/;
      IFEND;

      include_exception_conditions := pvt [p$include_exception_conditions].value^.keyword_value = 'ALL';

      IF pvt [p$display_options].value^.keyword_value = 'LOG' THEN

        pfp$get_item_info (pf_path^, group, $pft$catalog_info_selections [],
              $pft$file_info_selections [pfc$file_directory, pfc$file_log], info, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        RESET info;
        pfp$find_next_info_record (info, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_directory_array (info_record, directory, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        IF directory = NIL THEN
          osp$set_status_abnormal ('CL', pfe$unknown_permanent_file, pf_path^ [UPPERBOUND (pf_path^)],
                status);
          EXIT /main/;
        IFEND;
        pfp$find_direct_info_record (^info_record^.body, directory^ [1].info_offset, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_log_array (info_record, logs, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        display_file_log (logs, display_control, status);

      ELSEIF pvt [p$display_options].value^.keyword_value = 'PERMITS' THEN

        pfp$get_item_info (pf_path^, group, $pft$catalog_info_selections [],
              $pft$file_info_selections [pfc$file_directory, pfc$file_permits, pfc$indirect_file_permits],
              info, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        RESET info;
        pfp$find_next_info_record (info, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_directory_array (info_record, directory, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        IF directory = NIL THEN
          osp$set_status_abnormal ('CL', pfe$unknown_permanent_file, pf_path^ [UPPERBOUND (pf_path^)],
                status);
          EXIT /main/;
        IFEND;
        pfp$find_direct_info_record (^info_record^.body, directory^ [1].info_offset, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_permit_array (info_record, permits, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;

        display_permits (permits, display_control, status);

      ELSE

        pfp$get_item_info (pf_path^, group, $pft$catalog_info_selections [],
              $pft$file_info_selections [pfc$file_directory, pfc$file_description, pfc$file_cycles_version_2,
              pfc$archive_descriptors], info, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        RESET info;
        pfp$find_next_info_record (info, info_record, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        pfp$find_directory_array (info_record, directory, status);
        IF NOT status.normal THEN
          EXIT /main/;
        IFEND;
        IF directory = NIL THEN
          osp$set_status_abnormal ('CL', pfe$unknown_permanent_file, pf_path^ [UPPERBOUND (pf_path^)],
                status);
          EXIT /main/;
        IFEND;

        IF (pvt [p$display_options].value^.keyword_value = 'CYCLES') AND
              (NOT first_path_element_is_$local) THEN

          mmp$create_segment (NIL, mmc$sequence_pointer, 1, items_segment_pointer, status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;
          display_items := items_segment_pointer.seq_pointer;
          RESET display_items;

          IF pvt [p$depth].value^.kind = clc$integer THEN
            depth := pvt [p$depth].value^.integer_value.value;
          ELSE
            depth := 2;
          IFEND;

          pmp$get_unique_name (cycle_lfn, status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;

          info_tab := 1;
          get_file_info (depth, 1, 1, cycle_lfn, pf_path^, ^info_record^.body, directory^ [1].info_offset,
                include_exception_conditions, info_tab, display_items, display_item, status);
          IF NOT status.normal THEN
            EXIT /main/;
          IFEND;

          put_display_items (display_items, info_tab, depth, display_control, status);

        ELSE

          display_file_description (TRUE, ^info_record^.body, directory, display_control, status);

        IFEND;

      IFEND;
    END /main/;

    IF items_segment_pointer.seq_pointer <> NIL THEN
      mmp$delete_segment (items_segment_pointer, 1, local_status);
      items_segment_pointer.seq_pointer := NIL;
      #SPOIL (items_segment_pointer.seq_pointer);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    IF info_segment_pointer.seq_pointer <> NIL THEN
      mmp$delete_segment (info_segment_pointer, 1, local_status);
      info_segment_pointer.seq_pointer := NIL;
      #SPOIL (info_segment_pointer.seq_pointer);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    clp$close_display (display_control, local_status);
    IF status.normal AND (NOT local_status.normal) THEN
      status := local_status;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND clp$_display_catalog_entry;
?? TITLE := 'evaluate_path_and_handle_remote', EJECT ??
{
{ PURPOSE:
{   This procedure parses a path for a command and determines whether it
{   represents a file on a remote system.  If so it performs the appropriate
{   remote operation; otherwise it returns the evaluated_file_reference for the
{   path along with a boolean indicating whether the path is or is in the
{   $LOCAL catalog.
{

  PROCEDURE evaluate_path_and_handle_remote
    (    command_name: ost$name_reference;
         output_file: fst$file_reference;
         path: fst$file_reference;
         pvt: ^clt$parameter_value_table;
     VAR evaluated_file_reference: fst$evaluated_file_reference;
     VAR first_path_element_is_$local: boolean;
     VAR remote: boolean;
     VAR status: ost$status);

    CONST
      remote_path_prefix = ':$LOCAL.',
      remote_path_prefix_size = 8,
      remote_path_size = remote_path_prefix_size + osc$max_name_size;

    VAR
      block: ^clt$block,
      family_name: ost$family_name,
      unique_name: ost$name,
      remote_parameters: array [1 .. 2] of clt$parameter_substitution,
      remote_path: string (remote_path_size),
      work_area: ^^clt$work_area;


    clp$evaluate_file_reference (output_file, $clt$file_ref_parsing_options [], FALSE,
          evaluated_file_reference, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    family_name := fsp$path_element (^evaluated_file_reference, 1) ^;

    nfp$check_implicit_access (family_name, remote, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF remote THEN
      osp$set_status_abnormal (nfc$status_id, nfe$display_output_remote, command_name, status);
      RETURN;
    IFEND;


    clp$evaluate_file_reference (path, $clt$file_ref_parsing_options [], FALSE, evaluated_file_reference,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    family_name := fsp$path_element (^evaluated_file_reference, 1) ^;

    nfp$check_implicit_access (family_name, remote, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF remote THEN
      pmp$get_unique_name (unique_name, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$get_work_area (#RING (^work_area), work_area, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$find_current_block (block);

      remote_path (1, remote_path_prefix_size) := remote_path_prefix;
      remote_path (remote_path_prefix_size + 1, osc$max_name_size) := unique_name;
      remote_parameters [1].name := 'OUTPUT';
      remote_parameters [1].text := ^remote_path;
      remote_parameters [2].name := 'STATUS';
      remote_parameters [2].text := NIL;

      nfp$perform_implicit_access (family_name, output_file, remote_path, nfc$give, command_name,
            block^.parameters.unbundled_pdt, pvt, ^remote_parameters, work_area^, status);
      RETURN;
    IFEND;

    first_path_element_is_$local := family_name = fsc$local;

  PROCEND evaluate_path_and_handle_remote;
?? TITLE := 'display_catalog_id', EJECT ??

  PROCEDURE display_catalog_id
    (    directory: pft$p_directory_array;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      d: pft$array_index;

    IF directory = NIL THEN
      clp$put_display (display_control, 'EMPTY CATALOG', clc$no_trim, status);
      RETURN;
    IFEND;

    FOR d := LOWERBOUND (directory^) TO UPPERBOUND (directory^) DO
      IF directory^ [d].name_type = pfc$catalog_name THEN
        put_item ('CATALOG: ', directory^ [d].name, display_control, 1, amc$terminate, status);
      ELSE
        put_item ('   FILE: ', directory^ [d].name, display_control, 1, amc$terminate, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND display_catalog_id;
?? TITLE := 'display_permits', EJECT ??

  PROCEDURE display_permits
    (VAR permits: pft$p_permit_array;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    CONST
      alignment = 5;

?? NEWTITLE := 'put', EJECT ??

    PROCEDURE put
      (    item_name: string ( * );
           item_value: string ( * );
           term_option: amt$term_option);

      put_item (item_name, item_value, display_control, alignment, term_option, status);
      IF NOT status.normal THEN
        EXIT display_permits;
      IFEND;

    PROCEND put;
?? TITLE := 'put_group_name', EJECT ??

    PROCEDURE put_group_name
      (    group_name: string ( * ));

      clp$horizontal_tab_display (display_control, alignment - 2, status);
      IF NOT status.normal THEN
        EXIT display_permits;
      IFEND;

      clp$put_partial_display (display_control, 'PERMIT_GROUP: ', clc$no_trim, amc$continue, status);
      IF NOT status.normal THEN
        EXIT display_permits;
      IFEND;

      clp$put_partial_display (display_control, group_name, clc$no_trim, amc$terminate, status);
      IF NOT status.normal THEN
        EXIT display_permits;
      IFEND;

    PROCEND put_group_name;
?? TITLE := 'put_usage_share', EJECT ??

    PROCEDURE put_usage_share;

      VAR
        usage: pft$permit_selections,
        share: pft$share_requirements,
        header: ^string ( * ),
        j: pft$permit_options;

      VAR
        permit_names: [STATIC, READ, oss$job_paged_literal] array [pft$permit_options] of string (7) :=
              ['READ', 'SHORTEN', 'APPEND', 'MODIFY', 'EXECUTE', 'CYCLE', 'CONTROL'];

      usage := permits^ [p].usage_permissions;
      share := permits^ [p].share_requirements;

      PUSH header: [9];
      header^ := 'PERMITS: ';
      IF usage = $pft$permit_selections [] THEN
        put (header^, 'NONE', amc$terminate);
      ELSE

      /put_usage/
        FOR j := LOWERVALUE (pft$permit_options) TO UPPERVALUE (pft$permit_options) DO
          IF j IN usage THEN
            usage := usage - $pft$permit_selections [j];
            IF usage = $pft$permit_selections [] THEN
              put (header^, permit_names [j], amc$terminate);
              EXIT /put_usage/;
            IFEND;
            put (header^, permit_names [j], amc$continue);
            header := ^header^ (1, 2);
            header^ (1, 2) := ', ';
          IFEND;
        FOREND /put_usage/;
      IFEND;

      PUSH header: [7];
      header^ := 'SHARE: ';
      IF share = $pft$share_selections [] THEN
        put (header^, 'NONE', amc$terminate);
      ELSE

      /put_share/
        FOR j := LOWERVALUE (pft$share_options) TO UPPERVALUE (pft$share_options) DO
          IF j IN share THEN
            share := share - $pft$share_selections [j];
            IF share = $pft$share_selections [] THEN
              put (header^, permit_names [j], amc$terminate);
              EXIT /put_share/;
            IFEND;
            put (header^, permit_names [j], amc$continue);
            header := ^header^ (1, 2);
            header^ (1, 2) := ', ';
          IFEND;
        FOREND /put_share/;
      IFEND;

    PROCEND put_usage_share;
?? OLDTITLE, EJECT ??

    VAR
      p: pft$array_index;

    IF permits = NIL THEN
      clp$put_display (display_control, '   NO PERMITS', clc$no_trim, status);
      RETURN;
    IFEND;

    sort_permits (permits);

    FOR p := 1 TO UPPERBOUND (permits^) DO
      CASE permits^ [p].group.group_type OF
      = pfc$public =
        put_group_name ('PUBLIC');
      = pfc$family =
        put_group_name ('FAMILY');
        put ('FAMILY: ', permits^ [p].group.family_description.family, amc$terminate);
      = pfc$account =
        put_group_name ('ACCOUNT');
        put ('FAMILY: ', permits^ [p].group.account_description.family, amc$continue);
        put (', ACCOUNT: ', permits^ [p].group.account_description.account, amc$terminate);
      = pfc$project =
        put_group_name ('PROJECT');
        put ('FAMILY: ', permits^ [p].group.project_description.family, amc$continue);
        put (', ACCOUNT: ', permits^ [p].group.project_description.account, amc$continue);
        put (', PROJECT: ', permits^ [p].group.project_description.project, amc$terminate);
      = pfc$user =
        put_group_name ('USER');
        put ('FAMILY: ', permits^ [p].group.user_description.family, amc$continue);
        put (', USER: ', permits^ [p].group.user_description.user, amc$terminate);
      = pfc$user_account =
        put_group_name ('USER_ACCOUNT');
        put ('FAMILY: ', permits^ [p].group.user_account_description.family, amc$continue);
        put (', ACCOUNT: ', permits^ [p].group.user_account_description.account, amc$continue);
        put (', USER: ', permits^ [p].group.user_account_description.user, amc$terminate);
      = pfc$member =
        put_group_name ('MEMBER');
        put ('FAMILY: ', permits^ [p].group.member_description.family, amc$continue);
        put (', ACCOUNT: ', permits^ [p].group.member_description.account, amc$continue);
        put (', PROJECT: ', permits^ [p].group.member_description.project, amc$continue);
        put (', USER: ', permits^ [p].group.member_description.user, amc$terminate);
      CASEND;
      put_usage_share;
      put_item ('APPLICATION_INFORMATION: ', permits^ [p].application_info, display_control, alignment,
            amc$terminate, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND display_permits;
?? TITLE := 'sort_permits', EJECT ??

  PROCEDURE sort_permits
    (    permit_array: pft$p_permit_array);

    VAR
      gap: integer,
      start: integer,
      current: integer,
      swap: pft$permit_array_entry;

?? NEWTITLE := 'swap_entries', EJECT ??

    FUNCTION swap_entries
      (    current: pft$group;
           current_plus_gap: pft$group): boolean;

      IF current.group_type > current_plus_gap.group_type THEN
        swap_entries := TRUE;
      ELSEIF current.group_type < current_plus_gap.group_type THEN
        swap_entries := FALSE;
      ELSE
        CASE current.group_type OF
        = pfc$public =
          swap_entries := FALSE;
        = pfc$family =
          swap_entries := current.family_description.family > current_plus_gap.family_description.family;
        = pfc$account =
          IF current.account_description.family > current_plus_gap.account_description.family THEN
            swap_entries := TRUE;
          ELSEIF current.account_description.family < current_plus_gap.account_description.family THEN
            swap_entries := FALSE;
          ELSE
            swap_entries := current.account_description.account >
                  current_plus_gap.account_description.account;
          IFEND;
        = pfc$project =
          IF current.project_description.family > current_plus_gap.project_description.family THEN
            swap_entries := TRUE;
          ELSEIF current.project_description.family < current_plus_gap.project_description.family THEN
            swap_entries := FALSE;
          ELSEIF current.project_description.account > current_plus_gap.project_description.account THEN
            swap_entries := TRUE;
          ELSEIF current.project_description.account < current_plus_gap.project_description.account THEN
            swap_entries := FALSE;
          ELSE
            swap_entries := current.project_description.project >
                  current_plus_gap.project_description.project;
          IFEND;
        = pfc$user =
          IF current.user_description.family > current_plus_gap.user_description.family THEN
            swap_entries := TRUE;
          ELSEIF current.user_description.family < current_plus_gap.user_description.family THEN
            swap_entries := FALSE;
          ELSE
            swap_entries := current.user_description.user > current_plus_gap.user_description.user;
          IFEND;
        = pfc$user_account =
          IF current.user_account_description.family > current_plus_gap.user_account_description.family THEN
            swap_entries := TRUE;
          ELSEIF current.user_account_description.family < current_plus_gap.user_account_description.
                family THEN
            swap_entries := FALSE;
          ELSEIF current.user_account_description.account > current_plus_gap.user_account_description.
                account THEN
            swap_entries := TRUE;
          ELSEIF current.user_account_description.account < current_plus_gap.user_account_description.
                account THEN
            swap_entries := FALSE;
          ELSE
            swap_entries := current.user_account_description.user >
                  current_plus_gap.user_account_description.user;
          IFEND;
        = pfc$member =
          IF current.member_description.family > current_plus_gap.member_description.family THEN
            swap_entries := TRUE;
          ELSEIF current.member_description.family < current_plus_gap.member_description.family THEN
            swap_entries := FALSE;
          ELSEIF current.member_description.account > current_plus_gap.member_description.account THEN
            swap_entries := TRUE;
          ELSEIF current.member_description.account < current_plus_gap.member_description.account THEN
            swap_entries := FALSE;
          ELSEIF current.member_description.project > current_plus_gap.member_description.project THEN
            swap_entries := TRUE;
          ELSEIF current.member_description.project < current_plus_gap.member_description.project THEN
            swap_entries := FALSE;
          ELSE
            swap_entries := current.member_description.user > current_plus_gap.member_description.user;
          IFEND;
        CASEND;
      IFEND;

    FUNCEND swap_entries;
?? OLDTITLE, EJECT ??

{ Use shell sort technique.

    gap := UPPERBOUND (permit_array^);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := 1 TO UPPERBOUND (permit_array^) - gap DO
        current := start;
        WHILE (current > 0) AND swap_entries (permit_array^ [current].group,
              permit_array^ [current + gap].group) DO
          swap := permit_array^ [current];
          permit_array^ [current] := permit_array^ [current + gap];
          permit_array^ [current + gap] := swap;
          current := current - gap;
        WHILEND;
      FOREND;
    WHILEND;

  PROCEND sort_permits;
?? TITLE := 'display_file_log', EJECT ??

  PROCEDURE display_file_log
    (    logs: pft$p_log_array;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    CONST
      alignment = 5;

    VAR
      ignore_status: ost$status,
      str: ost$string,
      l: pft$array_index,
      up: pft$array_index,
      low: pft$array_index;

?? NEWTITLE := 'put', EJECT ??

    PROCEDURE put
      (    item_name: string ( * );
           item_value: string ( * );
           term_option: amt$term_option);

      put_item (item_name, item_value, display_control, alignment, term_option, status);
      IF NOT status.normal THEN
        EXIT display_file_log;
      IFEND;

    PROCEND put;
?? OLDTITLE, EJECT ??

    IF logs = NIL THEN
      clp$put_display (display_control, '   NO LOG ENTRIES', clc$no_trim, status);
      RETURN;
    IFEND;

    sort_log (logs);

    FOR l := 1 TO UPPERBOUND (logs^) DO
      convert_date_time (logs^ [l].access_date_time, TRUE, str);
      put ('DATE AND TIME: ', str.value (1, str.size), amc$continue);

      put (', FAMILY: ', logs^ [l].user_id.family, amc$continue);

      put (', USER: ', logs^ [l].user_id.user, amc$continue);

      clp$convert_integer_to_string (logs^ [l].access_count, 10, FALSE, str, ignore_status);
      put (', ACCESS COUNT: ', str.value (1, str.size), amc$continue);

      clp$convert_integer_to_string (logs^ [l].last_cycle, 10, FALSE, str, ignore_status);
      put (', LAST CYCLE: ', str.value (1, str.size), amc$terminate);
    FOREND;

  PROCEND display_file_log;
?? TITLE := 'sort_log', EJECT ??

  PROCEDURE sort_log
    (    log_array: pft$p_log_array);

    VAR
      gap: integer,
      start: integer,
      current: integer,
      swap: pft$log_array_entry;

?? NEWTITLE := 'swap_entries', EJECT ??

    FUNCTION swap_entries
      (    current: pft$log_array_entry;
           current_plus_gap: pft$log_array_entry): boolean;

      IF current.access_date_time.year < current_plus_gap.access_date_time.year THEN
        swap_entries := TRUE;
      ELSEIF current.access_date_time.year > current_plus_gap.access_date_time.year THEN
        swap_entries := FALSE;
      ELSEIF current.access_date_time.month < current_plus_gap.access_date_time.month THEN
        swap_entries := TRUE;
      ELSEIF current.access_date_time.month > current_plus_gap.access_date_time.month THEN
        swap_entries := FALSE;
      ELSEIF current.access_date_time.day < current_plus_gap.access_date_time.day THEN
        swap_entries := TRUE;
      ELSEIF current.access_date_time.day > current_plus_gap.access_date_time.day THEN
        swap_entries := FALSE;
      ELSEIF current.access_date_time.hour < current_plus_gap.access_date_time.hour THEN
        swap_entries := TRUE;
      ELSEIF current.access_date_time.hour > current_plus_gap.access_date_time.hour THEN
        swap_entries := FALSE;
      ELSEIF current.access_date_time.minute < current_plus_gap.access_date_time.minute THEN
        swap_entries := TRUE;
      ELSEIF current.access_date_time.minute > current_plus_gap.access_date_time.minute THEN
        swap_entries := FALSE;
      ELSEIF current.access_date_time.second < current_plus_gap.access_date_time.second THEN
        swap_entries := TRUE;
      ELSEIF current.access_date_time.second > current_plus_gap.access_date_time.second THEN
        swap_entries := FALSE;
      ELSEIF current.access_date_time.millisecond < current_plus_gap.access_date_time.millisecond THEN
        swap_entries := TRUE;
      ELSEIF current.access_date_time.millisecond > current_plus_gap.access_date_time.millisecond THEN
        swap_entries := FALSE;
      ELSEIF current.user_id.family < current_plus_gap.user_id.family THEN
        swap_entries := TRUE;
      ELSEIF current.user_id.family > current_plus_gap.user_id.family THEN
        swap_entries := FALSE;
      ELSE
        swap_entries := current.user_id.user < current_plus_gap.user_id.user;
      IFEND;

    FUNCEND swap_entries;
?? OLDTITLE, EJECT ??

{ Use shell sort technique.

    gap := UPPERBOUND (log_array^);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := 1 TO UPPERBOUND (log_array^) - gap DO
        current := start;
        WHILE (current > 0) AND swap_entries (log_array^ [current], log_array^ [current + gap]) DO
          swap := log_array^ [current];
          log_array^ [current] := log_array^ [current + gap];
          log_array^ [current + gap] := swap;
          current := current - gap;
        WHILEND;
      FOREND;
    WHILEND;

  PROCEND sort_log;
?? TITLE := 'display_file_description', EJECT ??

  PROCEDURE display_file_description
    (    describe_individual_file: boolean;
         info: pft$p_info;
         directory: pft$p_directory_array;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    CONST
      alignment = 5;

    VAR
      file_description: pft$p_file_description,
      log: string (5),
      cycles: ^pft$cycle_array_version_2,
      d: pft$array_index,
      info_record: pft$p_info_record,
      ignore_status: ost$status,
      str: ost$string;

?? NEWTITLE := 'put', EJECT ??

    PROCEDURE put
      (    item_name: string ( * );
           item_value: string ( * );
           term_option: amt$term_option);

      put_item (item_name, item_value, display_control, alignment, term_option, status);
      IF NOT status.normal THEN
        EXIT display_file_description;
      IFEND;

    PROCEND put;
?? OLDTITLE, EJECT ??

    IF directory = NIL THEN
      clp$put_display (display_control, 'NO FILES', clc$no_trim, status);
      RETURN;
    IFEND;

    FOR d := LOWERBOUND (directory^) TO UPPERBOUND (directory^) DO
      IF NOT describe_individual_file THEN
        clp$put_display (display_control, directory^ [d].name, clc$trim, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

      pfp$find_direct_info_record (info, directory^ [d].info_offset, info_record, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      pfp$find_cycle_array_version_2 (info_record, cycles, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF cycles = NIL THEN
        str.value (1, highest_cycle_size - 1) := '';
        str.value (highest_cycle_size) := '0';
      ELSE
        clp$convert_integer_to_rjstring (UPPERBOUND (cycles^),
              10, FALSE, ' ', str.value (1, highest_cycle_size), ignore_status);
      IFEND;
      put ('NUMBER OF CYCLES: ', str.value (1, highest_cycle_size), amc$continue);

      pfp$find_file_description (info_record, file_description, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      put (', ACCOUNT: ', file_description^.charge_id.account, amc$continue);
      put (', PROJECT: ', file_description^.charge_id.project, amc$terminate);

      IF describe_individual_file THEN
        put ('PASSWORD: ', file_description^.password, amc$continue);

        IF file_description^.logging_selection = pfc$log THEN
          log := 'TRUE ';
        ELSE
          log := 'FALSE';
        IFEND;
        put (', LOG SELECTION: ', log, amc$terminate);

        display_cycles (cycles, display_control, status);
      IFEND;
    FOREND;

  PROCEND display_file_description;
?? TITLE := 'display_cycles', EJECT ??

  PROCEDURE display_cycles
    (    cycles: ^pft$cycle_array_version_2;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    CONST
      alignment = 5;

    VAR
      ignore_status: ost$status,
      c: pft$array_index,
      str: ost$string;

?? NEWTITLE := 'put', EJECT ??

    PROCEDURE put
      (    item_name: string ( * );
           item_value: string ( * );
           term_option: amt$term_option);

      put_item (item_name, item_value, display_control, alignment, term_option, status);
      IF NOT status.normal THEN
        EXIT display_cycles;
      IFEND;

    PROCEND put;
?? OLDTITLE, EJECT ??

    IF cycles <> NIL THEN
      sort_cycles (cycles);
      FOR c := 1 TO UPPERBOUND (cycles^) DO
        clp$convert_integer_to_rjstring (cycles^ [c].cycle_number, 10, FALSE, ' ', str.
              value (1, highest_cycle_size), ignore_status);
        put ('CYCLE NUMBER: ', str.value (1, highest_cycle_size), amc$continue);

        clp$convert_integer_to_string (cycles^ [c].cycle_statistics.access_count, 10, FALSE, str,
              ignore_status);
        put (', ACCESS COUNT: ', str.value (1, str.size), amc$continue);

        convert_date_time (cycles^ [c].cycle_statistics.creation_date_time, TRUE, str);
        put (', CREATION DATE AND TIME: ', str.value (1, str.size), amc$continue);

        convert_date_time (cycles^ [c].cycle_statistics.access_date_time, TRUE, str);
        put (', LAST ACCESS DATE AND TIME: ', str.value (1, str.size), amc$continue);

        convert_date_time (cycles^ [c].cycle_statistics.modification_date_time, TRUE, str);
        put (', LAST MODIFICATION DATE AND TIME: ', str.value (1, str.size), amc$continue);

        convert_date_time (cycles^ [c].expiration_date_time, FALSE, str);
        put (', EXPIRATION DATE: ', str.value (1, str.size), amc$continue);

        str.value := class [cycles^ [c].device_class].value;
        str.size := class [cycles^ [c].device_class].size;
        put (', DEVICE_CLASS: ', str.value (1, str.size), amc$terminate);
      FOREND;
    IFEND;

  PROCEND display_cycles;

?? TITLE := 'sort_cycles', EJECT ??

  PROCEDURE sort_cycles
    (    cycles: ^pft$cycle_array_version_2);

    VAR
      gap: integer,
      start: integer,
      current: integer,
      swap: pft$cycle_array_entry_version_2;

{ Use shell sort technique.

    gap := UPPERBOUND (cycles^);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := 1 TO UPPERBOUND (cycles^) - gap DO
        current := start;
        WHILE (current > 0) AND (cycles^ [current].cycle_number < cycles^ [current + gap].cycle_number) DO
          swap := cycles^ [current];
          cycles^ [current] := cycles^ [current + gap];
          cycles^ [current + gap] := swap;
          current := current - gap;
        WHILEND;
      FOREND;
    WHILEND;

  PROCEND sort_cycles;
?? TITLE := 'sort_cycles_extended', EJECT ??

  PROCEDURE sort_cycles_extended
    (    cycles_extended: pft$p_cycle_directory_array);

    VAR
      gap: integer,
      start: integer,
      current: integer,
      swap: pft$cycle_directory_array_entry;

{ Use shell sort technique.

    gap := UPPERBOUND (cycles_extended^);
    WHILE gap > 1 DO
      gap := 2 * (gap DIV 4) + 1;
      FOR start := 1 TO UPPERBOUND (cycles_extended^) - gap DO
        current := start;
        WHILE (current > 0) AND (cycles_extended^ [current].cycle_number <
              cycles_extended^ [current + gap].cycle_number) DO
          swap := cycles_extended^ [current];
          cycles_extended^ [current] := cycles_extended^ [current + gap];
          cycles_extended^ [current + gap] := swap;
          current := current - gap;
        WHILEND;
      FOREND;
    WHILEND;

  PROCEND sort_cycles_extended;
?? TITLE := 'put_item', EJECT ??

  PROCEDURE put_item
    (    item_name: string ( * );
         item_value: string ( * );
     VAR display_control: clt$display_control;
         alignment: ost$string_index;
         term_option: amt$term_option;
     VAR status: ost$status);

    VAR
      item_name_index: ost$string_index,
      item_name_size: ost$string_size,
      item_value_size: ost$string_size;

    item_name_index := 1;
    item_name_size := STRLENGTH (item_name);
    item_value_size := size (item_value);

    IF item_name (1, 2) = ', ' THEN
      clp$put_partial_display (display_control, ', ', clc$no_trim, amc$continue, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      item_name_index := 3;
      item_name_size := item_name_size - 2;
    IFEND;

    IF display_control.column_number = 1 THEN
      clp$horizontal_tab_display (display_control, alignment, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    ELSEIF (display_control.column_number + item_name_size + item_value_size) >
          display_control.page_width THEN
      clp$new_display_line (display_control, 0, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$horizontal_tab_display (display_control, alignment, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    IFEND;

    clp$put_partial_display (display_control, item_name (item_name_index, item_name_size), clc$no_trim,
          amc$continue, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$put_partial_display (display_control, item_value (1, item_value_size), clc$no_trim, term_option,
          status);

  PROCEND put_item;
?? TITLE := 'convert_date_time', EJECT ??

  PROCEDURE convert_date_time
    (    date_time: ost$date_time;
         include_time: boolean;
     VAR str: ost$string);

    VAR
      date: ost$date,
      time: ost$time,
      status: ost$status;

    IF (date_time.year >= UPPERVALUE (date_time.year)) AND
          (date_time.month >= UPPERVALUE (date_time.month)) AND
          (date_time.day >= UPPERVALUE (date_time.day)) AND (date_time.hour >=
          UPPERVALUE (date_time.hour)) AND (date_time.minute >= UPPERVALUE (date_time.minute)) AND
          (date_time.second >= UPPERVALUE (date_time.second)) AND
          (date_time.millisecond >= UPPERVALUE (date_time.millisecond)) THEN
      str.size := 4;
      str.value := 'NONE';
      RETURN;
    IFEND;

    pmp$format_compact_date (date_time, osc$iso_date, date, status);
    IF status.normal THEN
      str.size := STRLENGTH (date.iso);
      str.value (1, STRLENGTH (date.iso)) := date.iso;
    ELSE
      str.size := 4;
      str.value (1, 4) := '????';
    IFEND;

    IF include_time THEN
      str.value (str.size + 1) := ' ';
      pmp$format_compact_time (date_time, osc$millisecond_time, time, status);
      IF status.normal THEN
        str.value (str.size + 2, STRLENGTH (time.millisecond)) := time.millisecond;
        str.size := str.size + 1 + STRLENGTH (time.millisecond);
      ELSE
        str.value (str.size + 2, 4) := '????';
        str.size := str.size + 1 + 4;
      IFEND;
    IFEND;

  PROCEND convert_date_time;

?? TITLE := 'size', EJECT ??

  FUNCTION size
    (    str: string ( * )): integer;

    VAR
      str_length: ost$string_size;

    str_length := STRLENGTH (str);
    WHILE (str_length > 0) AND (str (str_length) = ' ') DO
      str_length := str_length - 1;
    WHILEND;
    size := str_length;

  FUNCEND size;
?? TITLE := 'get_catalog_info', EJECT ??

  PROCEDURE get_catalog_info
    (    depth: pft$array_index;
         level: pft$array_index;
         name_tab: pft$array_index;
         cycle_lfn: amt$local_file_name;
         path: pft$path;
         group: pft$group;
         info: pft$p_info;
         include_exception_conditions: boolean;
     VAR info_tab {input, output} : pft$array_index;
     VAR display_items {input, output} : ^clt$display_catalog_items;
     VAR catalog_item: ^clt$display_catalog_item;
     VAR status: ost$status);

    VAR
      item: ^clt$display_catalog_item,
      item_info: pft$p_info,
      item_path: ^pft$path,
      info_record: pft$p_info_record,
      directory: pft$p_directory_array,
      name_size: ost$name_size,
      i: pft$array_index;

    status.normal := TRUE;

    name_size := osc$max_name_size;
    WHILE (name_size > 0) AND (path [UPPERBOUND (path)] (name_size) = ' ') DO
      name_size := name_size - 1;
    WHILEND;

    IF level <= depth THEN
      IF (name_tab + name_size) > info_tab THEN
        info_tab := name_tab + name_size;
      IFEND;
    IFEND;

    NEXT catalog_item IN display_items;
    catalog_item^.level := level;
    catalog_item^.name_tab := name_tab;
    #TRANSLATE (osv$upper_to_lower, path [UPPERBOUND (path)], catalog_item^.name);
    catalog_item^.name_size := name_size;
    catalog_item^.size := 0;
    catalog_item^.size_completely_known := TRUE;
    catalog_item^.kind := clc$display_catalog_item;
    catalog_item^.number_of_files := 0;
    catalog_item^.number_of_catalogs := 0;

    item_info := info;
    pfp$get_multi_item_info (path, group, $pft$catalog_info_selections [pfc$catalog_directory],
          $pft$file_info_selections [pfc$file_directory, pfc$file_description, pfc$file_cycles_version_2,
          pfc$archive_descriptors], item_info, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    item_info := info;
    pfp$find_next_info_record (item_info, info_record, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    pfp$find_directory_array (info_record, directory, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF directory = NIL THEN
      RETURN;
    IFEND;

    PUSH item_path: [1 .. UPPERBOUND (path) + 1];
    FOR i := 1 TO UPPERBOUND (path) DO
      item_path^ [i] := path [i];
    FOREND;

    FOR i := 1 TO UPPERBOUND (directory^) DO
      item_path^ [UPPERBOUND (item_path^)] := directory^ [i].name;
      IF directory^ [i].name_type = pfc$file_name THEN
        catalog_item^.number_of_files := catalog_item^.number_of_files + 1;
        get_file_info (depth, level + 1, name_tab + 2, cycle_lfn, item_path^, ^info_record^.body,
              directory^ [i].info_offset, include_exception_conditions, info_tab, display_items, item,
              status);
      ELSE
        catalog_item^.number_of_catalogs := catalog_item^.number_of_catalogs + 1;
        get_catalog_info (depth, level + 1, name_tab + 2, cycle_lfn, item_path^, group, item_info,
              include_exception_conditions, info_tab, display_items, item, status);
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      catalog_item^.size := catalog_item^.size + item^.size;
      IF NOT item^.size_completely_known THEN
        catalog_item^.size_completely_known := FALSE;
      IFEND;
    FOREND;

  PROCEND get_catalog_info;
?? TITLE := 'get_file_info', EJECT ??

  PROCEDURE get_file_info
    (    depth: pft$array_index;
         level: pft$array_index;
         name_tab: pft$array_index;
         cycle_lfn: amt$local_file_name;
         path: pft$path;
         info: pft$p_info;
         info_offset: pft$info_offset;
         include_exception_conditions: boolean;
     VAR info_tab {input, output} : pft$array_index;
     VAR display_items {input, output} : ^clt$display_catalog_items;
     VAR file_item: ^clt$display_catalog_item;
     VAR status: ost$status);

    VAR
      archive_info_record: pft$p_info_record,
      item: ^clt$display_catalog_item,
      info_record: pft$p_info_record,
      file_description: pft$p_file_description,
      cycles: ^pft$cycle_array_version_2,
      cycles_extended: pft$p_cycle_directory_array,
      cycle_str: ost$string,
      directory: pft$p_directory_array,
      name_size: ost$name_size,
      i: pft$array_index,
      p_cycle_array_extended_record: pft$p_info_record;

    status.normal := TRUE;

    name_size := osc$max_name_size;
    WHILE (name_size > 0) AND (path [UPPERBOUND (path)] (name_size) = ' ') DO
      name_size := name_size - 1;
    WHILEND;

    IF level <= depth THEN
      IF (name_tab + name_size) > info_tab THEN
        info_tab := name_tab + name_size;
      IFEND;
    IFEND;

    NEXT file_item IN display_items;
    file_item^.level := level;
    file_item^.name_tab := name_tab;
    #TRANSLATE (osv$upper_to_lower, path [UPPERBOUND (path)], file_item^.name);
    file_item^.name_size := name_size;
    file_item^.size := 0;
    file_item^.size_completely_known := TRUE;
    file_item^.kind := clc$display_file_item;
    file_item^.number_of_cycles := 0;
    file_item^.highest_cycle_number := 1;

    pfp$find_direct_info_record (info, info_offset, info_record, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    archive_info_record := info_record;

    pfp$find_cycle_array_version_2 (info_record, cycles, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF cycles = NIL THEN
      RETURN;
    IFEND;

    pfp$find_file_description (info_record, file_description, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pfp$find_cycle_array_extended (archive_info_record, p_cycle_array_extended_record, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pfp$find_cycle_directory (p_cycle_array_extended_record, cycles_extended, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    sort_cycles (cycles);

    sort_cycles_extended (cycles_extended);

    file_item^.number_of_cycles := UPPERBOUND (cycles^);
    file_item^.highest_cycle_number := cycles^ [1].cycle_number;
    cycle_str.size := 0;

    FOR i := 1 TO UPPERBOUND (cycles^) DO
      pfp$find_direct_info_record (^p_cycle_array_extended_record^.body, cycles_extended^ [i].info_offset,
            archive_info_record, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      get_cycle_info (depth, level + 1, name_tab, cycle_lfn, path, cycles^ [i], file_description^.password,
            archive_info_record, include_exception_conditions, cycle_str, info_tab, display_items, item,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      file_item^.size := file_item^.size + item^.size;
      IF NOT item^.size_completely_known THEN
        file_item^.size_completely_known := FALSE;
      IFEND;
    FOREND;

  PROCEND get_file_info;
?? TITLE := 'get_cycle_info', EJECT ??

  PROCEDURE get_cycle_info
    (    depth: pft$array_index;
         level: pft$array_index;
         name_tab: pft$array_index;
         cycle_lfn: amt$local_file_name;
         path: pft$path;
         cycle_array_entry: pft$cycle_array_entry_version_2,
         password: pft$password;
         archive_info: pft$p_info_record;
         include_exception_conditions: boolean;
     VAR cycle_str {input, output} : ost$string;
     VAR info_tab {input, output} : pft$array_index;
     VAR display_items {input, output} : ^clt$display_catalog_items;
     VAR cycle_item: ^clt$display_catalog_item;
     VAR status: ost$status);

?? NEWTITLE := 'abort_handler', EJECT ??

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

      IF cycle_attached THEN
        amp$return (cycle_lfn, ignore_status);
        cycle_attached := FALSE;
      IFEND;

    PROCEND abort_handler;

?? OLDTITLE, EJECT ??

    VAR
      archive_identification: pft$archive_identification,
      archive_status: ost$status,
      attach_status: ost$status,
      compare_status: ost$status,
      comparison_result: pmt$comparison_result,
      cycle_attached: boolean,
      cycle_damage_symptoms: fst$cycle_damage_symptoms,
      cycle_selector: pft$cycle_selector,
      data_modification_date_time: ost$date_time,
      existing_file: boolean,
      file_attributes: array [1 .. 1] of amt$get_item,
      get_file_status: ost$status,
      i: pft$array_index,
      ignore_contains_data: boolean,
      ignore_local_file: boolean,
      ignore_status: ost$status,
      later: boolean,
      p_archive_entry: pft$p_archive_array_entry,
      p_archive_group: pft$p_info_record,
      p_archive_list: pft$p_info_record,
      p_archive_media: ^pft$amd,
      p_info: pft$p_info,
      returned_cycle_number: fst$cycle_number,
      stale_cycle_entry: boolean;

    p_archive_list := NIL;
    later := TRUE;
    status.normal := TRUE;

    edit_integer (cycle_array_entry.cycle_number, TRUE, cycle_str);

    NEXT cycle_item IN display_items;
    cycle_item^.level := level;
    cycle_item^.name_tab := name_tab;
    cycle_item^.name := '--  cycle';
    cycle_item^.name (11, cycle_str.size) := cycle_str.value (1, cycle_str.size);
    cycle_item^.name_size := 10 + cycle_str.size;
    cycle_item^.size := 0;
    cycle_item^.size_completely_known := TRUE;
    cycle_item^.kind := clc$display_cycle_item;
    cycle_item^.cycle_number := cycle_array_entry.cycle_number;
    cycle_item^.cycle_archived := FALSE;
    cycle_item^.cycle_data_not_defined := FALSE;
    cycle_item^.cycle_data_released := FALSE;
    cycle_item^.cycle_device_class := cycle_array_entry.device_class;
    cycle_item^.cycle_has_been_opened := TRUE;
    cycle_item^.cycles_media_missing := FALSE;
    cycle_item^.cycles_respf_mod_mismatch := FALSE;
    cycle_item^.media_image_inconsistent := FALSE;
    cycle_item^.parent_catalog_restored := FALSE;
    cycle_item^.volume_unavailable := FALSE;

    IF level <= depth THEN
      IF (name_tab + cycle_item^.name_size) > info_tab THEN
        info_tab := name_tab + cycle_item^.name_size;
      IFEND;
    IFEND;

    pfp$find_archive_info (archive_info, p_archive_list, archive_status);
    IF status.normal AND (p_archive_list <> NIL) THEN
      p_info := ^p_archive_list^.body;
      archive_identification.application_identifier := osc$null_name;
      archive_identification.media_identifier.media_device_class := osc$null_name;
      archive_identification.media_identifier.media_volume_identifier := '';
      IF cycle_array_entry.data_modification_date_time.year > 0 THEN
        data_modification_date_time := cycle_array_entry.data_modification_date_time;
      ELSE
        data_modification_date_time := cycle_array_entry.cycle_statistics.modification_date_time;
      IFEND;
    /search_archive_list/
      REPEAT
        pfp$find_next_archive_entry (archive_identification, p_info, p_archive_group, p_archive_entry,
              p_archive_media, archive_status);
        IF archive_status.normal AND (p_archive_entry <> NIL) THEN
          pmp$date_time_compare (p_archive_entry^.archive_date_time, data_modification_date_time,
                comparison_result, archive_status);
          IF archive_status.normal AND (comparison_result = pmc$left_is_greater) THEN
            cycle_item^.cycle_archived := TRUE;
            cycle_item^.cycle_archive_identification := p_archive_entry^.archive_identification;
            EXIT /search_archive_list/;
          IFEND;
        IFEND;
      UNTIL (NOT archive_status.normal) OR (p_archive_entry = NIL);
    IFEND;

    IF cycle_array_entry.data_modification_date_time.year > 0 THEN
      pmp$date_time_compare (cycle_array_entry.data_modification_date_time,
            cycle_array_entry.cycle_statistics.modification_date_time, comparison_result, compare_status);
      IF NOT compare_status.normal THEN
        stale_cycle_entry := TRUE;
      ELSE
        stale_cycle_entry := comparison_result = pmc$right_is_greater;
      IFEND;
    ELSE
      stale_cycle_entry := TRUE;
    IFEND;

    cycle_attached := FALSE;
    #SPOIL (cycle_attached);
    IF stale_cycle_entry OR include_exception_conditions THEN
      osp$establish_block_exit_hndlr (^abort_handler);
      cycle_selector.cycle_option := pfc$specific_cycle;
      cycle_selector.cycle_number := cycle_array_entry.cycle_number;
      pfp$utility_attach (cycle_lfn, path, cycle_selector, password, $pft$usage_selections [],
            -$pft$share_selections [], pfc$no_wait, $fst$cycle_damage_symptoms [], cycle_damage_symptoms,
            returned_cycle_number, attach_status);
      IF attach_status.normal THEN
        cycle_attached := TRUE;
        #SPOIL (cycle_attached);
        file_attributes [1].key := amc$file_length;
        amp$get_file_attributes (cycle_lfn, file_attributes, ignore_local_file, existing_file,
              ignore_contains_data, get_file_status);
        amp$return (cycle_lfn, ignore_status);
        cycle_attached := FALSE;
        #SPOIL (cycle_attached);
      IFEND;
      osp$disestablish_cond_handler;

      IF attach_status.normal THEN
        IF get_file_status.normal THEN
          cycle_item^.cycle_has_been_opened := existing_file;
          cycle_item^.size := file_attributes [1].file_length;
        ELSE
          cycle_item^.size_completely_known := FALSE;
        IFEND;
      ELSE
        cycle_item^.size_completely_known := FALSE;
        CASE attach_status.condition OF
        = pfe$cycles_media_missing =
          IF include_exception_conditions THEN
            cycle_item^.cycles_media_missing := TRUE;
          IFEND;
        = pfe$cycle_data_resides_offline =
          cycle_item^.cycle_archived := TRUE;
          cycle_item^.cycle_data_released := TRUE;
          cycle_item^.size := p_archive_entry^.file_size;
          cycle_item^.size_completely_known := TRUE;
        = pfe$media_image_inconsistent =
          IF include_exception_conditions THEN
            cycle_item^.media_image_inconsistent := TRUE;
          IFEND;
        = pfe$parent_catalog_restored =
          IF include_exception_conditions THEN
            cycle_item^.parent_catalog_restored := TRUE;
          IFEND;
        = pfe$respf_modification_mismatch =
          IF include_exception_conditions THEN
            cycle_item^.cycles_respf_mod_mismatch := TRUE;
          IFEND;
        = pfe$undefined_data =
          IF include_exception_conditions THEN
            cycle_item^.cycle_data_not_defined := TRUE;
          IFEND;
        = pfe$volume_not_online =
          IF include_exception_conditions THEN
            cycle_item^.cycles_media_missing := TRUE;
          IFEND;
        = pfe$volume_unavailable =
          IF include_exception_conditions THEN
            cycle_item^.volume_unavailable := TRUE;
          IFEND;
        ELSE
          ;
        CASEND;
      IFEND;
    ELSE
      cycle_item^.size := cycle_array_entry.eoi;
      IF cycle_array_entry.data_residence = pfc$offline_data THEN
        cycle_item^.cycle_archived := TRUE;
        cycle_item^.cycle_data_released := TRUE;
        cycle_item^.size_completely_known := TRUE;
      IFEND;
    IFEND;

  PROCEND get_cycle_info;

?? TITLE := 'put_display_items', EJECT ??

  PROCEDURE put_display_items
    (    display_items: ^clt$display_catalog_items;
         info_tab: pft$array_index;
         depth: pft$array_index;
     VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      catalogs: [STATIC, READ, oss$job_paged_literal] string (9) := ' catalogs',
      files: [STATIC, READ, oss$job_paged_literal] string (6) := ' files';

    VAR
      highest_cycle_number: fst$cycle_number,
      item: ^clt$display_catalog_item,
      items: ^clt$display_catalog_items,
      line: string (osc$max_string_size),
      line_size: integer,
      size_str: ost$string,
      the_end: ^clt$display_catalog_item,
      trimmed_string_size: integer;

    status.normal := TRUE;

    size_str.size := 0;

    items := display_items;
    NEXT the_end IN items;
    RESET items;

  /display_loop/
    WHILE TRUE DO
      NEXT item IN items;
      IF item = the_end THEN
        EXIT /display_loop/;
      IFEND;

      IF item^.level > depth THEN
        CYCLE /display_loop/;
      IFEND;

      edit_integer (item^.size, item^.size_completely_known, size_str);

      clp$horizontal_tab_display (display_control, item^.name_tab, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$put_partial_display (display_control, item^.name (1, item^.name_size), clc$no_trim, amc$continue,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      clp$horizontal_tab_display (display_control, info_tab + 2, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      CASE item^.kind OF

      = clc$display_catalog_item =
        IF (item^.number_of_files + item^.number_of_catalogs) = 0 THEN
          size_str.value := '';
          STRINGREP (line, line_size, size_str.value (1, size_str.size), '       -- empty catalog');
        ELSEIF item^.number_of_files = 0 THEN
          STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes in',
                item^.number_of_catalogs, catalogs (1, 8 + $INTEGER (item^.number_of_catalogs > 1)));
        ELSEIF item^.number_of_catalogs = 0 THEN
          STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes in', item^.number_of_files,
                files (1, 5 + $INTEGER (item^.number_of_files > 1)));
        ELSE
          STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes in', item^.number_of_files,
                files (1, 5 + $INTEGER (item^.number_of_files > 1)), ' and', item^.number_of_catalogs,
                catalogs (1, 8 + $INTEGER (item^.number_of_catalogs > 1)));
        IFEND;

      = clc$display_file_item =
        IF item^.number_of_cycles = 1 THEN
          highest_cycle_number := item^.highest_cycle_number;
          NEXT item IN items;

          IF highest_cycle_number = 1 THEN
            IF item^.cycle_device_class = rmc$mass_storage_device THEN
              IF item^.cycle_data_released THEN
                trimmed_string_size := clp$trimmed_string_size
                      (item^.cycle_archive_identification.media_identifier.media_device_class);
                STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes on ',
                      item^.cycle_archive_identification.media_identifier.media_device_class
                      (1, trimmed_string_size));
              ELSE
                IF item^.cycle_archived THEN
                  trimmed_string_size := clp$trimmed_string_size
                        (item^.cycle_archive_identification.media_identifier.media_device_class);
                  STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes duplicated on ',
                        item^.cycle_archive_identification.media_identifier.media_device_class
                        (1, trimmed_string_size));
                ELSE
                  STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes');
                IFEND;
              IFEND;
            ELSEIF item^.cycle_device_class = rmc$magnetic_tape_device THEN
              size_str.value := '';
              STRINGREP (line, line_size, size_str.value (1, size_str.size),
                    '       -- device_class is magnetic_tape');
            IFEND;
          ELSE
            IF item^.cycle_device_class = rmc$mass_storage_device THEN
              IF item^.cycle_data_released THEN
                trimmed_string_size := clp$trimmed_string_size
                      (item^.cycle_archive_identification.media_identifier.media_device_class);
                STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes in cycle',
                      highest_cycle_number, ' on ',
                      item^.cycle_archive_identification.media_identifier.media_device_class
                      (1, trimmed_string_size));
              ELSE
                IF item^.cycle_archived THEN
                  trimmed_string_size := clp$trimmed_string_size
                        (item^.cycle_archive_identification.media_identifier.media_device_class);
                  STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes in cycle',
                        highest_cycle_number, ' duplicated on ',
                        item^.cycle_archive_identification.media_identifier.media_device_class
                        (1, trimmed_string_size));
                ELSE
                  STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes in cycle',
                        highest_cycle_number);
                IFEND;
              IFEND;
            ELSEIF item^.cycle_device_class = rmc$magnetic_tape_device THEN
              STRINGREP (line, line_size, '        cycle', highest_cycle_number,
                    ' -- device_class is magnetic_tape');
            IFEND;
          IFEND;

          IF (NOT item^.cycle_has_been_opened) OR (item^.cycles_media_missing) OR
                (item^.cycles_respf_mod_mismatch) OR (item^.media_image_inconsistent) OR
                (item^.parent_catalog_restored) OR (item^.volume_unavailable) OR
                (item^.cycle_data_not_defined) THEN
            RESET items TO item;
          IFEND;
        ELSE
          STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes in', item^.number_of_cycles,
                ' cycles');
        IFEND;

      = clc$display_cycle_item =
        IF item^.cycle_device_class = rmc$mass_storage_device THEN
          IF item^.cycles_media_missing THEN
            size_str.value := '';
            STRINGREP (line, line_size, size_str.value (1, size_str.size), '       -- media missing');
          ELSEIF item^.cycles_respf_mod_mismatch THEN
            size_str.value := '';
            STRINGREP (line, line_size, size_str.value (1, size_str.size),
                  '       -- respf modification mismatch');
          ELSEIF item^.media_image_inconsistent THEN
            size_str.value := '';
            STRINGREP (line, line_size, size_str.value (1, size_str.size),
                  '       -- media image inconsistent');
          ELSEIF item^.parent_catalog_restored THEN
            size_str.value := '';
            STRINGREP (line, line_size, size_str.value (1, size_str.size),
                  '       -- parent catalog restored');
          ELSEIF item^.volume_unavailable THEN
            size_str.value := '';
            STRINGREP (line, line_size, size_str.value (1, size_str.size), '       -- volume unavailable');
          ELSEIF item^.cycle_data_not_defined THEN
            size_str.value := '';
            STRINGREP (line, line_size, size_str.value (1, size_str.size), '       -- no data defined');
          ELSEIF item^.cycle_has_been_opened THEN
            IF item^.cycle_data_released THEN
              trimmed_string_size := clp$trimmed_string_size
                    (item^.cycle_archive_identification.media_identifier.media_device_class);
              STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes on ',
                    item^.cycle_archive_identification.media_identifier.media_device_class
                    (1, trimmed_string_size));
            ELSE
              IF item^.cycle_archived THEN
                trimmed_string_size := clp$trimmed_string_size
                      (item^.cycle_archive_identification.media_identifier.media_device_class);
                STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes duplicated on ',
                      item^.cycle_archive_identification.media_identifier.media_device_class
                      (1, trimmed_string_size));
              ELSE
                STRINGREP (line, line_size, size_str.value (1, size_str.size), ' bytes');
              IFEND;
            IFEND;
          ELSE
            size_str.value := '';
            STRINGREP (line, line_size, size_str.value (1, size_str.size), '       -- cycle never opened');
          IFEND;
        ELSEIF item^.cycle_device_class = rmc$magnetic_tape_device THEN
          size_str.value := '';
          STRINGREP (line, line_size, size_str.value (1, size_str.size),
                '       -- device_class is magnetic_tape');
        IFEND;
      CASEND;

      clp$put_partial_display (display_control, line (1, line_size), clc$no_trim, amc$terminate, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    WHILEND /display_loop/;

  PROCEND put_display_items;
?? TITLE := 'edit_size', EJECT ??

  PROCEDURE edit_integer
    (    int: integer;
         value_completely_known: boolean;
     VAR str {input, output} : ost$string);

    VAR
      ignore_status: ost$status,
      temp_str: ost$string,
      i: ost$string_size,
      j: ost$string_size;

    clp$convert_integer_to_string (int, 10, FALSE, temp_str, ignore_status);
    IF str.size < (temp_str.size + ((temp_str.size - 1) DIV 3) + ($INTEGER (NOT value_completely_known) * 2))
          THEN
      str.size := temp_str.size + ((temp_str.size - 1) DIV 3) + ($INTEGER (NOT value_completely_known) * 2);
    IFEND;
    j := str.size;
    FOR i := temp_str.size DOWNTO 1 DO
      str.value (j) := temp_str.value (i);
      j := j - 1;
      IF (i > 1) AND (((temp_str.size - i) MOD 3) = 2) THEN
        str.value (j) := ',';
        j := j - 1;
      IFEND;
    FOREND;
    IF NOT value_completely_known THEN
      str.value (j - 1, 2) := '> ';
      j := j - 2;
    IFEND;
    str.value (1, j) := '';

  PROCEND edit_integer;

MODEND clm$pf_display_commands;
