?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Display Variable List' ??
MODULE clm$display_var_list_command;

{
{ PURPOSE:
{   This module contains the processor for the display_variable_list variable.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_list
*copyc clt$command_list
*copyc clt$path_display_chunks
*copyc oss$job_paged_literal
*copyc ost$caller_identifier
*copyc ost$status
?? POP ??
*copyc clp$build_path_subtitle
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_parameters
*copyc clp$find_first_var_block
*copyc clp$find_next_var_block
*copyc clp$horizontal_tab_display
*copyc clp$make_file_clt$value
*copyc clp$new_display_line
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc clp$put_partial_display
*copyc clp$reset_for_next_display_page
*copyc clp$unhash_variable_name
*copyc clv$intrinsic_commands
*copyc clv$nil_display_control
*copyc clv$operator_commands
*copyc jmp$system_job
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc osv$upper_to_lower

  CONST
    variable_name_size = osc$max_name_size + 1,
    column = 2,
    minimum_display_line = variable_name_size + 2;

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

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

{ PROCEDURE (osm$disvl) display_variable_list, disvl (
{   output, o: file = $output
{   status)

?? PUSH (LISTEXT := ON) ??

  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,
    [87, 10, 22, 10, 1, 17, 755],
    clc$command, 3, 2, 0, 0, 0, 0, 2, 'OSM$DISVL'], [
    ['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]]];

?? POP ??

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

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

    CONST
      minimum_display_line = osc$max_name_size + 3,
      minimum_line_size = osc$max_name_size + 3,
      brief_header_length = 13,
      full_header_length = 7,
      system_entry_length = 7,
      subentry_column = 3,
      entry_name_size = osc$max_name_size + 1;

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

      clp$close_display (display_control, ignore_status);

    PROCEND abort_handler;
*copyc clp$new_page_procedure
?? TITLE := 'put_subtitle', EJECT ??

    PROCEDURE [INLINE] put_subtitle
      (VAR display_control: clt$display_control;
       VAR status: ost$status);

{ The display_variable_list variable 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,
      full_display: boolean,
      ignore_status: ost$status,
      search_modes: [STATIC, READ, oss$job_paged_literal] array [clt$command_search_modes] of string (10) :=
            ['global', 'restricted', 'exclusive'],
      search_mode: clt$command_search_modes,
      start_of_list: ^clt$command_list_entry,
      system_command_library_lfn: amt$local_file_name,
      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);

    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
      osp$disestablish_cond_handler;
      RETURN;
    IFEND;
    clv$titles_built := FALSE;
    clv$command_name := 'display_variable_list';

    display_variable_list (display_control, status);

    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_variable_list;
?? TITLE := 'display_variable_list', EJECT ??

  PROCEDURE display_variable_list
    (VAR display_control: clt$display_control;
     VAR status: ost$status);

    VAR
      allowed_classes: clt$internal_variable_classes,
      associated_utility: boolean,
      block: ^clt$block,
      index: integer,
      inherited_block: ^clt$block,
      inherited_classes: clt$internal_variable_classes,
      line_size: amt$page_width,
      term_option: amt$term_option,
      title_printed: boolean,
      translated_label: string (osc$max_name_size),
      translated_variable_name: string (variable_name_size),
      trim: clt$trim_display_text_option,
      variable_access: ^clt$variable_access,
      variable_name: clt$variable_name,
      variables_per_line: integer;

    IF display_control.page_width < minimum_display_line THEN
      line_size := minimum_display_line;
    ELSE
      line_size := display_control.page_width;
    IFEND;

    allowed_classes := -$clt$internal_variable_classes[clc$param_variable];
    clp$find_first_var_block (allowed_classes, inherited_classes, inherited_block, block,
          associated_utility);
    IF block = NIL THEN
      RETURN;
    IFEND;
    variables_per_line := line_size DIV variable_name_size;
    term_option := amc$continue;

    clp$put_partial_display (display_control, 'VARIABLES', clc$no_trim, amc$continue, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /put_block_header/
    BEGIN
      CASE block^.kind OF
      = clc$task_block =
        IF block^.task_kind = clc$job_monitor_task THEN
          clp$put_partial_display (display_control, ' IN JOB', clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        ELSE
          clp$put_partial_display (display_control, ' IN TASK', clc$trim, amc$continue, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
        IFEND;
        EXIT /put_block_header/;

      = clc$utility_block =
        clp$put_partial_display (display_control, ' IN UTILITY', clc$trim, amc$continue, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      = clc$when_block =
        clp$put_partial_display (display_control, ' IN ', clc$no_trim, amc$continue, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$put_partial_display (display_control, block^.kind_name, clc$trim, amc$continue, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        EXIT /put_block_header/;

      = clc$command_proc_block, clc$function_proc_block =
        clp$put_partial_display (display_control, ' IN ', clc$no_trim, amc$continue, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$put_partial_display (display_control, block^.kind_name, clc$trim, amc$continue, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

      ELSE
        ;
      CASEND;
      clp$put_partial_display (display_control, ' : ', clc$no_trim, amc$continue, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      #TRANSLATE (osv$upper_to_lower, block^.label, translated_label);
      clp$put_partial_display (display_control, translated_label, clc$trim, amc$continue, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

    END /put_block_header/;

    clp$new_display_line (display_control, 1, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    clp$horizontal_tab_display (display_control, column, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    variable_access := block^.variables.thread;
    title_printed := FALSE;

    WHILE TRUE DO

      index := 1;
      IF (inherited_block <> NIL) AND (NOT associated_utility) AND  (block^.kind IN $clt$block_kinds
            [clc$command_proc_block, clc$function_proc_block]) THEN
        allowed_classes := $clt$internal_variable_classes [clc$env_variable, clc$lib_variable,
            clc$pushed_variable];
      IFEND;

      WHILE variable_access <> NIL DO
        IF variable_access^.info.class IN allowed_classes THEN
          IF ((index MOD variables_per_line) = 0) OR (variable_access^.forward_thread = NIL) THEN
            term_option := amc$terminate;
            trim := clc$trim;
          ELSE
            term_option := amc$continue;
            trim := clc$no_trim;
          IFEND;
          clp$unhash_variable_name (variable_access^.hashed_name, variable_name);
          #TRANSLATE (osv$upper_to_lower, variable_name, translated_variable_name);
          clp$put_partial_display (display_control, translated_variable_name, trim, term_option, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;
          index := index + 1;
          IF term_option = amc$terminate THEN
            clp$horizontal_tab_display (display_control, column, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;
        IFEND;
        variable_access := variable_access^.forward_thread;
      WHILEND;

      IF block^.kind IN $clt$block_kinds [clc$command_proc_block, clc$function_proc_block] THEN
        allowed_classes := $clt$internal_variable_classes [clc$env_variable, clc$lib_variable,
            clc$pushed_variable];
      IFEND;
      clp$find_next_var_block (allowed_classes, inherited_classes, inherited_block, block,
            associated_utility);
      IF block = NIL THEN
        RETURN;
      IFEND;
      variable_access := block^.variables.thread;
      IF (NOT title_printed) AND (variable_access <> NIL) THEN
        clp$new_display_line (display_control, 1, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$put_partial_display (display_control, 'ACCESSIBLE VARIABLES', clc$no_trim, amc$terminate,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$new_display_line (display_control, 1, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        clp$horizontal_tab_display (display_control, column, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        title_printed := TRUE;
      IFEND;
    WHILEND;

  PROCEND display_variable_list;

MODEND clm$display_var_list_command;
