?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Command Utility Manager' ??
MODULE clm$command_utility_manager;

{
{ PURPOSE:
{   This module contains the procedures that manage the entries for command utilities on the block stack.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_utilities
*copyc cle$unexpected_call_to
*IF NOT $true(osv$unix)
*copyc clk$begin_utility
*copyc clk$change_utility_attributes
*copyc clk$end_utility
*copyc clk$get_command_origin
*copyc clk$get_utility_attributes
*copyc clk$pop_utility
*copyc clk$push_utility
*IFEND
*copyc clt$command_search_modes
*copyc clt$command_table
*copyc clt$function_table
*copyc clt$utility_attributes
*copyc clt$utility_dialog_info
*copyc clt$utility_name
*copyc ost$name
*copyc ost$status
?? POP ??
*IF NOT $true(osv$unix)
*copyc clp$change_utility_environment
*copyc clp$convert_integer_to_string
*IFEND
*copyc clp$create_utility_environment
*copyc clp$find_current_block
*copyc clp$find_external_input_block
*copyc clp$find_utility_block
*copyc clp$pop_block_stack
*copyc clp$validate_name
*copyc osp$append_status_parameter
*IF NOT $true(osv$unix)
*copyc osp$enforce_exception_policies
*copyc osp$file_access_condition
*IFEND
*copyc osp$set_status_abnormal
*copyc osv$lower_to_upper
*IF NOT $true(osv$unix)
*copyc osv$initial_exception_context
*IFEND

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

  PROCEDURE [XDCL, #GATE] clp$begin_utility
    (    name: clt$utility_name;
         attributes: clt$utility_attributes;
     VAR status: ost$status);


*IF NOT $true(osv$unix)
    VAR
      context: ^ost$ecp_exception_context;
*IFEND

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

*IF NOT $true(osv$unix)
    REPEAT
      clp$create_utility_environment (name, FALSE, FALSE, attributes, status);
      IF osp$file_access_condition (status) THEN
        IF context = NIL THEN
          PUSH context;
          context^ := osv$initial_exception_context;
        IFEND;
        context^.condition_status := status;
        osp$enforce_exception_policies (context^);
        status := context^.condition_status;
      IFEND;
    UNTIL status.normal OR (NOT osp$file_access_condition (status)) OR (NOT context^.wait);

*ELSE
    clp$create_utility_environment (name, FALSE, FALSE, attributes, status);
*IFEND


  PROCEND clp$begin_utility;
?? TITLE := 'clp$end_utility', EJECT ??
*copyc clh$end_utility

  PROCEDURE [XDCL, #GATE] clp$end_utility
    (    name: clt$utility_name;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      name_is_valid: boolean,
      validated_utility_name: clt$utility_name;


    status.normal := TRUE;

    IF name = osc$null_name THEN
      osp$set_status_abnormal ('CL', cle$improper_utility_name, name, status);
      RETURN;
    IFEND;
    clp$validate_name (name, validated_utility_name, name_is_valid);
    IF NOT name_is_valid THEN
      osp$set_status_abnormal ('CL', cle$improper_utility_name, name, status);
      RETURN;
    IFEND;

    clp$find_current_block (block);
    IF NOT ((block^.kind = clc$utility_block) AND (block^.label = validated_utility_name)) THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$end_utility', status);
    ELSE
      clp$pop_block_stack (block);
    IFEND;

  PROCEND clp$end_utility;
?? TITLE := 'clp$push_utility', EJECT ??
*copyc clh$push_utility

  PROCEDURE [XDCL, #GATE] clp$push_utility
    (    utility_name: ost$name;
         search_mode: clt$command_search_modes;
         commands: ^clt$command_table;
         functions: ^clt$function_table;
     VAR status: ost$status);

    VAR
      attributes: array [1 .. 3] of clt$utility_attribute;


*IF NOT $true(osv$unix)
    VAR
      context: ^ost$ecp_exception_context;

    context := NIL;
*IFEND

    status.normal := TRUE;

    attributes [1].key := clc$utility_command_search_mode;
    attributes [1].command_search_mode := search_mode;
    attributes [2].key := clc$utility_command_table;
    attributes [2].command_table := commands;
    attributes [3].key := clc$utility_function_table;
    attributes [3].function_table := functions;

*IF NOT $true(osv$unix)
    REPEAT
      clp$create_utility_environment (utility_name, FALSE, TRUE, attributes, status);
      IF osp$file_access_condition (status) THEN
        IF context = NIL THEN
          PUSH context;
          context^ := osv$initial_exception_context;
        IFEND;
        context^.condition_status := status;
        osp$enforce_exception_policies (context^);
        status := context^.condition_status;
      IFEND;
    UNTIL status.normal OR (NOT osp$file_access_condition (status)) OR (NOT context^.wait);

*ELSE
    clp$create_utility_environment (utility_name, FALSE, TRUE, attributes, status);
*IFEND

  PROCEND clp$push_utility;
?? TITLE := 'clp$pop_utility', EJECT ??
*copyc clh$pop_utility

  PROCEDURE [XDCL, #GATE] clp$pop_utility
    (VAR status: ost$status);

    VAR
      block: ^clt$block;

    status.normal := TRUE;
    clp$find_current_block (block);
    IF block^.kind <> clc$utility_block THEN
      osp$set_status_abnormal ('CL', cle$unexpected_call_to, 'clp$pop_utility', status);
    ELSE
      clp$pop_block_stack (block);
    IFEND;

  PROCEND clp$pop_utility;
*IF NOT $true(osv$unix)
?? TITLE := 'clp$change_utility_attributes', EJECT ??
*copyc clh$change_utility_attributes

  PROCEDURE [XDCL, #GATE] clp$change_utility_attributes
    (    name: clt$utility_name;
         attributes: clt$utility_attributes;
     VAR status: ost$status);

    status.normal := TRUE;
    clp$change_utility_environment (name, FALSE, attributes, status);

  PROCEND clp$change_utility_attributes;
?? TITLE := 'clp$get_utility_attributes', EJECT ??
*copyc clh$get_utility_attributes

  PROCEDURE [XDCL, #GATE] clp$get_utility_attributes
    (    name: clt$utility_name;
     VAR attributes {input, output} : clt$utility_attributes;
     VAR status: ost$status);

    VAR
      ignore_block_in_current_task: boolean,
      ignore_status: ost$status,
      index: integer,
      index_string: ost$string,
      name_is_valid: boolean,
      utility_block: ^clt$block,
      validated_utility_name: clt$utility_name;


    status.normal := TRUE;

  /get_utility_attributes/
    BEGIN
      IF name = osc$null_name THEN
        validated_utility_name := osc$null_name;
      ELSE
        clp$validate_name (name, validated_utility_name, name_is_valid);
        IF NOT name_is_valid THEN
          osp$set_status_abnormal ('CL', cle$improper_utility_name, '', status);
          EXIT /get_utility_attributes/;
        IFEND;
      IFEND;

      clp$find_utility_block (validated_utility_name, utility_block, ignore_block_in_current_task);
      IF utility_block = NIL THEN
        osp$set_status_abnormal ('CL', cle$unknown_utility, name, status);
        EXIT /get_utility_attributes/;
      IFEND;

      FOR index := 1 TO UPPERBOUND (attributes) DO
        CASE attributes [index].key OF

        = clc$null_utility_attribute =
          ;

        = clc$utility_command_search_mode =
          attributes [index].command_search_mode := utility_block^.command_search_mode;

        = clc$utility_command_table =
          attributes [index].command_table := utility_block^.command_environment.commands;

        = clc$utility_function_table =
          attributes [index].function_table := utility_block^.command_environment.original_functions;

        = clc$utility_function_proc_table =
          attributes [index].function_processor_table := utility_block^.command_environment.
                contemporary_functions;

        = clc$utility_interactive_include =
          attributes [index].interactive_include_processor := utility_block^.interactive_include_processor;

        = clc$utility_libraries =
          attributes [index].libraries := utility_block^.libraries;

        = clc$utility_line_preprocessor =
          attributes [index].line_preprocessor := utility_block^.line_preprocessor;

        = clc$utility_name =
          attributes [index].name := utility_block^.label;

        = clc$utility_online_manual =
          attributes [index].online_manual_name := utility_block^.online_manual_name;

        = clc$utility_prompt =
          attributes [index].prompt := utility_block^.prompt;

        = clc$utility_subcmnd_log_enabled =
          attributes [index].subcommand_logging_enabled := utility_block^.command_environment.
                subcommand_logging_enabled;

        = clc$utility_termination_command =
          IF (utility_block^.command_environment.commands = NIL) OR
                (utility_block^.command_environment.termination_command_index >
                UPPERBOUND (utility_block^.command_environment.commands^)) THEN
            attributes [index].termination_command := 'QUIT';
          ELSE
            attributes [index].termination_command := utility_block^.command_environment.
                  commands^ [utility_block^.command_environment.termination_command_index].name;
          IFEND;

        ELSE
          clp$convert_integer_to_string (index, 10, FALSE, index_string, ignore_status);
          IF status.normal THEN
            osp$set_status_abnormal ('CL', cle$unknown_utility_attribute, index_string.
                  value (1, index_string.size), status);
          ELSE
            osp$append_status_parameter (',', index_string.value (1, index_string.size), status);
          IFEND;
        CASEND;
      FOREND;

    END /get_utility_attributes/;

  PROCEND clp$get_utility_attributes;
?? TITLE := 'clp$fetch_utility_dialog_info', EJECT ??
*copyc clh$fetch_utility_dialog_info

  PROCEDURE [XDCL, #GATE] clp$fetch_utility_dialog_info
    (    utility: clt$utility_name;
     VAR dialog_info: ^clt$utility_dialog_info;
     VAR status: ost$status);

    VAR
      block: ^clt$block,
      block_in_current_task: boolean,
      name_is_valid: boolean,
      validated_utility_name: clt$utility_name;


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

    IF utility = osc$null_name THEN
      validated_utility_name := osc$null_name;
    ELSE
      clp$validate_name (utility, validated_utility_name, name_is_valid);
      IF NOT name_is_valid THEN
        osp$set_status_abnormal ('CL', cle$improper_utility_name, utility, status);
        RETURN;
        IFEND;
    IFEND;

    clp$find_utility_block (validated_utility_name, block, block_in_current_task);
    IF block = NIL THEN
      osp$set_status_abnormal ('CL', cle$unknown_utility, utility, status);
      RETURN;
    ELSEIF NOT block_in_current_task THEN
      osp$set_status_abnormal ('CL', cle$inaccessible_utility, utility, status);
      osp$append_status_parameter (osc$status_parameter_delimiter, 'CLP$FETCH_UTILITY_DIALOG_INFO', status);
      RETURN;
    IFEND;

    dialog_info := ^block^.command_environment.dialog_info;

  PROCEND clp$fetch_utility_dialog_info;
*IFEND
?? TITLE := 'clp$get_command_origin', EJECT ??
*copyc clh$get_command_origin

  PROCEDURE [XDCL, #GATE] clp$get_command_origin
    (VAR interactive: boolean;
     VAR status: ost$status);

    VAR
      block: ^clt$block;

    status.normal := TRUE;

    clp$find_external_input_block (block);
    interactive := (block <> NIL) AND (block^.input.kind = clc$file_input) AND
          block^.input.interactive_device;

  PROCEND clp$get_command_origin;

MODEND clm$command_utility_manager;
