?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Connected File Commands' ??
MODULE clm$connected_file_commands;

{
{ PURPOSE:
{   This module contains the processors for the commands that control the logical connections between files
{   within a job.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$standard_file_names
*copyc clt$parameter_list
*copyc cle$ecc_miscellaneous
*copyc clt$path_display_chunks
*copyc fst$file_reference
*copyc fst$path
*copyc fst$path_size
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*copyc amv$nil_file_identifier
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$convert_str_to_path_handle
*copyc clp$create_file_connection
*copyc clp$delete_file_connection
*copyc clp$evaluate_parameters
*copyc clp$find_connected_file
*copyc clp$find_connected_files
*copyc clp$find_input_block
*copyc clp$get_path_name
*copyc clp$get_set_count
*copyc clp$get_value
*copyc clp$new_display_line
*copyc clp$open_display
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$scan_parameter_list
*copyc clp$trimmed_string_size
*copyc clv$nil_display_control
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal

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

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


{ PROCEDURE (osm$crefc) create_file_connection, crefc (
{   standard_file, sf: file = $required
{   file, f: file = $required
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 5] of clt$pdt_parameter_name,
        parameters: array [1 .. 3] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
        type2: record
          header: clt$type_specification_header,
        recend,
        type3: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 6, 23, 9, 51, 48, 216], clc$command, 5, 3, 2, 0, 0, 0, 3, 'OSM$CREFC'],
            [['F                              ', clc$abbreviation_entry, 2],
            ['FILE                           ', clc$nominal_entry, 2],
            ['SF                             ', clc$abbreviation_entry, 1],
            ['STANDARD_FILE                  ', clc$nominal_entry, 1],
            ['STATUS                         ', clc$nominal_entry, 3]], [
{ PARAMETER 1
      [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, 3, clc$required_parameter, 0, 0],
{ PARAMETER 2
      [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$required_parameter, 0, 0],
{ PARAMETER 3
      [5, 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$file_type]],
{ PARAMETER 3
      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$standard_file = 1,
      p$file = 2,
      p$status = 3;

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

    VAR
      value: clt$value,
      subject_file: amt$local_file_name,
      target_file: amt$local_file_name;

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

    clp$create_file_connection (pvt [p$standard_file].value^.file_value^, pvt [p$file].value^.file_value^,
          status);

  PROCEND clp$_create_file_connection;
?? TITLE := 'clp$_delete_file_connection', EJECT ??

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

{  PROCEDURE (osm$delfc) delete_file_connection, delfc (
{    standard_file, sf : FILE = $REQUIRED
{    file, f : FILE = $REQUIRED
{    STATUS)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 5] of clt$pdt_parameter_name,
        parameters: array [1 .. 3] of clt$pdt_parameter,
        type1: record
          header: clt$type_specification_header,
        recend,
        type2: record
          header: clt$type_specification_header,
        recend,
        type3: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 6, 23, 9, 3, 44, 861], clc$command, 5, 3, 2, 0, 0, 0, 3, 'OSM$DELFC'],
            [['F                              ', clc$abbreviation_entry, 2],
            ['FILE                           ', clc$nominal_entry, 2],
            ['SF                             ', clc$abbreviation_entry, 1],
            ['STANDARD_FILE                  ', clc$nominal_entry, 1],
            ['STATUS                         ', clc$nominal_entry, 3]], [
{ PARAMETER 1
      [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, 3, clc$required_parameter, 0, 0],
{ PARAMETER 2
      [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$required_parameter, 0, 0],
{ PARAMETER 3
      [5, 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$file_type]],
{ PARAMETER 3
      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$standard_file = 1,
      p$file = 2,
      p$status = 3;

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

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

    clp$delete_file_connection (pvt [p$standard_file].value^.file_value^, pvt [p$file].value^.file_value^,
          status);

  PROCEND clp$_delete_file_connection;
?? TITLE := 'clp$_display_file_connections', EJECT ??

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

{ PROCEDURE (osm$disfc) display_file_connections, display_file_connection, disfc (
{   standard_files, standard_file, sf: any of
{       key
{         all
{       keyend
{       list of file
{     anyend = all
{   output, o: file = $output
{   status)

?? PUSH (LISTEXT := ON) ??

    VAR
      pdt: [STATIC, READ, cls$declaration_section] record
        header: clt$pdt_header,
        names: array [1 .. 6] of clt$pdt_parameter_name,
        parameters: array [1 .. 3] of clt$pdt_parameter,
        type1: 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$list_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
            recend,
          recend,
          default_value: string (3),
        recend,
        type2: record
          header: clt$type_specification_header,
          default_value: string (7),
        recend,
        type3: record
          header: clt$type_specification_header,
        recend,
      recend := [[1, [88, 6, 23, 9, 53, 7, 691], clc$command, 6, 3, 0, 0, 0, 0, 3, 'OSM$DISFC'],
            [['O                              ', clc$abbreviation_entry, 2],
            ['OUTPUT                         ', clc$nominal_entry, 2],
            ['SF                             ', clc$abbreviation_entry, 1],
            ['STANDARD_FILE                  ', clc$alias_entry, 1],
            ['STANDARD_FILES                 ', clc$nominal_entry, 1],
            ['STATUS                         ', clc$nominal_entry, 3]], [
{ PARAMETER 1
      [5, 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, 83, clc$optional_default_parameter, 0, 3],
{ PARAMETER 2
      [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, 7],
{ PARAMETER 3
      [6, 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$union_type], [[clc$keyword_type, clc$list_type], FALSE, 2], 44,
            [[1, 0, clc$keyword_type], [1], [['ALL                            ', clc$nominal_entry,
            clc$normal_usage_entry, 1]]], 19, [[1, 0, clc$list_type],
            [3, 1, clc$max_list_size, FALSE], [[1, 0, clc$file_type]]], 'all'],
{ PARAMETER 2
      [[1, 0, clc$file_type], '$output'],
{ PARAMETER 3
      [[1, 0, clc$status_type]]];

?? POP ??

    CONST
      p$standard_files = 1,
      p$output = 2,
      p$status = 3;

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


    VAR
      open_positions: [STATIC, READ, oss$job_paged_literal] array [amt$open_position] of record
        size: 1 .. 6,
        value: string (6),
      recend := [[6, '.$ASIS'], [5, '.$BOI'], [5, '.$BOP'], [5, '.$EOI']];

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

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

{The display_connection command has no subtitles,
{ this is merely a dummy routine used to keep
{ the module consistent with those that do produce subtitles.

    PROCEND put_subtitle;
?? TITLE := 'put_partial_display', EJECT ??

    PROCEDURE [INLINE] put_partial_display
      (    str: string ( * );
           trim_option: clt$trim_display_text_option;
           term_option: amt$term_option);

      clp$put_partial_display (display_control, str, trim_option, term_option, status);
      IF NOT status.normal THEN
        EXIT clp$_display_file_connections
      IFEND;

    PROCEND put_partial_display;
?? TITLE := 'put_file', EJECT ??

    PROCEDURE [INLINE] put_file
      (    path_handle_name: fst$path_handle_name;
           term_option: amt$term_option);

      VAR
        p: amt$open_position,
        file_reference: fst$path;

      clp$get_path_name (path_handle_name, osc$full_message_level, file_reference);
      put_partial_display (file_reference (1, clp$trimmed_string_size (file_reference)), clc$no_trim,
            term_option);

    PROCEND put_file;
?? TITLE := 'display_connected_file', EJECT ??

    PROCEDURE display_connected_file
      (    file_reference: fst$file_reference;
           connected_file: ^clt$connected_file_subject;
       VAR status: ost$status);

      VAR
        target_count: 0 .. clc$max_connected_file_targets,
        i: clt$connected_file_target_index;

      IF file_reference <> '' THEN
        put_partial_display (file_reference, clc$no_trim, amc$start);
      ELSE
        put_file (connected_file^.path_handle_name, amc$start);
      IFEND;

      target_count := 0;
      IF connected_file^.targets <> NIL THEN
        FOR i := 1 TO UPPERBOUND (connected_file^.targets^) DO
          IF connected_file^.targets^ [i].connection_active THEN
            IF target_count = 0 THEN
              put_partial_display (' is connected to: ', clc$no_trim, amc$continue);
            ELSE
              put_partial_display (', ', clc$no_trim, amc$continue);
            IFEND;
            put_file (connected_file^.targets^ [i].path_handle_name, amc$continue);
            IF connected_file^.targets^ [i].open_position.specified THEN
              put_partial_display (open_positions [connected_file^.targets^ [i].open_position.value].
                    value (1, open_positions [connected_file^.targets^ [i].open_position.value].size),
                    clc$no_trim, amc$continue);
            IFEND;
            target_count := target_count + 1;
          IFEND;
        FOREND;
      IFEND;
      IF target_count = 0 THEN
        put_partial_display (' is not connected to any files.', clc$no_trim, amc$terminate);
      ELSE
        put_partial_display ('.', clc$no_trim, amc$terminate);
      IFEND;

    PROCEND display_connected_file;
?? TITLE := 'display_connected_file_tree', EJECT ??

    PROCEDURE display_connected_file_tree
      (    connected_file: ^clt$connected_file_subject;
       VAR status: ost$status);

      TYPE
        clt$subject_file_display_info = record
          name: fst$path,
          size: fst$path_size,
          subject: ^clt$connected_file_subject,
        recend;

      VAR
        file_reference: fst$path,
        subject_count: integer,
        subject_info: ^array [1 .. * ] of clt$subject_file_display_info;

?? NEWTITLE := 'count_subject_files', EJECT ??

      PROCEDURE count_subject_files
        (    connected_file: ^clt$connected_file_subject);

        IF connected_file^.left_link <> NIL THEN
          count_subject_files (connected_file^.left_link);
        IFEND;

        subject_count := subject_count + 1;

        IF connected_file^.right_link <> NIL THEN
          count_subject_files (connected_file^.right_link);
        IFEND;

      PROCEND count_subject_files;
?? TITLE := 'get_subject_files', EJECT ??

      PROCEDURE get_subject_files
        (    connected_file: ^clt$connected_file_subject);

        IF connected_file^.left_link <> NIL THEN
          get_subject_files (connected_file^.left_link);
        IFEND;

        clp$get_path_name (connected_file^.path_handle_name, osc$full_message_level, file_reference);
        subject_count := subject_count + 1;
        subject_info^ [subject_count].name := file_reference (1, clp$trimmed_string_size (file_reference));
        subject_info^ [subject_count].size := clp$trimmed_string_size (file_reference);
        subject_info^ [subject_count].subject := connected_file;

        IF connected_file^.right_link <> NIL THEN
          get_subject_files (connected_file^.right_link);
        IFEND;

      PROCEND get_subject_files;
?? TITLE := 'sort_subject_files', EJECT ??

      PROCEDURE sort_subject_files;

        VAR
          gap: integer,
          start: integer,
          current: integer,
          swap: clt$subject_file_display_info;

        { Sort subject file names using shell sort technique. }

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

      PROCEND sort_subject_files;
?? OLDTITLE, EJECT ??

      subject_count := 0;
      count_subject_files (connected_file);
      PUSH subject_info: [1 .. subject_count];
      subject_count := 0;
      get_subject_files (connected_file);
      sort_subject_files;

      FOR subject_count := 1 TO UPPERBOUND (subject_info^) DO
        display_connected_file (subject_info^ [subject_count].name (1, subject_info^ [subject_count].size),
              subject_info^ [subject_count].subject, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      FOREND;

    PROCEND display_connected_file_tree;
?? OLDTITLE, EJECT ??

    VAR
      connected_files: ^clt$connected_files,
      connected_file: ^clt$connected_file_subject,
      current_file: ^clt$data_value,
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      subject_file_name: fst$path_handle_name,
      ignore_evaluated_file_reference: fst$evaluated_file_reference,
      ignore_status: ost$status,
      i: 1 .. clc$max_value_sets,
      set_count: 0 .. clc$max_value_sets,
      value: clt$value;

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

    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    osp$establish_block_exit_hndlr (^abort_handler);

  /display/
    BEGIN
      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
        EXIT /display/;
      IFEND;
      clv$titles_built := FALSE;
      clv$command_name := 'display_file_connection';
      current_file := pvt [p$standard_files].value;

      IF current_file^.kind = clc$keyword {keyword = ALL} THEN
{ Display ALL connected files. }
        clp$find_connected_files (connected_files);
        IF connected_files^.subject_tree = NIL THEN
          put_partial_display ('There are no connected files.', clc$no_trim, amc$terminate);
        ELSE
          display_connected_file_tree (connected_files^.subject_tree, status);
        IFEND;

      ELSE {list of files}

      /display_current_file/
        WHILE current_file <> NIL DO

{ Display selected connected files. }

          clp$convert_str_to_path_handle (current_file^.element_value^.file_value^, FALSE, TRUE, FALSE,
                subject_file_name, ignore_evaluated_file_reference, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          clp$find_connected_file (subject_file_name, connected_file);
          IF connected_file = NIL THEN
            put_file (subject_file_name, amc$start);
            put_partial_display (' is not a connected file.', clc$no_trim, amc$terminate);
          ELSE
            display_connected_file ('', connected_file, status);
          IFEND;
          current_file := current_file^.link;
        WHILEND /display_current_file/;
      IFEND;
    END /display/;

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

    osp$disestablish_cond_handler;

  PROCEND clp$_display_file_connections;

MODEND clm$connected_file_commands;
