?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Change SCL Options Command' ??
MODULE clm$scl_options_command;

{
{ PURPOSE:
{   This module contains the processor for the change_scl_options command.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$not_yet_implemented
*copyc clt$data_value
*copyc clt$parameter_list
*copyc clt$work_area
*copyc ost$status
?? POP ??
*copyc clp$build_standard_title
*copyc clp$change_scl_options
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$convert_data_to_string
*copyc clp$evaluate_parameters
*copyc clp$find_current_block
*copyc clp$find_scl_options
*copyc clp$get_work_area
*copyc clp$make_boolean_value
*copyc clp$make_keyword_value
*copyc clp$make_record_value
*copyc clp$make_value
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_data_representation
*copyc clp$put_display
*copyc clp$reset_for_next_display_page
*copyc osp$change_translation_tables
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
?? TITLE := 'clp$change_scl_options_command', EJECT ??

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

{******************************************************************************
{
{ NOTE: If the following PDT is regenerated, the initialization for the first
{ parameter (prompt_for_parameter_correction) must be manually changed to
{ allow that parameter to be given positionally.  This parameter is considered
{ obsolete and therefore has the HIDDEN attribute, and HIDDEN implies BY_NAME.
{ However, for compatibility reasons this parameter should NOT have the
{ BY_NAME attribute.
{ To make this change after the PDT has been regenerated replace the line
{
{     $clt$parameter_spec_methods[clc$specify_by_name],
{
{ with the line
{
{     $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
{
{ in the initialization for the descriptor of PARAMETER 1.
{
{******************************************************************************

{ PROCEDURE (osm$chaso) change_scl_options, change_scl_option, chasclo, chaso (
{   prompt_for_parameter_correction, pfpc: (BY_NAME, HIDDEN) boolean = $optional
{   line_style_correction_prompts, lscp: (BY_NAME) key
{       (line, l)
{       (screen, s)
{       none
{     keyend = $optional
{   screen_style_correction_prompts, sscp: (BY_NAME) key
{       (screen, s)
{       none
{     keyend = $optional
{   name_folding_level, nfl: (BY_NAME) key
{       (standard_folding, sf)
{       (full_folding, ff)
{     keyend = $optional
{   wild_card_pattern_type, wcpt: (BY_NAME) key
{       (basic, b)
{       (extended, e)
{     keyend = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 11] 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 .. 5] of clt$keyword_specification,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 3] of clt$keyword_specification,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 11, 15, 26, 49, 587],
    clc$command, 11, 6, 0, 0, 1, 0, 6, 'OSM$CHASO'], [
    ['LINE_STYLE_CORRECTION_PROMPTS  ',clc$nominal_entry, 2],
    ['LSCP                           ',clc$abbreviation_entry, 2],
    ['NAME_FOLDING_LEVEL             ',clc$nominal_entry, 4],
    ['NFL                            ',clc$abbreviation_entry, 4],
    ['PFPC                           ',clc$abbreviation_entry, 1],
    ['PROMPT_FOR_PARAMETER_CORRECTION',clc$nominal_entry, 1],
    ['SCREEN_STYLE_CORRECTION_PROMPTS',clc$nominal_entry, 3],
    ['SSCP                           ',clc$abbreviation_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 6],
    ['WCPT                           ',clc$abbreviation_entry, 5],
    ['WILD_CARD_PATTERN_TYPE         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [6, clc$hidden_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 2
    [1, 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, 192,
  clc$optional_parameter, 0, 0],
{ PARAMETER 3
    [7, 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, 118,
  clc$optional_parameter, 0, 0],
{ PARAMETER 4
    [3, 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, 155,
  clc$optional_parameter, 0, 0],
{ PARAMETER 5
    [11, 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, 155,
  clc$optional_parameter, 0, 0],
{ PARAMETER 6
    [9, 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$boolean_type]],
{ PARAMETER 2
    [[1, 0, clc$keyword_type], [5], [
    ['L                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['LINE                           ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['S                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['SCREEN                         ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 3
    [[1, 0, clc$keyword_type], [3], [
    ['NONE                           ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['S                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['SCREEN                         ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ],
{ PARAMETER 4
    [[1, 0, clc$keyword_type], [4], [
    ['FF                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['FULL_FOLDING                   ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['SF                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['STANDARD_FOLDING               ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ],
{ PARAMETER 5
    [[1, 0, clc$keyword_type], [4], [
    ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['BASIC                          ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['E                              ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['EXTENDED                       ', clc$nominal_entry, clc$normal_usage_entry, 2]]
    ],
{ PARAMETER 6
    [[1, 0, clc$status_type]]];

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

    CONST
      p$prompt_for_parameter_correcti = 1 {PROMPT_FOR_PARAMETER_CORRECTION} ,
      p$line_style_correction_prompts = 2,
      p$screen_style_correction_promp = 3 {SCREEN_STYLE_CORRECTION_PROMPTS} ,
      p$name_folding_level = 4,
      p$wild_card_pattern_type = 5,
      p$status = 6;

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

    VAR
      block: ^clt$block,
      old_options: ^ clt$scl_options,
      options: clt$scl_options;


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

    clp$find_scl_options (old_options);
    options := old_options^;

{ The parameters line_style_correction_prompts and screen_style_correction_prompts
{ logically replace the parameter prompt_for_parameter_correction, so if either of
{ the former is specified, the latter is ignored.

    IF pvt [p$line_style_correction_prompts].specified OR
          pvt [p$screen_style_correction_promp].specified THEN

      IF pvt [p$line_style_correction_prompts].specified THEN
        IF pvt [p$line_style_correction_prompts].value^.keyword_value = 'NONE' THEN
          options.line_style_correction_prompts.selected := FALSE;
        ELSE
          options.line_style_correction_prompts.selected := TRUE;
          IF pvt [p$line_style_correction_prompts].value^.keyword_value = 'LINE' THEN
            options.line_style_correction_prompts.prompting_style := osc$line_interaction;
          ELSE
            options.line_style_correction_prompts.prompting_style := osc$screen_interaction;
          IFEND;
        IFEND;
      IFEND;

      IF pvt [p$screen_style_correction_promp].specified THEN
        options.screen_style_correction_prompts.selected :=
              pvt [p$screen_style_correction_promp].value^.keyword_value = 'SCREEN';
      IFEND;

    ELSEIF pvt [p$prompt_for_parameter_correcti].specified THEN

      IF pvt [p$prompt_for_parameter_correcti].value^.boolean_value.value THEN
        options.line_style_correction_prompts.selected := TRUE;
        options.line_style_correction_prompts.prompting_style := osc$line_interaction;
        options.screen_style_correction_prompts.selected := TRUE;
      ELSE
        options.line_style_correction_prompts.selected := FALSE;
        options.screen_style_correction_prompts.selected := FALSE;
      IFEND;
    IFEND;

    IF pvt [p$name_folding_level].specified THEN
      IF pvt [p$name_folding_level].value^.keyword_value = 'FULL_FOLDING' THEN
        options.name_folding_level := clc$full_folding;
      ELSE {STANDARD_FOLDING}
        options.name_folding_level := clc$standard_folding;
      IFEND;
      IF options.name_folding_level <> old_options^.name_folding_level THEN

{ The following code ensures that if the NAME_FOLDING_LEVEL is being changed
{ that the change is being made to the job level instance of the SCL_OPTIONS
{ environment object.
{
{ This restriction is currently necessary because changing this option requires
{ changing the "case translation" tables that are defined on a job-wide basis.
{
{ NOTE that if this restriction is removed, it will be necessary for the
{ SCL_OPTIONS environment object to provide a specialized "pop" procedure
{ that will adjust the transalation tables, if necessary.

        clp$find_current_block (block);
        WHILE (block^.environment_object_info = NIL) OR
              (NOT block^.environment_object_info^.defined [clc$eo_scl_options]) DO
          block := block^.previous_block;
        WHILEND;
        IF (block^.kind <> clc$task_block) OR (block^.task_kind <> clc$job_monitor_task) THEN
          osp$set_status_abnormal ('CL', cle$not_yet_implemented,
                'change of NAME_FOLDING_LEVEL in pushed SCL_OPTIONS', status);
          RETURN;
        IFEND;

        osp$change_translation_tables (options.name_folding_level, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
    IFEND;

    IF pvt [p$wild_card_pattern_type].specified THEN
      IF pvt [p$wild_card_pattern_type].value^.keyword_value = 'BASIC' THEN
        options.wild_card_pattern_type := clc$wc_basic_pattern;
      ELSE {EXTENDED}
        options.wild_card_pattern_type := clc$wc_extended_pattern;
      IFEND;
    IFEND;

    clp$change_scl_options (options, status);

  PROCEND clp$_change_scl_options;
?? TITLE := 'clp$change_scl_options_command', EJECT ??

  PROCEDURE [XDCL] clp$$scl_options
    (    parameter_list: clt$parameter_list;
     VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

{ FUNCTION (osm$$sclo) $scl_options

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 2, 17, 17, 56, 30, 877],
    clc$function, 0, 0, 0, 0, 0, 0, 0, 'OSM$$SCLO']];

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

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

    make_scl_options_record (work_area, result, status);

  PROCEND clp$$scl_options;
?? TITLE := 'clp$_display_scl_options', EJECT ??

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

{ PROCEDURE (osm$disso) display_scl_options, display_scl_option, disso (
{   output, o: file = $output
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 6, 13, 17, 11, 7, 675],
    clc$command, 3, 2, 0, 0, 0, 0, 2, 'OSM$DISSO'], [
    ['O                              ',clc$abbreviation_entry, 1],
    ['OUTPUT                         ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ 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, 7],
{ PARAMETER 2
    [3, 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],
    '$output'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

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

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


      IF output_open THEN
        clp$close_display (display_control, handler_status);
        output_open := FALSE;
      IFEND;
      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);


      { The display_scl_options 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;
?? OLDTITLE, EJECT ??

    VAR
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      options_record: ^clt$data_value,
      output_open: boolean,
      representation: ^clt$data_representation,
      work_area: ^^clt$work_area;


    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, 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;

    make_scl_options_record (work_area^, options_record, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    output_open := FALSE;
    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
      RETURN;
    IFEND;
    output_open := TRUE;
    clv$titles_built := FALSE;
    clv$command_name := 'display_scl_options';

    clp$convert_data_to_string (options_record, clc$labeled_elem_representation, display_control.page_width,
          work_area^, representation, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$put_data_representation (display_control, representation, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$close_display (display_control, status);

    output_open := FALSE;

    osp$disestablish_cond_handler;

  PROCEND clp$_display_scl_options;
?? TITLE := 'make_scl_options_record', EJECT ??

  PROCEDURE make_scl_options_record
    (VAR work_area {input, output} : ^clt$work_area;
     VAR result: ^clt$data_value;
     VAR status: ost$status);

    VAR
      scl_options: ^clt$scl_options;


    status.normal := TRUE;

    clp$find_scl_options (scl_options);

    clp$make_record_value (4, work_area, result);

    result^.field_values^ [1].name := 'LINE_STYLE_CORRECTION_PROMPTS';
    clp$make_value (clc$keyword, work_area, result^.field_values^ [1].value);
    IF NOT scl_options^.line_style_correction_prompts.selected THEN
      result^.field_values^ [1].value^.keyword_value := 'NONE';
    ELSEIF scl_options^.line_style_correction_prompts.prompting_style = osc$line_interaction THEN
      result^.field_values^ [1].value^.keyword_value := 'LINE';
    ELSE
      result^.field_values^ [1].value^.keyword_value := 'SCREEN';
    IFEND;

    result^.field_values^ [2].name := 'SCREEN_STYLE_CORRECTION_PROMPTS';
    clp$make_value (clc$keyword, work_area, result^.field_values^ [2].value);
    IF scl_options^.screen_style_correction_prompts.selected THEN
      result^.field_values^ [2].value^.keyword_value := 'SCREEN';
    ELSE
      result^.field_values^ [2].value^.keyword_value := 'NONE';
    IFEND;

    result^.field_values^ [3].name := 'NAME_FOLDING_LEVEL';
    clp$make_value (clc$keyword, work_area, result^.field_values^ [3].value);
    IF scl_options^.name_folding_level = clc$full_folding THEN
      result^.field_values^ [3].value^.keyword_value := 'FULL_FOLDING';
    ELSE
      result^.field_values^ [3].value^.keyword_value := 'STANDARD_FOLDING';
    IFEND;

    result^.field_values^ [4].name := 'WILD_CARD_PATTERN_TYPE';
    clp$make_value (clc$keyword, work_area, result^.field_values^ [4].value);
    IF scl_options^.wild_card_pattern_type = clc$wc_extended_pattern THEN
      result^.field_values^ [4].value^.keyword_value := 'EXTENDED';
    ELSE
      result^.field_values^ [4].value^.keyword_value := 'BASIC';
    IFEND;

  PROCEND make_scl_options_record;

MODEND clm$scl_options_command;
