?? NEWTITLE := 'NOS/VE Job Scheduling : administer_attributes' ??
MODULE jmm$administer_attributes;

{ PURPOSE:
{   This module contains the routines that manipulate object attributes.
{
{ DESIGN:
{   Attributes of objects are kept in linked n-tuple tree structures.
{   This provides for a way to handle expressions like 'f=((1 3 7) (8 9))'.
{   Routines are provided here to build these attribute lists from the
{   SCL commands, copy and destroy these lists, and to merge them with
{   the defaults in preparation for display.
{
{ NOTES:
{   JMM$ADMINISTER_DISPLAY displays the attribute list.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
*copyc jmt$object_attribute
*copyc jmt$profile_data
?? PUSH (LISTEXT := ON) ??
*copyc clt$parameter_value_table
*copyc jmc$job_management_id
*copyc jmt$object_attribute_index
*copyc jme$object_attribute_errors
*copyc jme$queued_file_conditions
*copyc osd$integer_limits
*copyc oss$job_paged_literal
?? POP ??
*copyc clp$convert_value_to_string
*copyc clp$get_parameter_number
*copyc jmp$get_object
*copyc jmp$internal_error
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc jmv$object_definition
*copyc jmv$object_heap
*copyc jmv$working_storage
*copyc osv$lower_to_upper
?? RIGHT := 79 ??
?? TITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    jmv$dispatching_priority_names: [XDCL, READ,
          oss$job_paged_literal] array [1 .. 10] of string (3) :=
          ['P1 ', 'P2 ', 'P3 ', 'P4 ', 'P5 ', 'P6 ', 'P7 ', 'P8 ', 'P9 ',
          'P10'];

?? TITLE := '[XDCL] jmv$modify_display_attributes', EJECT ??

{ PURPOSE:
{   This variable references a utility specifiable procedure which
{   should be called when the display attributes are built.  The
{   procedure has the possibility to update the attributes prior
{   to display.

  VAR
    jmv$modify_display_attributes: [XDCL] ^jmt$modify_display_attributes :=
          NIL;

*copyc jmt$modify_display_attributes
?? TITLE := 'get_item ', EJECT ??

{ PURPOSE:
{   This routine builds an attribute list from an SCL parameter list.
{
{ DESIGN:
{   The routine uses the attribute's definition to determine how to interpret
{   the scl parameter list.  The first level of the attribute definition maps
{   to the parameter level of the command.  The second level of the attribute
{   definition maps to the value set level of a parameter.  The third level of
{   the attribute definition maps to the value element level.  Though the
{   attribute types allow for more levels, since SCL does not support any
{   further nesting, they cannot be used.
{
{ NOTES:
{   See JMM$ADMINISTER_DISPLAY for the routines to display attributes.

  PROCEDURE get_item
    (    data_value: ^clt$data_value;
         attribute_definition: jmt$profile_declaration;
         parameter_name: ost$name;
     VAR attribute: jmt$object_attribute;
     VAR status: ost$status);

?? NEWTITLE := 'wrong_kind_of_value', EJECT ??

    PROCEDURE wrong_kind_of_value;

      VAR
        attribute_name: ost$name,
        kind: string (10);

      CASE attribute_definition.kind OF
      = jmc$number =
        kind := 'INTEGER';
      = jmc$dispatching_priority =
        kind := 'P1 to P10';
      = jmc$name =
        kind := 'NAME';
      = jmc$object =
        kind := jmv$object_definition [attribute_definition.object_kind].
              declaration.name;
      = jmc$file =
        kind := 'FILE';
      = jmc$boolean =
        kind := 'BOOLEAN';
      ELSE
        kind := 'KEYWORD';
      CASEND;

      attribute_name := attribute_definition.name;
      IF parameter_name = attribute_name THEN
        osp$set_status_abnormal (jmc$job_management_id,
              jme$wrong_kind_of_value, kind, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              attribute_name, status);
      ELSE
        osp$set_status_abnormal (jmc$job_management_id,
              jme$wrong_kind_of_subvalue, kind, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              attribute_name, status);
        osp$append_status_parameter (osc$status_parameter_delimiter,
              parameter_name, status);
      IFEND;
      EXIT get_item;
    PROCEND wrong_kind_of_value;
?? NEWTITLE := 'check_value_in_range', EJECT ??

    PROCEDURE check_value_in_range;

      IF (attribute.number > attribute_definition.maximum) OR
            (attribute.number < attribute_definition.minimum) THEN
        IF parameter_name = attribute_definition.name THEN
          osp$set_status_abnormal (jmc$job_management_id,
                jme$value_out_of_range, attribute_definition.name, status);
        ELSE
          osp$set_status_abnormal (jmc$job_management_id,
                jme$subvalue_out_of_range, parameter_name, status);
          osp$append_status_parameter (osc$status_parameter_delimiter,
                attribute_definition.name, status);
        IFEND;
        EXIT get_item;
      IFEND;
    PROCEND check_value_in_range;

?? OLDTITLE, EJECT ??

    VAR
      count: ost$non_negative_integers,
      empty: boolean,
      i: jmt$object_attribute_index,
      priority_index: ost$positive_integers,
      the_value: ^clt$data_value;

    status.normal := TRUE;
    attribute.kind := jmc$empty;

    IF data_value = NIL THEN
      RETURN;
    IFEND;

    CASE data_value^.kind OF
    = clc$list =
      IF (attribute_definition.kind <> jmc$editable_list) AND
            (attribute_definition.kind <> jmc$list) THEN
        wrong_kind_of_value;
      IFEND;

{ Count the values in the list.

      count := 0;
      the_value := data_value;
      WHILE the_value <> NIL DO
        count := count + 1;
        the_value := the_value^.link;
      WHILEND;

{ Build the attribute list and call get_item to get each attribute in the list.

      attribute.kind := attribute_definition.kind;
      NEXT attribute.attribute_list: [1 .. count] IN jmv$working_storage;
      IF attribute.attribute_list = NIL THEN
        jmp$internal_error (20);
      IFEND;
      empty := TRUE;
      the_value := data_value;
      FOR i := 1 TO count DO
        attribute.attribute_list^ [i].kind := jmc$empty;
        get_item (the_value^.element_value,
              attribute_definition.declarations^ [1]^, parameter_name,
              attribute.attribute_list^ [i], status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        the_value := the_value^.link;
        empty := empty AND (attribute.attribute_list^ [i].kind = jmc$empty);
      FOREND;

{ If each attribute in the list is empty then change the list to empty.

      IF empty THEN
        attribute.kind := jmc$empty;
      IFEND;

    = clc$record =
      IF attribute_definition.kind <> jmc$type THEN
        wrong_kind_of_value;
      IFEND;

{ Count the values in the list.

      count := attribute_definition.count;

{ Build the attribute list and call get_item to get each attribute in the type.

      attribute.kind := attribute_definition.kind;
      NEXT attribute.attribute_list: [1 .. count] IN jmv$working_storage;
      IF attribute.attribute_list = NIL THEN
        jmp$internal_error (20);
      IFEND;
      empty := TRUE;
      FOR i := 1 TO count DO
        attribute.attribute_list^ [i].kind := jmc$empty;
        get_item (data_value^.field_values^ [i].value,
              attribute_definition.declarations^ [i]^, parameter_name,
              attribute.attribute_list^ [i], status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
        empty := empty AND (attribute.attribute_list^ [i].kind = jmc$empty);
      FOREND;

{ If each attribute in the list is empty then change the list to empty.

      IF empty THEN
        attribute.kind := jmc$empty;
      IFEND;

    = clc$range =
      IF attribute_definition.kind <> jmc$range THEN
        wrong_kind_of_value;
      IFEND;

{ Process values like a..b.

      attribute.kind := attribute_definition.kind;
      NEXT attribute.attribute_list: [1 .. 2] IN jmv$working_storage;
      IF attribute.attribute_list = NIL THEN
        jmp$internal_error (21);
      IFEND;
      attribute.attribute_list^ [1].kind := jmc$empty;
      attribute.attribute_list^ [2].kind := jmc$empty;
      get_item (data_value^.low_value, attribute_definition.declarations^ [1]^,
            parameter_name, attribute.attribute_list^ [1], status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

{ Get the second item only if it really exists.

      IF data_value^.low_value <> data_value^.high_value THEN
        get_item (data_value^.high_value, attribute_definition.
              declarations^ [1]^, parameter_name, attribute.
              attribute_list^ [2], status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;

{ If no values were given then make the attribute empty.

      IF (attribute.attribute_list^ [1].kind = jmc$empty) AND
            (attribute.attribute_list^ [2].kind = jmc$empty) THEN
        attribute.kind := jmc$empty;
      IFEND;

{ Verify that the scl value is consistant with the attribute being processed.

    = clc$unspecified =
      attribute.kind := jmc$empty;

    = clc$keyword =

      IF data_value^.keyword_value = 'DEFAULT' THEN
        attribute.kind := jmc$default;

      ELSEIF data_value^.keyword_value = 'UNLIMITED' THEN
        attribute.kind := jmc$unlimited;

      ELSEIF data_value^.keyword_value = 'UNSPECIFIED' THEN
        attribute.kind := jmc$unspecified;

      ELSEIF data_value^.keyword_value = 'SYSTEM_DEFAULT' THEN
        attribute.kind := jmc$system_default;

      ELSEIF data_value^.keyword_value = 'ALL' THEN
        attribute.kind := jmc$all;

      ELSEIF data_value^.keyword_value = 'NONE' THEN
        attribute.kind := jmc$none;

      ELSEIF attribute_definition.kind = jmc$name THEN
        attribute.kind := jmc$name;
        NEXT attribute.name IN jmv$working_storage;
        IF attribute.name = NIL THEN
          jmp$internal_error (23);
        IFEND;
        attribute.name^ := data_value^.keyword_value;

      ELSEIF attribute_definition.kind = jmc$dispatching_priority THEN
        attribute.kind := jmc$empty;

      /get_dispatching_priority_index/
        FOR priority_index := LOWERBOUND (jmv$dispatching_priority_names)
              TO UPPERBOUND (jmv$dispatching_priority_names) DO
          IF jmv$dispatching_priority_names [priority_index] =
                data_value^.name_value THEN
            attribute.kind := jmc$dispatching_priority;
            attribute.number := priority_index;
            EXIT /get_dispatching_priority_index/;
          IFEND;
        FOREND /get_dispatching_priority_index/;

        IF attribute.kind = jmc$empty THEN
          wrong_kind_of_value;
        IFEND;
        check_value_in_range;

      ELSE
        wrong_kind_of_value;

      IFEND;

    = clc$name =
      CASE attribute_definition.kind OF

      = jmc$name =
        attribute.kind := jmc$name;
        NEXT attribute.name IN jmv$working_storage;
        IF attribute.name = NIL THEN
          jmp$internal_error (23);
        IFEND;
        attribute.name^ := data_value^.name_value;

      = jmc$object =
        get_object (data_value^, attribute_definition, attribute, status);

      = jmc$boolean =
        attribute.kind := jmc$empty;

        IF (data_value^.name_value = 'TRUE') OR
              (data_value^.name_value = 'YES') OR (data_value^.name_value =
              'ON') THEN
          attribute.kind := jmc$boolean;
          attribute.bool := TRUE;
        ELSEIF (data_value^.name_value = 'FALSE') OR (data_value^.name_value =
              'NO') OR (data_value^.name_value = 'OFF') THEN
          attribute.kind := jmc$boolean;
          attribute.bool := FALSE;
        ELSE
          wrong_kind_of_value;
        IFEND;

      ELSE
        wrong_kind_of_value;
      CASEND;

    = clc$file =
      IF attribute_definition.kind <> jmc$file THEN
        wrong_kind_of_value;
      IFEND;
      attribute.kind := jmc$file;
      NEXT attribute.file: [STRLENGTH (data_value^.file_value^)] IN
            jmv$working_storage;
      IF attribute.file = NIL THEN
        jmp$internal_error (22);
      IFEND;
      attribute.file^ := data_value^.file_value^;

    = clc$integer =
      IF (attribute_definition.kind <> jmc$number) AND
            (attribute_definition.kind <> jmc$dispatching_priority) THEN
        wrong_kind_of_value;
      IFEND;
      attribute.kind := attribute_definition.kind;
      attribute.number := data_value^.integer_value.value;
      check_value_in_range;

    = clc$boolean =
      IF attribute_definition.kind <> jmc$boolean THEN
        wrong_kind_of_value;
      IFEND;
      attribute.kind := jmc$boolean;
      attribute.bool := data_value^.boolean_value.value;

    ELSE
      wrong_kind_of_value;
    CASEND;
  PROCEND get_item;
?? TITLE := 'get_object', EJECT ??

{ PURPOSE:
{   convert the scl parameter into an object reference.
{
{ DESIGN:
{   Search for an object of the appropriate type with the specified
{   name.  If it is found, build an object reference to it.

  PROCEDURE get_object
    (    object_name: clt$data_value;
         attribute_definition: jmt$profile_declaration;
     VAR attribute: jmt$object_attribute;
     VAR status: ost$status);

    VAR
      ignore: jmt$profile_object_reference;

    status.normal := TRUE;
    attribute.kind := jmc$object;
    jmp$get_object (object_name.name_value, attribute_definition.object_kind,
          attribute.object_p, ignore, status);
    IF NOT status.normal THEN
      attribute.kind := jmc$empty;
    IFEND;

  PROCEND get_object;
?? TITLE := '[XDCL] jmp$copy_attributes', EJECT ??

{ PURPOSE:
{   This routine copies an attribute structure.
{
{ DESIGN:
{   This routine makes a copy of the current level of the attribute structure
{   and calls itself recursively to copy lower levels.
{
{ NOTES:
{   When object references are copied, the referenced object's reference
{   counts are incremented.  New allocations are made for file and
{   name references.

  PROCEDURE [XDCL] jmp$copy_attributes
    (    old_attributes: jmt$object_attribute;
     VAR new_attributes: jmt$object_attribute);

    VAR
      i: jmt$object_attribute_index;

    new_attributes := old_attributes;
    CASE old_attributes.kind OF
    = jmc$list, jmc$type, jmc$range, jmc$editable_list =
      ALLOCATE new_attributes.attribute_list:
            [1 .. UPPERBOUND (old_attributes.attribute_list^)] IN
            jmv$object_heap^;
      IF new_attributes.attribute_list = NIL THEN
        jmp$internal_error (25);
      IFEND;
      FOR i := 1 TO UPPERBOUND (old_attributes.attribute_list^) DO
        jmp$copy_attributes (old_attributes.attribute_list^ [i],
              new_attributes.attribute_list^ [i]);
      FOREND;
    = jmc$object =
      new_attributes.object_p^.references :=
            new_attributes.object_p^.references + 1;
    = jmc$file =
      ALLOCATE new_attributes.file: [STRLENGTH (old_attributes.file^)] IN
            jmv$object_heap^;
      IF new_attributes.file = NIL THEN
        jmp$internal_error (26);
      IFEND;
      new_attributes.file^ := old_attributes.file^;
    = jmc$name =
      ALLOCATE new_attributes.name IN jmv$object_heap^;
      IF new_attributes.name = NIL THEN
        jmp$internal_error (27);
      IFEND;
      new_attributes.name^ := old_attributes.name^;
    ELSE

{ Do nothing.

    CASEND;

  PROCEND jmp$copy_attributes;
?? TITLE := '[XDCL] jmp$delete_attributes', EJECT ??

{ PURPOSE:
{   This routine deletes an attribute structure.
{
{ DESIGN:
{   This routine first deletes the lower levels of the attribute structure
{   by calling itself recursively and then deletes the current level.
{
{ NOTES:
{   When object references are deleted, the referenced object's reference
{   counts are decremented.  File and name structures are freed.

  PROCEDURE [XDCL] jmp$delete_attributes
    (VAR object_attributes: jmt$object_attribute);

    VAR
      i: jmt$object_attribute_index;

    CASE object_attributes.kind OF
    = jmc$list, jmc$type, jmc$range, jmc$editable_list =
      FOR i := 1 TO UPPERBOUND (object_attributes.attribute_list^) DO
        jmp$delete_attributes (object_attributes.attribute_list^ [i]);
      FOREND;
      FREE object_attributes.attribute_list IN jmv$object_heap^;
    = jmc$object =
      object_attributes.object_p^.references :=
            object_attributes.object_p^.references - 1;
      object_attributes.object_p := NIL;
    = jmc$file =
      FREE object_attributes.file IN jmv$object_heap^;
    = jmc$name =
      FREE object_attributes.name IN jmv$object_heap^;
    ELSE
    CASEND;
    object_attributes.kind := jmc$empty;

  PROCEND jmp$delete_attributes;
?? TITLE := '[XDCL, #GATE] jmp$get_attributes', EJECT ??

{ PURPOSE:
{   This interface gets the attributes for an object from an SCL command
{   list of a command.
{
{ DESIGN:
{   The routine locates the definition of the attributes and calls a lower
{   level routine to actually build the attribute list.
{
{ NOTES:
{   JMV$WORKING_STORAGE is reset since this marks the beginning of a command
{   and it may be used by get_item.

  PROCEDURE [XDCL, #GATE] jmp$get_attributes
    (    the_kind: jmt$profile_object_kinds;
         parameter_description_table: ^clt$parameter_description_table;
         parameter_value_table: ^clt$parameter_value_table;
     VAR the_attributes: jmt$object_attribute;
     VAR status: ost$status);

    VAR
      attribute: jmt$object_attribute,
      attribute_definition: jmt$profile_declaration,
      empty: boolean,
      i: jmt$object_attribute_index,
      parameter_name: ost$name,
      parameter_number: clt$parameter_number;

    status.normal := TRUE;
    RESET jmv$working_storage;
    the_attributes.kind := jmc$empty;

    attribute_definition := jmv$object_definition [the_kind].declaration;
    attribute.kind := attribute_definition.kind;
    NEXT attribute.attribute_list: [1 .. attribute_definition.count] IN
          jmv$working_storage;
    IF attribute.attribute_list = NIL THEN
      jmp$internal_error (20);
    IFEND;

    empty := TRUE;
    FOR i := 1 TO attribute_definition.count DO
      attribute.attribute_list^ [i].kind := jmc$empty;
      #TRANSLATE (osv$lower_to_upper, attribute_definition.declarations^ [i]^.
            name, parameter_name);
      clp$get_parameter_number (parameter_description_table, parameter_name,
            parameter_number, status);
      IF status.normal THEN
        get_item (parameter_value_table^ [parameter_number].value,
              attribute_definition.declarations^ [i]^,
              attribute_definition.declarations^ [i]^.name,
              attribute.attribute_list^ [i], status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;
      IFEND;
      status.normal := TRUE;
      empty := empty AND (attribute.attribute_list^ [i].kind = jmc$empty);
    FOREND;

    IF NOT empty THEN
      the_attributes := attribute;
    IFEND;

  PROCEND jmp$get_attributes;
?? TITLE := '[XDCL, #GATE] jmp$get_attributes_for_display', EJECT ??

{ PURPOSE:
{   This interface builds an attribute list that is displayable from the
{   attribute list of the specified object.
{
{   The displayable attribute list includes
{   o the attributes given by in the object's attribute list;
{   o the attributes from the default attribute list for this object kind
{     for those attributes not specified in the object's attribute list.
{
{ DESIGN:
{   The routine scans the attribute list building a copy which uses the
{   information from the original attribute list when provided and
{   information from the default attribute list when not provided.
{
{   If a routine has been provided to do additional processing of the
{   attributes, it is called.

  PROCEDURE [XDCL, #GATE] jmp$get_attributes_for_display
    (    profile: jmt$profile_data;
         the_object: jmt$profile_object;
     VAR displayable_attributes: jmt$object_attribute;
     VAR status: ost$status);

?? NEWTITLE := 'form_merged_list', EJECT ??

{ PURPOSE:
{   This routine edits the default list with the editing directions in
{   the attribute.  This editing list is a list of type where the first
{   element in the type is a range.  This range specifies the range of
{   values for which the remaining elements of the type apply.
{
{ DESIGN:
{   The editing list is applied to the default list though, rather than
{   replacing sections of the default list with the editing list, they
{   are merged to satisfy defaults.  Adjoining ranges which result in the
{   same results are combined into a larger range.

    PROCEDURE form_merged_list
      (    original: jmt$object_attribute;
           default: jmt$object_attribute;
       VAR result: jmt$object_attribute);

      TYPE
        item = record
          upper: integer,
          lower: integer,
          attribute: jmt$object_attribute,
          next_item: ^item,
        recend;

      VAR
        an_item: ^item,
        attribute_a: jmt$object_attribute,
        attribute_b: jmt$object_attribute,
        i: integer,
        items: integer,
        matches: boolean,
        new_item: ^item,
        pair: ^jmt$object_attribute_list,
        previous_item: ^item,
        result_list: ^jmt$object_attribute_list,
        top_item: ^item;

{ setup

      top_item := NIL;
      items := 0;

{ unpack default attribute list

      FOR i := UPPERBOUND (default.attribute_list^) DOWNTO 1 DO
        PUSH new_item;
        merge_with_defaults (default.attribute_list^ [i],
              default.attribute_list^ [i], new_item^.attribute);
        pair := new_item^.attribute.attribute_list^ [1].attribute_list;
        new_item^.lower := pair^ [1].number;
        new_item^.upper := new_item^.lower;
        IF pair^ [2].kind <> jmc$empty THEN
          new_item^.upper := pair^ [2].number;
        IFEND;
        new_item^.next_item := top_item;
        top_item := new_item;
        items := items + 1;
      FOREND;

{ unpack editing attribute list

      an_item := top_item;
      previous_item := NIL;
      FOR i := 1 TO UPPERBOUND (original.attribute_list^) DO
        PUSH new_item;
        new_item^.attribute := original.attribute_list^ [i];
        pair := new_item^.attribute.attribute_list^ [1].attribute_list;
        new_item^.lower := pair^ [1].number;
        new_item^.upper := new_item^.lower;
        IF pair^ [2].kind <> jmc$empty THEN
          new_item^.upper := pair^ [2].number;
        IFEND;
        WHILE an_item^.upper < new_item^.lower DO
          previous_item := an_item;
          an_item := an_item^.next_item;
        WHILEND;
        IF an_item^.lower < new_item^.lower THEN
          previous_item := an_item;
          PUSH an_item;
          an_item^ := previous_item^;
          previous_item^.next_item := an_item;
          previous_item^.upper := new_item^.lower - 1;
          an_item^.lower := new_item^.lower;
          merge_with_defaults (previous_item^.attribute,
                previous_item^.attribute, an_item^.attribute);
          items := items + 1;
        IFEND;
        WHILE (an_item <> NIL) AND (an_item^.upper <= new_item^.upper) DO
          merge_with_defaults (new_item^.attribute, an_item^.attribute,
                an_item^.attribute);
          previous_item := an_item;
          an_item := an_item^.next_item;
        WHILEND;
        IF (an_item <> NIL) AND (an_item^.lower <= new_item^.upper) THEN
          an_item^.lower := new_item^.upper + 1;
          new_item^.next_item := an_item;
          merge_with_defaults (new_item^.attribute, an_item^.attribute,
                new_item^.attribute);
          IF previous_item = NIL THEN
            top_item := new_item;
          ELSE
            previous_item^.next_item := new_item;
          IFEND;
          previous_item := new_item;
          items := items + 1;
        IFEND;
      FOREND;

{ Remove duplicate items from list

      previous_item := top_item;
      an_item := previous_item^.next_item;

    /remove_duplicates/
      WHILE an_item <> NIL DO
        FOR i := 2 TO UPPERBOUND (previous_item^.attribute.attribute_list^) DO
          attribute_a := previous_item^.attribute.attribute_list^ [i];
          attribute_b := an_item^.attribute.attribute_list^ [i];
          CASE attribute_a.kind OF
          = jmc$number, jmc$dispatching_priority =
            matches := attribute_a.number = attribute_b.number;
          = jmc$boolean =
            matches := attribute_a.bool = attribute_b.bool;
          = jmc$file =
            matches := attribute_a.file^ = attribute_b.file^;
          = jmc$name =
            matches := attribute_a.name^ = attribute_b.name^;
          = jmc$object =
            matches := attribute_a.object_p = attribute_b.object_p;
          ELSE
            matches := FALSE
          CASEND;
          IF NOT matches THEN
            previous_item := an_item;
            an_item := an_item^.next_item;
            CYCLE /remove_duplicates/;
          IFEND;
        FOREND;
        previous_item^.next_item := an_item^.next_item;
        previous_item^.upper := an_item^.upper;
        items := items - 1;
        an_item := an_item^.next_item;
      WHILEND /remove_duplicates/;

{ Build result

      result.kind := jmc$editable_list;
      NEXT result.attribute_list: [1 .. items] IN jmv$working_storage;
      FOR i := 1 TO items DO
        result.attribute_list^ [i] := top_item^.attribute;
        pair := top_item^.attribute.attribute_list^ [1].attribute_list;
        pair^ [1].number := top_item^.lower;
        IF top_item^.lower = top_item^.upper THEN
          pair^ [2].kind := jmc$empty;
        ELSE
          pair^ [2].kind := pair^ [1].kind;
          pair^ [2].number := top_item^.upper;
        IFEND;
        top_item := top_item^.next_item;
      FOREND;
    PROCEND form_merged_list;
?? OLDTITLE ??
?? NEWTITLE := 'merge_with_defaults', EJECT ??

    PROCEDURE merge_with_defaults
      (    original: jmt$object_attribute;
           default: jmt$object_attribute;
       VAR result: jmt$object_attribute);

      VAR
        smaller_array_size: jmt$object_attribute_index,
        desired_array_size: jmt$object_attribute_index,
        i: jmt$object_attribute_index;

      result := original;
      CASE original.kind OF
      = jmc$empty, jmc$default =
        IF original.kind <> default.kind THEN
          merge_with_defaults (default, default, result);
        IFEND;
      = jmc$editable_list =
        form_merged_list (original, default, result);
      = jmc$list, jmc$type =
        desired_array_size := UPPERBOUND (original.attribute_list^);
        NEXT result.attribute_list: [1 .. desired_array_size] IN
              jmv$working_storage;
        IF result.attribute_list = NIL THEN
          jmp$internal_error (28);
        IFEND;
        smaller_array_size := UPPERBOUND (default.attribute_list^);
        IF smaller_array_size > desired_array_size THEN
          smaller_array_size := desired_array_size;
        IFEND;
        FOR i := 1 TO smaller_array_size DO
          merge_with_defaults (original.attribute_list^ [i],
                default.attribute_list^ [i], result.attribute_list^ [i]);
        FOREND;
        FOR i := smaller_array_size + 1 TO desired_array_size DO
          merge_with_defaults (original.attribute_list^ [i],
                default.attribute_list^ [1], result.attribute_list^ [i]);
        FOREND;
      = jmc$range =
        NEXT result.attribute_list: [1 .. 2] IN jmv$working_storage;
        IF result.attribute_list = NIL THEN
          jmp$internal_error (28);
        IFEND;
        merge_with_defaults (original.attribute_list^ [1],
              default.attribute_list^ [1], result.attribute_list^ [1]);
        result.attribute_list^ [2] := original.attribute_list^ [2];
      ELSE
      CASEND;
    PROCEND merge_with_defaults;
?? OLDTITLE, EJECT ??

    VAR
      default_attributes: jmt$object_attribute;

    status.normal := TRUE;

    jmv$object_definition [the_object.kind].
          fetch_attribute_defaults^ (profile, the_object, default_attributes);
    merge_with_defaults (the_object.attributes, default_attributes,
          displayable_attributes);

    IF jmv$modify_display_attributes <> NIL THEN
      jmv$modify_display_attributes^ (the_object, displayable_attributes,
            status);
    IFEND;

  PROCEND jmp$get_attributes_for_display;
?? TITLE := '[XDCL, #GATE] jmp$set_default_attributes', EJECT ??

{ PURPOSE:
{   This interface sets the default values of an object when first created.
{
{ DESIGN:
{   The routine checks for the 'DEFAULT_VALUES' parameter and if specified
{   it searches for an object with the specified name.

  PROCEDURE [XDCL, #GATE] jmp$set_default_attributes
    (    the_kind: jmt$profile_object_kinds;
         default_value: clt$parameter_value;
     VAR the_attributes: jmt$object_attribute;
     VAR status: ost$status);

    VAR
      ignore: jmt$profile_object_reference,
      the_object: jmt$profile_object_reference;

    status.normal := TRUE;
    the_attributes.kind := jmc$empty;

    IF NOT default_value.specified THEN
      RETURN;
    IFEND;

    jmp$get_object (default_value.value^.name_value, the_kind, the_object,
          ignore, status);
    IF status.normal THEN
      the_attributes := the_object^.attributes;
    IFEND;

  PROCEND jmp$set_default_attributes;
MODEND jmm$administer_attributes;

