?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Collect Text Command' ??
MODULE clm$collect_text_command;

{
{ PURPOSE:
{   This module contains the processor for the collect_text command.
{
{ NOTE:
{   The COLLECT_TEXT command processor is given control even in "skip" mode.
{   It always tries to read past the text even if it can't (or shouldn't)
{   write the text to the output file, including those cases where there's an
{   error with a parameter other than "until".
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clc$standard_file_names
*copyc clt$collect_text_command_info
*copyc clt$parameter_list
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*copyc amv$nil_file_identifier
*copyc clp$close_display
*copyc clp$change_colt_ruc_value
*copyc clp$evaluate_parameters
*copyc clp$find_caller_input_block
*copyc clp$get_command_origin
*copyc clp$get_interpreter_mode
*copyc clp$get_line_from_command_file
*copyc clp$open_display_reference
*copyc clp$pop_input
*copyc clp$push_input
*copyc clp$put_display
*copyc clp$substitute_delimited_text
*copyc clv$nil_block_handle
*copyc clv$nil_display_control
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$generate_output_message
*copyc osp$get_status_condition_string
*copyc osp$set_status_abnormal
?? TITLE := 'Parameter Description Table (PDT) for the collect_text command', EJECT ??
{
{ * * * *   The PDT for COLLECT_TEXT is declared at the module level so that
{           it can be accessed by CLP$GET_COLLECT_TEXT_CMND_INFO as well as
{           CLP$_COLLECT_TEXT.
{
{ * * * *   NOTE: If this PDT must be regenerated, don't forget to move the
{                 declaration of the PVT variable into CLP$_COLLECT_TEXT.
{                 Failure to do so will result in an access violation when
{                 the command is called.
{
{ * * * *   NOTE: If the default value for the UNTIL parameter of COLLECT_TEXT
{                 is changed (an unimaginable idea), the following variable
{                 must be changed as well as the PDT.
{
  VAR
    clv$retain_unprintable_char: [XREF] boolean;
  VAR
    default_until_string: [STATIC, READ, oss$job_paged_literal] string (2) := '**';

{  PROCEDURE (osm$colt) collect_text, colt (
{    output, o: file = $required
{    until, u: string literal = '**'
{    prompt, p: string 0..31 = 'ct? '
{    substitution_mark, sm: any of
{        key
{          none
{        keyend
{        string 1
{      anyend = none
{    input, i: file = $optional
{    retain_unprintable_characters, ruc: boolean = csd$colt_ruc, FALSE
{    status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 13] of clt$pdt_parameter_name,
      parameters: array [1 .. 7] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (4),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
        default_value: string (6),
      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$string_type_qualifier,
        recend,
        default_value: string (4),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
      type6: record
        header: clt$type_specification_header,
        default_name: string (12),
        default_value: string (5),
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [93, 11, 16, 5, 52, 1, 963],
    clc$command, 13, 7, 1, 0, 0, 0, 7, 'OSM$COLT'], [
    ['I                              ',clc$abbreviation_entry, 5],
    ['INPUT                          ',clc$nominal_entry, 5],
    ['O                              ',clc$abbreviation_entry, 1],
    ['OUTPUT                         ',clc$nominal_entry, 1],
    ['P                              ',clc$abbreviation_entry, 3],
    ['PROMPT                         ',clc$nominal_entry, 3],
    ['RETAIN_UNPRINTABLE_CHARACTERS  ',clc$nominal_entry, 6],
    ['RUC                            ',clc$abbreviation_entry, 6],
    ['SM                             ',clc$abbreviation_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 7],
    ['SUBSTITUTION_MARK              ',clc$nominal_entry, 4],
    ['U                              ',clc$abbreviation_entry, 2],
    ['UNTIL                          ',clc$nominal_entry, 2]],
    [
{ 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
    [13, 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, 8, clc$optional_default_parameter, 0, 4],
{ PARAMETER 3
    [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, 8, clc$optional_default_parameter, 0, 6],
{ PARAMETER 4
    [11, 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, 72, clc$optional_default_parameter, 0, 4],
{ PARAMETER 5
    [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_parameter, 0, 0],
{ PARAMETER 6
    [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$optional_default_parameter, 12, 5],
{ PARAMETER 7
    [10, 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$string_type], [0, clc$max_string_size, TRUE],
    '''**'''],
{ PARAMETER 3
    [[1, 0, clc$string_type], [0, 31, FALSE],
    '''ct? '''],
{ PARAMETER 4
    [[1, 0, clc$union_type], [[clc$keyword_type,
    clc$string_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['NONE                           ', clc$nominal_entry,
  clc$normal_usage_entry, 1]]
      ],
    8, [[1, 0, clc$string_type], [1, 1, FALSE]]
    ,
    'none'],
{ PARAMETER 5
    [[1, 0, clc$file_type]],
{ PARAMETER 6
    [[1, 0, clc$boolean_type],
    'CSD$COLT_RUC',
    'FALSE'],
{ PARAMETER 7
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$output = 1,
      p$until = 2,
      p$prompt = 3,
      p$substitution_mark = 4,
      p$input = 5,
      p$retain_unprintable_characters = 6,
      p$status = 7;

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

  PROCEDURE [XDCL, #GATE] clp$get_collect_text_cmnd_info
    (VAR collect_text_command_info: clt$collect_text_command_info);


    collect_text_command_info.pdt := #SEQ (pdt);
    collect_text_command_info.number_of_parameters := p$status;
    collect_text_command_info.until_parameter_number := p$until;
    collect_text_command_info.input_parameter_number := p$input;
    collect_text_command_info.default_until_string := ^default_until_string;

  PROCEND clp$get_collect_text_cmnd_info;
?? TITLE := 'clp$_collect_text', EJECT ??

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

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

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

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


      clp$change_colt_ruc_value (FALSE, FALSE);
      clp$close_display (display_control, handler_status);
      IF input_block_handle <> clv$nil_block_handle THEN
        clp$pop_input (TRUE, input_block_handle, input_file_id, input_executable, NIL, handler_status);
      IFEND;
      handler_status.normal := TRUE;

    PROCEND abort_handler;
?? OLDTITLE, EJECT ??

    VAR
      caller_in_current_task: boolean,
      caller_input_block: ^clt$block,
      default_input_file: [STATIC, READ, oss$job_paged_literal] string (8) := '$command',
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      ignore_status: ost$status,
      input_block_handle: clt$block_handle,
      input_executable: boolean,
      input_file: ^fst$file_reference,
      input_file_id: amt$file_identifier,
      interactive: boolean,
      interpreter_mode: clt$interpreter_modes,
      line: ^clt$command_line,
      local_status: ost$status,
      new_line: ^clt$command_line,
      new_line_size: clt$command_line_size,
      prompt_string: ^clt$string_value,
      strng: ost$string,
      until_string: ^clt$string_value;


{ NOTE that clp$get_interpreter_mode must be called before clp$evaluate_parameters
{ because the latter's call to clp$setup_parameter_evaluation may affect the
{ interpreter_mode stored in the clc$command_block.

    clp$get_interpreter_mode (interpreter_mode);

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);

    IF interpreter_mode = clc$help_mode THEN
      RETURN;
    IFEND;

    new_line := NIL;

{  Check for bad status.

    IF NOT status.normal THEN

{  The default values are not returned for parameters if a bad status
{  was returned by clp$evaluate_parameters.

      until_string := ^default_until_string;
      PUSH prompt_string: [0];

{  Check if the input parameter was specified.

      IF pvt [p$input].specified THEN

{  Just return with normal status if you are in SKIP mode.
{  Otherwise you are in INTERPRET mode and should return with
{  bad status.  No further processing is necessary.

        IF interpreter_mode = clc$skip_mode THEN
          status.normal := TRUE;
        IFEND;
        RETURN;

{  Return with bad status if the until string was specified and
{  could not be evaluated in either SKIP mode or INTERPRET mode.
{  We return a bad status even in SKIP mode because we can't know
{  when the text to be collect terminates.

      ELSEIF pvt [p$until].specified THEN
        IF pvt [p$until].value = NIL THEN
          RETURN;
        IFEND;

{  Save the specified until string value.

        until_string := pvt [p$until].value^.string_value;
      IFEND;


{  If you are in SKIP mode set status to normal and continue processing
{  to position the current input file past the until string.

      IF interpreter_mode = clc$skip_mode THEN

        status.normal := TRUE;

{  Change the interpreter mode from INTERPRET to SKIP mode and continue
{  processing to position the current input file past the until string.

      ELSE
        interpreter_mode := clc$skip_mode;
      IFEND;

{  Status is normal.
    ELSEIF (interpreter_mode = clc$skip_mode) AND pvt [p$input].specified THEN

{ Commands are being skipped and the input parameter was specified.  Do not
{ attempt to find the UNTIL string.

      RETURN;

    ELSE
      until_string := pvt [p$until].value^.string_value;
      prompt_string := pvt [p$prompt].value^.string_value;
      clp$change_colt_ruc_value (pvt [p$retain_unprintable_characters].value^.boolean_value.value,
            TRUE);
      IF pvt [p$substitution_mark].value^.kind = clc$string THEN
        PUSH new_line: [clc$max_command_line_size];
      IFEND;
    IFEND;

    caller_in_current_task := TRUE;
    input_block_handle := clv$nil_block_handle;
    input_file_id := amv$nil_file_identifier;
    display_control := clv$nil_display_control;
    #SPOIL (input_block_handle, input_file_id, display_control);

    osp$establish_block_exit_hndlr (^abort_handler);

  /collect_text/
    BEGIN
      IF interpreter_mode = clc$interpret_mode THEN
        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^, NIL, fsc$legible_data,
              default_ring_attributes, display_control, status);
      IFEND;

      IF NOT status.normal THEN
        clp$get_command_origin (interactive, local_status);
        IF interactive THEN
          EXIT /collect_text/;
        IFEND;
      IFEND;

      IF pvt [p$input].specified THEN
        input_file := pvt [p$input].value^.file_value;
      ELSE
        input_file := ^default_input_file;
        clp$find_caller_input_block (clc$current_command_input, caller_input_block, caller_in_current_task);
      IFEND;
      IF pvt [p$input].specified OR (NOT caller_in_current_task) THEN
        clp$push_input (input_file^, osc$null_name, '', FALSE, TRUE, input_block_handle, input_file_id,
              input_executable, local_status);
        IF NOT local_status.normal THEN
          IF status.normal AND (NOT local_status.normal) THEN
            status := local_status;
          IFEND;
          EXIT /collect_text/;
        IFEND;
      IFEND;

    /copy_loop/
      WHILE TRUE DO
        clp$get_line_from_command_file (prompt_string^, line, local_status);
        IF status.normal AND (NOT local_status.normal) THEN
          status := local_status;
        IFEND;
        IF NOT local_status.normal THEN
          EXIT /copy_loop/;
        ELSEIF line = NIL THEN
          IF status.normal THEN
            osp$set_status_abnormal ('CL', cle$encountered_eoi, 'COLLECT_TEXT', status);
          IFEND;
          EXIT /copy_loop/;
        ELSEIF (STRLENGTH (line^) = STRLENGTH (until_string^)) AND (line^ = until_string^) THEN
          EXIT /copy_loop/;
        ELSEIF (display_control.file_id <> amv$nil_file_identifier) AND
              (interpreter_mode = clc$interpret_mode) THEN
          IF new_line <> NIL THEN
            clp$substitute_delimited_text (line^, pvt [p$substitution_mark].value^.string_value^ (1),
                  new_line^, new_line_size, local_status);
            IF local_status.normal THEN
              clp$put_display (display_control, new_line^ (1, new_line_size), clc$no_trim, local_status);
            IFEND;
          ELSE
            clp$put_display (display_control, line^, clc$no_trim, local_status);
          IFEND;
          IF (NOT local_status.normal) THEN
            osp$get_status_condition_string(local_status.condition, strng, ignore_status);
            IF (strng.value(1,strng.size) = 'AA 2924') THEN
              osp$generate_output_message(local_status,ignore_status);
              local_status.normal := TRUE;
            ELSE
              interpreter_mode := clc$skip_mode;
            IFEND;
            IF status.normal THEN
              status := local_status;
            IFEND;
          IFEND;
        IFEND;
      WHILEND /copy_loop/;
    END /collect_text/;

    clp$change_colt_ruc_value (FALSE, FALSE);
    IF input_block_handle <> clv$nil_block_handle THEN
      clp$pop_input (TRUE, input_block_handle, input_file_id, input_executable, NIL, local_status);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    IF display_control.file_id <> amv$nil_file_identifier THEN
      clp$close_display (display_control, local_status);
      IF status.normal AND (NOT local_status.normal) THEN
        status := local_status;
      IFEND;
    IFEND;

    osp$disestablish_cond_handler;

  PROCEND clp$_collect_text;

MODEND clm$collect_text_command;
