?? NEWTITLE := 'NOS/VE SCL Interpreter: Display Command Environment Command' ??
MODULE clm$display_command_env_command;
?? RIGHT := 110 ??

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

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$block
*copyc clt$established_handler_index
*copyc clt$parameter_list
*copyc ost$status
?? POP ??
*copyc clp$close_display
*copyc clp$evaluate_parameters
*copyc clp$find_current_block
*copyc clp$get_path_name
*copyc clp$environment_object_name
*copyc clp$open_display_reference
*copyc clp$put_partial_display
*copyc clp$trimmed_string_size
*copyc clv$nil_display_control
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??

  TYPE
    t$display_option = (c$do_all_blocks, c$do_blocks, c$do_command_mode, c$do_environment_objects,
          c$do_environment_variables, c$do_established_condition_hdlr, c$do_message_level,
          c$do_natural_language, c$do_procedure_variables, c$do_variables, c$do_variable_values),

    t$display_options = set of t$display_option;

?? OLDTITLE ??
?? NEWTITLE := 'clp$display_command_env_command', EJECT ??

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

{ PROCEDURE (osm$discs) display_command_stack, discs (
{   display_options, display_option, do: list of key
{       all
{       (all_blocks, all_block, ab)
{       (blocks, block, b)
{       (command_mode, cm)
{       (environment_objects, environment_object, eo)
{       (environment_variables, environment_variable, ev)
{       (established_condition_handlers, ech, condition_handlers, ch)
{       (message_level, ml)
{       (natural_language, nl)
{       (procedure_variables, procedure_variable, pv)
{       (variables, variable, v)
{       (variable_values, variable_value, vv)
{     keyend = (blocks, command_mode, message_level, environment_variables, variable_values)
{   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 .. 6] of clt$pdt_parameter_name,
      parameters: array [1 .. 3] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 32] of clt$keyword_specification,
        recend,
        default_value: string (77),
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [104, 4, 14, 10, 52, 5, 494],
    clc$command, 6, 3, 0, 0, 0, 0, 3, 'OSM$DISCS'], [
    ['DISPLAY_OPTION                 ',clc$alias_entry, 1],
    ['DISPLAY_OPTIONS                ',clc$nominal_entry, 1],
    ['DO                             ',clc$abbreviation_entry, 1],
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3]],
    [
{ 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, 1207,
  clc$optional_default_parameter, 0, 77],
{ PARAMETER 2
    [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, 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$list_type], [1191, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$keyword_type], [32], [
      ['AB                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
      ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1],
      ['ALL_BLOCK                      ', clc$alias_entry, clc$normal_usage_entry, 2],
      ['ALL_BLOCKS                     ', clc$nominal_entry, clc$normal_usage_entry, 2],
      ['B                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
      ['BLOCK                          ', clc$alias_entry, clc$normal_usage_entry, 3],
      ['BLOCKS                         ', clc$nominal_entry, clc$normal_usage_entry, 3],
      ['CH                             ', clc$abbreviation_entry, clc$normal_usage_entry, 7],
      ['CM                             ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
      ['COMMAND_MODE                   ', clc$nominal_entry, clc$normal_usage_entry, 4],
      ['CONDITION_HANDLERS             ', clc$alias_entry, clc$normal_usage_entry, 7],
      ['ECH                            ', clc$alias_entry, clc$normal_usage_entry, 7],
      ['ENVIRONMENT_OBJECT             ', clc$alias_entry, clc$normal_usage_entry, 5],
      ['ENVIRONMENT_OBJECTS            ', clc$nominal_entry, clc$normal_usage_entry, 5],
      ['ENVIRONMENT_VARIABLE           ', clc$alias_entry, clc$normal_usage_entry, 6],
      ['ENVIRONMENT_VARIABLES          ', clc$nominal_entry, clc$normal_usage_entry, 6],
      ['EO                             ', clc$abbreviation_entry, clc$normal_usage_entry, 5],
      ['ESTABLISHED_CONDITION_HANDLERS ', clc$nominal_entry, clc$normal_usage_entry, 7],
      ['EV                             ', clc$abbreviation_entry, clc$normal_usage_entry, 6],
      ['MESSAGE_LEVEL                  ', clc$nominal_entry, clc$normal_usage_entry, 8],
      ['ML                             ', clc$abbreviation_entry, clc$normal_usage_entry, 8],
      ['NATURAL_LANGUAGE               ', clc$nominal_entry, clc$normal_usage_entry, 9],
      ['NL                             ', clc$abbreviation_entry, clc$normal_usage_entry, 9],
      ['PROCEDURE_VARIABLE             ', clc$alias_entry, clc$normal_usage_entry, 10],
      ['PROCEDURE_VARIABLES            ', clc$nominal_entry, clc$normal_usage_entry, 10],
      ['PV                             ', clc$abbreviation_entry, clc$normal_usage_entry, 10],
      ['V                              ', clc$abbreviation_entry, clc$normal_usage_entry, 11],
      ['VARIABLE                       ', clc$alias_entry, clc$normal_usage_entry, 11],
      ['VARIABLES                      ', clc$nominal_entry, clc$normal_usage_entry, 11],
      ['VARIABLE_VALUE                 ', clc$alias_entry, clc$normal_usage_entry, 12],
      ['VARIABLE_VALUES                ', clc$nominal_entry, clc$normal_usage_entry, 12],
      ['VV                             ', clc$abbreviation_entry, clc$normal_usage_entry, 12]]
      ]
    ,
    '(blocks, command_mode, message_level, environment_variables, variable_values)'],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

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

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

    TYPE
      clt$command_kinds = set of clt$command_kind;

    VAR
      block: ^clt$block,
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      display_options: t$display_options,
      ignore_status: ost$status,
      line_number_string: string (16),
      line_number_string_length: integer,
      str: ost$string;

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

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

      clp$close_display (display_control, ignore_status);

    PROCEND p$abort_handler;
?? OLDTITLE ??
?? NEWTITLE := 'P$EVALUATE_DISPLAY_OPTIONS', EJECT ??

    PROCEDURE p$evaluate_display_options
      (    value_p: ^clt$data_value;
       VAR display_options: t$display_options;
       VAR status: ost$status);

      VAR
        list_value_p: ^clt$data_value,
        element_p: ^clt$data_value;

      display_options := $t$display_options [];
      list_value_p := value_p;

      WHILE (list_value_p <> NIL) AND (list_value_p^.kind = clc$list) DO
        element_p := list_value_p^.element_value;
        list_value_p := list_value_p^.link;

        IF (element_p <> NIL) AND (element_p^.kind = clc$keyword) THEN
          IF element_p^.keyword_value = 'ALL' THEN
            display_options := -$t$display_options [];
          ELSEIF element_p^.keyword_value = 'ALL_BLOCKS' THEN
            display_options := display_options + $t$display_options [c$do_all_blocks];
          ELSEIF element_p^.keyword_value = 'BLOCKS' THEN
            display_options := display_options + $t$display_options [c$do_blocks];
          ELSEIF element_p^.keyword_value = 'COMMAND_MODE' THEN
            display_options := display_options + $t$display_options [c$do_command_mode];
          ELSEIF element_p^.keyword_value = 'ENVIRONMENT_OBJECTS' THEN
            display_options := display_options + $t$display_options [c$do_environment_objects];
          ELSEIF element_p^.keyword_value = 'ENVIRONMENT_VARIABLES' THEN
            display_options := display_options + $t$display_options [c$do_environment_variables];
          ELSEIF element_p^.keyword_value = 'ESTABLISHED_CONDITION_HANDLERS' THEN
            display_options := display_options + $t$display_options [c$do_established_condition_hdlr];
          ELSEIF element_p^.keyword_value = 'MESSAGE_LEVEL' THEN
            display_options := display_options + $t$display_options [c$do_message_level];
          ELSEIF element_p^.keyword_value = 'NATURAL_LANGUAGE' THEN
            display_options := display_options + $t$display_options [c$do_natural_language];
          ELSEIF element_p^.keyword_value = 'PROCEDURE_VARIABLES' THEN
            display_options := display_options + $t$display_options [c$do_procedure_variables];
          ELSEIF element_p^.keyword_value = 'VARIABLES' THEN
            display_options := display_options + $t$display_options [c$do_variables];
          ELSEIF element_p^.keyword_value = 'VARIABLE_VALUES' THEN
            display_options := display_options + $t$display_options [c$do_variable_values];
          IFEND;
        IFEND;
      WHILEND;

    PROCEND p$evaluate_display_options;
?? OLDTITLE ??
?? NEWTITLE := 'P$PUT', EJECT ??

    PROCEDURE p$put
      (    text: string ( * );
           trim_option: clt$trim_display_text_option;
           term_option: amt$term_option);

      clp$put_partial_display (display_control, text, trim_option, term_option, status);
      IF NOT status.normal THEN
        EXIT clp$display_command_env_command; {----->
      IFEND;

    PROCEND p$put;
?? OLDTITLE ??
?? NEWTITLE := 'p$put_environment_objects', EJECT ??

    PROCEDURE p$put_environment_objects
      (    info: ^clt$environment_object_info);

      VAR
        header_put: boolean,
        i: clt$environment_object_ordinal;

      IF info = NIL THEN
        RETURN; {----->
      IFEND;

      header_put := FALSE;

      FOR i := LOWERVALUE (clt$environment_object_ordinal) TO UPPERVALUE (clt$environment_object_ordinal) DO
        IF info^.defined [i] THEN
          IF NOT header_put THEN
            p$put ('    Environment Objects ...', clc$no_trim, amc$terminate);
            header_put := TRUE;
          IFEND;
          p$put ('        ', clc$no_trim, amc$start);
          p$put (clp$environment_object_name (i) ^, clc$trim, amc$terminate);
        IFEND;
      FOREND;

    PROCEND p$put_environment_objects;
?? OLDTITLE ??
?? NEWTITLE := 'p$put_established_handlers', EJECT ??

    PROCEDURE p$put_established_handlers
      (    info: clt$established_handler_info);

      VAR
        i: clt$established_handler_index;


      IF (info.specific_handler_count = 0) AND (info.any_fault_handler = NIL) AND
            (info.any_condition_handler = NIL) THEN
        RETURN; {----->
      IFEND;

      p$put ('    Condition Handlers ...', clc$no_trim, amc$terminate);
      FOR i := 1 TO info.specific_handler_count DO
        p$put ('        ', clc$no_trim, amc$start);
        p$put (info.specific_handlers^ [i].condition, clc$trim, amc$terminate);
      FOREND;

      IF info.any_fault_handler <> NIL THEN
        p$put ('        ANY_FAULT', clc$no_trim, amc$terminate);
      IFEND;

      IF info.any_condition_handler <> NIL THEN
        p$put ('        ANY_CONDITION', clc$no_trim, amc$terminate);
      IFEND;

    PROCEND p$put_established_handlers;
?? OLDTITLE ??
?? NEWTITLE := 'p$put_path_name', EJECT ??

    PROCEDURE p$put_path_name
      (    local_file_name: amt$local_file_name);

      VAR
        file_reference: fst$path;

      clp$get_path_name (local_file_name, osc$full_message_level, file_reference);
      p$put (file_reference (1, clp$trimmed_string_size (file_reference)), clc$no_trim, amc$continue);

    PROCEND p$put_path_name;
?? OLDTITLE ??
?? EJECT ??
    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    p$evaluate_display_options (pvt [p$display_options].value, display_options, status);


    display_control := clv$nil_display_control;
    #SPOIL (display_control);
    osp$establish_block_exit_hndlr (^p$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^, NIL, fsc$list, default_ring_attributes,
          display_control, status);
    IF NOT status.normal THEN
      osp$disestablish_cond_handler;
      RETURN; {----->
    IFEND;

    clp$find_current_block (block);
    block := block^.previous_block;
    WHILE block <> NIL DO
      CASE block^.kind OF

      = clc$block_block =
        p$put ('BLOCK statement', clc$no_trim, amc$start);
        IF block^.label <> '' THEN
          p$put (', labelled: ', clc$no_trim, amc$continue);
          p$put (block^.label, clc$trim, amc$continue);
        IFEND;
        p$put ('.', clc$no_trim, amc$terminate);

      = clc$case_block =
        p$put ('CASE statement', clc$no_trim, amc$start);
        p$put ('.', clc$no_trim, amc$terminate);

      = clc$command_block =
        IF (c$do_all_blocks IN display_options) OR (block^.command_kind IN
              $clt$command_kinds [clc$command_is_include_file, clc$command_is_include_line,
              clc$command_is_execute_task]) OR (block^.started_application) THEN
          p$put (block^.label, clc$trim, amc$start);
          p$put (' command', clc$no_trim, amc$continue);
          IF (block^.started_application) AND (block^.application_info <> NIL) THEN
            p$put ('(application identifier = ', clc$no_trim, amc$continue);
            p$put (block^.application_info^.identifier.name, clc$trim, amc$continue);
            p$put (', nested application identifier = ', clc$no_trim, amc$continue);
            p$put (block^.application_info^.nested_identifier.name, clc$trim, amc$continue);
            IF block^.application_info^.application_scheduling THEN
              p$put (', application scheduling = TRUE', clc$trim, amc$continue);
            IFEND;
            p$put (')', clc$no_trim, amc$continue);
          IFEND;
          p$put ('.', clc$no_trim, amc$terminate);
        IFEND;

      = clc$for_block =
        p$put ('FOR statement', clc$no_trim, amc$start);
        IF block^.label <> '' THEN
          p$put (', labelled: ', clc$no_trim, amc$continue);
          p$put (block^.label, clc$trim, amc$continue);
        IFEND;
        p$put (', control variable: ', clc$no_trim, amc$continue);
        p$put (block^.for_variable^, clc$trim, amc$continue);
        p$put ('.', clc$no_trim, amc$terminate);

      = clc$if_block =
*if false
        fip#addl_initialize (str, 'IF statement');
{temp}  IF c$do_environment_variables IN display_options THEN
          dip#addl_string (str, '
        IFEND;
*else
        p$put ('IF statement', clc$no_trim, amc$start);
*ifend
        p$put ('.', clc$no_trim, amc$terminate);

      = clc$input_block =
        IF c$do_all_blocks IN display_options THEN
          CASE block^.input.kind OF
          = clc$line_input =
            p$put ('Input from line', clc$no_trim, amc$start);
          = clc$sequence_input =
            IF block^.label <> '' THEN
              p$put (block^.label, clc$trim, amc$start);
              p$put (' input from internal file', clc$no_trim, amc$continue);
            ELSE
              p$put ('Input from internal file', clc$no_trim, amc$start);
            IFEND;
          = clc$file_input =
            IF block^.label <> '' THEN
              p$put (block^.label, clc$trim, amc$start);
              p$put (' input from file ', clc$no_trim, amc$continue);
            ELSE
              p$put ('Input from file ', clc$no_trim, amc$start);
            IFEND;
            p$put_path_name (block^.input.local_file_name);
            STRINGREP (line_number_string, line_number_string_length, ' at line', block^.input.record_number);
            p$put (line_number_string (1, line_number_string_length), clc$no_trim, amc$continue);
          CASEND;
          p$put ('.', clc$no_trim, amc$terminate);
        IFEND;

      = clc$loop_block =
        p$put ('LOOP statement', clc$no_trim, amc$start);
        IF block^.label <> '' THEN
          p$put (', labelled: ', clc$no_trim, amc$continue);
          p$put (block^.label, clc$trim, amc$continue);
        IFEND;
        p$put ('.', clc$no_trim, amc$terminate);

      = clc$command_proc_block =
        p$put ('PROCEDURE ', clc$no_trim, amc$start);
        p$put (block^.label, clc$trim, amc$continue);
        p$put (' from file ', clc$no_trim, amc$continue);
        p$put_path_name (block^.input.local_file_name);
        STRINGREP (line_number_string, line_number_string_length, ' at line', block^.input.record_number);
        p$put (line_number_string (1, line_number_string_length), clc$no_trim, amc$continue);
        IF (block^.started_application) AND (block^.application_info <> NIL) THEN
          p$put ('(application identifier = ', clc$no_trim, amc$continue);
          p$put (block^.application_info^.identifier.name, clc$trim, amc$continue);
          p$put (', nested application identifier = ', clc$no_trim, amc$continue);
          p$put (block^.application_info^.nested_identifier.name, clc$trim, amc$continue);
          p$put (')', clc$no_trim, amc$continue);
        IFEND;
        p$put ('.', clc$no_trim, amc$terminate);

      = clc$repeat_block =
        p$put ('REPEAT statement', clc$no_trim, amc$start);
        IF block^.label <> '' THEN
          p$put (', labelled: ', clc$no_trim, amc$continue);
          p$put (block^.label, clc$trim, amc$continue);
        IFEND;
        p$put ('.', clc$no_trim, amc$terminate);

      = clc$sub_parameters_block =
        IF c$do_all_blocks IN display_options THEN
          p$put ('"Sub-parameters" block', clc$no_trim, amc$start);
          p$put ('.', clc$no_trim, amc$terminate);
        IFEND;

      = clc$task_block =
        CASE block^.task_kind OF
        = clc$job_monitor_task =
          p$put ('Job', clc$no_trim, amc$start);
          p$put ('.', clc$no_trim, amc$terminate);
        = clc$task_statement_task =
          IF block^.synchronous_with_parent THEN
            p$put ('Synchronous TASK statement', clc$no_trim, amc$start);
          ELSE
            p$put ('Asynchronous TASK statement', clc$no_trim, amc$start);
          IFEND;
          p$put ('.', clc$no_trim, amc$terminate);
        = clc$other_task =
          IF c$do_all_blocks IN display_options THEN
            IF block^.synchronous_with_parent THEN
              p$put ('Synchronous task', clc$no_trim, amc$start);
            ELSE
              p$put ('Asynchronous task', clc$no_trim, amc$start);
            IFEND;
            p$put ('.', clc$no_trim, amc$terminate);
          IFEND;
        CASEND;

      = clc$utility_block =
        p$put (block^.label, clc$trim, amc$start);
        p$put (' utility.', clc$no_trim, amc$terminate);

      = clc$when_block =
        p$put ('WHEN statement for condition ', clc$no_trim, amc$start);
        p$put (block^.when_condition^.name, clc$trim, amc$continue);
        p$put ('.', clc$no_trim, amc$terminate);

      = clc$while_block =
        p$put ('WHILE statement', clc$no_trim, amc$start);
        IF block^.label <> '' THEN
          p$put (', labelled: ', clc$no_trim, amc$continue);
          p$put (block^.label, clc$trim, amc$continue);
        IFEND;
        p$put ('.', clc$no_trim, amc$terminate);

      ELSE
        IF c$do_all_blocks IN display_options THEN
          p$put ('"Unknown" block type.', clc$no_trim, amc$terminate);
        IFEND;
      CASEND;

      IF c$do_environment_objects IN display_options THEN
        p$put_environment_objects (block^.environment_object_info);
      IFEND;

      IF c$do_established_condition_hdlr IN display_options THEN
        p$put_established_handlers (block^.established_handler_info);
      IFEND;

      block := block^.previous_block;
    WHILEND;

    clp$close_display (display_control, status);

    osp$disestablish_cond_handler;

  PROCEND clp$display_command_env_command;
?? OLDTITLE ??
MODEND clm$display_command_env_command;
