?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Display Task Status' ??
MODULE clm$display_task_status_command;

{
{ PURPOSE:
{   This module provides the source for the display_task_status command.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_list
*copyc clt$path_display_chunks
*copyc oss$job_paged_literal
*copyc ost$caller_identifier
*copyc ost$status
*copyc ost$status_message
*copyc ost$status_message_line_count
*copyc ost$status_message_line_size
?? POP ??
*copyc clp$find_named_task_group_list
*copyc clp$build_standard_title
*copyc clp$close_display
*copyc clp$convert_integer_to_string
*copyc clp$evaluate_parameters
*copyc clp$fetch_named_task_entry
*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 clv$named_task_group_list
*copyc clv$nil_display_control
*copyc clv$value_descriptors
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$format_message
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*copyc osv$upper_to_lower
?? OLDTITLE ??
?? NEWTITLE := 'clp$_display_task_status', EJECT ??

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

?? RIGHT := 110 ??

{ PROCEDURE (osm$dists) display_task_status, dists (
{   task_name, task_names, tn: list of any of
{       key
{         all
{       keyend
{       name
{     anyend = $required
{   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,
        element_type_spec: 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$name_type_qualifier,
          recend,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type3: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 1, 25, 14, 11, 33, 662],
    clc$command, 6, 3, 1, 0, 0, 0, 3, 'OSM$DISTS'], [
    ['O                              ',clc$abbreviation_entry, 2],
    ['OUTPUT                         ',clc$nominal_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 3],
    ['TASK_NAME                      ',clc$nominal_entry, 1],
    ['TASK_NAMES                     ',clc$alias_entry, 1],
    ['TN                             ',clc$abbreviation_entry, 1]],
    [
{ 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, 85, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [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 3
    [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$list_type], [69, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$union_type], [[clc$keyword_type, clc$name_type],
      FALSE, 2],
      44, [[1, 0, clc$keyword_type], [1], [
        ['ALL                            ', clc$nominal_entry, clc$normal_usage_entry, 1]]
        ],
      5, [[1, 0, clc$name_type], [1, osc$max_name_size]]
      ]
    ],
{ PARAMETER 2
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 3
    [[1, 0, clc$status_type]]];

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

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

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

*copy clv$display_variables
*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_program 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;
?? TITLE := 'put_partial_display', EJECT ??

    PROCEDURE [INLINE] put_partial_display
      (    str: string ( * );
           trim_option: clt$trim_display_text_option;
           term_option: amt$term_option);

      VAR
        local_status: ost$status;

      clp$put_partial_display (display_control, str, trim_option, term_option, local_status);
      IF NOT local_status.normal THEN
        EXIT clp$_display_task_status;
      IFEND;

    PROCEND put_partial_display;
?? TITLE := 'generate_message_display', EJECT ??

    PROCEDURE generate_message_display
      (    message_status: ost$status);

      VAR
        message: ost$status_message,
        message_area: ^ost$status_message,
        message_line_count: ^ost$status_message_line_count,
        message_line_index: 1 .. osc$max_status_message_lines,
        message_line_size: ^ost$status_message_line_size,
        message_line: ^string ( * );

      status.normal := TRUE;

      osp$format_message (message_status, osc$full_message_level, clv$page_width, message, status);
      IF NOT status.normal THEN
        EXIT clp$_display_task_status;
      IFEND;
      message_area := ^message;
      RESET message_area;
      NEXT message_line_count IN message_area;
      FOR message_line_index := 1 TO message_line_count^ DO
        NEXT message_line_size IN message_area;
        NEXT message_line: [message_line_size^] IN message_area;
        clp$put_display (display_control, message_line^, clc$trim, status);
        IF NOT status.normal THEN
          EXIT clp$_display_task_status;
        IFEND;
      FOREND;

    PROCEND generate_message_display;
?? TITLE := '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);

      VAR
        ignore_status: ost$status;

      clp$close_display (display_control, ignore_status);

    PROCEND abort_handler;
?? TITLE := 'put_task_status', EJECT ??

    PROCEDURE [INLINE] put_task_status
      (    task_name: ost$name);

{ This procedure will never return with bad status, thus no status
{ parameter is passed. A non-local exit occurs instead.

      clp$new_display_line (display_control, 0, status);
      IF NOT status.normal THEN
        EXIT clp$_display_task_status;
      IFEND;
      put_partial_display (task_name, clc$trim, amc$continue);

      IF task_name = named_task.name THEN
        IF named_task.status.complete THEN
          IF named_task.status.status.normal THEN
            put_partial_display (' completed normally.', clc$no_trim, amc$terminate);
          ELSE
            put_partial_display (' terminated with ..', clc$no_trim, amc$continue);
            clp$new_display_line (display_control, 0, status);
            IF NOT status.normal THEN
              EXIT clp$_display_task_status;
            IFEND;
            generate_message_display (named_task.status.status);
          IFEND;
        ELSE
          put_partial_display (' still executing.', clc$no_trim, amc$terminate);
        IFEND;
      ELSE
        put_partial_display (' is not known to the requesting task.', clc$no_trim, amc$terminate);
      IFEND;

    PROCEND put_task_status;
?? OLDTITLE, EJECT ??

    VAR
      current_task_name: ^clt$data_value,
      default_ring_attributes: amt$ring_attributes,
      display_control: clt$display_control,
      index: integer,
      local_status: ost$status,
      named_task: clt$named_task,
      named_task_group_list: ^^clt$named_task,
      named_task_list: ^clt$named_task;


    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_task_status';

    IF display_control.page_width < clc$narrow_page_width THEN
      clv$page_width := clc$narrow_page_width;
    ELSEIF display_control.page_width > clc$wide_page_width THEN
      clv$page_width := clc$wide_page_width;
    ELSE
      clv$page_width := display_control.page_width;
    IFEND;

  /display/
    BEGIN
      current_task_name := pvt [p$task_name].value;
      WHILE current_task_name <> NIL DO
        IF current_task_name^.element_value^.kind = clc$keyword THEN
          clp$find_named_task_group_list (named_task_group_list);
          named_task_list := named_task_group_list^;
          WHILE named_task_list <> NIL DO
            named_task := named_task_list^;
            put_task_status (named_task.name);
            named_task_list := named_task_list^.link;
            IF named_task_list <> NIL THEN
              clp$new_display_line (display_control, 1, status);
              IF NOT status.normal THEN
                EXIT /display/;
              IFEND;
            IFEND;
          WHILEND;
        ELSE
          clp$fetch_named_task_entry (current_task_name^.element_value^.name_value, named_task);
          put_task_status (current_task_name^.element_value^.name_value);
        IFEND;
        current_task_name := current_task_name^.link;
        IF (current_task_name <> NIL) THEN
          clp$new_display_line (display_control, 1, status);
          IF NOT status.normal THEN
            EXIT /display/;
          IFEND;
        IFEND;
      WHILEND;
    END /display/;

    clp$close_display (display_control, local_status);

    osp$disestablish_cond_handler;

  PROCEND clp$_display_task_status;

MODEND clm$display_task_status_command;
