The Developer Connection…ice Driver Kit for OS/2 3/DEV3-D1.ISO/devtools/dataflex/datalist.pkg

Text File | 1993-08-10 | 67.6 KB | 2,117 lines

//************************************************************************
//
// Copyright 1987-1992 Data Access Corporation, Miami FL, USA
// All Rights reserved
// DataFlex is a registered trademark of Data Access Corporation.
//
//
//     $Source: /u3/source.30/product/pkg/RCS/datalist.pkg,v $
//     $Revision: 1.1 $
//     $State: Exp $
//     $Author: james $
//     $Date: 1992/09/08 14:43:03 $
//     $Locker:  $
//
//     $Log: datalist.pkg,v $
//Revision 1.1  1992/09/08  14:43:03  james
//Initial revision
//
//Revision 1.27  92/07/02  18:17:23  lee
//added guard in beginning/end_of_data for no items to prevent invalid item
//refrerence.
//
//Revision 1.26  92/07/01  04:30:08  lee
//if virtual_scroll fails, perform find_record to find and display current
//record. (was just moving to row w/o find or refresh to deos.)
//
//Revision 1.25  92/06/28  16:11:42  lee
//fixed deletion bottom row so you can navigate to the records after the deleted
//record.
//
//Revision 1.24  92/06/27  10:13:35  lee
//fixed initialize list to deal with pad and top row as blank.
//
//Revision 1.23  92/06/27  09:29:46  lee
//changed up_row and scroll (upward) to goto end of data if it was on blank
//row and still is after virtual scroll. This assumes this occurred because
//you were on the top row with only a blank record showing.
//end_of_data now correctly moves to last row in partially filled lists.
//blank and padding row are added to list when displaying as empty (activatin
//and clear_data).
//
//Revision 1.22  92/06/22  13:46:27  lee
//changed default setting of auto_regenerate_state to true (OOPS!).
//
//Revision 1.21  92/06/17  23:55:00  lee
//fixed various bugs in table: only validates on same row and during save
//childwrapping moves to last enterable item when moving backward
//request_delete disables validation during removal of row.
//beginning/end_of panel moves to top/biottom row, same column
//
//Revision 1.20  92/06/10  06:09:45  lee
//various fixes for bugs introduced during "overhaul"
//
//Revision 1.19  92/06/06  11:55:44  lee
//put guard in fill_page to not search for more records if there is only one row.
//(it was previously going to one after/before the first/last item on beg/end of
//data).
//
//Revision 1.18  92/06/06  08:12:46  lee
//added add-mode stuff (lots of it!). moved some things from table into
//data_list for row_changing.
//
//Revision 1.17  92/05/14  16:11:25  SWM
//Updated Copyright slug.
//
//Revision 1.16  92/04/28  14:31:12  lee
//Initialize_list now passes TRUE to beginning of data to prevent save on
//initialization.
//
//Revision 1.15  92/04/03  16:37:16  lee
//fixed syntax usage for item_matching forward to be correct. batch data_lists
//will now perform item_matching (and incremental-search) properly.
//
//Revision 1.14  92/04/01  11:13:53  lee
//fixed references to bind_list_main_file/index to bind_datalist_...
//
//Revision 1.13  92/04/01  00:30:04  lee
//removed navstart and liststart (unused), renamed bind_main_file and bind_index
//in datalist to bind_list_main_file and bind_list_index to avoid conflict with
//commands used by data_set, moved bind_static from sellist to datalist as it
//only sets properties defined in datalist (not sellist).
//
//Revision 1.12  92/03/29  18:44:37  lee
//added MSG_END_CONSTRUCT_OBJECT, moved ENDMAC macro stuff into END_CONSTRUCT-
//OBJECT procedures (in .pkgs). moved Flag_ITems to list.pkg after generalizing
//it based on PROTOTYPE_OBJECT instead of Whether or not it is a table-oriented
//object. Moved define_access_keys mechanism completely into actionbr.pkg.
//fixed two typos: import_class_protocol used !# instead of !3, and register-
//procedure used !1 instead of !2.
//
//Revision 1.11  92/03/27  16:21:05  steve-l
//DISPLAY_ROW altered to set line_Display_state and send refresh instead of
//forwarding refresh directly
//
//Revision 1.10  92/03/18  12:40:09  steve-l
//altered all calls to vfind to perform a relate if successful
//
//Revision 1.9  92/03/18  02:18:16  steve-l
//added SEND UPDATE_DEPENDENT_ITEMS to end of Beginning_of_data and End_of_data
//and added function PROTOTYPE_OBJECT to return row-prototype object-id.
//
//Revision 1.8  92/03/10  17:06:47  steve-l
//REFRESH altered to support "remote" delete (e.g. delete from zoom)
//
//Revision 1.7  92/03/09  19:00:53  james
//Added #CHKSUB directive to insure source
//only compiled with correct revision of
//compiler.
//
//Revision 1.6  92/02/28  10:19:45  steve-l
//VIRTUAL_SCROLL altered to correct slight batch-mode scrolling problems, i.e.
//bad distance parameter and bogus return values corrected
//
//Revision 1.5  92/01/13  14:47:59  steve-l
//Added MSG_REFRESH procedure and altered display_row procedure
//
//Revision 1.4  92/01/12  15:27:29  steve-l
//*** empty log message ***
//
//Revision 1.3  91/11/19  09:37:27  steve-l
//Checking in for Steve-L
//
//Revision 1.2  91/11/08  09:14:10  steve-l
//the function VIRTUAL_SCROLL was altered to re-read the correct record
//[DAR 2000]; CLEAR and CLEAR_ALL altered to respect cleared bit-array
//[DAR 2193]
//
//************************************************************************/

//************************************************************************
//     File Name: DataList.Pkg
// Creation Date: January 1, 1991
// Modified Date: March 17, 1992
//     Author(s): Steven A. Lowe
//
// This module contains the Data_List class definition.
//************************************************************************/

#CHKSUB 1 1 // Verify the UI subsystem.

use protoent   //row-prototype class
use WideList   //multi-column list class
use Server     //data_set connection class

//
// constants for REFRESH message parameter values
//
#IFSUB 'MODE_CLEAR'
#ELSE
    #REPLACE MODE_CLEAR             1  //notification from origin of clear
    #REPLACE MODE_FIND_OR_CLEAR_SET 2  //notification from find or clear
    #REPLACE MODE_CLEAR_ALL         3  //notification from clear-all
    #REPLACE MODE_DELETE            4  //notification after successful delete
    #REPLACE MODE_SAVE              5  //notification after successful save
#ENDIF


Register_Function Current_Record returns integer

class Data_List is a Wide_List STARTMAC dlStart ENDMAC dlEnd

  //
  // forward-reference of row-prototype, Element
  //
  Register_Object Element

  //
  // forward-reference of data-set find functions
  //
  procedure construct_object integer img
    forward send construct_object img
    on_key kBegin_of_Panel SEND Goto_Top_Row    PRIVATE
    on_key kEnd_of_Panel   SEND Goto_Bottom_Row PRIVATE
    Property integer Advancing_State        PUBLIC   0
    Property integer Auto_Regenerate_State  PUBLIC   1
    Property integer Batch_State            PUBLIC   0
    Property integer Changing_State         PUBLIC   0
    Property integer Just_Reordered_State   PUBLIC   0
    Property integer Main_File              PRIVATE  0
    Property integer No_Create_State        PUBLIC   1
    Property integer Ordering               PUBLIC  -1
    Property integer Line_Display_State     PUBLIC   0
    Property integer Reordering_State       PUBLIC   0
    Property integer Static_State           PUBLIC   0
    Property integer Unsorted_State         PUBLIC   0
    Property integer Was_New_Row_State      PUBLIC   0
    object Records is an array
    end_object
    send define_server  //invoke Server support constructor
    set Auto_Fill_State to TRUE  //default auto-fill to true
  end_procedure

  IMPORT_CLASS_PROTOCOL Server_Mixin

  //
  // dummy functions for non-input classes (like selection list)
  //
  function auto_clear_deo_state returns integer
    function_return 0
  end_function
  function auto_save_state returns integer
    function_return 0
  end_function

  //
  // created to empty list item data (aug'd by SelList)
  //
  procedure empty_list
    send delete_data
  end_procedure

  procedure activating returns integer
    local integer retval srvr# ordr#
    get server to srvr#
    get ordering to ordr#
    if ((srvr# <> 0) AND (main_file(current_object) = main_file(srvr#)) AND ;
        (ordr# >= 0)) set suggested_ordering of srvr# to ordr#
    forward get msg_activating to retval
    if ((retval = 0) AND (static_state(current_object) = 0)) begin
      send empty_list    //delete_data

      send add_row
      send entry_display 0 0    //redisplay active (parent) files
      send insert_row 0 // add top padding row
      set top_item to (item_limit(current_object))
      set changed_state to false
      send Enter_Add_Mode FALSE
    end
    procedure_return retval
  end_procedure

  procedure Beginning_of_Panel
    set search_mode to (search_mode(current_object))  //reset incr srch index
    forward send Beginning_of_Panel
  end_procedure

  procedure End_of_Panel
    set search_mode to (search_mode(current_object))  //reset incr srch index
    forward send End_of_Panel
  end_procedure

  procedure down_row
    set search_mode to (search_mode(current_object))  //reset incr srch index
    forward send down_Row
  end_procedure

  procedure up_row
    local integer origRec oldErr
    set search_mode to (search_mode(current_object))  //reset incr srch index
    get current_record to origRec
    move (err) to oldErr
    indicate err FALSE
    forward send up_Row
    [err] procedure_return
    indicate err as oldErr NE 0
    //
    // if we were on a blank row, and we're still on a blank row, we must
    // be on the top row at the end of the data: force end of data
    //
    if ((origRec = 0) AND (current_record(current_object) = 0)) ;
        send end_of_data
  end_procedure

  procedure set Main_File integer newval
    set Data_List.Main_File to newval
  end_procedure

  function Main_File returns INTEGER
    local integer retval obj#
    get Data_List.Main_File to retval
    if retval le 0 begin
      get Server to obj#
      if obj# ne 0 get Main_File of obj# to retval
    end
    function_Return retval
  end_function

  procedure set record_number integer row# integer newval
    set array_Value of (Records(current_object)) item row# to newval
  end_procedure

  function record_number integer row# returns integer
    local integer retval
    get array_Value of (Records(Current_Object)) item row# to retval
    function_Return retval
  end_function

  function Current_Record returns integer
    local integer retval
    get record_number item (current_row(current_object)) to retval
    function_Return retval
  end_function

  procedure SET Current_Record integer newVal
    set record_number item (current_row(current_object)) to newVal
  end_procedure

  //
  // the following scroll procedure is invoked by RT via scrollbar arrows
  // (w/mouse) or PgUp/PgDn keys
  //
  procedure scroll integer dir integer dist
    local integer retval destItem lim oldDyn oldCol wasNew oldChg oldObjEntEx

    if (Batch_State(current_object)) forward send scroll dir dist
    else begin
      get current_item to destItem
      get item_limit to lim

      //
      // exit current item
      //
      get object_item_entry_exit to oldObjEntEx
      if (oldObjEntEx AND (exec_exit(current_object,destItem) <> 0)) ;
          procedure_return
      set object_item_entry_exit to FALSE

      move (destItem - base_item(current_object)) to oldCol

      move (current_record(current_object) = 0) to wasNew
      if wasNew begin
        get Exit_Add_Mode TRUE FALSE destItem to retval
        //
        // if still on a blank record on scroll up, no more rows on screen,
        // so we must be at the end of data on top row: force end of data
        //
        if ((dir = UPWARD_DIRECTION) AND ;
            (current_record(current_object) = 0)) begin
          send end_of_data
          procedure_return
        end
      end

      get dynamic_update_state to oldDyn
      set dynamic_update_state to FALSE

                  // if trying to move past end of list, just go to last item
      if ((dir = DOWNWARD_DIRECTION) AND ;
          (row_count(current_object) - 1) <= (bottom_row(current_object))) ;
          move (((row_count(current_object) - 1) * lim) + oldCol) to destItem
      else begin  // else attempt to scroll
        get virtual_scroll dir dist to retval

        if retval LT 0 begin // if couldn't scroll whole dist, goto 1st/last
          if dir EQ DOWNWARD_DIRECTION ;
              move (((row_count(current_object) - 2) * lim) + oldCol) ;
              to destItem       // (- 2) to move to row before padding row
          else move (top_item(current_object) + oldCol) to destItem
        end
      end

      if (wasNew AND (current_record(current_object) = 0)) ;
          send Enter_Add_Mode FALSE

      set current_item to destItem

      set dynamic_update_state to oldDyn

      set object_item_entry_exit to oldObjEntEx

      //
      // enter current item
      //
      if (oldObjEntEx AND (exec_entry(current_object,destItem) <> 0)) ;
          procedure_return

      //
      // make sure Server is latched on to new current record
      //
      send find_record (current_record(current_object))
      //
      // reset incremental search index
      //
      set search_mode to (search_mode(current_object))
    end
  end_procedure

  //
  // note displayRow changes baseItem without resetting it
  //
  procedure display_row integer row#
    local integer oldlinedisp oldval lim

    get item_limit to lim

    set base_item to (row# * lim)
    get line_display_State to oldlinedisp
    set line_display_state to true
    get current_item to oldval
    set new_item to (row# * lim)
    send refresh MODE_FIND_OR_CLEAR_SET
    set new_item to oldval
    set line_display_state to oldlinedisp
  end_procedure

  //
  // invoked by append_blank_row and insert_blank_row
  //
  procedure clear_row integer row#
    local integer oldval lim ser#

    get item_limit to lim

    set base_item to (row# * lim)
    get Server to ser#
    if ser# ne 0 send Clear to ser#
    else begin
      get main_file to ser#
      if ser# ne 0 begin
        move ser# to filenumber
        move 0 to fieldindex
        clear Indirect_File
      end
      send clear
    end
    set record_number item row# to 0
  end_procedure

  procedure INSERT_ROW integer row#  //insert row before specified row#
    forward send insert_row (Prototype_Object(current_object)) row#
    send insert_item to (Records(Current_Object)) row# 0 //insert 0 before row#
  end_procedure

  procedure INSERT_NEW_ROW integer row#  //insert & display row before specified row#
    send insert_row row#
    send display_row row#
  end_procedure

  procedure add_row     //add row at end of item list
    forward send add_row (Prototype_Object(current_object))
    set array_value of (Records(Current_Object)) ;
        item (Row_Count(Current_Object) - 1) to 0
  end_procedure

  procedure append_new_row     //add row at end of item list & display
    send add_Row
    send display_row (row_count(Current_Object) - 1)
  end_procedure

  procedure append_blank_row     //add blank row at end of item list
    send add_row
    send clear_row (row_count(Current_Object) - 1)
  end_procedure

  procedure insert_blank_row integer row#
    send insert_row row#
    send clear_row row#
  end_procedure

  procedure Destroy_Top integer numRows
    local integer count
    move 0 to count
    while count lt numRows
      send Delete_Row 0
      increment count
    end
  end_procedure

  procedure Destroy_Bottom integer numRows
    local integer count maxrows
    move 0 to count
    get row_count to maxrows
    while count lt numRows
      decrement maxrows
      send Delete_Row maxrows
      increment count
    until maxrows le 0
  end_procedure

  procedure DELETE_ROW integer row#   //remove given row#
    local integer lim baseItem counter width
    get item_limit to width
    calc (width * row#) to baseItem
    calc (baseItem + width - 1) to lim
    for counter from baseItem to lim
      send delete_item baseItem
    loop
    send delete_item to (Records(Current_Object)) row#
  end_procedure

  //
  // invoked by Scroll, Display, and Row_Changing
  //
  procedure find_record integer rec#
    local integer srvr# oldDisp
    get Server to srvr#
    if srvr# ne 0 begin
      get Line_Display_State to oldDisp
      set Line_Display_State to true  //set flag to prevent regen
      if (Deferred_State(current_object)) send Read_By_RecNum to srvr# ;
          (main_file(current_object)) rec#
      else send Find_by_RecNum to srvr# (main_file(current_object)) rec#
      set Line_Display_State to oldDisp //reset no-regen flag
    end
    else send Read_Record rec#
  end_procedure

  procedure read_record integer rec#
    local integer oldrec
    get main_file to filenumber
    if filenumber ne 0 begin
      move 0 to fieldindex
      move Indirect_File.RECNUM to oldrec
      clear Indirect_File
      move rec# to Indirect_File.recnum
      find eq Indirect_File.RECNUM
      if [not found] clear Indirect_File
      else relate Indirect_File
    end
    else indicate found false
  end_procedure

  //
  // called by VIRTUAL_SCROLL and MSG_FILL_PAGE to trim list to displayable area
  // plus top and bottom 'buffer' rows (should not be used if Batch)
  //
  procedure trim_page integer direction
    local integer count retval oldChg rowCnt

    calc (row_count(current_object) - Displayable_rows(Current_Object)) to count
    //
    // trimming could be by count-1 iff count>1, with over/under rows
    // simply cleared afterward, instead of destroying and recreating items
    //
    if count gt 0 begin
      if direction eq UPWARD_DIRECTION send DESTROY_BOTTOM count
      else send DESTROY_TOP count
    end
    send insert_row 0             //pad by one at top

    get row_count to rowCnt

    //
    // if the last row was not already blank
    //
    if ((record_number(current_object,rowCnt - 1) <> 0) AND ;
        (not(no_create_state(current_object)) OR ;
        ((rowCnt - 1) >= displayable_rows(current_object)))) ;
        send add_row

    //
    // set top_item triggers set current_item; setting changing_state to
    // true kills item_change effects, but still sets current_item
    // however, it does not set base_item
    //
    get changing_State to oldChg
    set changing_State to true
    set top_item to (item_limit(Current_Object))
    set changing_State to oldChg
    //
    // manually set base item for current row
    //
    set base_item to (current_row(current_object) * item_limit(current_object))

    //
    // manually force entry for new current item
    //

    if (select_mode(current_object)) EQ AUTO_SELECT ;
        set select_state item current to TRUE
  end_procedure

  //
  // fix up rows at end of page; delete and add rows as necessary.
  // if page is (can be) full, should be blank padding row off screen
  // if page is partially full, if no_create = false, should be blank row
  //
  procedure finish_page
    local integer count retval oldChg rowCnt svr rec# file# ndx

    get row_count to rowCnt

    calc ((rowCnt - top_row(current_object)) - displayable_rows(current_object)) to count

    //
    // if last row is blank, remove it
    //
    if ((count GE 0) AND (record_number(current_object,rowCnt - 1) = 0)) begin
      send delete_row (rowCnt - 1)
      decrement count
    end

    //
    // if extra padding rows exist, remove them
    //
    if count GT 0 send DESTROY_BOTTOM count
    //
    // else, if page is not full, try to find records to fill out page
    //
    else if count LT 0 begin
      move (0 - count) to count

      get server to svr
      get main_file to file#
      get record_number (row_count(current_object) - 1) to rec#
      if ((svr <> 0) AND (rec# <> 0)) send Read_by_RecNum to svr file# rec#
      else send read_Record rec#

      [not found] procedure_return

      get main_file to file#
      get ordering to ndx

      if svr ne 0 send establish_find_direction to svr (GT) file# ndx

      repeat
        if svr send Locate_Next to svr

        //
        // if this object has no server, use the VFIND command to locate
        // the next record for the given file, search-index, and find-mode
        //
        else begin
          vfind file# ndx (GT)
          [found] move file# to filenumber
          [found] move 0 to fieldindex
          [found] relate Indirect_File.RECNUM
        end

        //
        // if a record was found, display it
        //
        if [found] begin
          send append_new_row
          decrement count
        end
        else move 0 to count

      until count EQ 0

    end
    //
    // if the last row is not already blank, and no_create=false, add blank row
    //
    get row_count to rowCnt
    if ((rowCnt <= 0) OR ((record_number(current_object,rowCnt - 1) <> 0) AND ;
        (not(no_create_state(current_object)) OR ;
        ((rowCnt - 1) >= displayable_rows(current_object))))) ;
        send add_row

  end_procedure

  //
  // this scroll function is used by virtual tables; batch tables use the
  // normal scroll procedure
  //
  function virtual_scroll integer direction integer dist returns integer
    local integer count mode oldDyn srvr# row# retval
    local integer distance rowCount file# rec# ndx

    //
    // if this is a batch list, use the inherited SCROLL procedure & exit
    //
    if (Batch_State(current_object)) begin
      send scroll direction (dist * item_limit(current_object))
      function_return 0
    end

    //
    // this is a virtual list, so see if it has a server or a main-file;
    // if it doesn't, we can't do anything so exit
    //
    get Server to srvr#
    get main_file to file#
    if ((srvr# = 0) AND (file# = 0)) function_return 1

    //
    // if distance argument is zero, a full-page scroll is implied; otherwise,
    // use the given distance value (in rows)
    //
    if dist eq 0 ;
        calc ((display_size(Current_Object) / item_limit(Current_Object)) - 1) ;
        to distance
    else move dist to distance

    //
    // if direction argument is upward, start with the top row and
    // set the mode to LT
    //
    if direction eq upward_direction begin
      get top_Row to row#
      move (LT) to mode
    end

    //
    // else if direction argument is downward, start with the bottom row and
    // set the mode to GT
    //
    else begin
      get bottom_row to row#
      move (GT) to mode
    end

    //
    // get the record number for the starting row and read it into the buffer
    //
    get record_number item row# to rec#

    //
    // if the starting row has a valid record and this list has a server,
    // use the server to read the starting record into the buffer
    //
    if ((srvr# <> 0) AND (rec# > 0)) send Read_by_RecNum to srvr# file# rec#

    //
    // else if the starting row does not have a valid record or it does not
    // have a valid server, use the list's Read_Record procedure to read
    // the starting record into the buffer (or clear the buffer if rec# = 0)
    //
    else send Read_Record rec#

    //
    // if the find failed (by either method), exit - we cannot scroll if we
    // can't find the starting record
    //
    [not found] function_Return 2  //missing record err

    //
    // save the old Dynamic_Update_State value and reset it to FALSE
    //
    get dynamic_update_State to oldDyn
    set dynamic_update_state to false

    //
    // initialize the (row-scan loop) counter
    //
    move 0 to count

    //
    // get the search ordering
    //
    get Ordering to ndx

    //
    // if this object has a server, use Establish_Find_Direction to init
    // for scan (using Locate_Next)
    //
    if srvr# ne 0 send establish_find_direction to srvr# mode file# ndx

    //
    // else if this object has no server, make sure the ordering is not
    // BEST_INDEX (because the non-constrained find commands don't
    // understand it); if the ordering is BEST_INDEX, reset to RECNUM
    //
    else if ndx lt 0 move 0 to ndx

    //
    // we've already got the first record (the starting record), so make
    // sure the FOUND indicator is set to TRUE (in case it changed since
    // the starting record was found)
    //
    indicate found true

    //
    // as long as we have a record and have not 'gone the distance',
    // the following loop continues to scan and display records
    //
    While ((count < distance) AND found)

      //
      // if this object has a server, use Locate_Next to find the next
      // record (using the ordering, file, and mode set by the
      // Establish_Find_Direction message sent previously)
      //
      if srvr# send Locate_Next to srvr#

      //
      // if this object has no server, use the VFIND command to locate
      // the next record for the given file, search-index, and find-mode
      //
      else begin
        vfind file# ndx mode
        [found] move file# to filenumber
        [found] move 0 to fieldindex
        [found] relate Indirect_File.RECNUM
      end

      //
      // if a record was found, display it
      //
      if [found] begin

        //
        // if this is the first record found, remove the blank padding rows
        // from this list's items (at the top and bottom); note that if no
        // records are found by the scanning loop, no 'trimming' of the
        // display-page occurs
        //
        if count eq 0 begin

          //
          // remove top blank padding rows (usually only 1)
          //
          while (top_row(Current_Object)) GT 0
            send delete_row 0
          end

          //
          // find out how many rows remain in the list
          //
          get row_count to rowCount

          //
          // remove bottom blank padding rows (usually only 1)
          //
          while rowCount GT (displayable_rows(Current_Object))
            send delete_row (rowCount - 1)
            get row_count to rowCount
          end
        end

        //
        // if we're scrolling upward, insert a new row at the top of the
        // list for the record we just found. note that this includes
        // displaying the values from the fields in the record buffer to
        // their respective items in the new row
        //
        if direction eq upward_direction send insert_new_row 0

        //
        // else if we're scrolling downward, append a new row at the bottom
        // of the list for the record we just found. note that this includes
        // displaying the values from the fields in the record buffer to
        // their respective items in the new row
        //
        else send append_new_row

        //
        // increment the (row-scan loop) counter
        //
        increment count
      end
    end

    // if we actually found at least one new record, we must re-trim the
    // page to put back the blank padding rows at the top and bottom of
    // the list (these rows are for navigation and cosmetic purposes)
    //
    if count gt 0 send trim_page direction

    //
    // make sure the current record is correct by comparing its RECNUM to
    // current_record (the record number for the current row)
    //
    move 0 to fieldindex
    move file# to filenumber
    move Indirect_File.RECNUM to rec#
    get current_record to ndx

    //
    // if the buffer's RECNUM field does not match current_record, or we
    // couldn't scroll, read the current_record into the buffer, so that the
    // record buffer matches the data on the screen, i.e. so the current row's
    // record is in the buffer
    //
    if ((ndx <> rec#) OR (count = 0)) begin
      clear Indirect_File                 //clear the main file
      move ndx to Indirect_File.RECNUM    //set RECNUM to current_record
      find eq Indirect_File.RECNUM        //find by recnum in the main file
      if [not found] clear Indirect_File  //if find fails, clear buffer
      else relate Indirect_File           //else if find succeeds, relate
    end

    //
    // restore Dynamic_Update_State to its prior value
    //
    set dynamic_update_state to oldDyn

    //
    // return the difference between the number of rows actually scrolled
    // and the requested number of rows to scroll; if we were able to scroll
    // the full requested number of rows, the return value will be 0.  If we
    // were unable to scroll the full requested number of rows, the return
    // value will be negative.  A positive return value indicates an error
    // or some kind that prevented the starting row from being found.
    //
    function_Return (count - distance)

  end_function

  procedure delete_Data
    local integer obj#
    forward send delete_Data
    move (Records(current_object)) to obj#
    if obj# ne 0 begin
      send delete_Data to obj#
      set base_item to 0
    end
  end_procedure

    //
    // if allow new row, last row is not current row, is visible ;
    // or the bottom row is clear and is blank, delete it
    //
  procedure trim_last_row
    local integer rowCnt
    get row_count to rowCnt
    if (not(no_create_state(current_object)) AND ;
        (current_row(current_object) <> (rowCnt - 1))) begin
      if ((rowCnt > 0) AND ((((rowCnt - top_row(current_object)) <= ;
          displayable_rows(current_object)) OR ;
          (record_number(current_object,bottom_row(current_object)) = 0)) AND ;
          (record_number(current_object,rowCnt - 1) = 0))) ;
        send delete_row (rowCnt - 1)
    end
  end_procedure

  procedure insert_clear_row
    local integer oldDynUpdt base oldChg rowCnt

    get Dynamic_Update_State to oldDynUpdt
    set Dynamic_Update_State to false
    get base_item to base  //send insert blank row changed base_item...
    send insert_blank_row (current_row(current_object))
    get Changing_State to oldChg
    set Changing_State to true
    if (current_Row(current_object)) EQ (top_row(current_object)) ;
        set top_item to base
    else set current_item to base
    set item 1 // 1 = direction:forward, finds first enterable item.
    set base_item to base
    send entry_display 0 0    //redisplay active (parent) files
    send trim_last_row
    if (current_row(current_object)) EQ (row_count(current_object) - 1) ;
        send finish_page
    set Changing_State to oldChg
    set Dynamic_Update_State to oldDynUpdt
  end_procedure

  //
  // created for Server support
  //
  procedure clear  //notification of clear-record
    if (not(Line_Display_State(current_object)) AND ;
        Current_Record(Current_Object) <> 0) ;
        send enter_add_mode TRUE

    send entry_clear 1          //clear current row
    send entry_display 0 0      //redisplay parent-files

    set current_record to 0     //curRec := 0
  end_procedure

  procedure clear_data integer all_flag
    local integer oldDynUpdt retval

    if (current_record(current_object) = 0) ;
        get Exit_Add_Mode FALSE FALSE ;
        (current_item(current_object)) to retval

    is_file_included (main_file(current_object)) 0  //check cleared bit-array
    if [found] begin
      if (Line_Display_State(current_object)) send entry_clear_all 1
      else begin
        get Dynamic_Update_State to oldDynUpdt
        set Dynamic_Update_State to false
        send empty_list    //delete_data
        send add_row
        send entry_display 0 0    //redisplay active (parent) files
        send insert_row 0 // insert top padding row
        set top_item to (item_limit(current_object))
        set Dynamic_Update_State to oldDynUpdt
        set changed_state to false
      end
    end
    else if all_flag send entry_clear_all 1
    else send entry_clear 1

    send Enter_Add_Mode FALSE
  end_procedure

  //
  // created for Server support
  //
  procedure clear_all  //notification of clear-set
    send clear_data TRUE
  end_procedure

  //
  // created for Server support
  //
  procedure clear_Set  //notification of derived clear
    send clear_data FALSE
  end_procedure

  //
  //use of lineDisplayState is required because the list sends its Server
  //msgs Clear and Find when it only wants to affect the current row
  //
  procedure display
    if (Line_Display_State(current_object)) send entry_display 0 0
    else begin
      is_file_included (main_file(current_object)) 1  //check done bit-array
      if [found] send Refresh_Page downward_Direction
      else send entry_display 0 0
    end
  end_procedure

  procedure Refresh_Page integer direction
    local integer dynUpdt oldChg retval newitem

    set changed_state to false
    if (active_State(current_object)) begin
      get dynamic_update_state to dynUpdt
      set dynamic_update_state to false
      get Changing_State to oldChg
      set Changing_State to TRUE
      send delete_Data
      send fill_page direction
      //
      // recalc row attributes
      //
      if direction eq downward_direction ;
        move (top_item(current_object)) to newitem
      else begin
        move (top_item(current_object) + display_size(current_object) - 1) ;
            to newitem
        //
        // if partially filled, move to last row on screen
        //
        if (item_count(current_object) - top_item(current_object)) LE ;
            (display_size(current_object)) begin
          move ((row_count(current_object) - 1) * item_limit(current_object)) ;
              to newItem
          //
          // if not on top row, and last row is blank, goto next to last row
          //
          if ((row(current_object,newItem) <> top_row(current_object)) AND ;
              (record_number(current_object,row(current_object,newItem))) = 0) ;
              move (newItem - item_limit(current_object)) to newItem
        end
      end
      set new_item to newitem
      if (select_mode(current_object)) EQ AUTO_SELECT ;
          send select_toggling newitem TRUE
      set base_item to ;
          (current_row(current_object) * item_limit(current_object))
      set Changing_State to oldChg
      set dynamic_update_state to dynUpdt
    end
    else send empty_list  //(delete_data) inactive list, so empty it
  end_procedure

  //
  // this procedure clears the destination row (and enter add-mode)
  //
  //
  // if added to end of table, enter_add_mode, otherwise clear_row,
  // (which also causes enter_add_mode)
  //
  procedure start_new_row integer item#
    local integer oldItem row# oldDyn oldLineDisp
    get current_item to oldItem
    set new_item to item#  //temporarily change current item/row for add-mode
    get row item# to row#
    if row# GE (row_count(current_object) - 1) begin
      get dynamic_update_state to oldDyn
      set dynamic_update_state to FALSE
      get line_display_State to oldLineDisp
      set line_display_state to true
      send clear_row row#
      set line_display_State to oldLineDisp
      send Enter_Add_Mode FALSE
      set dynamic_update_state to oldDyn
    end
    else send clear_row row#
    set new_item to oldItem  //restore original current item/row
  end_procedure

  function enterable_item integer item# returns integer
    local integer oldItem newItem

    get current_item to oldItem
    set new_item to (item# - 1)

    get next_entry_ok to newItem
    if newItem LT 0 move item# to newItem

    set new_item to oldItem

    function_return newItem
  end_function

  //
  // this function is invoked by ITEM_CHANGE when changing rows; it returns
  // the item# that ITEM_CHANGE is to go to, which may or may not be the
  // original destination
  //
  function row_changing integer from# integer to# returns integer
    local integer diff lim toRow fromRow topRow oldbase wasNew
    local integer botRow rec# scrollRet oldDyn

    get row item from# to fromRow
    move (record_number(current_object,fromRow) = 0) to wasNew

    //
    // if the origin row is blank, close the hole
    //
    if (wasNew AND not(batch_State(current_object))) ;
      get Exit_Add_Mode TRUE TRUE to# to to#  //returns adjusted dest item

    //
    // reset wasNew to TRUE if the origin row was blank
    // (before we forwarded to this routine from table)
    //
    move (wasNew OR was_new_row_state(current_object)) to wasNew

    get row item from# to fromRow
    get row item to# to toRow
    get item_limit to lim
    get top_row to topRow
    get bottom_row to botRow

    //
    // if movement is backward, and destination row is prior to the top
    // row, scroll the list
    //
    if toRow LT topRow begin      //should only be on up-arrow on top row

      //
      // the number of rows to scroll is the difference between the
      // top row and the destination row
      //
      calc (topRow - toRow) to diff

      //
      // scroll the designated number of rows
      //
      get virtual_scroll UPWARD_DIRECTION diff to scrollRet

      //
      // if virtual_scroll returns a positive number, an error occurred,
      // most likely the inability to read the current row in preparation
      // for scanning; in this case, return the top_item as the destination
      //
      if scrollRet gt 0 function_return (top_item(Current_Object))

      //
      // if virtual_scroll returns the negation of the requested number
      // of rows to scroll, no scrolling occurred
      //
      if (diff + scrollRet) EQ 0 begin
        send find_record (current_record(current_object))
        function_return from#
      end

      //
      // if virtual_scroll was successful and this is not a batch list,
      // adjust the destination item by the number of rows inserted
      //
      else if (not(Batch_State(current_object))) ;
          calc (to# + (diff * lim)) to to#

    end

    //
    // if movement is forward, and the destination row is after the bottom
    // row, scroll the list
    //
    else if toRow GT botRow begin  //should only be on down-arrow on botton row

      //
      // the number of rows to scroll is the difference between the
      // destination row and the bottom row
      //
      calc (toRow - botRow) to diff

      //
      // if we're advancing one row and the original row was a
      // blank row and no_create_state is false, insert a blank row
      // by entering (continuing) add-mode
      //
      if ((diff = 1) AND wasNew AND advancing_state(current_object) AND ;
          not(no_create_state(current_object)) AND ;
          auto_clear_deo_state(current_object)) begin

        //
        // clear the destination row
        //
        send start_new_row to#

        //
        // delete to topmost (padding) row
        //
        send delete_row 0

        //
        // return the destination row's first column, adjusted for the
        // row-deletion above
        //
        get enterable_item (toRow * lim - lim) to to#
        function_return to#
      end

      //
      // attempt to scroll the designated number of rows
      //
      get virtual_scroll DOWNWARD_DIRECTION diff to scrollRet

      //
      // if virtual_scroll returns a value greater than zero, an error
      // occurred; typically, the current record could not be read
      //
      if scrollRet GT 0 ;
          function_return ((row_count(current_object) - 1) * lim)

      //
      // if virtual_scroll returns the negation of the number of rows
      // requested, no scrolling occurred. if no create, stay on last row;
      // if create, put the cursor on the last row and make it blank
      //
      if ((diff + scrollRet) = 0) begin
        //
        // if no create, just goto desired row (adjusted for padding row)
        //
        if (No_Create_State(current_object)) ;
            function_return (to# - lim)
        else begin // if (advancing_state(current_object)) begin
          //
          // clear the destination row
          //
          send start_new_row to#

          //
          // delete to topmost (padding) row
          //
          send delete_row 0

          //
          // return the destination row's first column, adjusted for the
          // row-deletion above
          //
          get enterable_item (toRow * lim - lim) to to#
          function_return to#
        end
      end

      //
      // if virtual_scroll was successful and this is not a batch list,
      // adjust the destination item by the number of rows inserted
      //
      if (not(Batch_State(current_object))) ;
          calc (to# - ((diff + scrollRet) * lim)) to to#

    end
    //
    // if the destination row has no valid record_number, clear it and
    // force the destination item to be its first column
    //
    // also, see if add-mode should continue
    //
    else if ((No_Create_State(current_object) = 0) AND ;
        ((record_number(Current_Object,toRow) = 0) OR ;
        (wasNew AND advancing_state(current_object) AND ;
        auto_clear_deo_state(current_object)))) begin

      send start_new_row to#

      //
      // return the first column of the (blank) destination row
      //
      get enterable_item (toRow * lim) to to#
      function_return to#
    end

    //
    // if it was a new record that was just created, and we are on the last row
    // we need to replace the padding row we just overwrote
    //
    else if (wasNew AND (current_record(current_object) <> 0) AND ;
        (current_row(current_object) eq (row_count(current_object) - 1))) ;
        send add_row

    //
    // get the row for the destination item
    //
    get row item to# to toRow

    //
    // if this list is not batch, ensure that the record buffer contains
    // the record corresponding to the destination row
    //
    if (not(Batch_State(current_object))) begin

      //
      // if scrolling down was required, adjust destination to end of list
      //
      if toRow gt botRow move botRow to toRow

      //
      // if scrolling up was required, adjust destination to start of list
      //
      else if toRow lt topRow move topRow to toRow

      //
      // get the record_number of the destination row
      //
      get record_number item toRow to rec#

      //
      // save the base_item value and reset to the first column of the
      // destination row
      //
      get base_item to oldbase
      set base_item to (toRow * lim)
      set new_item to to#       //temporarily change current row for add-mode

      //
      // if this list is auto-select, make sure the destination row is
      // selected
      //
      if (select_mode(current_object)) EQ AUTO_SELECT ;
          send select_toggling (toRow * lim) TRUE

      //
      // find the record for the destination row
      //
      send Find_Record rec#

      //
      // reset base_item to it's original value
      //
      set base_item to oldbase
      set new_item to from#     //restore current row

    end

    function_return to#
  end_function

  procedure item_change integer from# integer to# returns integer
    local integer retval toRow lim newCol newItem curItem suspendValidate
    //
    // if Changing_State is TRUE, we have an item_change invocation already
    // in progress, so just give rubber-stamp approval to the destination
    // item and exit
    //
    if (Changing_State(Current_Object)) begin
      set Advancing_State to FALSE
      procedure_Return to#
    end

    //
    // set Changing_State to TRUE to prevent infinite recursion
    //
    set Changing_State to true

    //
    // remember item_limit
    //
    get item_limit to lim

    //
    // if we are changing columns, set Reordering_State to TRUE; this will
    // permit the AUTO_REORDER_LIST message to function, if used as the
    // iENTRY message of a destination item
    //
    if (MOD(from#,lim)) NE (MOD(to#,lim)) set reordering_state to true

    //
    // else if we are not changing columns, set Reordering_State to FALSE;
    // this will prevent the AUTO_REORDER_LIST message from functioning,
    // if used as the iENTRY message of a destination item
    //
    else set reordering_state to false

    //
    // init Just_Reordered_State to FALSE
    //
    set just_reordered_state to false

    //
    // forward the ITEM_CHANGE message to perform the inherited behavior
    //
    forward get msg_item_change from# to# retval

    //
    // set Changing_State back to FALSE, now that the danger of infinite
    // recursion is past (it could only happen via forwarding)
    //
    set Changing_State to false

    //
    // set Reordering_State to FALSE, now that the iENTRY message of the
    // destination has already been executed
    //
    set reordering_state to false

    //
    // if Just_Reordered_State is TRUE, the destination item did indeed use
    // the AUTO_REORDER_LIST message as its iENTRY message and it was
    // successfully invoked.  In this case, we must make sure that we are
    // in the intended destination column
    //
    if (just_reordered_state(current_object)) begin

      //
      // set Just_Reordered_State back to FALSE
      //
      set just_reordered_state to false

      //
      // calculate the column of the destination item
      //
      move (MOD(to#,lim)) to newCol

      //
      // list-reordering always leaves the cursor on the top row, so we
      // must alter the return-value (the destination item) to insure that
      // the cursor goes to the intended column (not always the first column)
      //
      move (top_item(current_object) + newCol) to retval

    end

    //
    // figure out the destination-item's row number
    //
    get row retval to toRow

    //
    // set BASE_ITEM to the appropriate value for the destination row
    //
    set base_item to (toRow * lim)

    set Advancing_State to FALSE

    //
    // return the destination item number
    //
    procedure_Return retval

  end_procedure

  procedure fill_page integer direction
    local integer rowCount count mode IsBatch srvr#
    local integer file# ndx curRow rec# retval
    get Server to srvr#
    get main_file to file#
    if ((srvr# = 0) AND (file# = 0)) procedure_return  //no server & no mainfile
    get displayable_rows to rowCount
    if (item_count(Current_Object)) LT 1 send add_Row
    if direction eq UPWARD_DIRECTION send display_row 0
    else send display_row (Row_Count(Current_Object) - 1)
    if direction eq UPWARD_DIRECTION move 0 to mode  //LT
    else move 4 to mode  //GT
    get Batch_State to IsBatch
    get Ordering to ndx
    if srvr# ne 0 send establish_find_direction to srvr# mode file# ndx
    else if ndx lt 0 move 0 to ndx   //default to RECNUM if no data-set/order
    move 1 to count
    if rowCount GT 1 begin
      Repeat
        if srvr# send Locate_Next to srvr#
        else begin
          vfind file# ndx mode
          [found] move file# to filenumber
          [found] move 0 to fieldindex
          [found] relate Indirect_File.RECNUM
        end
        [found] begin
          if direction eq UPWARD_DIRECTION send INSERT_NEW_ROW 0
          else send append_new_row
          increment count
        end
      until (FINDERR OR (not(IsBatch) AND (count >= rowCount)))
    end
    if (not(IsBatch)) begin
      send trim_page direction

      get current_Row to curRow
      get record_number item curRow to rec#
      if rec# gt 0 begin
        if srvr# ne 0 begin
          set base_item to (curRow * item_limit(current_object))
          send Read_by_RecNum to srvr# file# rec#
        end
        else send Read_Record rec#
      end
    end
    set Unsorted_State to FALSE
  end_procedure

  procedure Beginning_of_Data integer noSave
    local integer obj# fnum ordr# rowCount oldCol
    set search_mode to (search_mode(current_object))   //reset incr srch index
    get row_count to rowCount
    if rowCount LE 0 move 0 to oldCol
    else begin
      move (current_item(current_object) - base_item(current_object)) to oldCol
      if (Batch_State(current_object) AND ;              //if list empty, treat
          ((rowCount > 1) OR ;                           //as if it were virtual
          (record_number(current_object,0) <> 0))) begin //list already filled
        set top_item to oldCol
        procedure_Return
      end
    end
    get Server to obj#
    get Ordering to ordr#
    get main_file to fnum
    if fnum eq 0 procedure_return  // no main file, no data display
    if obj# ne 0 begin
      if (Deferred_State(current_object)) begin
        send Request_Read to obj# FIRST_RECORD fnum ordr#
        if [found] begin
          send Refresh_Page downward_Direction
          set current_item to (base_item(current_object) + oldCol)
        end
        else send Clear_All
      end
      else begin
        send Request_Find to obj# FIRST_RECORD fnum ordr#
        if [not found] begin
          send Clear to obj#
          send clear_all
        end
        else set current_item to (base_item(current_object) + oldCol)
      end
    end
    else begin
      if ordr# lt 0 move 0 to ordr#
      move 0 to fieldindex
      move fnum to filenumber
      clear Indirect_File
      vfind fnum ordr# 3  //GE
      if [found] begin
        move fnum to filenumber
        move 0 to fieldindex
        relate Indirect_File.RECNUM
        send Refresh_Page Downward_Direction
        set current_item to (base_item(current_object) + oldCol)
      end
      else send Clear_All
    end
    send update_dependent_items
  end_procedure

  procedure End_of_Data
    local integer obj# fnum ordr# rec# olddisp oldCol lim wasNew retVal
    local integer rowCount
    set search_mode to (search_mode(current_object))  //reset incr srch index
    get item_limit to lim
    get row_count to rowCount
    if rowCount LE 0 move 0 to oldCol
    else begin
      move (MOD(current_item(current_object),lim)) to oldCol
      if (Batch_State(current_object)) begin
        set top_item to (integer((item_count(current_object) - 1) / lim) ;
          * lim + oldCol)
        procedure_Return
      end
    end
    get Server to obj#
    get Ordering to ordr#
    get Main_File to fnum
    if fnum eq 0 procedure_return  //no main file, no data display
    if obj# ne 0 begin
      move (current_record(current_object) = 0) to wasNew
      send Request_Read to obj# LAST_RECORD fnum ordr#
      if [found] begin
          if wasNew get Exit_Add_Mode FALSE FALSE ;
              (current_item(current_object)) to retVal
        send Refresh_Page upward_Direction
        if not (Deferred_State(current_object)) begin
          get line_display_state to olddisp
          set line_display_state to true
          get current_record to rec#
          send Find_By_RecNum to obj# fnum rec#
          set line_display_state to olddisp
        end
        set current_item to (base_item(current_object) + oldCol)
      end
      else if (Deferred_State(current_object)) send Clear_All
      else begin
        send Clear to obj#
        send clear_all
      end
    end
    else begin
      if ordr# lt 0 move 0 to ordr#
      move 0 to fieldindex
      move fnum to filenumber
      clear Indirect_File
      vfind fnum ordr# 0  //LT
      if [found] begin
        move fnum to filenumber
        move 0 to fieldindex
        relate Indirect_File.RECNUM
        send Refresh_Page upward_Direction
        set current_item to (base_item(current_object) + oldCol)
      end
      else send Clear_All
    end
    send update_dependent_items
  end_procedure

  procedure Goto_Top_Row
    local integer retval oldCol

    move (current_item(current_object) - base_item(current_object)) to oldCol
    if (focus(desktop) <> current_object) send activate
    set current_item to (top_item(current_object) + OldCol)
  end_procedure

  procedure Goto_Bottom_Row
    local integer retval oldCol lastRow botRow

    move (current_item(current_object) - base_item(current_object)) to oldCol

    if (focus(desktop) <> current_object) send activate

    move (row_count(current_object) - 1) to lastRow
    get bottom_row to botRow
    if botRow LT lastRow move botRow to lastRow

    set current_item to ((lastRow * item_limit(current_object)) + OldCol)
  end_procedure

  procedure Initialize_List
    local integer rowCount retval topRow
    forward send initialize_list
    if (Unsorted_State(current_object) AND ;
        (current_record(current_object) <> 0)) ;
        get Regenerate (current_item(current_object)) TRUE to retval
    else begin
      get Row_Count to rowCount
      get top_row to topRow
      if ((rowCount < 1) OR ;
          (((rowCount - topRow) = 1) AND ;
          (record_number(current_object,topRow) = 0) AND ;
          not(changed_state(current_object)))) begin
        if (server(current_object)) EQ 0 begin
          get main_file to filenumber
          move 0 to fieldnumber
          if status Indirect_File send refresh_page downward_direction
          else send beginning_of_Data TRUE // TRUE arg = nosave
        end
        else send Beginning_of_Data TRUE   // TRUE arg = nosave
      end
    end
  end_procedure

  function item_matching string searchStr integer item# returns integer
    local integer slen ser# file# retval rec# ordr# oldCol mainfile
    local string lookStr
    if (Batch_State(current_object)) begin
        forward get item_matching searchStr to item#
        move item# to retval
    end
    else begin
      move -1 to retval
      length searchStr to slen
      if slen gt 1 left searchStr to lookStr (slen - 1)
      else move "" to lookStr
      get data_file to file#
      if file# le 0 function_return -1 //can't find if no valid main file
      get Server to ser#
      get main_file to mainfile
      move (current_item(current_object) - base_item(current_object)) ;
          to oldCol
      move file# to filenumber
      move 0 to fieldindex
      move Indirect_File.RECNUM to rec#
      move 0 to Indirect_File.RECNUM      //hold recbuf
      move rec# to Indirect_File.RECNUM   //replace rec#
      get data_field to fieldindex
      move lookStr to Indirect_File.RECNUM
      if mainfile ne file# begin  //find in parent-file
        if ser# ne 0 begin   //has a server
          send Request_Superfind to ser# GE file# ;
              (data_field(current_object,CURRENT))
          [found] move (oldCol+top_item(current_object)) to retval  //current item
        end
        else begin  //no server
          send entry_superfind GE mainfile
          if [found] begin
            send display
            move (oldCol+top_item(current_object)) to retval  //current item
            indicate found true
          end
          else begin
            move file# to filenumber
            move 0 to fieldindex
            clear Indirect_File
            move rec# to Indirect_File.RECNUM
            find eq Indirect_File.RECNUM
          end
        end
      end
      else begin  //find in main-file
        get Ordering to ordr#
        if ser# ne 0 begin
          if (Deferred_State(current_object)) begin
            send Request_Read to ser# GE file# ordr#
            if [found] begin
              send display
              move (oldCol+top_item(current_object)) to retval  //current item
              indicate found true
            end
          end
          else begin
            send Request_Find to ser# GE file# ordr#
            [found] move (oldCol+top_item(current_object)) to retval  //current item
          end
        end
        else begin
          if ordr# lt 0 move 0 to ordr#
          vfind file# ordr# GE
          if [found] begin
            move file# to filenumber
            move 0 to fieldindex
            relate Indirect_File.RECNUM
            send display
            move (oldCol+top_item(current_object)) to retval  //current item
            indicate found true
          end
        end
        [not found] begin
          move file# to filenumber
          move 0 to fieldindex
          clear Indirect_File
          move rec# to Indirect_File.RECNUM
          find eq Indirect_File.RECNUM
        end
      end
    end
    function_return retval
  end_function

  procedure Scan_Servers
    send find_servers_to_watch TRUE
  end_procedure

  procedure auto_reorder_list integer item#
    if (reordering_state(current_object)) send reorder_list item#
  end_procedure

  procedure reorder_list integer theItem#
    local integer ordr file field dataType fldNdx item#
    local integer reoState mainfile mainNdx
    if NUM_ARGUMENTS lt 1 get current_item to item#
    else move theItem# to item#
    get reordering_state to reoState
    set reordering_state to false
    get data_field item item# to field
    get data_file item item# to file
    if ((file > 0) AND (field >= 0)) begin
      FIELD_DEF file field to dataType fldNdx
      if ((fldNdx > 0) OR (field = 0)) begin  //field for item# has a main index
        get main_file to mainfile
        get ordering to ordr
        if file eq mainfile begin  //reorder using main-file
          if ordr ne fldNdx begin  //dont' reset unless req.
            set ordering to fldNdx                             //reset ordering
            send read_Record (current_record(current_object))  //read row's rec
            send display  //redisplay page starting with current row

            if reoState set just_reordered_state to true  //set for item_change
            else set current_item to (MOD(item#,item_limit(current_object)) + ;
                  base_item(current_object))  //reset in case called via key

          end
        end
        else begin  //reorder using parent-file
          get superfind_field mainfile item# to mainNdx  //get field for superfind
          FIELD_DEF mainfile mainNdx to dataType mainNdx //get main index for field
          if ((mainNdx <> ordr) AND (mainNdx >= 0)) begin
            set ordering to mainNdx
            send read_record (current_record(current_object))
            send display

            if reoState set just_reordered_state to true  //set for item_change
            else set current_item to (MOD(item#,item_limit(current_object)) + ;
                  base_item(current_object))  //reset in case called via key

          end
        end
      end
    end
  end_procedure

  procedure assign_current_record
      get main_file to filenumber
      move 0 to fieldindex
      set record_number to (row(current_object,base_item(current_object))) ;
          Indirect_File.RECNUM
  end_procedure

  procedure refresh integer notifyMode
    local integer oldRec retval mainfile lineDisp

    get main_file to mainfile

    if ((notifyMode = MODE_DELETE) AND ;
        (mainfile = main_file(server(current_object)))) begin
      forward send refresh notifyMode
      send assign_current_record
      send Enter_Add_Mode FALSE
    end
    //
    // if line-oriented or we are not deleting the table's main-file or
    // this is a save or delete-parent-file notification, just redisplay
    // current row
    //
    else if ((notifyMode > MODE_CLEAR_ALL) OR ;
        Line_Display_State(current_object)) begin

      get current_record to oldRec
      forward send refresh notifyMode
      send assign_current_record

      if ((oldRec = 0) AND (current_record(current_object) <> 0)) begin

        get line_display_state to lineDisp

        if notifyMode EQ MODE_SAVE begin
          set Unsorted_State to TRUE
          if (lineDisp OR advancing_state(current_object) OR ;
              not(auto_clear_deo_state(current_object)) OR ;
              not(was_new_row_state(current_object))) ;
              get Exit_Add_Mode FALSE FALSE ;
              (current_item(current_object)) to retval
        end
        else if not lineDisp get Exit_Add_Mode FALSE FALSE ;
            (current_item(current_object)) to retval

      end
    end

    else begin               //notifyMode = find/clearSet or Clear
      is_file_included mainfile 1            //look in done

      if [found] begin
          if (current_record(current_object) = 0) ;
            get Exit_Add_Mode FALSE FALSE ;
              (current_item(current_object)) to retval
          send Refresh_Page downward_Direction
      end
      else begin
        is_file_included mainfile 0                  //look in cleared

        if [found] begin  //empty list or insert blank row
          if ((notifyMode = MODE_CLEAR_ALL) OR ;
              (notifyMode = MODE_FIND_OR_CLEAR_SET)) send clear_all
          else send clear
        end
        else begin
          forward send refresh notifyMode
          send assign_current_record
        end
      end
    end
  end_procedure

  function find_top_record integer item# returns integer  //find rec and return rec#
    local integer ser# file# rec# ordr# destRow

    get server to ser#
    get main_file to file#
    get row item item# to destRow
    get record_number item destRow to rec#

    if ((rec# = 0) AND (destRow > 1)) ;
        get record_number item (destRow - 1) to rec#

    //
    // if this list has a server, use the server's Read_By_RecNum
    // to find the (new) current row's record
    //
    if ser# ne 0 send Read_by_RecNum to ser# file# rec#

    //
    // if this list has no server but has a valid main_file, use
    // Read_Record to find the (new) current row's record
    //
    else if file# ne 0 send read_Record rec#

    //
    // if this list has no server or main_file, the find automatically
    // fails (nothing to find on/with/by!)
    //
    else indicate found false

    [not found] begin
      get ordering to ordr#
      move file# to filenumber
      move 0 to fieldindex
      clear Indirect_File
      if ser# ne 0 send Request_Read to ser# FIRST_RECORD file# ordr#
      else if file# ne 0 begin
        if ordr# lt 0 move 0 to ordr#
        vfind file# ordr# GE
        [found] begin
          move file# to filenumber
          move 0 to fieldindex
          relate Indirect_File.RECNUM
        end
      end
    end

    [not found] move 0 to rec#

    function_return rec#
  end_function

  //
  // passed destination item#
  // returns adjusted item#
  //
  function Remove_Hole integer item# returns integer
    local integer dynUpdt rowCount curRow lim retval svr rec# mainfile rowBot

    get current_row to curRow
    move item# to retval
    get item_limit to lim

    //
    // save the value of Dynamic_Update_State and reset to FALSE
    //
    get dynamic_update_State to dynUpdt
    set dynamic_update_State to false

    get row_count to rowCount

    //
    // if the list has more than one row, delete the current row
    // if it is not the last blank row
    //
    if rowCount GT 1 begin
      if ((curRow <> (rowCount - 1)) AND ;
        (record_number(current_object,curRow) = 0)) begin
        //
        // delete the current row
        //
        send delete_row curRow

        if item# GE ((curRow + 1) * lim) calc (retval - lim) to retval
      end

      //
      // add/delete rows at end, if necessary
      //
      if ((current_record(current_object) <> 0) OR ;
          (current_row(current_object) = bottom_row(current_object)))
        send finish_page

      //
      // reset base_item to the new current row's first column
      //
      set base_item to (curRow * item_limit(current_object))

    end
    else begin // if list has only one row which is empty, clear it
      send entry_clear 1      //make sure main-file items cleared
      send entry_display 0 1  //make sure parent-files redisplayed
    end

    set dynamic_update_State to dynUpdt // restore dynamic_update_state
    function_return retval
  end_function

  function regenerate integer item# integer forceFlag returns integer
    local integer rec#

    if (forceFlag OR Auto_Regenerate_State(current_object)) begin

      //
      // get the record_number of the (new) current row of the list
      //
      get find_top_record item item# to rec#  //finds and returns rec#

      if rec# eq 0 send clear_all       //rec# = 0 if find failed

      //
      // if the find on the current row's record was successful, regenerate
      // the list page using the current row as the new top row
      //
      else send Refresh_Page DOWNWARD_DIRECTION

      function_Return (top_item(current_object))

    end

    function_return item#

  end_function

  procedure Enter_Add_Mode integer makeHoleFlag
    if makeHoleFlag send insert_clear_row
    else if (current_row(current_object)) NE (bottom_row(current_object)) ;
        send trim_last_row
  end_procedure

  function Exit_Add_Mode integer closeHoleFlag integer regenPageFlag ;
        integer item# returns integer
    local integer dynUpdt rowCount curRow rec# retval


    get current_item to retval
    get current_row to curRow

    if closeHoleFlag get Remove_Hole item item# to retval

    if (regenPageFlag AND unsorted_state(current_object)) ;
        get Regenerate retval FALSE to retval

    function_return retval

  end_function

  //
  //  added for dependent-items support
  //
  function prototype_object returns integer
    function_return (element(current_object))
  end_function

  function next_entry_ok returns integer
    local integer retval

    set Advancing_State to TRUE  //set on now, turned off after item_change

    forward get next_entry_ok to retval

    function_return retval
  end_function

  procedure exiting integer toObject returns integer
    local integer retval
    forward get msg_exiting toObject to retval
    set advancing_state to FALSE
    procedure_return retval
  end_procedure

end_class

//
// Support Commands
//

//
// dlStart <class> <image> { ACTION_BAR <actionbar#> } { POP_UP | POPUP}
//     { RING } { VIRTUAL | BATCH } { USING <ServerID> } { MAIN_FILE
//     <FileName> } { BY <Index> }
//
// handles optional syntax for Table construction statement
//
#COMMAND dlStart R R
  FORWARD_BEGIN_CONSTRUCT !1 !2 !3 !4 !5 !6 !7 !8 !9
  bind_using !3 !4 !5 !6 !7 !8 !9
  bind_datalist_main_file !3 !4 !5 !6 !7 !8 !9
  bind_datalist_index !3 !4 !5 !6 !7 !8 !9
  bind_batch !3 !4 !5 !6 !7 !8 !9
#ENDCOMMAND

#COMMAND Bind_Batch
  #IF (!0>0)
    #IFSAME !1 BATCH VIRTUAL
      #IFSAME !1 BATCH
        set Batch_State to true
      #ELSE
        set Batch_State to false
      #ENDIF
    #ELSE
      Bind_Batch !2 !3 !4 !5 !6 !7 !8 !9
    #ENDIF
  #ENDIF
#ENDCOMMAND

#COMMAND Bind_Static
  #IF (!0>0)
    #IFSAME !1 STATIC
      set Batch_State to true
      set Static_State to true
    #ELSE
      Bind_Static !2 !3 !4 !5 !6 !7 !8 !9
    #ENDIF
  #ENDIF
#ENDCOMMAND

#COMMAND bind_datalist_main_file
  #IF (!0>1)
    #IFSAME !1 MAIN_FILE
      #PUSH !u
      #SET U$ !2.RECNUM
      set main_file to |CI!u
      #POP U$
    #ELSE
      bind_datalist_main_file !2 !3 !4 !5 !6 !7 !8 !9
    #ENDIF
  #ENDIF
#ENDCOMMAND

#COMMAND bind_datalist_index
  #IF (!0>1)
    #IFSAME !1 BY
      set ordering to !2
    #ELSE
      bind_datalist_index !2 !3 !4 !5 !6 !7 !8 !9
    #ENDIF
  #ENDIF
#ENDCOMMAND

//
// dlEnd <className>
//
// This macro ends the declaration of an instance, and checks for the
// existance of the ELEMENT component (defined by Begin_Row...End_Row)
//
#COMMAND dlEnd R
  #IFDEF OBJ$!Zj$ROWDEF
  #ELSE
    #ERROR 777 Object is missing BEGIN_ROW...END_ROW commands
  #ENDIF
  FORWARD_END_CONSTRUCT !1 !2 !3 !4 !5 !6 !7 !8 !9 //end instance normally
#ENDCOMMAND