?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Object Library Generator' ??
?? EJECT ??
MODULE ocm$display_new_library;



{ PURPOSE:
{   To display information about all or
{   part of the contents of a object
{   file or library.


?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_miscellaneous
*copyc oce$library_generator_errors
*copyc oct$open_file_list
?? POP ??
*copyc clp$evaluate_parameters
*copyc ifp$discard_suspended_output
*copyc ocp$close_output_file
*copyc ocp$display_module
*copyc ocp$generate_message
*copyc ocp$obtain_library_list
*copyc ocp$obtain_object_file
*copyc ocp$open_output_file
*copyc ocp$output
*copyc ocp$search_nlm_tree
*copyc ocp$search_object_file
*copyc ocp$search_open_file_list
*copyc ocp$sort_name_list
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$establish_condition_handler
*copyc ocv$global_display_toggles
*copyc ocv$nlm_list
*copyc ocv$olg_scratch_seq
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    command_status: ost$status;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$_display_new_library', EJECT ??

  PROCEDURE [XDCL] ocp$_display_new_library
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

?? NEWTITLE := 'display_module_list' ??
?? NEWTITLE := 'terminate_display_module', EJECT ??

    PROCEDURE display_module_list
      (    module_list: oct$name_list;
           display_toggles: oct$display_toggles;
       VAR status: ost$status);

      VAR
        term_dm_established_descriptor: pmt$established_handler;


      PROCEDURE terminate_display_module
        (    condition: pmt$condition;
             condition_descriptor: ^pmt$condition_information;
             save_area: ^ost$stack_frame_save_area;
         VAR condition_status: ost$status);


        VAR
          ignore_status: ost$status;


        ifp$discard_suspended_output;

        status.normal := TRUE;
        osp$set_status_abnormal (oc, oce$e_some_modules_not, 'displayed', command_status);

        EXIT display_module_list;


      PROCEND terminate_display_module;
?? OLDTITLE ??
?? EJECT ??

      VAR
        current_module: ^oct$name_list,
        nlm: ^oct$new_library_module_list,
        terminate_condition: pmt$condition,
        dummy: boolean;

      terminate_condition.selector := ifc$interactive_condition;

      pmp$establish_condition_handler (terminate_condition, ^terminate_display_module,
            ^term_dm_established_descriptor, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;


      IF (display_toggles - $oct$display_toggles [occ$display_time_date]) = $oct$display_toggles [] THEN
        ocp$output (occ$single_space, ' ', 1, occ$end_of_line);
      IFEND;


      current_module := module_list.link;

      WHILE current_module <> NIL DO
        ocp$search_nlm_tree (current_module^.name, nlm, dummy);

        ocp$display_module (display_toggles, nlm^.description^, nlm^.changed_info, status);
        IF NOT status.normal THEN
          ocp$generate_message (status);
          osp$set_status_abnormal (oc, oce$e_some_modules_not, 'displayed', command_status);
        IFEND;

        current_module := current_module^.link;
      WHILEND;


      ocp$output (occ$single_space, ' ', 1, occ$end_of_line);


    PROCEND display_module_list;
?? OLDTITLE ??
?? NEWTITLE := 'collect_modules_from_current' ??
?? EJECT ??

    PROCEDURE collect_modules_from_current
      (    first_module: pmt$program_name;
           last_module: pmt$program_name;
       VAR module_list: oct$name_list;
       VAR status: ost$status);


      VAR
        nlm: ^oct$new_library_module_list,
        module_found: boolean,
        current_module: pmt$program_name,

        last_old_module: ^oct$name_list,
        last_new_module: ^oct$name_list;




      last_old_module := ^module_list;
      WHILE last_old_module^.link <> NIL DO
        last_old_module := last_old_module^.link;
      WHILEND;
      last_new_module := last_old_module;


      ocp$search_nlm_tree (first_module, nlm, module_found);
      IF NOT module_found THEN
        IF first_module = last_module THEN
          osp$set_status_abnormal (oc, oce$w_module_not_found, first_module, status);
        ELSE
          osp$set_status_abnormal (oc, oce$w_subrange_module_not_found, first_module, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, first_module, status);
          osp$append_status_parameter (osc$status_parameter_delimiter, last_module, status);
        IFEND;
        ocp$generate_message (status);
        osp$set_status_abnormal (oc, oce$e_some_modules_not, 'displayed', command_status);
        RETURN;
      IFEND;

      REPEAT
        IF nlm^.name = osc$null_name THEN
          IF last_module <> osc$null_name THEN
            osp$set_status_abnormal (oc, oce$e_range_module_2_not_found, last_module, status);
            osp$append_status_parameter (osc$status_parameter_delimiter, first_module, status);
            ocp$generate_message (status);
            osp$set_status_abnormal (oc, oce$e_some_modules_not, 'displayed', command_status);
            last_old_module^.link := NIL;
          IFEND;
          RETURN;
        IFEND;

        current_module := nlm^.name;

        NEXT last_new_module^.link IN ocv$olg_scratch_seq;
        last_new_module := last_new_module^.link;
        IF last_new_module = NIL THEN
          osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
          RETURN;
        IFEND;

        last_new_module^.name := current_module;
        last_new_module^.link := NIL;

        nlm := nlm^.f_link;
      UNTIL current_module = last_module;



    PROCEND collect_modules_from_current;
?? OLDTITLE ??
?? EJECT ??

{ PROCEDURE (ocm$creol_disnl) display_new_library, disnl (
{   module, modules, m: any of
{       list of program_name
{       list of range of program_name
{     anyend = $optional
{   display_option, display_options, do: any of
{       key
{         all, none
{       keyend
{       list of key
{         (component, c)
{         (date_time, dt)
{         (entry_point, ep)
{         (header, h)
{         (libraries, library, l)
{         (reference, r)
{       keyend
{     anyend = date_time
{   output, o: file = $output
{   alphabetical_order, ao: boolean = false
{   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 .. 5] of clt$pdt_parameter,
      type1: 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$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$range_type_qualifier,
            element_type_spec: record
              header: clt$type_specification_header,
            recend,
          recend,
        recend,
      recend,
      type2: 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 .. 2] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$keyword_type_qualifier,
            keyword_specs: array [1 .. 13] of clt$keyword_specification,
          recend,
        recend,
        default_value: string (9),
      recend,
      type3: record
        header: clt$type_specification_header,
        default_value: string (7),
      recend,
      type4: record
        header: clt$type_specification_header,
        default_value: string (5),
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 6, 16, 42, 29, 479],
    clc$command, 11, 5, 0, 0, 0, 0, 5, 'OCM$CREOL_DISNL'], [
    ['ALPHABETICAL_ORDER             ',clc$nominal_entry, 4],
    ['AO                             ',clc$abbreviation_entry, 4],
    ['DISPLAY_OPTION                 ',clc$nominal_entry, 2],
    ['DISPLAY_OPTIONS                ',clc$alias_entry, 2],
    ['DO                             ',clc$abbreviation_entry, 2],
    ['M                              ',clc$abbreviation_entry, 1],
    ['MODULE                         ',clc$nominal_entry, 1],
    ['MODULES                        ',clc$alias_entry, 1],
    ['O                              ',clc$abbreviation_entry, 3],
    ['OUTPUT                         ',clc$nominal_entry, 3],
    ['STATUS                         ',clc$nominal_entry, 5]],
    [
{ PARAMETER 1
    [7, 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, 65, clc$optional_parameter, 0, 0],
{ PARAMETER 2
    [3, 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, 605, clc$optional_default_parameter, 0, 9],
{ PARAMETER 3
    [10, 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 4
    [1, 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, 5],
{ PARAMETER 5
    [11, 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$union_type], [[clc$list_type],
    FALSE, 2],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$program_name_type]]
      ],
    26, [[1, 0, clc$list_type], [10, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$range_type], [3],
          [[1, 0, clc$program_name_type]]
        ]
      ]
    ],
{ PARAMETER 2
    [[1, 0, clc$union_type], [[clc$keyword_type,
    clc$list_type],
    FALSE, 2],
    81, [[1, 0, clc$keyword_type], [2], [
      ['ALL                            ', clc$nominal_entry,
  clc$normal_usage_entry, 1],
      ['NONE                           ', clc$nominal_entry,
  clc$normal_usage_entry, 2]]
      ],
    504, [[1, 0, clc$list_type], [488, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$keyword_type], [13], [
        ['C                              ', clc$abbreviation_entry,
  clc$normal_usage_entry, 1],
        ['COMPONENT                      ', clc$nominal_entry,
  clc$normal_usage_entry, 1],
        ['DATE_TIME                      ', clc$nominal_entry,
  clc$normal_usage_entry, 2],
        ['DT                             ', clc$abbreviation_entry,
  clc$normal_usage_entry, 2],
        ['ENTRY_POINT                    ', clc$nominal_entry,
  clc$normal_usage_entry, 3],
        ['EP                             ', clc$abbreviation_entry,
  clc$normal_usage_entry, 3],
        ['H                              ', clc$abbreviation_entry,
  clc$normal_usage_entry, 4],
        ['HEADER                         ', clc$nominal_entry,
  clc$normal_usage_entry, 4],
        ['L                              ', clc$abbreviation_entry,
  clc$normal_usage_entry, 5],
        ['LIBRARIES                      ', clc$nominal_entry,
  clc$normal_usage_entry, 5],
        ['LIBRARY                        ', clc$alias_entry,
  clc$normal_usage_entry, 5],
        ['R                              ', clc$abbreviation_entry,
  clc$normal_usage_entry, 6],
        ['REFERENCE                      ', clc$nominal_entry,
  clc$normal_usage_entry, 6]]
        ]
      ]
    ,
    'date_time'],
{ PARAMETER 3
    [[1, 0, clc$file_type],
    '$output'],
{ PARAMETER 4
    [[1, 0, clc$boolean_type],
    'false'],
{ PARAMETER 5
    [[1, 0, clc$status_type]]];

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

    CONST
      p$module = 1,
      p$display_option = 2,
      p$output = 3,
      p$alphabetical_order = 4,
      p$status = 5;

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

    VAR
      first_module: pmt$program_name,
      ignore_status: ost$status,
      last_module: pmt$program_name,
      module_list: oct$name_list,
      node: ^clt$data_value,
      page_header: string (33),
      toggles: oct$display_toggles;

    status.normal := TRUE;
    command_status.normal := TRUE;

    RESET ocv$olg_scratch_seq;

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

    page_header := 'Display of CURRENT Object Library';
    ocp$open_output_file (pvt [p$output].value^.file_value^, ^page_header, status);
    IF NOT status.normal THEN
      ocp$close_output_file (ignore_status);
      RETURN;
    IFEND;

    IF pvt [p$display_option].specified THEN
      toggles := $oct$display_toggles [];
      IF pvt [p$display_option].value^.kind = clc$keyword THEN
        IF pvt [p$display_option].value^.keyword_value = 'ALL' THEN
          toggles := -$oct$display_toggles [];
        ELSE { none
          toggles := $oct$display_toggles [];
        IFEND;
      ELSE { list of keywords
        node := pvt [p$display_option].value;
        WHILE (node <> NIL) AND (node^.element_value <> NIL) DO
          CASE node^.element_value^.keyword_value (1) OF
          = 'C' =
            toggles := toggles + $oct$display_toggles [occ$display_component_info];
          = 'L' =
            toggles := toggles + $oct$display_toggles [occ$display_libraries];
          = 'D' =
            toggles := toggles + $oct$display_toggles [occ$display_time_date];
          = 'E' =
            toggles := toggles + $oct$display_toggles [occ$display_xdcls];
          = 'H' =
            toggles := toggles + $oct$display_toggles [occ$display_module_header];
          = 'R' =
            toggles := toggles + $oct$display_toggles [occ$display_xrefs];
          CASEND;
          node := node^.link;
        WHILEND;
      IFEND;
    ELSE
      toggles := ocv$global_display_toggles;
    IFEND;

    module_list.link := NIL;
    IF pvt [p$module].specified THEN
      node := pvt [p$module].value;

      WHILE (node <> NIL) AND (node^.element_value <> NIL) DO
        IF node^.element_value^.kind = clc$range THEN
          first_module := node^.element_value^.low_value^.program_name_value;
          last_module := node^.element_value^.high_value^.program_name_value;
        ELSE
          first_module := node^.element_value^.program_name_value;
          last_module := first_module;
        IFEND;
        collect_modules_from_current (first_module, last_module, module_list, status);
        IF NOT status.normal THEN
          ocp$close_output_file (ignore_status);
          RETURN;
        IFEND;
        node := node^.link;
      WHILEND;
    ELSE
      IF ocv$nlm_list^.f_link^.name = osc$null_name THEN
        osp$set_status_condition (oce$w_no_modules_on_current_lib, status);
        RETURN;
      IFEND;

      first_module := ocv$nlm_list^.f_link^.name;
      last_module := ocv$nlm_list^.b_link^.name;

      collect_modules_from_current (first_module, last_module, module_list, status);
      IF NOT status.normal THEN
        ocp$close_output_file (ignore_status);
        RETURN;
      IFEND;
    IFEND;

    IF pvt [p$alphabetical_order].value^.boolean_value.value THEN
      ocp$sort_name_list (module_list);
    IFEND;

    display_module_list (module_list, toggles, status);
    IF NOT status.normal THEN
      ocp$close_output_file (ignore_status);
      RETURN;
    IFEND;

    ocp$close_output_file (status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    status := command_status;


  PROCEND ocp$_display_new_library;
?? OLDTITLE ??
MODEND ocm$display_new_library;
