Module selst_ds.pkg

     1//************************************************************************
     2// Confidential Trade Secret.
     3// Copyright (c) 1997 Data Access Corporation, Miami Florida
     4// as an unpublished work.  All rights reserved.
     5// DataFlex is a registered trademark of Data Access Corporation.
     6//
     7//************************************************************************
     8//
     9// $File name  : Selst_ds.Pkg
    10// $File title : selection list support for DF.
    11// Notice      :
    12// $Author(s)  : John Tuohy
    13//
    14// $Rev History
    15//
    16// 05/25/00   JJT   Cancel check server of InvObj...only if relational_state
    17// 11/26/98   JJT   Fixed cancel bug where Obj# was used instead of InvObj#
    18// 6/24/97    JJT   Changed Auto_Server_State to also set deferred_state. When
    19//                  auto-server=t deferred s/b true, when auto-server=f
    20//                  defrerred should be false
    21// 06/23/97   JJT   Modified request_find to properly superfind when the field
    22//                  is a parent file. This way lists with parent.field items
    23//                  will work right. This is more consistent with the rest of
    24//                  DF which requires you to use parent.field, not child.field.
    25//                  This should work with and without servers. If the field
    26//                  is a mainfield, there is no difference.
    27// 6/23/97    JJT   Createted: Converted from SelList.pkg and changed
    28//                  to Selection_list_ds
    29// 2/26/2002  JJT - 8.2 clean up (indirect_file, local, self, etc.)
    30//************************************************************************
    31
    32
    33//************************************************************************
    34// Version: 1.0
    35//  12-01-1992 : Created
    36//
    37// Author: John J. Tuohy
    38//
    39// 1. Adds Stop_UI_State Support
    40// 2. Creates Move_Value_Out_State property (set when a popup) - Allows lists
    41//    in clients.
    42// 3. Modifies Move_Value_Out to directly update the invoking object's
    43//    data_set (server). Allows stand alone lists
    44// 4. Augments Initialize list to make sure that during initialization
    45//    non-data_set list displays the first record...
    46// 5. This is no 02:19 pm)Adds Find_Search_State property and all logic to support alternate
    47//    Search capability. (07/25/94-The following sentence no longer applies to
    48//    DAF1.1) [This directly alters the Selection_List Class with
    49//    a FOR SELECTION_LIST modifier. If this package is used the selection_list
    50//    class is no longer public.-no longer JJT]
    51// 6. Adds Auto_Locate_State Support
    52// 7. Adds Seeding the list support (Seed_list_State, Load_Buffer_MSG)
    53// 8. Adds automatically finding column to start in (Auto_Column_State)
    54// 9. Adds Initial_Column property
    55//10. Adds Col_Index Property. Reorder_list now uses this. Good for
    56//    overriding and augmenting.
    57//11. Sends message in property Display_Buffer_MSG to the invoking object
    58//    during move_value_out. Handy for complex updates.
    59//12. Adds movable support (ver 1.1)
    60//
    61// 05-09-1993  Add Auto_Locate_State support
    62// 08-06-1993  added items 7-11
    63// 03/17/94    Item 9 v.1.1
    64// 03/31/94    protect auto_column_state and seed_list_state from doing
    65//             anything with a non-popup. Else invoking information is
    66//             retrieved causing problems.
    67// 04/05/94    Modify seed_list to support export_item seeding
    68// 06/02/94    Changed auto_server latch. It was not working with sel-lists
    69//             inside of clients (add_focus is needed). However, activate is
    70//             still needed for regular activation.
    71// 08/24/94    Load_Buffer_msg and Display_Buffer_msg were sending
    72//             self which is sensitive to delegation. No Longer!
    73// 11/30/94    (LS) Removed refs to list_mx0; (merged into list.pkg)
    74// 12/5/94     (LS) moved Move_Vlaue_Out and Export_Item procedures
    75//             and Export_Column and Display_Buffer_Msg properties
    76//             into _Selection_List.
    77//************************************************************************/
    78
    79//************************************************************************/
    80// 12/22/94 JJT Merge Changes
    81//              Merged the 0 class into entry_form.
    82//              Merged slstF_mx direct in the class
    83//              A bunch of list stuff is in here directly
    84//
    85// 03/08/95    JJT  Changed Move_Value_out to fix two bugs.
    86//                 1) Invoking_object_id was being moved to a local too deep.
    87//                    Export and batch could send the display_MSG to obj#.
    88//
    89// 03/10/95    JJT Cancel sends refind_records to invoking server. DAF1.1
    90//                 already did that. This can create a problem if the
    91//                 invoking object does not understand the server message.
    92// 03/10/95    JJT Removed the set auto_fill_state in bind_sellist_popup
    93//                 command. List.pkg now handles this in set move_value_
    94//                 out_state.
    95//
    96//03/22/95     JJT Modified Cancel to only send request_cancel if
    97//                 Move_value_out_state is false.
    98//
    99//03/22/95     JJT Entry_display does not set checkbox values if item
   100//                 does not exist
   101//
   102//03/22/95     JJT Added auto_save_state function to return 0. Other
   103//                 objects inquire about this value during wrapping
   104//
   105//03/22/95     JJT Sometimes Entry_Find finds by the wrong field. This occurs
   106//                 during server-less searches. The problem seems to be inside
   107//                 of entry_find in entry class. We will create a manual entry
   108//                 _find to get around this. I have not seen this problem in
   109//                 a reliable example. This appears to happen with auto-
   110//                 prompting (suggesting that ENTRY must set something for
   111//                 entry_find).
   112// 09/07/95   JJT - Code Clean up (removed dead commented code)
   113//************************************************************************/
   114// 02/08/96   JJT - 1. Added Auto_export_State and set it to true. If true
   115//                  the list will figure out if it should be a lookup
   116//                  or relational selection-list.
   117//                  2. Created relational_state which is set if this is a
   118//                  relational update. Seed_list now seeds based on this
   119//                  3. Altered Move_Value_out to respect auto_export. Also
   120//                  batch_state can now have a relational update.
   121// 01/29/97   JJT   Deactivating removes auto-server DEO first (for ddo/win)
   122// 04/30/97   JJT   Seed_List first makes sure server (if any) is in_use.
   123//                  If it is not the establish_find_direction will clear
   124//                  the buffer.
   125//  8/5/97    JJT   1. Added prompt_callback message. This is sent to by popup
   126//                  dblists to allow calling objects to customize the list.
   127//                  2. Auto-server is not set if there is no auto-server
   128//                  3. Check invokng object to see if it understands data_file
   129//                  4. Store_defaults and Restore_defaults created to store the
   130//                  most commonly used properties. This is called when the list
   131//                  is activated and deactivated. This allows users to change the
   132//                  common properties with prompt_callback. This allows a single
   133//                  dblist to be used for many purposes.
   134//  9/18/97    JJT  Changed entering and cancel to handle the refinding of existing
   135//                  record differently. Only use original_selection if there is
   136//                  no server.
   137// 12/10/97    JJT  If move_value_out temporarily set auto_server_state to false
   138//************************************************************************/
   139
   140
   141#CHKSUB 1 1 // Verify the UI subsystem.
   142
   143use Set.pkg
   144use DataList.pkg
   145use List.pkg
   146Use AutoLcMx.pkg   // Auto locate of popup mixin
   147Use cRowIdArray.pkg  // cRowIdArray (has Set capabilities)
   148
   149register_procedure refind_Records
   150register_function current_record returns integer
   151register_function currentRowId returns integer
   152
   153
   154class Selection_List_DS_mixin is a mixin
   155  procedure Construct_Object integer img
   156    forward send construct_object img
   157
   158    on_key kBegin_of_Data SEND Beginning_of_Data  PRIVATE
   159    on_key kEnd_of_Data   SEND End_of_Data        PRIVATE
   160
   161    object oSelectedRowIdsSet is a cRowIdArray
   162    end_object
   163
   164    send define_list  //invoke constructor for list support
   165
   166    // message id to send during move_value_out
   167    Property Integer Display_Buffer_msg  0
   168
   169    // Column to export (if export_item_state) -1=use initial column
   170    { Category=Behavior }
   171    Property Integer Export_Column 0
   172
   173    Set Initial_Row to FILL_FROM_CENTER // center the guess
   174
   175    // List mixin sets select_mode to single. No_Select will work better
   176    // for normal select an item. If radio (auto_select works better).
   177    set select_mode to NO_SELECT
   178    // This must also happen after the list mixin, since the list mixin
   179    // sets this key to OK.
   180    on_key kEnter         SEND Find_or_OK         PRIVATE
   181
   182    { Category=Behavior }
   183    { PropertyType=Boolean }
   184    Property Integer Find_Search_State    True
   185    { Category=Behavior }
   186    { PropertyType=Boolean }
   187    Property Integer Auto_Column_State    True
   188    { Category=Behavior }
   189    { PropertyType=Boolean }
   190    Property Integer Seed_List_State      True
   191    Property Integer Load_Buffer_msg      0
   192    { Visibility=Private }
   193    Property Integer Private.Auto_Server_State False
   194
   195    // 02/08/96 -JJT Added
   196    { Category=Data }
   197    { PropertyType=Boolean }
   198    Property Integer Auto_Export_State True
   199    { Visibility=Private }
   200    Property Integer Relational_State  False // maintained by system
   201    Set Auto_top_item_State to False // sometimes this gets clobbered by
   202
   203    // These are used to store the default properties. These are
   204    // stored when the object is activated and restored when it is
   205    // deactivated (if move_value_out_state is true).
   206    { Visibility=Private }
   207    Property Integer stored_Server                   0
   208    { Visibility=Private }
   209    Property Integer stored_auto_Server_State        0
   210    { Visibility=Private }
   211    Property Integer stored_deferred_State           0
   212    { Visibility=Private }
   213    Property Integer stored_Initial_Column           0
   214    { Visibility=Private }
   215    Property Integer stored_Export_Column            0
   216    { Visibility=Private }
   217    Property Integer stored_Auto_Column_State        0
   218    { Visibility=Private }
   219    Property Integer stored_Seed_List_State          0
   220    { Visibility=Private }
   221    Property Integer stored_Export_Item_State        0
   222    { Visibility=Private }
   223    Property Integer stored_Auto_Export_State        0
   224    { Visibility=Private }
   225    Property Integer stored_Auto_Index_State         0
   226    { Visibility=Private }
   227    Property Integer stored_Ordering                 0
   228    { Visibility=Private }
   229    Property Integer stored_Display_Buffer_msg       0
   230    { Visibility=Private }
   231    Property Integer stored_Load_buffer_msg          0
   232    { Visibility=Private }
   233    Property Boolean stored_pbReverseOrdering        False
   234    { Visibility=Private }
   235    Property Boolean stored_pbUseServerOrdering      False
   236    //
   237    { DesignTime=False }
   238    Property RowId Original_RowId
   239
   240
   241    Send Define_Auto_Locate
   242  end_procedure
   243
   244  IMPORT_CLASS_PROTOCOL LIST_Mixin   //include list support module
   245  IMPORT_CLASS_PROTOCOL Auto_Locate_Mixin
   246
   247  // when auto_server_state is set deferred_state must also be set. Normally
   248  // the list should be deferred when auto-server so the invoking object
   249  // does not change each time you change a record in the list. When
   250  // auto-server is false the list does not need to be deferred. If one
   251  // needs to change this behavior they will have the set deferred_State
   252  // manually AFTER they have set auto-server.
   253  { MethodType=Property }
   254  { InitialValue=False }
   255  { Category=Data }
   256  { PropertyType=Boolean }
   257  Procedure Set Auto_Server_State Integer iState
   258    Set Private.Auto_Server_State to iState
   259    // note: if setting auto-server-state to false we make no assumptions about deferred_state.
   260    if iState Set Deferred_State to True
   261  end_Procedure
   262
   263  { MethodType=Property }
   264  Function Auto_Server_State returns Integer
   265    function_Return (private.auto_server_state(self))
   266  End_Function
   267
   268  { MethodType=Property }
   269  function Select_Count returns integer
   270    integer retval
   271    if (Batch_State(self)) ;
   272        forward get select_count to retval
   273    else ;
   274        Get item_count of oSelectedRowIdsSet to retval
   275    function_return retval
   276  end_function
   277
   278  { Visibility=Private }
   279  procedure set Select_Count integer newval
   280    forward set select_count to newval
   281    if (Batch_State(self) = 0) Begin
   282        set item_count of oSelectedRowIdsSet   to newval
   283    end
   284  end_procedure
   285
   286  // as of 11.0, use first_selected_item and next_selected_item only for batch tables and use
   287  // FirstSelectedRowId and NextSelectedRowId for non-batch tables
   288  // If your table supports recnum, the first/next_selected_item can still be used but it is discouraged
   289
   290  Function First_Selected_Item Returns Integer
   291    integer count maxx SelMode iFile
   292    boolean bBatch
   293    rowId   riId
   294    integer iRec
   295
   296    Get Batch_State to bBatch
   297    Get Main_file   to iFile
   298    Get Select_Mode to SelMode
   299
   300    If ( not(bBatch) and  not(IsRecnumTable(self, iFile)))  begin
   301        Error DFERR_PROGRAM "Cannot use first_selected_item method with non-batch/RowKey"
   302        Function_return -1
   303    end
   304
   305    // if auto or no select or single w/ no selected item
   306    // just return the selected item
   307    If (SelMode=NO_SELECT OR SelMode=AUTO_SELECT or (SelMode=SINGLE_SELECT AND Select_Count(self)=0) ) Begin
   308       // of non-batch current_record should be correct (even in with new rowId logic)
   309       Function_Return ( If(bBatch, Base_Item(self), Current_Record(self)))
   310    End
   311
   312    if bBatch begin
   313      move (item_count(self) - 1) to maxx
   314      for count from 0 to maxx
   315        if (select_state(self,count)) function_Return count
   316      loop
   317    end
   318    else begin
   319      // this is obsolete. Should use FirstSelectedRowId and RowId logic.
   320      // We will use FirstSelectedRowId to get the rowId and then find the record
   321      // to get the record. This find represents a behavior change but it should be safe
   322      Get FirstSelectedRowId to riId
   323      If not (isNullrowId(riId)) begin
   324          send ReadByRowId riId           // read the record
   325          Get_field_value iFile 0 to iRec // to get the recnum  // compatibility w/ recnum
   326          function_Return iRec
   327      end
   328    end
   329    function_return -1 // no selected items/records
   330  end_function
   331
   332    function FirstSelectedRowId returns RowId
   333        integer iSelectCount eSelMode
   334        RowId riId
   335        boolean bBatch
   336        Get Batch_State to bBatch
   337        If  bBatch   begin
   338            Error DFERR_PROGRAM "Cannot use FirstSelectedRowId method with batch grid"
   339            Function_return riId
   340        end
   341
   342        // if auto or no select or single w/ no selected item
   343        // just return the selected item
   344        Get Select_Mode to eSelMode
   345        Get Select_Count to iSelectCount
   346        If (eSelMode=NO_SELECT OR eSelMode=AUTO_SELECT OR (eSelMode=SINGLE_SELECT AND iSelectCount=0) ) Begin
   347            Get CurrentRowId to riId
   348        End
   349        Else If (iSelectCount > 0) begin
   350            Get RowId_Value of oSelectedRowIdsSet 0 to riId
   351        end
   352        function_return riId // no records
   353    end_function
   354
   355    // used to get and find the next row Id. Returns rowId and the recortd loaded in the buffer (not the dd)
   356    function NextSelectedRowId Integer bClear returns RowId
   357        handle  hoSelArrID
   358        integer iCounter
   359        RowId   riId
   360        boolean bBatch
   361
   362        Get Batch_State to bBatch
   363        If  bBatch begin
   364            Error DFERR_PROGRAM "Cannot use NextSelectedRowId method with batch grid"
   365            Function_return riId
   366        end
   367
   368        get Enumeration_Counter to iCounter
   369        if (iCounter < select_count(self)) begin
   370            move oSelectedRowIdsSet to hoSelArrID
   371            get RowId_value of hoSelArrID iCounter to riId
   372            if bClear begin
   373                send Remove_RowId of hoSelArrID riId
   374            end
   375            Else begin
   376                set Enumeration_Counter to (iCounter + 1)
   377            end
   378            send ReadByRowId riId // find the record
   379        end
   380        Else begin
   381            Move (NullRowId()) to riId
   382        end
   383        function_Return riId
   384    end_function
   385
   386
   387
   388  //
   389  //  Move_value_out has been augmented to allow for more independance
   390  //  between the data_set and its invoking object. Here is the new logic:
   391  //
   392  //  if export_item_state
   393  //     Do normal export item behavior (forward send the message)
   394  //  else // not export_item_state .. a normal update
   395  //     Find selected record as needed
   396  //     Find out who prompted us (invoking_object)
   397  //     Find the data_set of the invoking object
   398  //     If data_set exists (it should) notify data_set about the record
   399  //  If a display_buffer_MSG exists send this message to the invoking
   400  //  object. (This allows the invoking object to do custom updating).
   401  //
   402
   403  // better export value out support
   404  // Invoking_object_id checked sooner.
   405  //
   406  { MethodType=Event Visibility=Private }
   407  procedure Move_Value_Out
   408    integer item# srvr# srvrobj# obj# oldDisp mainfile msg# BS Rec# co iFile
   409    integer Relational
   410    RowId riRec
   411
   412    Get Batch_State to BS
   413    get Main_file to iFile
   414
   415    // if batch we get an item#, if non-batch we've got a rec#
   416    If BS begin // if batch get rec# as well as item
   417       get first_selected_item to item#
   418       Get Record_RowId  (Row(self,Item#)) to riRec
   419    end
   420    Else begin
   421       get FirstSelectedRowId to riRec
   422    end
   423
   424    get Invoking_Object_ID to obj#
   425
   426    If (Auto_export_State(self)) ;
   427       Get Relational_State  to Relational
   428    Else ;
   429       Move (Export_Item_State(self)=0) to Relational
   430
   431    If Not Relational Begin  // export the item
   432       // if not batch
   433       //    refind record (so it is in buffer and displayed)
   434       //    determine rec number (which was the item#) and the item# col0
   435       // if batch
   436       //    determine the record number (we've got the item#)
   437       If Not BS Begin
   438          Send Find_RowId riRec  // find existing record (display)
   439          Get Base_Item to Item# // this is item# - col 0 adjusted
   440       End
   441       // done for backwards compatability. If RowId style, pass 0 as rec#
   442       If (IsRecnumTable(self,iFile)) Begin
   443           Get RecordStatus  (Row(self,Item#)) to Rec#
   444       end
   445       Send Export_Item Item# Rec#
   446    End
   447    Else Begin
   448       get Server to srvr#
   449       // refind the selected record. If data_set (server) do it through the
   450       // data_set. If no server, just find the record
   451       if (srvr# AND BS=0) begin
   452          get line_display_State to oldDisp
   453          set line_display_State to true
   454          send FindByRowId of srvr# iFile riRec
   455          set line_display_State to oldDisp
   456       end
   457       else if iFile begin
   458          Send ReadByRowId riRec
   459       end
   460       [found] if obj# begin // if record exists and invoking object exists
   461         Get Server of Obj# to Srvrobj#   // find server of invoking object
   462         If srvrobj# eq 0 send entry_display to obj# 0 0 // sissy update
   463         Else if (srvr#<>srvrobj# OR BS) begin // if server of selection list and invoking obj are different notify invoking server
   464             // only update the Invoking Server if the file is reachable by this server (the DDO and its parents).
   465             // If the file is not reachable this may well be a programming error. However, we are testing for this
   466             // and not raising an error because such an error might cause existing programs to break. If compatiblity
   467             // were not an issue, an error would probably be a better choice
   468             If (Which_data_set(Srvrobj#,iFile)) begin
   469                 Send FindByRowId of Srvrobj# iFile riRec
   470             end
   471         end
   472       end
   473    end
   474
   475    // pass optional message to the invoking object. Note that Current object
   476    // ID is passes to the procedure
   477    get display_buffer_msg to msg#
   478    if (msg# AND obj#) Begin
   479       Move self to co
   480       send msg# to obj# Co
   481    End
   482    set changed_state to false  //list not changed after value exported
   483  end_procedure
   484
   485  //  New message pass column 0 item to export. Use export_column property to
   486  //  determine what value to export.
   487  //
   488  // Note that we pass item# and Rec#. We don't use record number. We pass this
   489  // because it might be useful if this message is augmented.
   490  //
   491  { MethodType=Event }
   492  Procedure Export_Item Integer Item# Integer Rec#
   493    integer obj# Col
   494    String Val
   495    Get invoking_object_id to Obj#
   496    Get Export_Column to Col                // The column to export. If -1 we
   497    If Col eq -1 Get Initial_Column to Col  // use initial_column value.
   498    Get value Item (Item#+Col) to val       // Get value from sel list
   499    Set value of obj# item CURRENT to Val   // export item and set changed true
   500    Set Item_Changed_State of obj# item CURRENT to True
   501  End_Procedure // Export_Item
   502
   503  { MethodType=Event  NoDoc=True }
   504  procedure Entering returns integer
   505    integer retval obj#
   506    integer iRec
   507    rowId riRec
   508    integer iFile
   509    get Server to obj#
   510    if (Batch_State(self)) begin
   511      forward get msg_Entering to retval
   512      set Original_Selection to (current_item(self))
   513    end
   514    else begin
   515      //if obj# ne 0 set Original_Selection to (Current_Record(obj#))
   516      //else begin
   517      // only track original record if we do not have a server. If
   518      // server, we will restore record through the server
   519      If not obj# Begin
   520        get Main_file to iFile
   521        if (iFile<>0) begin
   522            If (IsRecnumTable(self,iFile)) begin
   523                Get_field_value iFile 0 to iRec    // compatibility w/ recnum
   524            end
   525            set Original_Selection to iRec
   526            set Original_RowId to (getRowId(iFile))
   527        end
   528        else begin
   529            set Original_Selection to 0
   530            set Original_RowId to (NullRowId())
   531        end
   532      end
   533      // if there is a server, we will send refind records just to make sure the buffer is
   534      // correct. dbLists can do weird things with auto-servers leaving the buffer with the
   535      // wrong or cleared data. Until the first record is found, this can cause issues.
   536      else Begin
   537          Get CurrentRowId to riRec
   538          If not (isNullRowId(riRec)) begin
   539              Send ReadByRowId riRec    // if current record, this will find the main rec and all parents
   540          end
   541          else begin
   542              Send Refind_records to Obj# // if no current record, we still need proper parents for constraints.
   543          end
   544      end
   545      forward get msg_Entering to retval
   546    end
   547    procedure_return retval
   548  end_procedure
   549
   550  // modified 9/18/97 - clean up this logic.
   551  procedure Cancel returns integer
   552    integer srvr#  file# oldinuse InvObj# InvSrvr#
   553    Boolean bOk
   554    RowId   riRec
   555    // if move_value_out_state is false we treat this like any other deo
   556    // and simply send cancel.
   557    If (Move_Value_out_State(self)) Begin
   558       // added 03/31/94 - else server does not disconnect during deactivate
   559       set changed_state to false  //list not changed after value exported
   560       if (Batch_State(self)) begin
   561         set current_item to (Original_Selection(self))
   562         send request_cancel
   563       end
   564       else begin
   565         send request_cancel
   566
   567         get main_file to file#
   568         get Server to srvr#
   569         Get Invoking_Object_id to InvObj#
   570         // if not relational...we know nothing about invoking DEO or its server
   571         if (Relational_state(self)) ; // InvObj# gt desktop ;
   572             get server of InvObj# to Invsrvr#
   573
   574         // if list has a server, refind the right records for the
   575         // server. If no server, refind the the original record we
   576         // entered with.
   577         if srvr# ;
   578             send refind_records to srvr#
   579         else if file# begin
   580            get Original_RowId to riRec
   581            If not (isNullRowid(riRec)) Begin
   582                Move (FindByRowId(File#,riRec)) to bOk
   583                relate File#
   584            end
   585         end
   586         // after refinding the list's record, refind the records
   587         // in the invoking object. This is done last because it is
   588         // the most important.
   589         // Don't need to do this if the invoking server is the same
   590         // as the list's server
   591         if (InvSrvr#<>0 AND InvSrvr#<>Srvr#) ;
   592             send refind_records to InvSrvr#
   593       end
   594    end
   595    Else Send request_cancel
   596  end_procedure
   597
   598
   599
   600  { MethodType=Property  NoDoc=True }
   601  Procedure Set Select_State integer item# integer newState
   602    integer iRow  selMode
   603    Handle  hoSelArr
   604    Boolean bIsRecnum
   605    integer iRec
   606    RowId riRec
   607    Integer iItem
   608
   609    get select_mode to selMode
   610    if (selMode=NO_SELECT) procedure_return  //do nothing
   611
   612    //
   613    // Upon occasion item# comes thru as 65437 ( which appears to be
   614    // (65536 + CURRENT a.k.a. -99). It appears to be the result of a
   615    // toggle (space or mouse up). We must adjust for this.
   616    //
   617    IF (Item#=65437) Move CURRENT TO ITEM#
   618
   619    if (item# = CURRENT) get current_item to item#
   620
   621    // Force the selected item always to be column zero. This works
   622    // best for radio and checkboxes and just about anything else. It
   623    // also insures that a selected item is always column 0
   624    Move (Row(self,Item#)*Item_Limit(self)) to Item#
   625
   626    //
   627    if (newState=TOGGLE_STATE) ;
   628        move (not(select_State(self,item#))) to newState
   629    Forward set select_State item# to newState
   630
   631    // We only update the select array with single or multi-select modes
   632    // and only if not batch (batch already knows)
   633    if (Batch_State(self)=0 AND (selMode=SINGLE_SELECT OR selMode=MULTI_SELECT)) begin
   634      get row item# to iRow
   635      Move oSelectedRowIdsSet to hoSelArr
   636      get record_RowId iRow to riRec
   637      if (select_State(self,item#)) begin
   638        if (selMode = SINGLE_SELECT) begin
   639            send delete_data of hoSelArr
   640        end
   641        Get Add_RowId of hoSelArr riRec to iItem
   642      end
   643      else Begin
   644         send Remove_RowId of hoSelArr riRec
   645      end
   646    end
   647  End_Procedure
   648
   649  // Added parameter Clear_Fg. If true unset the selected item.
   650  // Returns: If batch     - next selected Item (column 0)
   651  //          if not batch - next selected record #
   652  //          -1 if no more items
   653  //  Should be used for finding the next batch item.
   654  //  For backwards compatibility this will work with recnum tables to return recnum
   655  function Next_Selected_Item Integer ClFg returns integer
   656    integer iRec iCounter iItem iItems
   657    rowId   riId
   658    boolean bBatch
   659
   660    Get Batch_State to bBatch
   661    If ( not(bBatch) and  not(IsRecnumTable(self,Main_file(self))))  begin
   662        Error DFERR_PROGRAM "Cannot use next_selected_item method with non-batch/RowKey"
   663        Function_return -1
   664    end
   665
   666    get Enumeration_Counter to iCounter
   667    if bBatch begin
   668      move (item_count(self) - 1) to iItems
   669      for iItem from iCounter to iItems
   670          if (select_state(self,iItem)) begin
   671             set Enumeration_Counter to (iItem + 1)
   672             set current_item to iItem
   673             If ClFg ;
   674                 Set Select_State Item iItem to False
   675             function_return iItem
   676          end
   677      loop
   678      function_return -1
   679    end
   680    else Begin
   681      // provided for backwards compatibility
   682      Get NextSelectedRowId ClFg to riId // will also load the the record
   683      If not (IsNullRowId(riId)) begin
   684          Get_Field_Value (main_file(self)) 0 to iRec   // compatibility w/ recnum
   685      end
   686      Else begin
   687          Move -1 to iRec
   688      end
   689      function_return iRec
   690    end
   691  end_function
   692
   693  // use new function (maintained for compatability sake)
   694  { Visibility=Private Obsolete=True }
   695  Function Next_Selection Returns Integer  //returns -1 if no selections
   696    Function_Return (Next_Selected_Item(self,0))
   697  end_function
   698
   699
   700  { Visibility=Private }
   701  procedure display_row integer iRow
   702    RowId   riRec
   703    integer SelMode iItem
   704    Get Select_mode to SelMode
   705    forward send display_row iRow
   706    // only if not batch and single or multi-select. This will speed things up.
   707    if (Batch_State(self)=0 AND (selMode=SINGLE_SELECT OR selMode=MULTI_SELECT)) begin
   708       get record_RowId iRow to riRec
   709       get find_RowId of oSelectedRowIdsSet riRec to iItem
   710       if (iItem<>-1) begin
   711           set select_state (iRow * item_limit(self)) to TRUE
   712       end
   713    End
   714  end_procedure
   715
   716  //
   717  // created to empty oSelectedRowIdsSet array along with list item data
   718  //
   719  { Visibility=Private }
   720  procedure empty_list
   721    integer obj#
   722    forward send empty_list
   723    Move oSelectedRowIdsSet to obj#
   724    if obj# ;
   725        send delete_data to obj#
   726  end_procedure
   727
   728  //
   729  // created for Bottom_of_Panel support
   730  //
   731  { Visibility=Private }
   732  function last_panel_item returns integer
   733    integer lastitem maxitem topItem
   734    get top_item to topItem
   735    Move (topItem + Display_Size(self) - 1) to lastitem
   736    get item_count to maxitem
   737    if (lastItem>maxitem) ;
   738         move (maxitem - 1) to lastitem
   739    while ( not(RowHasRecord(self, row(self,lastitem) )) AND lastitem > topItem)
   740      decrement lastitem
   741    end
   742    function_return lastitem
   743  end_function
   744
   745  //
   746  // created to support FIRST_CHARACTER searching
   747  //
   748  { MethodType=Event Visibility=Private }
   749  procedure Key integer keyval
   750    integer ser# file# retval ordr# oldCol mainfile curi bits
   751    integer iField
   752    string lookStr
   753    RowId  riRec
   754    Boolean bFound
   755
   756    //    if (keyval <= 255 AND search_mode(self) = FIRST_CHARACTER) begin
   757    if (Batch_State(self)=0 AND keyval <= 255 AND search_mode(self) = FIRST_CHARACTER) begin
   758
   759      get current_item to curi
   760
   761      move (character(keyval)) to lookStr
   762
   763      get item_option of self item curi 19 to bits
   764      if bits uppercase lookStr    //CAPSLOCK check
   765
   766      get data_file to file#
   767      if file# le 0 begin
   768        forward send key keyval
   769        procedure_return       //can't find if no valid main file
   770      end
   771
   772      Move (getRowId(file#)) to riRec
   773
   774      get Server to ser#
   775      get main_file to mainfile
   776      set_attribute DF_FILE_STATUS of File# to DF_FILE_INACTIVE
   777
   778      get data_field to iField
   779      Set_Field_value file# iField to lookStr
   780
   781      if mainfile ne file# begin  //find in parent-file
   782        if ser# ne 0 begin   //has a server
   783          send Request_Superfind to ser# GE file# (data_field(self,CURRENT))
   784        end
   785        else begin  //no server
   786          send entry_superfind GE mainfile
   787          if [found] begin
   788            send display
   789            indicate found true
   790          end
   791          else begin
   792            Move (FindByRowId(File#,riRec)) to bFound
   793          end
   794        end
   795      end
   796      else begin  //find in main-file
   797        get Ordering to ordr#
   798        if ser# ne 0 begin
   799          if (Deferred_State(self)) begin
   800            send Request_Read to ser# GE file# ordr#
   801            if [found] begin
   802              send display
   803              indicate found true
   804            end
   805          end
   806          else begin
   807            send Request_Find to ser# GE file# ordr#
   808          end
   809        end
   810        else begin
   811          if ordr# lt 0 move 0 to ordr#
   812          vfind file# ordr# GE
   813          if [found] begin
   814            relate file#
   815            send display
   816            indicate found true
   817          end
   818        end
   819        [not found] begin
   820            Move (FindByRowId(File#,riRec)) to bFound
   821        end
   822      end
   823    end
   824    else forward send key keyval
   825  end_procedure
   826
   827  procedure End_Construct_Object
   828    send Flag_Items // mark checkbox items
   829    forward send End_Construct_Object
   830  end_procedure
   831
   832  Procedure Toggle_Select
   833      integer selmode
   834      Get Select_mode to selmode
   835      // change so that autoselect also returns a space. This allows
   836      // the space to work w/ incremental searches
   837      if (selmode = NO_SELECT or selmode = AUTO_SELECT) Begin
   838          // if first character we don't want the toggle behavior
   839          // or the space (jumps to the top of the list)
   840          If (Search_Mode(self)<>FIRST_CHARACTER ) ;
   841             send key kSpace
   842      End
   843      else send select_toggling CURRENT TOGGLE_STATE
   844  End_Procedure // Toggle_Select
   845
   846  { Visibility=Private }
   847  procedure Flag_Items
   848    integer count maxx obj# Fss
   849    move (Prototype_Object(self)) to obj#
   850    Get Find_Search_state to FSS
   851    move (Item_Count(obj#) - 1) to maxx
   852    // get Radio_State to radState
   853    for count from 0 to maxx
   854      set Entry_State of obj# item count to FSS
   855      // if radState ne 0 set Checkbox_Item_State of obj# item count to true
   856    loop
   857  end_procedure
   858
   859  //  New procedure to handle radio items properly
   860  //
   861  { Visibility=Private }
   862  Procedure Entry_Display Integer f1 integer f2
   863    integer BI RS
   864    Get Base_Item to BI
   865    Get Radio_State to RS
   866    // if radio, only do this if we have an item in base_item
   867    If RS Move ( Item_Count(self) > BI ) to RS
   868    If RS Set CheckBox_Item_State Item bi to False
   869    Forward Send Entry_Display f1 f2
   870    If RS Set CheckBox_Item_State Item bi to True
   871  End_Procedure
   872
   873  //  Augment datalist to make sure that the correct item is selected if
   874  //  the select mode is auto_select
   875  //
   876  { Visibility=Private }
   877  Procedure New_Entry_Set
   878     Forward Send New_entry_Set
   879     if (select_mode(self) = AUTO_SELECT) ;
   880        set select_state item current to TRUE
   881   End_procedure
   882
   883  //  Augment activating to do all kinds of goodies
   884  //    1. if Auto_locate_state .... locate the object
   885  //    2. if Auto_Column_State .... find best column for this object
   886  //    3. if selected column has an MSG_Auto_Reorder_List on its iEntry
   887  //       make sure we are using that index
   888  //    4. if seed_list_state, seed the lookup list
   889  //
   890  { MethodType=Event  NoDoc=True }
   891  // as of 15.1 we changed all deactivating/activating signatures to not return values (see windows.pkg / ComboForm / Activating for more)
   892  Procedure Activating //Returns Integer
   893    integer RVal pScope item#
   894    integer FileNum FieldNum i ItemLimit ele OldMode
   895
   896    Get Focus of desktop to pScope // object that invoked us
   897    If pScope le DESKTOP Move 0 to pScope
   898
   899    // attempt to find column to start list at.
   900    // 03/31/94 - only respect auto_column_state if a popup type (i.e.,
   901    //            if Move_value_out_state is true
   902    If (Move_Value_out_State(self) AND pscope>0 ) Begin
   903       get delegation_mode of pscope to OldMode
   904       set delegation_mode of pscope to NO_DELEGATE_OR_ERROR
   905       get Data_File  of pscope Item CURRENT to FileNum
   906       set delegation_mode of pscope to OldMode
   907       Set Relational_State to false
   908       If FileNum Begin
   909            get Data_field of pscope Item CURRENT to FieldNum
   910            Set Relational_State to ( Main_File(self)=FileNum )
   911            If (Auto_Column_State(self)) Begin
   912                Get Select_Best_Column FileNum FieldNum to i
   913                if i ge 0 Set Initial_Column to i
   914            End
   915       End
   916    End
   917
   918    forward get MSG_activating to rVal  // normal activating
   919    If rVal Procedure_Return rVal       // it failed....end it
   920
   921    // set invoking object Id
   922    Set Invoking_object_id to pScope
   923
   924    // If auto_locate_state send message to locate this object
   925    If (Auto_Locate_State(self) ) Send Auto_Locate pScope
   926
   927    // seed list if required
   928    // 03/31/94 - only respect seed_list_state if a popup type (i.e.,
   929    //            if Move_value_out_state is true
   930    If (Move_Value_out_State(self) AND Seed_List_State(self)) ;
   931        Send Seed_List
   932  End_procedure
   933
   934  // Select_Best_Column
   935  //    Pass: the file and field of the invoking object's item.
   936  //  Return: The best column for this field or -1 if none are good
   937  //
   938  Function Select_Best_Column Integer FileNum Integer FieldNum Returns Integer
   939    Integer ele ItemLimit i
   940    Move (Item_Limit(self)-1) to ItemLimit
   941    // use prototype row in case actual list is empty
   942    Move (element(self)) to ele
   943    For i from 0 to itemlimit // check all items in the list
   944     // see if we have a file and field match...if so, that's the item
   945     If ( FileNum=Data_File(ele,i) AND FieldNum=Data_Field(ele,i) ) ;
   946        Function_return i
   947    loop
   948    Function_return -1
   949  End_Function
   950
   951  // This seeds a selection_list by performing an entry_update from the
   952  // invoking object strucuture and then finding the record we need.
   953  //
   954  // 04/05/94 - add support for seeding of export_item lists
   955  { Visibility=Private }
   956  procedure Seed_List
   957      // Augment procedure to seed the list.  If the Load_Buffer_Msg
   958      // property is non-zero, this message will be sent to the calling object,
   959      // which will load the buffer.  Otherwise, the value of the current item
   960      // in the calling object is used.
   961      integer srvr# ordr# obj# msg# ObjSrvr# Col PObj# File# CO
   962      integer iField iFile
   963      String Val
   964      get invoking_object_id to obj#
   965      get main_file to file#
   966      if (Obj#=0 or file#=0) procedure_return   // Main_File is mandatory
   967      get server to srvr#
   968      // 04/30/97 -JJT DSO must be in use before any seeding
   969      If srvr# Set in_use_state of srvr# to TRUE
   970      get ordering to ordr#
   971      get load_buffer_msg to msg# // optional message we can send to invoking obj
   972      clear File#    // First clear the main_file buffer
   973      // Seed file buffer
   974      if msg# eq 0 begin   // next load the buffer with seeded data
   975         // Default action is to perform an entry update just like a find
   976         // key would do. If we have a server allow the server to control this.
   977         // If no server talk directly to the object.
   978         If (Relational_State(self)) Begin
   979            Get Server of Obj# to ObjSrvr#
   980            If ObjSrvr# Send Request_Entry_Update to ObjSrvr# File# 1
   981            Else Send Entry_Update to Obj# File# 1
   982         End
   983         Else Begin // support seeding with exported items
   984            Get Export_Column to Col                // The column to export. If -1 we
   985            If Col eq -1 Get Initial_Column to Col  // use initial_column value.
   986            Get Prototype_object to PObj#
   987            Get Data_File  of PObj# Col to iFile
   988            Get Data_Field of PObj# Col to iField
   989            If (iFile>0 AND File#=iFile) Begin
   990               Get value of obj# item CURRENT to Val   // Value of item we come from
   991               set_field_value iFile iField to val
   992            End
   993         End
   994      End
   995      else Begin
   996         Move self to CO
   997         send msg# to obj# CO  // Sent to calling object. pass obj
   998      end
   999      // if we have a data_set for the list just tell the server to find the
  1000      // next record (request_read doesn't update anything...that's good).
  1001      // replaced by find_current_buffer
  1002      //if srvr# ne 0 Send request_read to srvr# ge filenumber ordr#
  1003      //else begin // if no server....find the old fashioned way & relate
  1004      //   vfind filenumber ordr# ge          // find ge <main_file> by <index>
  1005      //   if status indirect_file relate indirect_file
  1006      //end
  1007      // much better finding procedure looks up and down
  1008      Send Find_Current_Buffer
  1009  end_procedure
  1010
  1011  // Augmented to support auto_server state
  1012  // Note that this will only work properly with single object selection
  1013  // lists. Don't try this if you've got child DEO objects within this.
  1014  // Also, it is critical that this hook-up occurs when it does (before
  1015  // the object is active - active_state=F).
  1016  // 06/02/94 - changed to support both activate and Add_focus. Note that
  1017  //            both add_focus and Activate must be used since active_state
  1018  //            is set by Activate when the list has no client and is set by
  1019  //            add_focus when the list is in a client. We should look for a
  1020  //            cleaner way to do this.
  1021
  1022  //  called by Activate and add_focus
  1023  //
  1024  { Visibility=Private }
  1025  procedure Latch_Auto_server
  1026    Integer Srvr Obj OldMode FileNum
  1027    If (Active_state(self)=0) Begin // should always be false
  1028       if (Move_Value_out_State(self)) Begin  // if popup first
  1029            Send Store_Defaults      // save off current values
  1030            // if move-value-out we can not be using an invoking server
  1031            // so we set this false. It will get restored upon deactivation
  1032            Get Focus of desktop to Obj
  1033            If Obj gt DESKTOP Begin
  1034               // we will attempt pre-set auto_server_state. If the
  1035               // invoking object does not have a filenumber then
  1036               // we will not allow auto-server objects. This lets forms (not dbforms)
  1037               // use auto_server Sls without an error.
  1038               get delegation_mode of Obj to OldMode
  1039               set delegation_mode of obj to NO_DELEGATE_OR_ERROR
  1040               get Data_File  of Obj Item CURRENT to FileNum
  1041               set delegation_mode of Obj to OldMode
  1042               If FileNum eq 0 Set Auto_Server_State to False
  1043               // this is a very useful callback. The invoking object can set any
  1044               // properties in this object it wishes. Note the invoking object is
  1045               // passed the id of the dblist.
  1046               send Prompt_Callback to Obj self
  1047               if (Auto_Server_State(self)) Begin
  1048                   Get Server of Obj to Srvr        // if no invoking server, do
  1049                   If Srvr begin                    // not change the server at all.
  1050
  1051                       If (server(self)) ;
  1052                           Send Remove_Deo_From_Server  // the deo is removed from server
  1053
  1054                       Set private.Server to Srvr
  1055                       Send scan_servers
  1056                       // if we are latching on to a server, let's make sure the fields have this
  1057                       // server. The Enclient seed behavior might be messing this up. This created problems
  1058                       // with latching onto constrained servers
  1059                       send refind_records to srvr
  1060                   end
  1061               end
  1062            End
  1063       End
  1064    End
  1065  End_Procedure // Latch_Auto_server
  1066
  1067  { NoDoc=True }
  1068  Procedure Add_Focus Handle hoParent Returns Integer
  1069    Integer rVal
  1070    Send Latch_auto_Server // needed when slist is in a client
  1071    forward get MSG_add_focus hoParent to rVal
  1072    Procedure_return rVal
  1073  End_Procedure // Add_focus
  1074
  1075  { NoDoc=True }
  1076  procedure Activate returns integer
  1077    Integer rVal
  1078    Send Latch_auto_Server // needed when slist has not client
  1079    forward get MSG_Activate to rVal
  1080    Procedure_return rVal
  1081  End_Procedure // Activate
  1082
  1083  // Store_defaults stores the most commonly changed dblist properties when
  1084  // the object is activated. Restore_defaults restores them when it is
  1085  // deactivated. This only occurs with popup lists (move_value_out_State=t).
  1086  // Store and Restore_defaults should be mirrors of each other. This can be
  1087  // augmented if the developer needs to store other properties.
  1088  // This allows a developer to make custom changes in the invoking object
  1089  // in the callback procedure prompt_callback. The developer can change any
  1090  // of the common properties and they will get restored autoamtically by the
  1091  // dblist when it is deactivated.
  1092  { MethodType=Event }
  1093  Procedure Store_Defaults
  1094        set stored_Server               to (Server(self))
  1095        set stored_auto_Server_State    to (Auto_Server_State(self))
  1096        set stored_deferred_State       to (deferred_State(self))
  1097        set stored_Initial_Column       to (Initial_Column(self))
  1098        set stored_Export_Column        to (Export_Column(self))
  1099        set stored_Auto_Column_State    to (Auto_Column_State(self))
  1100        set stored_Seed_List_State      to (Seed_List_State(self))
  1101        set stored_Auto_Export_State    to (Auto_Export_State(self))
  1102        set stored_Export_Item_State    to (Export_Item_State(self))
  1103        set stored_Auto_Index_State     to (Auto_Index_State(self))
  1104        set stored_pbUseServerOrdering  to (pbUseServerOrdering(self))
  1105        set stored_Ordering             to (Ordering(self))
  1106        set stored_Display_Buffer_msg   to (Display_Buffer_msg(self))
  1107        set stored_Load_Buffer_msg      to (Load_Buffer_msg(self))
  1108        set stored_pbReverseOrdering    to (pbReverseOrdering(self))
  1109  End_Procedure
  1110
  1111  { MethodType=Event }
  1112  Procedure Restore_Defaults
  1113        set Server                  to (stored_Server(self))
  1114        set auto_Server_State       to (stored_Auto_Server_State(self))
  1115        set deferred_State          to (stored_deferred_State(self))
  1116        set Initial_Column          to (stored_Initial_Column(self))
  1117        set Export_Column           to (stored_Export_Column(self))
  1118        set Auto_Column_State       to (stored_Auto_Column_State(self))
  1119        set Seed_List_State         to (stored_Seed_List_State(self))
  1120        set Auto_Export_State       to (stored_Auto_Export_State(self))
  1121        set Export_Item_State       to (stored_Export_Item_State(self))
  1122        set Auto_Index_State        to (stored_Auto_Index_State(self))
  1123        // This MUST be restored before you restore Ordering or the ordering may
  1124        // not get properly reset
  1125        Set pbUseServerOrdering     to (stored_pbUseServerOrdering(self))
  1126        set Ordering                to (stored_Ordering(self))
  1127
  1128        set Display_Buffer_msg      to (stored_Display_Buffer_msg(self))
  1129        set Load_Buffer_msg         to (stored_Load_Buffer_msg(self))
  1130        set pbReverseOrdering       to (stored_pbReverseOrdering(self))
  1131  End_Procedure
  1132
  1133  //  Augmented to support auto_server state
  1134  //
  1135  // if auto_server set the server back to 0. At this point server.pkg
  1136  // has already removed this deo from the interface. Note there is a bug
  1137  // in server.pkg. If you change the server w/ set server the old
  1138  // server is not removed because remove_deo_from_Server is called after
  1139  // the server id is set to 0. (oops). This isn't impacted because the
  1140  // server has already been removed here.
  1141  { NoDoc=True }
  1142  // as of 15.1 we changed all deactivating/activating signatures to not return values (see windows.pkg / ComboForm / Activating for more)
  1143  Procedure Deactivating //Returns Integer
  1144      Integer rval St
  1145      Get Auto_Server_State to St        // added 01/29/97 to make SURE that
  1146      If ST Send Remove_Deo_From_Server  // the deo is removed from server
  1147      Forward Get MSG_Deactivating to rVal
  1148      If (rval=0 and St) Set Server to 0
  1149      If (Move_Value_Out_State(Self)) ; // if popup
  1150        Send Restore_Defaults                     // reset to default properites
  1151      Procedure_Return rVal
  1152  End_Procedure // DeActivating
  1153
  1154  // New Augmentation. We don't want select_toggling to set item_changed
  1155  // _state to TRUE if we are using find_Search_state.
  1156  { NoDoc=True }
  1157  Procedure Select_Toggling integer Itm Integer State
  1158    Integer CS
  1159    Get Item_Changed_State Item itm to CS
  1160    Forward Send Select_toggling Itm State
  1161    If (Find_Search_state(self)) ;
  1162       Set Item_Changed_State item itm to CS
  1163  End_Procedure
  1164
  1165
  1166  // If the property Find_Search_state is True (which is the default) the
  1167  // alternate search method is used. If it is false (you must set this),
  1168  // the old style incremental search is used.
  1169  //
  1170  // The new style works as follows:  (user presses <enter> )
  1171  //   Send message Find_Or_OK
  1172  //   Find_or_Ok checks to see if the item was changed (if it was
  1173  //      we are doing a lookup, if not we have made a selection).
  1174  //        If no Changes Send OK
  1175  //        Else Send Request_Lookup passing current_item
  1176  //             Request_Lookup sends Request_Find
  1177  //
  1178  // Note that the kEnter is now inconsistant in that it performs two
  1179  // behaviors (find or OK). While this is inconsistant it is totally
  1180  // intruitive (user's never notice the inconsistancy ... it does what
  1181  // they want it to do.
  1182  //
  1183
  1184  // Procedure Find_or_Ok  - sent by kEnter key.
  1185  //   If the item is changed we are doing a search (do request_lookup)
  1186  //   else (no change) we have selected and are returning a value
  1187  Procedure Find_or_Ok
  1188    Integer rVal
  1189    // added entry_state check allows mixed searching
  1190    If (Find_Search_State(self) AND ;        // if item is changed
  1191        item_changed_state(self,Current) AND ;  // do a lookup
  1192        Entry_State(self,CURRENT) ) ;
  1193          send Request_Lookup (Current_Item(self))
  1194    else Begin               // item not changed. Do a normal kEnter key
  1195       Get MSG_OK to rVal    // process by send OK message. Keep track and
  1196       Procedure_Return rVal // return the return value from OK in case UI
  1197    end                      // UI needs stopping
  1198  End_procedure
  1199
  1200  // Procedure Request_Lookup     (public)
  1201  //
  1202  // lookup and redisplay. Standard behavior is to just do a find. This
  1203  // is very useful for overriding and doing it yourself. The passed Item#
  1204  // is useful when doing an override.
  1205  Procedure Request_Lookup Integer Item#
  1206    // we are counting on request_Find returning the FOUND indicator propery set
  1207    Send Request_Find GE True
  1208    If (not(Found)) Begin
  1209        // if not found, we will attempt to find the first record in the other direction. This
  1210        // should be the last record. This keeps selection lists from ending up with a
  1211        // invalid value in the list after a failed selection. This can probably only happen
  1212        // when DD constraints are in place
  1213        Send Request_Find LE True
  1214    End
  1215  End_Procedure
  1216
  1217  // This is pretty much standard request_Find behavior. This acts pretty
  1218  // the same as pressing F9 in a table. Load buffer with screen values
  1219  // and find the record by the main_index for the current field. Pretty
  1220  // much "lifted" from the table class.
  1221  //
  1222  // 05/02/97 JJT - modified to properly superfind when the field is a
  1223  //                parent file.
  1224  procedure Request_Find integer mode integer entUpdtFlag
  1225    integer DataFile DataField MainFile MainField
  1226    integer ser# Dfrd ele itm
  1227    get Data_File to dataFile
  1228    if DataFile lt 1 procedure_return  // if no file for item, do nothing
  1229    get current_col to itm      // column of current item
  1230    get Server to ser#
  1231    get main_file to MainFile
  1232    Get Data_Field to DataField
  1233    if ser# ne 0 Begin                        // if this uses a data_set
  1234       Get Deferred_state to Dfrd             // let the data_set do the
  1235       // if main file <> data-file we assume the data-file is a parent
  1236       // and we will attempt to find via a superfind.
  1237       if datafile ne mainfile Begin
  1238          Get prototype_object to ele
  1239          // 06/06/95 - altered to find value from prototype row!
  1240          // get the field in the main file that relates to the parent.
  1241          // this will be our finding field in the main filed
  1242          get superfind_field of ele MainFile itm to MainField //get field for superfind
  1243          if MainField lt 0 procedure_return // if no mainfield, we cannot find
  1244       end
  1245
  1246       // this can be a find on the main or parent file
  1247       send Item_Find to ser# mode DataFile DataField EntUpdtFlag FALSE Dfrd
  1248
  1249       // If this was a parent file find, we must now do our "superfind" by
  1250       // finding on the main file using the mainfield. We do this manually
  1251       // in case deferred_state is TRUE. Request_superfind has no deferred
  1252       // mode variant (e.g. no request_superread).
  1253       If ( (found) AND MainFile<>DataFile) ;
  1254           send Item_Find to ser# GE MainFile MainField EntUpdtFlag FALSE  Dfrd
  1255       [Not found] Procedure_Return
  1256       if Dfrd send display // if deferred_state we must manually update list
  1257    end
  1258    else begin                // if no data_set use the built in
  1259      if datafile ne mainfile ; // if no server, we can do local super find
  1260         send entry_superfind mode MainFile   // entry_find behavior.
  1261      else ;
  1262         send entry_find mode    // entry_find behavior.
  1263      [Not found] Procedure_Return
  1264      Send Display
  1265    end
  1266    //**Set New_Item to (oldCol+top_item(self)) // stay in current column
  1267    Indicate Found TRUE
  1268  end_procedure
  1269
  1270
  1271  { Visibility=Private }
  1272  procedure Entry_Update integer mfile# integer flag
  1273    integer item# file# selMode
  1274    integer iField
  1275    string astr
  1276    If (Find_Search_State(self)) ;
  1277        Forward Send Entry_Update mFile# Flag
  1278    Else Begin
  1279        // copied directly from Selection_List Class.. Normal entry_update
  1280        // behavior
  1281        get target_file to file#
  1282        get select_mode to selMode
  1283        if ((SelMode = SINGLE_SELECT OR SelMode = AUTO_SELECT) AND ;
  1284            Select_Count(self) > 0 AND ;
  1285            (mfile# = 0 OR mfile# = file#)) begin
  1286          if (Batch_State(self)) begin
  1287            get first_selected_item to item#
  1288            get value item item# to astr
  1289            if (file#>0) begin
  1290              get target_field to iField
  1291              set_Field_value file# iField to astr
  1292            end
  1293
  1294          end
  1295        end
  1296    end
  1297  end_procedure
  1298
  1299  // This message is required by other deos. Always respond: NO
  1300  { MethodType=Property }
  1301  Function Auto_Save_State returns Boolean  // returns: Nope
  1302  End_Function // Auto_save_state
  1303
  1304  //
  1305  // Manually code entry-find. This corrects a bug in entry_class. This is
  1306  // only called by serverless searches (request_find).
  1307  //
  1308  { NoDoc=True }
  1309  procedure Entry_Find integer mode
  1310    integer ndx datafile datafield rec dataType
  1311    get data_file  to datafile
  1312    if datafile begin
  1313       get data_field to datafield
  1314       get_attribute DF_FIELD_INDEX of datafile datafield to Ndx // main index field
  1315       If (dataField=0 or Ndx>0) Begin
  1316          set_attribute DF_FILE_STATUS of datafile to DF_FILE_INACTIVE // inactivate buffer
  1317          send Entry_Update dataFile 1      //entUpdt all DEOs as required
  1318          Send vFind_Rec datafile ndx mode  //find the record
  1319       end
  1320
  1321    end
  1322  end_procedure
  1323
  1324end_class
  1325
  1326