?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Substitute Delimited Text' ??
MODULE clm$substitute_delimited_text;

{
{ PURPOSE:
{   This module contains a procedure to process delimited text.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$bad_data_value
*copyc cle$string_too_long
*copyc clt$command_line
*copyc clt$command_line_index
*copyc clt$command_line_size
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*copyc clp$data_representation_text
*copyc clp$evaluate_unqual_union_expr
*copyc clp$get_work_area
*copyc clp$identify_lexical_units
*copyc clp$initialize_parse_state
*copyc clp$internal_convert_to_string
*copyc clp$scan_non_space_lexical_unit
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal

?? TITLE := 'clp$substitute_delimited_text', EJECT ??
*copyc clh$substitute_delimited_text

  PROCEDURE [XDCL, #GATE] clp$substitute_delimited_text
    (    old_text: clt$command_line;
         delimiter: char;
     VAR new_text: clt$command_line;
     VAR new_text_size: clt$command_line_size;
     VAR status: ost$status);

    TYPE
      char_set = set of char;

    VAR
      char_delimiter: char_set,
      new_text_length: integer,
      old_text_length: clt$command_line_size,
      original_work_area: ^clt$work_area,
      scan_found_char: boolean,
      scan_index: clt$command_line_index,
      start_index: 1 .. clc$max_command_line_size + 2,
      string_size: clt$command_line_size,
      substitution_text: ^clt$string_value,
      work_area_ptr: ^^clt$work_area;

?? NEWTITLE := 'evaluate_substitution_text', EJECT ??
{
{ This procedure was cloned from clp$evaluate_expression_to_str.  This was done
{ (rather than calling the original routine directly) for two reasons: 1) so
{ that the actual length of the result string would be available, and 2) to
{ reduce the amount of run-time stack space needed (avoids the need to set
{ aside a possibly huge string to receive the result.
{

    PROCEDURE evaluate_substitution_text
      (    expression: clt$expression_text);

      VAR
        ignore_result_type_description: ^clt$type_description,
        lexical_units: ^clt$lexical_units,
        parse: clt$parse_state,
        representation: ^clt$data_representation,
        request: clt$convert_to_string_request,
        result: ^clt$data_value;


      status.normal := TRUE;
      substitution_text := NIL;

      IF original_work_area = NIL THEN
        clp$get_work_area (#RING (^work_area_ptr), work_area_ptr, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        original_work_area := work_area_ptr^;
      ELSE
        work_area_ptr^ := original_work_area;
      IFEND;

      clp$identify_lexical_units (^expression, work_area_ptr^, lexical_units, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      clp$initialize_parse_state (^expression, lexical_units, parse);
      clp$scan_non_space_lexical_unit (parse);

      clp$evaluate_unqual_union_expr (work_area_ptr^, parse, ignore_result_type_description, result, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      request.initial_indentation := 0;
      request.continuation_indentation := 0;
      request.max_string := clc$max_string_size;
      request.include_advanced_items := TRUE;
      request.include_hidden_items := TRUE;
      request.kind := clc$convert_data_value;
      CASE result^.kind OF
      = clc$application, clc$boolean, clc$cobol_name, clc$command_reference, clc$data_name, clc$date_time,
            clc$entry_point_reference, clc$file, clc$integer, clc$keyword, clc$lock, clc$name,
            clc$network_title, clc$program_name, clc$real, clc$scu_line_identifier, clc$statistic_code,
            clc$status, clc$status_code, clc$string, clc$time_increment, clc$time_zone, clc$unspecified =
        request.representation_option := clc$data_elem_representation;
      = clc$array, clc$deferred, clc$list, clc$range, clc$record, clc$string_pattern, clc$type_specification =
        request.representation_option := clc$data_source_representation;
      ELSE
        osp$set_status_abnormal ('CL', cle$bad_data_value, '', status);
        RETURN;
      CASEND;
      request.value := result;

      clp$internal_convert_to_string (request, work_area_ptr^, representation, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      substitution_text := clp$data_representation_text (representation);

    PROCEND evaluate_substitution_text;
?? TITLE := 'set_status_line_too_long', EJECT ??

    PROCEDURE [INLINE] set_status_line_too_long;

      new_text_size := old_text_length;
      new_text := old_text;
      osp$set_status_abnormal ('CL', cle$string_too_long, ' for substitution', status);
      EXIT clp$substitute_delimited_text;

    PROCEND set_status_line_too_long;
?? OLDTITLE, EJECT ??

    status.normal := TRUE;
    char_delimiter := $char_set [delimiter];
    old_text_length := STRLENGTH (old_text);
    start_index := 1;
    new_text_length := 0;
    new_text_size := 0;
    original_work_area := NIL;

  /scan_loop/
    WHILE TRUE DO
      #SCAN (char_delimiter, old_text (start_index, * ), scan_index, scan_found_char);
      string_size := scan_index - 1;

      IF string_size > 0 THEN
        new_text_length := new_text_length + string_size;
        IF new_text_length > clc$max_command_line_size THEN
          set_status_line_too_long;
        IFEND;
        new_text (new_text_size + 1, string_size) := old_text (start_index, string_size);
        new_text_size := new_text_length;
      IFEND;

      start_index := start_index + scan_index;
      IF scan_found_char THEN
        IF (start_index > old_text_length) OR (old_text (start_index) = delimiter) THEN
          new_text_length := new_text_length + 1;
          IF new_text_length > clc$max_command_line_size THEN
            set_status_line_too_long;
          IFEND;
          new_text (new_text_size + 1) := delimiter;
          new_text_size := new_text_length;
          start_index := start_index + 1;
        ELSE
          #SCAN (char_delimiter, old_text (start_index, * ), scan_index, scan_found_char);
          string_size := scan_index - 1;
          evaluate_substitution_text (old_text (start_index, string_size));
          IF NOT status.normal THEN
            new_text_size := old_text_length;
            new_text := old_text;
            EXIT /scan_loop/;
          ELSEIF STRLENGTH (substitution_text^) > 0 THEN
            new_text_length := new_text_length + STRLENGTH (substitution_text^);
            IF new_text_length > clc$max_command_line_size THEN
              set_status_line_too_long;
            IFEND;
            new_text (new_text_size + 1, STRLENGTH (substitution_text^)) := substitution_text^;
            new_text_size := new_text_length;
          IFEND;
          start_index := start_index + scan_index;
        IFEND;
      IFEND;
      IF start_index > old_text_length THEN
        EXIT /scan_loop/;
      IFEND;
    WHILEND /scan_loop/;

    IF original_work_area <> NIL THEN
      work_area_ptr^ := original_work_area;
    IFEND;

  PROCEND clp$substitute_delimited_text;

MODEND clm$substitute_delimited_text;
