?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE SCL Interpreter : Define_Application_Menu' ??
MODULE clm$define_application_menu;

{
{ PURPOSE:
{   This module contains the processors of the CREATE_APPLICATION_MENU sub_utility subcommands.
{

?? NEWTITLE := 'GLOBAL DECLARATIONS', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_mt_generator
*copyc csc$max_classes
*copyc csc$max_items_per_class
*copyc csc$max_menu_items
*copyc cst$application_functions
*copyc cst$class_name
*copyc cst$key_type
*copyc cst$menu_class
*copyc cst$menu_item
*copyc cst$menu_item_number
*copyc cst$menu_list
*copyc cst$screen_events
*copyc cst$standard_functions
*copyc oss$job_paged_literal
*copyc ost$status_condition_name
*copyc osv$lower_to_upper
*copyc pmt$program_name
?? POP ??
*copyc clp$begin_utility
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$include_file
*copyc clp$evaluate_parameters
*copyc osp$set_status_abnormal
?? EJECT ??

  TYPE
    standard_keys = set of cst$standard_functions,
    application_keys = set of cst$application_functions,
    screen_keys = set of cst$screen_events;

  TYPE
    key_type = record
      case cs_key_type: cst$key_type of
      = csc$standard_function =
        standard: cst$standard_functions,
      = csc$application_function =
        application: cst$application_functions,
      = csc$screen_function =
        screen: cst$screen_events,
      casend,
    recend;

  TYPE
    menu_record = record
      name: ost$status_condition_name,
      number_of_classes: cst$max_classes,
      number_of_items: cst$menu_item_number,
    recend;

  TYPE
    classes = record
      name: cst$class_name,
      number_of_items: 0 .. csc$max_items_per_class,
    recend;

  CONST
    number_of_key_types = 34,
    max_key_type_size = 21;

  VAR
    table: [STATIC, READ, oss$job_paged_literal] array [1 .. number_of_key_types] of record
      name: string (max_key_type_size),
      key_type: key_type,
    recend := [
          {} ['BACK                 ', [csc$standard_function, csc$back]],
          {} ['BACKWARD             ', [csc$standard_function, csc$backward]],
          {} ['CLEAR                ', [csc$screen_function, csc$clear]],
          {} ['CLEAR_EOL_MENU_ITEM  ', [csc$screen_function, csc$clear_eol_menu_item]],
          {} ['DATA                 ', [csc$standard_function, csc$data]],
          {} ['DELETE_CHAR_MENU_ITEM', [csc$screen_function, csc$delete_char_menu_item]],
          {} ['DELETE_LINE          ', [csc$screen_function, csc$delete_line]],
          {} ['DOWN                 ', [csc$standard_function, csc$down]],
          {} ['EDIT                 ', [csc$standard_function, csc$edit]],
          {} ['F1                   ', [csc$application_function, csc$f1]],
          {} ['F10                  ', [csc$application_function, csc$f10]],
          {} ['F11                  ', [csc$application_function, csc$f11]],
          {} ['F12                  ', [csc$application_function, csc$f12]],
          {} ['F13                  ', [csc$application_function, csc$f13]],
          {} ['F14                  ', [csc$application_function, csc$f14]],
          {} ['F15                  ', [csc$application_function, csc$f15]],
          {} ['F16                  ', [csc$application_function, csc$f16]],
          {} ['F2                   ', [csc$application_function, csc$f2]],
          {} ['F3                   ', [csc$application_function, csc$f3]],
          {} ['F4                   ', [csc$application_function, csc$f4]],
          {} ['F5                   ', [csc$application_function, csc$f5]],
          {} ['F6                   ', [csc$application_function, csc$f6]],
          {} ['F7                   ', [csc$application_function, csc$f7]],
          {} ['F8                   ', [csc$application_function, csc$f8]],
          {} ['F9                   ', [csc$application_function, csc$f9]],
          {} ['FORWARD              ', [csc$standard_function, csc$forward]],
          {} ['HELP                 ', [csc$standard_function, csc$help]],
          {} ['HOME                 ', [csc$screen_function, csc$home]],
          {} ['INSERT_CHAR_MENU_ITEM', [csc$screen_function, csc$insert_char_menu_item]],
          {} ['INSERT_LINE          ', [csc$screen_function, csc$insert_line]],
          {} ['NEXT                 ', [csc$standard_function, csc$next]],
          {} ['STOP                 ', [csc$standard_function, csc$stop]],
          {} ['UNDO                 ', [csc$standard_function, csc$undo]],
          {} ['UP                   ', [csc$standard_function, csc$up]]];

  CONST
    prompt_string = 'CAM',
    prompt_string_size = 3;

  VAR
    class_number: cst$max_classes,
    item_number: cst$menu_item_number,
    menu_classes: ^array [1 .. * ] of classes,
    message_module_name: pmt$program_name,
    store_info_status: ost$status,
    utility_name: [STATIC, READ, oss$job_paged_literal] ost$name := 'create_application_menu',
    selected_standard_keys: standard_keys,
    selected_application_keys: application_keys,
    selected_screen_keys: screen_keys,
    work_area_ptr: ^SEQ ( * );

?? TITLE := 'check_classes_for_name', EJECT ??

  PROCEDURE [INLINE] check_classes_for_name
    (    name: cst$class_name;
     VAR name_found: boolean;
     VAR class_index: cst$max_classes);

    FOR class_index := 1 TO csc$max_classes DO
      IF menu_classes^ [class_index].name = name THEN
        name_found := TRUE;
        RETURN;
      IFEND;
    FOREND;

    name_found := FALSE;
    class_index := 0;

  PROCEND check_classes_for_name;
?? TITLE := 'find_key_type', EJECT ??

  PROCEDURE find_key_type
    (    key_name: ost$name;
         shift: boolean;
     VAR menu_item: cst$menu_item;
     VAR status: ost$status);

    VAR
      low_index: 1 .. number_of_key_types,
      high_index: 0 .. number_of_key_types,
      temp: integer,
      current_index: 1 .. number_of_key_types + 1;

    status.normal := TRUE;
    low_index := 1;
    high_index := number_of_key_types;

    REPEAT
      temp := low_index + high_index;
      current_index := temp DIV 2;
      IF key_name = table [current_index].name THEN

      /search/
        BEGIN
          menu_item.menu_type := table [current_index].key_type.cs_key_type;
          CASE table [current_index].key_type.cs_key_type OF
          = csc$standard_function =
            menu_item.standard_function := table [current_index].key_type.standard;
            IF shift THEN
              menu_item.standard_function := SUCC (menu_item.standard_function);
            IFEND;
            IF menu_item.standard_function IN selected_standard_keys THEN
              EXIT /search/;
            IFEND;
            selected_standard_keys := selected_standard_keys + $standard_keys [menu_item.standard_function];
            RETURN;
          = csc$application_function =
            menu_item.application_function := table [current_index].key_type.application;
            IF shift THEN
              menu_item.application_function := SUCC (menu_item.application_function);
            IFEND;
            IF menu_item.application_function IN selected_application_keys THEN
              EXIT /search/;
            IFEND;
            selected_application_keys := selected_application_keys + $application_keys
                  [menu_item.application_function];
            RETURN;
          = csc$screen_function =
            menu_item.screen_function := table [current_index].key_type.screen;
            IF menu_item.screen_function IN selected_screen_keys THEN
              EXIT /search/;
            IFEND;
            selected_screen_keys := selected_screen_keys + $screen_keys [menu_item.screen_function];
            RETURN;
          ELSE
          CASEND;
        END /search/;
        IF shift THEN
          osp$set_status_abnormal ('CL', cle$duplicate_shifted_keys, key_name, status);
        ELSE
          osp$set_status_abnormal ('CL', cle$duplicate_keys, key_name, status);
        IFEND;
        RETURN;
      ELSEIF key_name < table [current_index].name THEN
        high_index := current_index - 1;
      ELSE
        low_index := current_index + 1;
      IFEND;
    UNTIL low_index > high_index;

  PROCEND find_key_type;
?? TITLE := 'clp$_create_menu_class', EJECT ??

  PROCEDURE clp$_create_menu_class
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$cream_cremc) create_menu_class, cremc (
{   name, n: string 1..31 = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  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,
        qualifier: clt$string_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 11, 30, 15, 10, 26, 820],
    clc$command, 3, 2, 1, 0, 0, 0, 2, 'OCM$CREAM_CREMC'], [
    ['N                              ',clc$abbreviation_entry, 1],
    ['NAME                           ',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, 8, clc$required_parameter, 0, 0],
{ 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$string_type], [1, 31, FALSE]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      menu_class: cst$class_name,
      name_found: boolean,
      ignore_class_index: cst$max_classes;

    status.normal := TRUE;

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

    menu_class := pvt [p$name].value^.string_value^;
    IF menu_class = osc$null_name THEN
      osp$set_status_abnormal ('CL', cle$null_not_allowed, menu_class, status);
      RETURN;
    IFEND;

    check_classes_for_name (menu_class, name_found, ignore_class_index);
    IF name_found THEN
      osp$set_status_abnormal ('CL', cle$duplicate_menu_class, menu_class, status);
      RETURN;
    IFEND;

    IF (class_number + 1) > csc$max_classes THEN
      osp$set_status_abnormal ('CL', cle$max_menu_classes_exceeded, '', status);
      RETURN;
    IFEND;

    class_number := class_number + 1;
    menu_classes^ [class_number].name := menu_class;

  PROCEND clp$_create_menu_class;
?? TITLE := 'clp$_create_menu_item', EJECT ??

  PROCEDURE clp$_create_menu_item
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$cream_cremi) create_menu_item, cremi (
{   key, k: key
{       f1, f2, f3, f4, f5, f6, f7, f8, f9, f10, f11, f12, f13, f14, f15, f16..
{ , next, help, stop, back, up, down
{       forward, backward, edit, data, insert_line, delete_line, home, clear,..
{  clear_eol_menu_item
{       delete_char_menu_item, insert_char_menu_item, undo
{     keyend = $optional
{   shift: boolean = no
{   class, c: string 1..31 = $optional
{   short_label, sl: string 1..6 = $required
{   alternate_short_label, asl: string 1..6 = $optional
{   long_label, ll: string 1..31 = $optional
{   alternate_long_label, all: string 1..31 = $optional
{   pair_with_previous, pwp: boolean = no
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 16] of clt$pdt_parameter_name,
      parameters: array [1 .. 9] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 34] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
        default_value: string (2),
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type5: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type7: record
        header: clt$type_specification_header,
        qualifier: clt$string_type_qualifier,
      recend,
      type8: record
        header: clt$type_specification_header,
        default_value: string (2),
      recend,
      type9: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 11, 30, 15, 23, 4, 502],
    clc$command, 16, 9, 1, 0, 0, 0, 9, 'OCM$CREAM_CREMI'], [
    ['ALL                            ',clc$abbreviation_entry, 7],
    ['ALTERNATE_LONG_LABEL           ',clc$nominal_entry, 7],
    ['ALTERNATE_SHORT_LABEL          ',clc$nominal_entry, 5],
    ['ASL                            ',clc$abbreviation_entry, 5],
    ['C                              ',clc$abbreviation_entry, 3],
    ['CLASS                          ',clc$nominal_entry, 3],
    ['K                              ',clc$abbreviation_entry, 1],
    ['KEY                            ',clc$nominal_entry, 1],
    ['LL                             ',clc$abbreviation_entry, 6],
    ['LONG_LABEL                     ',clc$nominal_entry, 6],
    ['PAIR_WITH_PREVIOUS             ',clc$nominal_entry, 8],
    ['PWP                            ',clc$abbreviation_entry, 8],
    ['SHIFT                          ',clc$nominal_entry, 2],
    ['SHORT_LABEL                    ',clc$nominal_entry, 4],
    ['SL                             ',clc$abbreviation_entry, 4],
    ['STATUS                         ',clc$nominal_entry, 9]],
    [
{ PARAMETER 1
    [8, 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, 1265, clc$optional_parameter, 0, 0],
{ PARAMETER 2
    [13, 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, 2],
{ PARAMETER 3
    [6, 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, 8, clc$optional_parameter, 0, 0],
{ PARAMETER 4
    [14, 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, 8, clc$required_parameter, 0, 0],
{ PARAMETER 5
    [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, 8, clc$optional_parameter, 0, 0],
{ PARAMETER 6
    [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, 8, clc$optional_parameter, 0, 0],
{ PARAMETER 7
    [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, 8, clc$optional_parameter, 0, 0],
{ PARAMETER 8
    [11, 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, 2],
{ PARAMETER 9
    [16, 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$keyword_type], [34], [
    ['BACK                           ', clc$nominal_entry,
  clc$normal_usage_entry, 20],
    ['BACKWARD                       ', clc$nominal_entry,
  clc$normal_usage_entry, 24],
    ['CLEAR                          ', clc$nominal_entry,
  clc$normal_usage_entry, 30],
    ['CLEAR_EOL_MENU_ITEM            ', clc$nominal_entry,
  clc$normal_usage_entry, 31],
    ['DATA                           ', clc$nominal_entry,
  clc$normal_usage_entry, 26],
    ['DELETE_CHAR_MENU_ITEM          ', clc$nominal_entry,
  clc$normal_usage_entry, 32],
    ['DELETE_LINE                    ', clc$nominal_entry,
  clc$normal_usage_entry, 28],
    ['DOWN                           ', clc$nominal_entry,
  clc$normal_usage_entry, 22],
    ['EDIT                           ', clc$nominal_entry,
  clc$normal_usage_entry, 25],
    ['F1                             ', clc$nominal_entry,
  clc$normal_usage_entry, 1],
    ['F10                            ', clc$nominal_entry,
  clc$normal_usage_entry, 10],
    ['F11                            ', clc$nominal_entry,
  clc$normal_usage_entry, 11],
    ['F12                            ', clc$nominal_entry,
  clc$normal_usage_entry, 12],
    ['F13                            ', clc$nominal_entry,
  clc$normal_usage_entry, 13],
    ['F14                            ', clc$nominal_entry,
  clc$normal_usage_entry, 14],
    ['F15                            ', clc$nominal_entry,
  clc$normal_usage_entry, 15],
    ['F16                            ', clc$nominal_entry,
  clc$normal_usage_entry, 16],
    ['F2                             ', clc$nominal_entry,
  clc$normal_usage_entry, 2],
    ['F3                             ', clc$nominal_entry,
  clc$normal_usage_entry, 3],
    ['F4                             ', clc$nominal_entry,
  clc$normal_usage_entry, 4],
    ['F5                             ', clc$nominal_entry,
  clc$normal_usage_entry, 5],
    ['F6                             ', clc$nominal_entry,
  clc$normal_usage_entry, 6],
    ['F7                             ', clc$nominal_entry,
  clc$normal_usage_entry, 7],
    ['F8                             ', clc$nominal_entry,
  clc$normal_usage_entry, 8],
    ['F9                             ', clc$nominal_entry,
  clc$normal_usage_entry, 9],
    ['FORWARD                        ', clc$nominal_entry,
  clc$normal_usage_entry, 23],
    ['HELP                           ', clc$nominal_entry,
  clc$normal_usage_entry, 18],
    ['HOME                           ', clc$nominal_entry,
  clc$normal_usage_entry, 29],
    ['INSERT_CHAR_MENU_ITEM          ', clc$nominal_entry,
  clc$normal_usage_entry, 33],
    ['INSERT_LINE                    ', clc$nominal_entry,
  clc$normal_usage_entry, 27],
    ['NEXT                           ', clc$nominal_entry,
  clc$normal_usage_entry, 17],
    ['STOP                           ', clc$nominal_entry,
  clc$normal_usage_entry, 19],
    ['UNDO                           ', clc$nominal_entry,
  clc$normal_usage_entry, 34],
    ['UP                             ', clc$nominal_entry,
  clc$normal_usage_entry, 21]]
    ],
{ PARAMETER 2
    [[1, 0, clc$boolean_type],
    'no'],
{ PARAMETER 3
    [[1, 0, clc$string_type], [1, 31, FALSE]],
{ PARAMETER 4
    [[1, 0, clc$string_type], [1, 6, FALSE]],
{ PARAMETER 5
    [[1, 0, clc$string_type], [1, 6, FALSE]],
{ PARAMETER 6
    [[1, 0, clc$string_type], [1, 31, FALSE]],
{ PARAMETER 7
    [[1, 0, clc$string_type], [1, 31, FALSE]],
{ PARAMETER 8
    [[1, 0, clc$boolean_type],
    'no'],
{ PARAMETER 9
    [[1, 0, clc$status_type]]];

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

    CONST
      p$key = 1,
      p$shift = 2,
      p$class = 3,
      p$short_label = 4,
      p$alternate_short_label = 5,
      p$long_label = 6,
      p$alternate_long_label = 7,
      p$pair_with_previous = 8,
      p$status = 9;

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

    VAR
      menu_class: cst$class_name,
      name_found: boolean,
      class_index: cst$max_classes,
      key_name: ost$name,
      shift: boolean,
      item: cst$menu_item,
      menu_item: ^cst$menu_item;

    status.normal := TRUE;

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

    IF pvt [p$class].specified THEN { must be a string
      menu_class := pvt [p$class].value^.string_value^;
      IF menu_class = osc$null_name THEN
        osp$set_status_abnormal ('CL', cle$null_not_allowed, 'MENU CLASS', status);
        RETURN;
      IFEND;

      check_classes_for_name (menu_class, name_found, class_index);
      IF NOT name_found THEN
        osp$set_status_abnormal ('CL', cle$menu_class_not_defined, menu_class, status);
        RETURN;
      IFEND;
    ELSE
      class_index := class_number;
      IF class_index = 0 THEN
        osp$set_status_abnormal ('CL', cle$no_menu_class_defined, '', status);
        RETURN;
      IFEND;
    IFEND;

    item.pair_with_previous := pvt [p$pair_with_previous].value^.boolean_value.value;

    item.short_label := pvt [p$short_label].value^.string_value^;
    IF item.short_label = osc$null_name THEN
      osp$set_status_abnormal ('CL', cle$null_not_allowed, 'SHORT_LABEL', status);
      RETURN;
    IFEND;

    IF pvt [p$alternate_short_label].specified THEN { must be a string
      item.alternate_short_label := pvt [p$alternate_short_label].value^.string_value^;
      IF item.alternate_short_label = osc$null_name THEN
        osp$set_status_abnormal ('CL', cle$null_not_allowed, 'ALTERNATE_SHORT_LABEL', status);
        RETURN;
      IFEND;
    ELSE
      item.alternate_short_label := item.short_label;
    IFEND;

    IF pvt [p$long_label].specified THEN
      item.long_label := pvt [p$long_label].value^.string_value^;
      IF item.long_label = osc$null_name THEN
        osp$set_status_abnormal ('CL', cle$null_not_allowed, 'LONG_LABEL', status);
        RETURN;
      IFEND;

    ELSE
      item.long_label := item.short_label;
    IFEND;

    IF pvt [p$alternate_long_label].specified THEN
      item.alternate_long_label := pvt [p$alternate_long_label].value^.string_value^;
      IF item.alternate_long_label = osc$null_name THEN
        osp$set_status_abnormal ('CL', cle$null_not_allowed, 'ALTERNATE_LONG_LABEL', status);
        RETURN;
      IFEND;
    ELSE
      item.alternate_long_label := item.long_label;
    IFEND;

    IF pvt [p$key].specified THEN
      key_name := pvt [p$key].value^.keyword_value;

      shift := pvt [p$shift].value^.boolean_value.value;

      find_key_type (key_name, shift, item, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      item.item_assigned := TRUE;
    ELSE

{ item.menu_type := csc$unused_entry;

      item.item_assigned := FALSE;
    IFEND;

    IF (menu_classes^ [class_index].number_of_items + 1) > csc$max_items_per_class THEN
      osp$set_status_abnormal ('CL', cle$max_menu_items_exceeded, '', status);
      RETURN;
    IFEND;

    item.menu_parent := class_index;
    menu_classes^ [class_index].number_of_items := menu_classes^ [class_index].number_of_items + 1;
    item_number := item_number + 1;
    NEXT menu_item IN work_area_ptr;
    IF menu_item = NIL THEN
      osp$set_status_abnormal ('CL', cle$module_too_large, message_module_name, store_info_status);
    ELSE
      menu_item^ := item;
    IFEND;

  PROCEND clp$_create_menu_item;
?? TITLE := 'clp$_end_application_menu', EJECT ??

  PROCEDURE clp$_end_application_menu
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$cream_endam) end_application_menu, endam

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
    recend := [
    [1,
    [89, 11, 30, 15, 43, 26, 841],
    clc$command, 0, 0, 0, 0, 0, 0, 0, 'OCM$CREAM_ENDAM']];

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

    VAR
      ignore_status: ost$status;

    status.normal := TRUE;

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

    clp$end_include (utility_name, ignore_status);

  PROCEND clp$_end_application_menu;
?? TITLE := 'clp$define_application_menu', EJECT ??

  PROCEDURE [XDCL] clp$define_application_menu
    (VAR work_area: ^SEQ ( * );
         menu_name: ost$status_condition_name;
         module_name: pmt$program_name;
     VAR number_of_classes: cst$max_classes;
     VAR number_of_items: cst$menu_item_number;
     VAR status: ost$status);

{ table command_table sn=oss$job_paged_literal
{ command (create_menu_class   , cremc)       p=clp$_create_menu_class    ..
{   cm=local
{ command (create_menu_item    , cremi)       p=clp$_create_menu_item     ..
{   cm=local
{ command (end_application_menu, quit, endam) p=clp$_end_application_menu ..
{   cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??

VAR
  command_table: [STATIC, READ, oss$job_paged_literal]
      ^clt$command_table := ^command_table_entries,

  command_table_entries: [STATIC, READ, oss$job_paged_literal] array [1
      .. 7] of clt$command_table_entry := [
  {} ['CREATE_MENU_CLASS              ', clc$nominal_entry,
        clc$normal_usage_entry, 1, clc$automatically_log, clc$linked_call,
        ^clp$_create_menu_class],
  {} ['CREATE_MENU_ITEM               ', clc$nominal_entry,
        clc$normal_usage_entry, 2, clc$automatically_log, clc$linked_call,
        ^clp$_create_menu_item],
  {} ['CREMC                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 1, clc$automatically_log, clc$linked_call,
        ^clp$_create_menu_class],
  {} ['CREMI                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 2, clc$automatically_log, clc$linked_call,
        ^clp$_create_menu_item],
  {} ['ENDAM                          ', clc$abbreviation_entry,
        clc$normal_usage_entry, 3, clc$automatically_log, clc$linked_call,
        ^clp$_end_application_menu],
  {} ['END_APPLICATION_MENU           ', clc$nominal_entry,
        clc$normal_usage_entry, 3, clc$automatically_log, clc$linked_call,
        ^clp$_end_application_menu],
  {} ['QUIT                           ', clc$alias_entry,
        clc$normal_usage_entry, 3, clc$automatically_log, clc$linked_call,
        ^clp$_end_application_menu]];

?? POP ??

    VAR
      menu_info: ^menu_record,
      i: cst$max_classes,
      utility_attributes: array [1 .. 3] of clt$utility_attribute;

    status.normal := TRUE;
    store_info_status.normal := TRUE;
    class_number := 0;
    item_number := 0;
    work_area_ptr := work_area;
    message_module_name := module_name;
    selected_standard_keys := $standard_keys [];
    selected_application_keys := $application_keys [];
    selected_screen_keys := $screen_keys [];


    NEXT menu_info IN work_area_ptr;
    IF menu_info = NIL THEN
      osp$set_status_abnormal ('CL', cle$module_too_large, module_name, status);
      RETURN;
    IFEND;

    menu_info^.name := menu_name;
    NEXT menu_classes: [1 .. csc$max_classes] IN work_area_ptr;
    IF menu_classes = NIL THEN
      osp$set_status_abnormal ('CL', cle$module_too_large, module_name, status);
      RETURN;
    IFEND;

    FOR i := 1 TO csc$max_classes DO
      menu_classes^ [i].name := osc$null_name;
      menu_classes^ [i].number_of_items := 0;
    FOREND;

    utility_attributes [1].key := clc$utility_command_search_mode;
    utility_attributes [1].command_search_mode := clc$global_command_search;
    utility_attributes [2].key := clc$utility_command_table;
    utility_attributes [2].command_table := command_table;
    utility_attributes [3].key := clc$utility_prompt;
    utility_attributes [3].prompt.value := prompt_string;
    utility_attributes [3].prompt.size := prompt_string_size;
    clp$begin_utility (utility_name, utility_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    clp$include_file (clc$current_command_input, prompt_string, utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    ELSEIF status.normal AND (NOT store_info_status.normal) THEN
      status := store_info_status;
      RETURN;
    IFEND;

    clp$end_utility (utility_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF class_number < 1 THEN
      osp$set_status_abnormal ('CL', cle$too_few_classes, menu_name, status);
      RETURN;
    IFEND;

    IF item_number < 1 THEN
      osp$set_status_abnormal ('CL', cle$too_few_items, menu_name, status);
      RETURN;
    IFEND;

    menu_info^.number_of_classes := class_number;
    menu_info^.number_of_items := item_number;

    number_of_classes := class_number;
    number_of_items := item_number;
    work_area := work_area_ptr;

  PROCEND clp$define_application_menu;

MODEND clm$define_application_menu;
