Module Datalist.pkg
1//************************************************************************
2// File Name: Datalist.Pkg
3// Creation Date: Thu 06-06-1991
4// Author(s): John J. Tuohy
5//
6// Class: Data_List
7//
8// replacement Data_List
9// 03-21-1992 - adjustments to handle empty tables and list
10// 01-14-1993 - shut dynamic update state in delete_row proc.
11// 12/27/93 - updated for DAC DAF
12// 05/19/94 - set dynamic_update_state in scroll procedure (pg up/dn was
13// uncomfortably slow).
14// 07/21/94 - Added goto_top_row/Bottom_row messages and set top/bottom
15// panel keys to these messages (this is what the old 3.01 data_
16// list did. Also added Read_record (which does the same as
17// read_by_recnum (backwards compatability issue).
18// 09/13/94 - Added symbolic names for TOP, BOTTOM and CENTER of rows
19// 10/18/94 - Added Read_by_recnum in reorder_list to make sure the
20// current record is in the done array.
21//
22//************************************************************************/
23
24//************************************************************************/
25// 12/27/94 (JJT) Set Changed_state now back in server.
26// 12/30/94 (JJT) Display_UI's request_assign now passes table's Main_file
27// 01/04/95 (JJT) Modified Display_row always send entry_display. Note
28// that we use entry_display 0 1 through-out. This
29// bypasses any problems with done arrays not being set
30// correctly.
31// Modified Initialize_list to check that an active record
32// is valid before using it.
33// 02/01/95 (JJT) Disable_no_refresh_State disables display_other_ui
34// 02/01/95 (JJT) Added new display_ui logic that optimizes request_assign.
35// 03/08/95 (JJT) Fixed bug in intitialize_list (OR not and).
36// 03/09/95 (JJT) Display_ui clears changed_state conditional upon main_file
37// being the same is the server's main-file.
38// 03/27/95 (JJT) Clear_Current_record only sends clear to DSO if not
39// deferred and the main-files are OK. Else vClear
40// 05/01/95 (JJT) Altered refresh. When called as part of a saves or delete
41// where the table did not start the process the table
42// did not display properly. Save & delete should just
43// redisplay the current line. Also, a clear to an already
44// cleared lin should just blank the line (and not open up
45// a new line).
46// 05/16/95 (JJT) Improved above logic. Moved the unsorted_State set in
47// refresh into table.
48// 05/16/95 (JJT) Display_UI now checks the record of the base item row and
49// not the current_row. The row being displayed is not always
50// the current_row (based on current_item). It is always the
51// row of the base-item.
52// 06/06/95 (JJT) Col_Index. Get Superfind_field modified to use ele. (bug)
53// 06/09/95 (JJT) Fixed Refresh to handle empty rows properly. See refresh (bug)
54// 09/04/95 JJT - Code Clean up (removed dead commented code)
55// 09/14/95 JJT - In refresh changed add_row to Append_Blank_Row. Else
56// we have the chance that it will leave that row with a -1
57// in it instead of 0.
58//************************************************************************/
59// 10/19/95 (JJT) **JJT**(3) change how tables are refreshed when they
60// activate and deactivate. Also needs changes in server.
61// 02/04/97 (JJT) changed col_index to check for no superfind parent.
62// 09/17/97 JJT Changed procedure refresh to be a little less aggressive
63// about setting refresh_dirty_state. If the main file is not
64// part of the refresh do not set the dirty bit.
65// 12/15/97 JJT Changed Col_index to handle parent fields better. Only return
66// index, if parent field has an index.
67// 12/19/97 JJT Added missing ; refresh_page if statement
68//************************************************************************/
69// 05/03/00 JJT Item_matching only checks for items in current item column
70//************************************************************************/
71// 01/02/02 JJT Item_matching does better check with incremental non-batch searches
72//************************************************************************/
73// 2/26/2002 JJT - 8.2 clean up (indirect_file, local, self, etc.)
74
75use VDFBase.pkg
76use protoent.pkg
77use Widelist.pkg
78use refmodes.pkg // refresh mode constants
79use fndmodes.pkg // special find modes
80
81define FILL_FROM_TOP for 0
82define FILL_FROM_CENTER for -2
83define FILL_FROM_BOTTOM for -1
84
85Enum_List
86 define rsNewAtTop for -2
87 define rsNewAtBottom for -1
88 define rsCleared for 0
89 // anything >0 is considered active. If a recnum table, the recnum is used here. If RowKey, 1 is used
90End_Enum_List
91
92Register_Function CurrentRowId returns RowId
93Register_Function File_record returns integer
94Register_Function FileRowId returns RowId
95Register_Function FileRecord returns integer
96
97
98
99Register_Procedure Auto_reorder_List
100
101Use cRowIdArray.pkg
102
103class Data_List_mixin is a mixin
104 //
105 // forward-reference of row-prototype, Element
106 //
107 Register_Object Element
108
109 procedure Construct_Object integer img
110 forward send construct_object img
111 { Category=Behavior }
112 { PropertyType=Boolean }
113 Property Integer Batch_State False
114 { Category=Behavior }
115 { PropertyType=Boolean }
116 Property Integer Static_State False
117 { Category=Behavior }
118 { PropertyType=Boolean }
119 Property Integer Init_From_Top_State True //
120 { EnumList="Fill_From_Top, Fill_From_Center, Fill_From_Bottom" }
121 { Category=Behavior }
122 Property integer Initial_Row Fill_From_Top // dflt refresh row
123 { Category=Behavior }
124 Property integer Initial_Column 0 // dflt refresh col
125 { Category=Data }
126 { PropertyType=Boolean }
127 Property Integer Auto_Index_State False
128 { Category=Data }
129 { PropertyType=Boolean }
130 Property Integer Read_Only_State False
131 { Category=Data }
132 { PropertyType=Boolean }
133 Property Integer No_Relate_State False // optimizer. Non_DS only
134
135 // This is the current index direction. If true, index is reversed
136 { Category=Behavior }
137 property boolean pbReverseOrdering False
138
139 // If True, the DDO server is use if the DDO exists and it specifies an ordering. You usually set the
140 // DDO ordering when you have constraints and you always want the optimal index. In such a case
141 // it makes sense that the dbList or dbGrid should use this optimal index.
142 // This is set false for historical reasons. True is actually a better setting.
143 { Category=Data }
144 property Boolean pbUseServerOrdering False
145
146 { Visibility=Private }
147 Property integer private.Main_File 0
148 { Visibility=Private }
149 Property integer pbPrivateOrdering -1 // index order - private.. use ordering
150 { Visibility=Private }
151 Property integer Changing_State 0 // internal
152 { Visibility=Private }
153 Property integer Line_Display_State 0 // internal
154 { Visibility=Private }
155 Property Integer No_refresh_State FALSE // internal.optimizer
156 // This disables no_refresh_state. This property is internal and
157 // will probably go away (along the no_refresh_state)
158 { Visibility=Private }
159 Property Integer Disable_No_refresh_State TRUE // don't mess with this
160 { Visibility=Private }
161 Property Integer Item_Index_state FALSE // internal
162 { Visibility=Private }
163 Property Integer Find_Mode 0 // internal non-ds
164 { Visibility=Private }
165 property integer piLastDisplayableRows 0
166
167 // oRowIds stores the RowIds of each row. oRecords stores the status of each row. The status can be:
168 // rsNewAtTop (-2), rsNewAtBottom (-1), rsCleared (0), or "active" >0 (1 if RowKey table, rencum is recnum table)
169 // The pre-rowId table use a single array to store the record number and the status. To maintain compatibility we
170 // oRecords will continue to do this if the table supports recnum. This means that any update in oRowIds must also
171 // properly update oRecords. And, if the table is recnum based with a record, the record must be stored. Our of our
172 // packages pay no attention the recnum value - we just look at status where >0 is the same as "Active". If a developer
173 // happens to use the records for some purpose, their app will still work (but is should be changed). The old public messages
174 // to use records is get/set record_number and get/set current_record. The get versions work, the set versions will generate
175 // an error because you are probably trying to update the record array without updating the rowid array.
176
177 // this used to be records. By changing the name, we will see any errors (messages sent to this private object)
178 object oRecords is an array
179 end_object
180
181 object oRowIds is an cRowIdArray
182 end_object
183
184
185
186 set Auto_Fill_State to TRUE //default auto-fill to true
187 on_key kBegin_of_Data SEND Beginning_of_Data PRIVATE
188 on_key kEnd_of_Data SEND End_of_Data PRIVATE
189 //
190 on_key kBegin_of_Panel SEND Goto_Top_Row PRIVATE
191 on_key kEnd_of_Panel SEND Goto_Bottom_Row PRIVATE
192
193 Set add_focus_msg to initialize_list
194 set entry_msg to 0
195 End_Procedure // Construct_Object
196
197 { MethodType=Property }
198 { InitialValue=0 }
199 { Category="Data" }
200 procedure set Main_File integer newval
201 set private.Main_File to newval
202 end_procedure
203
204 { MethodType=Property }
205 function Main_File returns INTEGER
206 integer retval obj#
207 get private.Main_File to retval
208 if retval le 0 begin
209 get Server to obj#
210 if obj# ne 0 Begin
211 get Main_File of obj# to retval
212 // this'll speed it up the next time!
213 if Retval ne 0 Set private.Main_File to retval
214 end
215 end
216 function_Return retval
217 end_function
218
219 // internal
220 { MethodType=Event NoDoc=True }
221 // as of 15.1 we changed all deactivating/activating signatures to not return values (see windows.pkg / ComboForm / Activating for more)
222 Procedure Activating //Returns Integer
223 integer retval srvr# ordr# Col# i
224
225 // first make sure we have the correct index if an auto index
226 // state
227 Get Initial_Column to Col#
228 If (Auto_index_State(self) OR ;
229 (Item_Entry_Msg(Element(self),Col#)=MSG_Auto_Reorder_List) ) Begin
230 Get Col_Index Col# to ordr#
231 if ordr# ge 0 Set Ordering to Ordr#
232 end
233
234 get server to srvr#
235 get ordering to ordr#
236
237 if (Srvr# AND main_file(self)=main_file(srvr#) AND ordr#>=0) ;
238 set suggested_ordering of srvr# to ordr#
239
240 if (Srvr#=0 AND Ordr#=-1) Set Ordering to 0 // if no server...cant guess
241
242 set Read_Only_State to ;
243 (Read_Only_State(self) OR Srvr#=0 OR Read_Only_State(Srvr#) )
244
245 forward get msg_activating to retval
246 // always activate with an empty list...so it gets rebuilt
247 // If not static clear everything
248 // if static and not batch clear data but keep selections (delete_data)
249 //
250 if (retval=0 AND Refresh_dirty_state(self)) begin
251 set Refresh_dirty_state to false
252 If (Static_State(self)=0) Send Empty_List // Delete_Data
253 Else If (Batch_state(self)=0) Send Delete_Data
254 End
255 procedure_return retval
256 end_procedure
257
258 // NOTE: Although Set record_rowId, Set RecordStatus, Set CurrentRowId and Set CurrentRecordStatus are all public
259 // they should be used *very* carefully. A row is defined by its RowId and it's status. If you chnange one
260 // your probably want to change both. RecordStatus also is overloaded for historical purposes. If the table is
261 // is a recnum table it contains a recnum or a 0, top or bottom. If rowId it contains 1 or 0, top bottom.
262 // If you mess with these methods you must handle this properly. Look at procedure display_row to see how this is done.
263 // In general, you should never need to use these set messages. They are very low level and make it easy to break things.
264
265 { MethodType=Property }
266 Procedure Set Record_RowId Integer row# RowID riNewval
267 set RowId_Value of oRowIds row# to riNewval
268 end_procedure
269
270 { MethodType=Property }
271 function Record_RowId integer row# returns RowId
272 Function_Return (RowId_Value(oRowIds,row#))
273 end_function
274
275 { MethodType=Property }
276 procedure set RecordStatus integer row# integer newval
277 set array_Value of oRecords row# to newval
278 end_procedure
279
280 { MethodType=Property }
281 function RecordStatus integer row# returns integer
282 Function_Return (Integer_Value(oRecords,row#))
283 end_function
284
285
286 { MethodType=Property }
287 function CurrentRowId returns RowId
288 Function_Return (record_rowId(self,current_row(self)))
289 end_function
290
291 { MethodType=Property }
292 { DesignTime=False }
293 procedure SET CurrentRowId RowId NewVal
294 set record_rowId (current_row(self)) to newVal
295 end_procedure
296
297 { MethodType=Property }
298 { DesignTime=False }
299 procedure SET CurrentRecordStatus integer iNewVal
300 set RecordStatus (current_row(self)) to iNewVal
301 end_procedure
302
303
304 // returns true if current row has a RowId
305 { MethodType=Property }
306 function CurrentRowHasRecord returns Boolean
307 Function_Return (not(IsNullRowId(CurrentRowId(self))))
308 end_function
309
310 { MethodType=Property }
311 Function RowHasRecord integer iRow Returns Boolean
312 Function_Return (not(IsNullRowId(Record_RowId(self,iRow))))
313 End_Function
314
315 { Visibility=Private }
316 Function IsRecnumTable integer iFile Returns boolean
317 Boolean bRecnumTable
318 Get_Attribute DF_FILE_RECNUM_TABLE of iFIle to bRecnumTable
319 Function_Return bRecnumTable
320 End_Function
321
322 //
323 // note also sets base_Item and record_rowId
324 //
325 { Visibility=Private }
326 procedure display_row integer row#
327 integer oldlinedisp iRec
328 set Row_base_item to row#
329
330 // we need to update the rowId array and the status array. See notes above about the Status array. For proper row Id
331 // prcessing, this is used to determin the row status (new bottom, new top, cleared, active). If the table is recnum based
332 // the "active" flag is actually a record number allowing a developer to use old logic with their application.
333 // Hence the logic used below.
334 If (IsRecnumTable(self, Main_file(self))) begin
335 Get FileRecord to iRec
336 end
337 else begin
338 Move 1 to iRec // anything >0 means we have a rec
339 end
340
341 set recordStatus row# to iRec
342
343 set record_rowId row# to (FileRowId(self))
344
345 get line_display_State to oldlinedisp
346 set line_display_state to true
347 Send entry_Display 0 1
348 set line_display_state to oldlinedisp
349 end_procedure
350
351 //
352 // invoked by append_blank_row and insert_blank_row
353 //
354 { Visibility=Private }
355 procedure clear_row integer row#
356 integer oldLDS
357 get Line_Display_State to oldLDS
358 set Line_Display_State to true
359 set Row_base_item to row#
360 Send Clear_Current_record
361 set Line_Display_State to oldLDS
362 set recordStatus row# to 0
363 set record_rowId row# to (NullRowID())
364 end_procedure
365
366 { Visibility=Private }
367 procedure Insert_Row integer row# //insert row before specified row#
368 forward send insert_row (Prototype_Object(self)) row#
369 send insert_item of oRecords row# rsNewAtTop // rsNewAtTop //insert 0 before row#
370 send Insert_RowId of oRowIds row# (NullRowId())
371 end_procedure
372
373 { Visibility=Private }
374 procedure Insert_new_row integer row# //insert & display row before specified row#
375 send insert_row row#
376 send display_row row#
377 end_procedure
378
379 { Visibility=Private }
380 procedure Add_Row //add row at end of item list
381 Integer iRow
382 forward send add_row (ProtoType_Object(self))
383 Get row_count to iRow
384 set array_value of oRecords (iRow - 1) to rsNewAtBottom
385 set RowId_value of oRowIds (iRow - 1) to (NullRowId())
386 end_procedure
387
388 { Visibility=Private }
389 procedure append_new_row //add row at end of item list & display
390 send add_Row
391 send display_row (row_count(self) - 1)
392 end_procedure
393
394 { Visibility=Private }
395 procedure append_blank_row //add blank row at end of item list
396 send add_row
397 send clear_row (row_count(self) - 1)
398 end_procedure
399
400 { Visibility=Private }
401 procedure insert_blank_row integer row#
402 send insert_row row#
403 send clear_row row#
404 end_procedure
405
406 { Visibility=Private }
407 procedure Delete_row integer row# //remove given row#
408 integer lim baseItem counter width Dyn#
409 Get Dynamic_update_state to Dyn# // 01-14-1993
410 Set Dynamic_update_state to False // 01-14-1993
411 get item_limit to width
412 Move (width * row#) to baseItem
413 Move (baseItem + width - 1) to lim
414 for counter from baseItem to lim
415 send delete_item baseItem
416 loop
417 send delete_item of oRecords row#
418 send delete_RowId of oRowIds row#
419 Set Dynamic_update_state to Dyn# // 01-14-1993
420 end_procedure
421
422 //
423 // Function: Fill_next_Row
424 // Pass: Row# - The record for this row MUST be rsNewAtBottom or rsNewAtTop
425 // -1 = find down, -2 = find up.
426 // Return: 1 if found. if rsNewAtBottom or rsNewAtTop it is not found
427 // New record and related in buffer
428 //
429 { Visibility=Private }
430 Function Fill_next_row Integer Row# returns Integer
431 integer lastRow mode
432 Integer Rec# OldRec#
433 rowId riOldRec
434
435 get recordStatus row# to rec# // s/b rsNewAtBottom or rsNewAtTop
436 Move Row# to LastRow
437 if (rec# = rsNewAtBottom) begin
438 Decrement LastRow // lastrow is the current row we add to
439 Move 4 to mode // 4=GT
440 end
441 else begin
442 Increment LastRow
443 Move 0 to mode // 0=LT
444 End
445 // if lastrow is lt 0 then we must be adding row 0 to an empty table
446 // in this case place the LAST record in row 0. This could happen in
447 // the case of Deletes from the top line of a table (that is not the
448 // top of the file)
449 If lastrow lt 0 Send Find_Init Upward_Direction // find last record
450 Else Begin
451 Get recordStatus LastRow to OldRec# // get prior record
452 // read in the record for the current row
453 If (OldRec#=rsCleared or OldRec#=rsNewAtTop or OldRec#=rsNewAtBottom) Function_return Rec# // couldn't find the prior rec
454 // probably an empty list
455 // if currec eq lastrow we've already got the record we need
456 // optional syntax for speed... I'm not sure its worth it
457 Get record_RowId LastRow to riOldRec // get prior record
458 Send ReadByRowId riOldRec
459 Send Establish_Find_mode mode
460 Send Read_Next_Record
461 End
462 If (Found) begin
463 Send Display_Row row# // add to list
464 //Get record_rowId row# to riRec
465 Function_return 1 // 1 means we have a record
466 end
467 function_return Rec#
468 end_Function
469
470 { NoDoc=True }
471 procedure Down_Row
472 integer toitem Lim DynUpdt // retval
473 set search_mode to (search_mode(self)) //reset incr srch index
474 get Item_limit to lim
475 Move (current_item(Self) + lim) to toitem
476 If (toItem >= item_Count(self) AND ;
477 Batch_State(self)=0) Begin
478 Get Dynamic_update_state to DynUpdt
479 Set Dynamic_update_state to False
480 send add_row
481 set base_item to (Current_Row(self) * lim)
482 set Current_item to toItem
483 set Dynamic_update_state to DynUpdt
484 End
485 Else set current_item to toItem
486 end_procedure
487
488 procedure Up_Row
489 integer toitem Lim OldDynUpdt
490 set search_mode to (search_mode(self)) //reset incr srch index
491 get Item_limit to lim
492 Move (current_item(Self) - lim) to toitem
493 If (toItem<0 AND Batch_State(self)=0) Begin
494 get Dynamic_Update_State to oldDynUpdt
495 set Dynamic_Update_State to false
496 send Insert_Row 0
497 Move (toitem + lim) to toitem
498 Set New_item to (toitem+lim)
499 set base_item to (Current_Row(self) * lim)
500 set current_item to toItem
501 set Dynamic_Update_State to oldDynUpdt
502 end
503 Else set current_item to toItem
504 End_Procedure
505
506 { NoDoc=True }
507 procedure Beginning_of_Panel
508 set search_mode to (search_mode(self)) //reset incr srch index
509 forward send Beginning_of_Panel
510 end_procedure
511
512 { NoDoc=True }
513 procedure End_of_Panel
514 set search_mode to (search_mode(self)) //reset incr srch index
515 forward send End_of_Panel
516 end_procedure
517
518 { Visibility=Private }
519 Procedure Trim_Page // force to fit within visible table
520 Integer Count Drows OldChg
521 get changing_State to oldChg
522 set changing_State to true
523 // trim top
524 Get Top_Row to Count
525 While Count ne 0
526 Send Delete_Row 0
527 Decrement count
528 Loop
529 // trim bottom row if needed
530 Get Row_Count to Count
531 Get Displayable_Rows to dRows
532 While Count gt dRows
533 decrement Count
534 Send Delete_Row Count
535 Loop
536 set changing_State to oldChg
537 set Row_base_item to (Current_Row(self))
538 End_procedure
539
540 { Visibility=Private }
541 procedure Scroll integer dir integer dist
542 integer retval dynUpdt
543 set search_mode to (search_mode(self)) //reset incr srch index
544 if (Batch_State(self)) ;
545 forward send scroll dir dist
546 else begin
547 get dynamic_update_State to dynUpdt
548 set dynamic_update_State to false
549 get virtual_scroll dir dist to retval
550 set dynamic_update_State to dynUpdt
551 end
552 end_procedure
553
554 // private: only used by non-batch lists
555 //
556 { Visibility=Private }
557 Function Virtual_Scroll Integer Direction Integer Dist Returns integer
558 RowId riCRrec riRec
559 Integer Col# Row# Dest_row# Rowsadded dRows
560 Integer OldChg Dyn#
561
562 Get Current_Row to Row#
563 Get Current_Col to Col#
564 Get CurrentRowId to riRec
565 Get Displayable_Rows to dRows
566 // if no distance passed use default. Num row -1
567 if dist eq 0 Move (dRows - 1) to dist
568
569 // if scroll down must find records starting with last rec
570 // if scroll up must find records starting with top record
571 if direction eq DOWNWARD_DIRECTION ;
572 Move (Row_Count(self)-1) to Dest_row#
573 else Move 0 to Dest_row#
574 get record_rowId Dest_row# to riRec
575 if (IsNullRowId(riRec)) Function_Return 0 // no record...no movement
576 Send ReadByRowId riRec // could be optimized (save 1 find)
577 If Not (Found) Begin
578 Send ReadByRowId riRec
579 Function_Return 0
580 End
581
582 if (focus(desktop) = self) ;
583 get exec_exit item current to windowindex // force exit of current item
584
585 get changing_State to oldChg
586 set changing_State to true
587
588 Get Add_Rows Direction Dist to RowsAdded
589
590 If RowsAdded Begin
591
592 If Direction eq DOWNWARD_DIRECTION ;
593 Set Top_Item to ( ((Row_Count(self)-dRows)* Item_Limit(self))MAX 0 )
594 Else ;
595 Set Top_Item to 0
596 Send Trim_Page
597 End
598
599 set changing_State to oldChg
600
601 If RowsAdded ne Dist ;
602 Move (if(Direction=DOWNWARD_DIRECTION,Row_Count(self)-1,0)) to row#
603 // now relocate row# to top or bottom as needed
604 set Row_base_item to Row#
605 get record_rowId item row# to riRec
606 send ReadByRowId riRec
607 send Display_Other_UI
608 Set New_Item to (Row# * Item_limit(self) + Col# )
609
610 Send New_Entry_Set
611 Function_Return RowsAdded
612 end_Function
613
614 //
615 // created to empty list item data (aug'd by SelList)
616 //
617 { Visibility=Private }
618 procedure empty_list
619 send delete_data
620 end_procedure
621
622 { NoDoc=True }
623 procedure Delete_Data
624 integer obj#
625 forward send delete_Data
626 move oRecords to obj#
627 // we do this to get around program close down problems. Delete_data
628 // gets called by destroy-object. If changed_state is outside you
629 // get an exit error.
630 if obj# ne 0 Begin
631 send delete_Data of oRowIds
632 send delete_Data to obj#
633 set base_item to 0
634 Set Changed_state to FALSE // I would think delete_data should..it doesn't
635 End
636 end_procedure
637
638 //
639 // created for Server support
640 //
641 { Visibility=Private }
642 procedure Clear //notification of clear-record
643 if (Line_Display_State(self)) send entry_clear 1
644 end_procedure
645
646 //
647 // created for Server support
648 //
649 { Visibility=Private }
650 procedure Clear_All //notification of clear-set
651 integer oldDynUpdt
652 if (Line_Display_State(self)) send entry_clear_all 1
653 else begin
654 get Dynamic_Update_State to oldDynUpdt
655 set Dynamic_Update_State to false
656 send Empty_List // delete_data
657 Send Append_blank_row // add 1 empty row..for navigation aid
658 set Dynamic_Update_State to oldDynUpdt
659 end
660 end_procedure
661
662 //
663 //use of lineDisplayState is required because the list sends its Server
664 //msgs Clear and Find when it only wants to affect the current row
665 //
666 procedure Display
667 Integer Row# Col#
668 if (Line_Display_State(self)) send entry_display 0 1 // was 0 0
669 else begin
670//* is_file_included (main_file(self)) 1
671//* if [found] Begin
672 If (Item_Count(self)=0) Begin
673 Get Initial_Row to Row#
674 Get Initial_Column to Col#
675 end
676 else begin
677 Get current_Row to Row#
678 Get current_col to Col#
679 End
680 send refresh_page Row# Col#
681//* end
682//* else send entry_display 0 0
683 end
684 set changed_state to false
685 end_procedure
686
687 { Visibility=Private }
688 procedure display_Line
689 integer oldDisp
690 get line_display_State to oldDisp
691 set line_display_State to true
692 Send Display
693 set line_display_State to oldDisp
694 End_Procedure
695
696 //
697 // created for Server support
698 //
699 { Visibility=Private }
700 procedure Clear_Set //notification of derived clear
701 send clear_all
702 end_procedure
703
704 // Public:
705 // refresh page will refresh the screen both up and down. Based on
706 // the contents of the active record buffer.
707 // This allows for proper multi-user refreshes
708 //
709 Procedure Refresh_Page integer Row# integer Col#
710 Integer C#
711 If Num_Arguments eq 1 ;
712 Get Current_Col to C#
713 Else Move Col# to C#
714 if (item_count(self) AND focus(desktop) = self) ;
715 get exec_exit item current to windowindex //force exit of current item
716 set changed_state to false
717 if (active_State(self)) ;
718 send Fill_Page Row# c#
719 else send Empty_List // (delete_data) inactive list, so empty it
720 End_Procedure
721
722 // Internal
723 // Fill list around Row# Col# based on the current active record buffer
724 //
725 //
726 { Visibility=Private }
727 Procedure Fill_Page integer Row# integer Col#
728 handle hServer
729 // check that the target value is valid. If not, do a find from
730 // beginning. If that fails, clear the grid
731 get server to hServer
732 // if the main DDO is not the owner, attempt to find the owner DD before checking
733 // constraints. With auto-server stuff the server may be a child with invalid data but
734 // the main file for the list is ok. This check was put in post 8.2 - we found that
735 // auto-server dbLists being called from a hdr/dtl view would fail if the dtl was empty.
736 If (hServer and main_file(self)<>main_file(hServer)) ;
737 Get which_data_set of hServer (main_file(self)) to hServer
738 If (hServer and not(validate_constraints(hServer))) begin
739 // if the record is not valid, the only thing we can do is to try to build
740 // the list from the first record. Any other attempt to find the right record
741 // could lead to non-optimized or wrong finding
742
743 // This rarely ever happens as the bad record in buffer should be caught long
744 // before this. But if it does get this far, this proects the grid from displaying
745 // invalid data
746
747 send find_init downward_direction
748 if (not(found)) begin // if no record, there are no valid recor
749 send Clear_All // display an empty grid.
750 procedure_return
751 end
752 end
753 // chck for special row conditions
754 if Row# eq FILL_FROM_BOTTOM Move (Displayable_Rows(self)-1) to Row#
755 else if Row# eq FILL_FROM_CENTER Move ((Displayable_Rows(self)-1)/2) to Row#
756 Get Load_Page Row# to Row#
757 Set Row_base_item to Row#
758 Set New_Item to (Row# * Item_limit(self) + Col# )
759 send ReadByRowId (CurrentRowId(self))
760 Send Display_Other_UI
761 Send New_Entry_Set
762 End_Procedure
763
764 // Load_Page: Load page starting at row#.
765 // Internal
766 // Pass: Row# to load from. MUST have starting record in buffer
767 // Returns: The records new row (in case it got adjusted).
768 // Will relocate if the top is not filled.
769 // Note that the record is not in the buffer any more.
770 //
771 { Visibility=Private }
772 Function Load_Page Integer Row# Returns Integer
773 integer dynUpdt oldChg dRows whocares BS RowsAdded
774 RowId riRec
775 Get Batch_State to BS
776 get dynamic_update_state to dynUpdt
777 set dynamic_update_state to false
778 get Changing_State to oldChg
779 set Changing_State to TRUE
780 // number of rows in table-1
781 Move (Displayable_Rows(self)-1) to dRows
782 //
783 send delete_Data // delete all current data
784 Send Append_New_Row // this fills out the target row..now up and down
785 // 1st fill from row to top..if not at top
786 If (Row#>0 OR BS) Begin // fill er up bub
787 //Get Top_Item to OldTop
788 Get Add_Rows UPWARD_DIRECTION Row# to RowsAdded
789 If RowsAdded Begin
790 If BS ;
791 Set Top_Item to (Top_Item(self) - ;
792 ((Row# MIN RowsAdded)*item_limit(self)))
793 Else ;
794 Set Top_Item to 0
795 End
796 // this is the row we are really on now
797 Move RowsAdded to Row#
798 // if we need to fill down we MUST have the current record
799 // restored
800 If (Row#<DRows or BS) Begin
801 get record_rowId item Row# to riRec
802 if not (IsNullrowId(riRec)) send ReadByRowId riRec
803 end
804 End
805 // now fill from row to end of table
806 If (Row#<DRows or BS);
807 Get Add_Rows DOWNWARD_DIRECTION (dRows-Row#) to whocares
808 set Changing_State to oldChg
809 set dynamic_update_state to dynUpdt
810 Function_Return Row# // actual row we are on - if adjusted
811 end_function
812
813 // Add_Rows: Load records into table
814 //
815 // very internal
816 //
817 // Pass: Direction and number of rows to add (to top or bottom).
818 // Current top or bottom record must be in buffer.
819 //
820 // Returns: number of rows actually added.
821 //
822 { Visibility=Private }
823 Function Add_Rows integer direction Integer NumRows returns integer
824 integer mode RowsAdded BS
825 //Move CurRow to Row#
826 Get Batch_State to BS
827 Move (if(direction=UPWARD_DIRECTION,LT,GT)) to mode
828 Send Establish_Find_mode mode
829 Repeat
830 Send Read_Next_Record
831 [found] begin
832 if direction eq UPWARD_DIRECTION ;
833 send Insert_New_Row 0
834 else ;
835 send append_new_row
836 indicate found TRUE
837 Increment RowsAdded
838 end
839 until ( not(found) OR (BS=0 AND RowsAdded = NumRows) )
840 Function_Return RowsAdded
841 end_Function
842
843 { Visibility=Private }
844 Procedure New_Entry_Set
845 // manually force entry for new current item
846 if (focus(desktop) = self) ;
847 get exec_entry item current to windowindex
848 //if (select_mode(self) = AUTO_SELECT) ;
849 // set select_state item current to TRUE
850 end_procedure
851
852 // Assume the From# comes pre-loaded with its current record
853 // return with current record for the returned item (to#)
854 //
855 { MethodType=Event Visibility=Private }
856 function Row_Changing integer from# integer to# returns integer
857 integer lim toRow fromrow dynUpdt top rec#
858 RowId riRec
859 integer iOldCurrentItem iOldTo bToMoved iRet
860
861 get Current_item to iOldCurrentItem
862
863 If (Batch_State(self)) Function_Return to#
864
865 Get row Item to# to toRow // destination row
866 Get row Item from# to fromRow // source row
867 get Item_Limit to lim
868
869 // Temporary fix to fix problem of row changing getting sent
870 // in a 1 row 2 column table when doing a shift+tab
871 if fromRow eq toRow function_return to#
872
873 set new_item to to# // this assigns the new item
874 set base_item to (toRow * lim)
875 Get recordStatus toRow to Rec# // the new rec number
876 If (Rec#=rsNewAtBottom or Rec#=rsNewAtTop) Begin // if an added row we will fill this row
877 get fill_next_row torow to rec# // attempt to fill row (return, rsNewAtTop, rsNewAtBottom, rsCleared or >=1)
878 // we failed..remove this row. refind the proper record
879 If (Rec#=rsNewAtTop or Rec#=rsNewAtBottom or Rec#=rsCleared) Begin
880 send delete_Row toRow
881 If (to# < from#) // Move (to# + lim) to to#
882 else Begin
883 move from# to to#
884 Get Top_item to top
885 If top ne 0 Set Top_item to 0 // (top-1)
886 End
887 set new_item to to#
888 // restore proper record
889 Send ReadByRowId (CurrentRowId(self))
890 End
891 get Current_item to iOldTo
892 send Trim_Page
893 // sometimes trimming moves the current item. If this happens we
894 // want to know it
895 If (Current_item(self)<>iOldTo) ;
896 Move 1 to bToMoved
897 End
898 Else Begin
899 Get record_RowId toRow to riRec // the new rec number
900 if not (IsNullRowId(riRec)) send ReadByRowId riRec
901 End
902 Send Display_Other_UI // display all but itself
903 Get current_item to to# // in case it moved
904
905 // This traps cases where moves occur but the final current item ends up
906 // being in the same position where it started. We still want to force an entry
907 // message. So if we know a move has occured but it does not look like the item
908 // actually changed, we will force the message
909 if (bToMoved and to#=iOldCurrentItem) ;
910 get exec_entry to# to iRet
911
912 function_return to#
913 end_function
914
915 { MethodType=Event NoDoc=True }
916 Procedure Item_Change Integer iFromItem Integer iToItem returns integer
917 integer retval t_Col# newval
918 if (Changing_State(self)) procedure_Return iToItem
919 set Changing_State to true
920 // Added to restore current line back to its original contents
921 // if a read only object
922 If ( Read_Only_State(self) AND ;
923 Item_Changed_State(self,iFromItem) AND ;
924 Batch_State(self)=0) Send Display_Line
925 forward get msg_item_change iFromItem iToItem to retval
926 set Changing_State to false
927 set row_base_item to (row(self,retval))
928 If ( (Auto_index_state(self) OR ;
929 Item_index_state(self)) AND ;
930 (Column(self,iFromItem)<>Column(self,Retval)) ) ;
931 Begin
932 Send Reorder_list retval // assign new index
933 get Current_Item to newval // if current_item changed
934 if newval ne iFromItem move newval to retval // then we re-ordered.
935 End
936 Set Item_Index_State to FALSE
937 procedure_Return retval
938 end_procedure
939
940 // This returns true if the ordering should come from the DDO. This only
941 // happens if the pbUseServerOrdering is T and there is a server with an
942 // ordering property. If T, the ordering property will return the DDOs ordering.
943 // Important: If DDO has no Ordering (it usually does not), this returns false indicating
944 // that the ordering for the list is provided by the list
945
946 Function ServerOrderingOverride returns Boolean
947 handle hoServer
948 Get Server to hoServer
949 Function_return (pbUseServerOrdering(self) and hoServer and (ordering(hoServer)>=0))
950 end_function
951
952
953 // Public: Reorder_list
954 // Assign Index and refresh screen based.
955 // Parameter: iNewCol is optional, if not passed use current column
956 // If bacth or if the DDO controls the ordering, nothing happens
957 Procedure Reorder_list Integer iNewCol
958 integer iIndex iRow iCol iItem iNewOrder
959
960 If (Batch_state(self)) Procedure_Return // can't reorder batches
961
962 // If server is controlling the index, we do not reorder by column
963 If (ServerOrderingOverride(self)) Procedure_return
964
965 // In some cases the current record is not in place with done flags
966 // set correctly. Read current record should help this.
967 Send ReadByRowId (CurrentRowId(self))
968
969 // if no arguments use current_item else use to#
970 if (NUM_ARGUMENTS<1);
971 get current_item to iItem
972 else;
973 move iNewCol to iItem
974
975 Get Row iItem to iRow
976 Get Column iItem to iCol
977 Get Col_Index iCol to iIndex
978 If (iIndex=-1 OR Ordering(self)=iIndex) Function_Return
979 Set Ordering to iIndex
980 set Changing_State to TRUE
981 send refresh_page iRow iCol
982 set Changing_State to FALSE
983 end_procedure
984
985 // Set index to idex number iIndex and refresh.
986 Procedure Request_New_Index Integer iIndex
987
988 // If server is controlling the index, we do not reorder
989 If (ServerOrderingOverride(self)) Procedure_return
990
991 If (Ordering(self)<>iIndex) Begin
992 Set Ordering to iIndex
993 Send Display
994 End
995
996End_Procedure
997
998 // Function Col_Index public
999 // return the best Index for this column or -1 if no choice is good
1000 //
1001 // This is useful for override and augmentation. When the Auto_Reorder_List
1002 // message is invoked as part of iEntry this gets called. If we override it
1003 // we can do some custom selections for a choice of index.
1004 //
1005 Function Col_Index Integer Item# Returns Integer
1006 integer iFile iField fldNdx
1007 integer mainfile mainNdx Ele Itm
1008 Move (MOD(item#,item_limit(self))) to Itm
1009 Move (Prototype_object(self)) to ele // use prototype in case we have an empty table
1010 get data_field of ele item itm to iField
1011 get data_file of ele item itm to iFile
1012 if iFile begin
1013 get main_file to mainfile
1014 if iFile ne mainfile Begin // if tables field is a parent field
1015 // first make sure that this parent field has an index, If not
1016 // it cannot do an auto-index
1017 If iField gt 0 Begin // if recnum, we have an index
1018 get_attribute DF_FIELD_INDEX of iFile iField to FldNdx
1019 If FldNdx eq 0 function_return -1 // if none, return -1
1020 End
1021 // it has an index, now make that there is a relational link
1022 // between the parent file and the main (child file). If not,
1023 // no index
1024 move mainfile to iFile
1025 // 06/06/95 - altered to find value from prototype row!
1026 Get superfind_field of ele iFile itm to iField //get field for superfind
1027 end
1028 if iField eq 0 function_return 0
1029 if iField lt 0 function_return -1
1030 Get_Attribute DF_FIELD_INDEX of iFile iField to FldNdx
1031 end
1032 Function_Return (If(FldNdx=0,-1,FldNdx))
1033 End_Function
1034
1035 procedure Fill_List
1036 Send Fill_Page (Initial_Row(self)) (Initial_Column(self))
1037 end_procedure
1038
1039 // Internal:
1040 // Fill from top or bottom of the table based on dir
1041 // If the table is empty then we will use the Initial_Column as our column.
1042 // If the table has lines. we use the current column position.
1043 { Visibility=Private }
1044 Procedure Beg_End_Data Integer Direction Integer NoSave
1045 Integer rowcount Newish Col# Lim
1046 set search_mode to (search_mode(self)) //reset incr srch index
1047 Get row_count to rowcount
1048 Move ( RowCount<1 OR ;
1049 (rowCount = 1 AND IsNullRowId(record_rowId(self,0)) ) ) to Newish
1050 Move (if(Newish, Initial_Column(self),;
1051 Current_Col(self) )) to Col#
1052 //
1053 If (Batch_State(self) and Newish=0) Begin
1054 If Direction eq DOWNWARD_DIRECTION ;
1055 set Current_Item to 0
1056 Else ;
1057 set Current_item to ( (Row_Count(self)-1) * ;
1058 Item_Limit(self) )
1059 Send Move_to_Column Col#
1060 End
1061 Else begin
1062 Send Find_Init Direction
1063 if [found] ;
1064 send Refresh_Page (if(direction=Downward_Direction,0,-1)) Col#
1065 else send Clear_All
1066 End
1067 send update_dependent_items
1068 End_Procedure
1069
1070 procedure Beginning_of_Data Integer NoSave
1071 Integer Ns
1072 If Num_Arguments eq 0 Move 1 to NS
1073 Else Move NoSave to NS
1074 Send Beg_End_Data Downward_Direction NS
1075 end_procedure
1076
1077 procedure End_of_Data Integer NoSave
1078 Integer Ns
1079 If Num_Arguments eq 0 Move 1 to NS
1080 Else Move NoSave to NS
1081 Send Beg_End_Data Upward_Direction NS
1082 end_procedure
1083
1084 // Internal: for override
1085 { MethodType=Event Visibility=Private }
1086 procedure Initialize_List
1087 integer rowCount srvr
1088 RowId riRec
1089 forward send initialize_list // Actually does nothing...
1090 get Row_Count to rowCount // If there are no rows or 1 row but
1091 if (rowCount < 1 OR ; // an empty field we initialize.
1092 (rowCount = 1 AND IsNullRowid(record_rowId(self,0)) )) begin
1093 Get FileRowId to riRec // FOUND will tell us if we have an active rec
1094 // 01/04/95 JJT-modified to make sure that the found record is a valid
1095 // record. If it is not ingore the record
1096 If (Found) begin
1097 get server to srvr
1098 // JJT- 03/08/95
1099 // was: If (srvr AND Validate_Constraints(srvr)) begin
1100 If (srvr=0 OR Validate_Constraints(srvr)) begin
1101 Send Display
1102 procedure_return
1103 end
1104 end
1105 If (Init_From_Top_State(self)) send Beginning_of_Data
1106 else send End_of_Data
1107 end
1108 End_procedure
1109
1110 // This was changed in 8.1 to better handle incremental searches with non-bacth lists.
1111 { Visibility=Private }
1112 function Item_Matching string sSearch integer iItem returns integer
1113 handle hoServer
1114 integer iFile iField iIndex iMain
1115 RowId riRecord
1116 integer iCol iLen
1117 integer iNewItem
1118 boolean bFound
1119 string sLookStr sSt
1120 if (Batch_State(self)) begin
1121 // This now does a more intelligent item matching..It only returns values from
1122 // current item's column. It doesn't make sense to search for items in a different
1123 // column.
1124 get Current_col to iCol
1125 decrement iItem
1126 Repeat
1127 increment iItem
1128 forward get item_matching sSearch to iItem
1129 // if match is found in different col, keep looking.
1130 Until (iItem=-1 OR Column(self,iItem)=iCol)
1131 move iItem to iNewItem
1132 end // if batch state
1133
1134 else begin // non batch incremental search
1135 // The last character is a "*", we want to remove that from
1136 // the lookup string
1137 Move (length(sSearch)) to iLen
1138 if (iLen>1) ;
1139 Move (left(sSearch,iLen-1)) to sLookStr
1140 else ;
1141 Move "" to sLookStr
1142 get data_file to iFile
1143 if (iFile<=0) ;
1144 function_return -1 //can't find if no valid main file
1145
1146 get data_field to iField
1147 get Server to hoServer
1148 get main_file to iMain
1149
1150 Move (GetRowId(iFile)) to riRecord // remember current rec, if find
1151 // fails we will refind this.
1152
1153 // deactivate field buffer and load new lookup stringi
1154 set_attribute DF_FILE_STATUS of iFile to DF_FILE_INACTIVE
1155 Set_Field_value iFile iField to sLookStr
1156
1157 if (iMain<>iFile) begin // find in parent-file (unlikely)
1158 if hoServer begin // has a server
1159 send Request_Superfind to hoServer GE iFile iField
1160 Move (Found) to bFound
1161 end
1162 else begin //no server
1163 send entry_superfind GE iMain
1164 Move (Found) to bFound
1165 if bfound send display
1166 end
1167 end
1168 else begin // find in main-file (expected type of search)
1169 get Ordering to iIndex
1170 if (hoServer) begin
1171 send Request_Read to hoServer GE iFile iIndex
1172 Move (Found) to bFound
1173 end
1174 else begin
1175 if (iIndex<0) move 0 to iIndex
1176 vfind iFile iIndex GE
1177 Move (Found) to bFound
1178 end
1179 // found, double check that the field is matches incrementally.
1180 // if we don't do this the search jumps to wrong record
1181 If bFound begin
1182 get_field_value iFile iField to sSt
1183 Move (left(sSt,length(sLookStr))) to sSt
1184 // doing a lower case search is imperfect but it should
1185 // be close enough. The item search logic is really case
1186 // insensitive. Search must be perfect, or it is not match
1187 if (lowercase(sLookStr)<>lowercase(sSt)) move 0 to bFound
1188 end
1189
1190 // if *truly* found, update list or server as needed
1191 if bFound begin
1192 if hoServer begin
1193 if (deferred_state(self)) ;
1194 send display //if deferred just update the list
1195 else ;
1196 send request_assign of hoServer 0 // this will latch and update list
1197 end
1198 else begin
1199 relate iFile // no server, just relate and display
1200 send display
1201 end
1202 end
1203
1204 end // end of main-file search
1205
1206 If bFound ; // if found
1207 Get Current_Item to iNewItem // set found item for return
1208 Else Begin // if not found
1209 move -1 to iNewItem // set -1 as return item
1210 Move (FindByrowId(iFile,riRecord)) to bFound // refind the original record
1211 end
1212 end // end of non batch search
1213 function_return iNewItem
1214 end_function
1215
1216
1217 { Visibility=Private }
1218 procedure Scan_Servers
1219 send find_servers_to_watch TRUE
1220 end_procedure
1221
1222 // Find_Current_Buffer: Public Message
1223 // find record that matches the record buffer, Current record should
1224 // be inactive --- Forces load buffer record..does not notify others.
1225 Procedure Find_Current_Buffer
1226 Send Establish_Find_mode Ge // first look down the list
1227 Send Read_Next_record // anyone home?
1228 [~Found] Send Find_init upward_direction // no..go to end of the list
1229 End_procedure
1230
1231 // Public:
1232 // Move to the selected column...
1233 Procedure Move_to_Column Integer Col#
1234 If (Col#<>Current_Col(self)) ;
1235 Set Current_Item to (Base_Item(self)+Col#)
1236 End_Procedure
1237
1238 // Refind & relate the record in rec# by Main_file
1239 //
1240 procedure Find_RowId RowId riRec
1241 Send ReadByRowId riRec // read and relate the record
1242 Send Display_UI
1243 end_procedure
1244
1245
1246 //--------------------------------------------------------------------
1247 // All record finding handled by these routines
1248 //--------------------------------------------------------------------
1249 //
1250 // Procedure Display_UI
1251 // Procedure Display_Other_UI
1252 // Procedure Read_by_Recnum record
1253 // Procedure Establish_Find_Mode find_mode
1254 // Procedure Read_Next_Record
1255 // Procedure Find_Init Direction
1256 // Procedure Clear_Current_Record
1257 // Function File_record Returns Record
1258 //
1259
1260 // display other UI objects. If server only do this if the
1261 // deferred_state to false (also do a request assign).
1262 // if no server this is idea for override
1263 //
1264 // JJT- Modify to never set no_refresh_state to true.
1265 // This was an optimzation that never should have
1266 // happened. By disabling this, display_other_ui acts exactly like
1267 // display_ui. So, this message might go away in the future.
1268 { Visibility=Private }
1269 Procedure Display_Other_UI
1270 Integer Old_RS
1271 Get No_refresh_State to Old_Rs
1272 // this property will probably go away - so don't get used to it.
1273 If not (Disable_No_refresh_State(self)) ;
1274 Set No_refresh_State to TRUE
1275 Send Display_UI
1276 Set No_refresh_State to Old_Rs
1277 End_Procedure
1278
1279 // display all UI objects. If server only do this if the
1280 // deferred_state to false (also do a request assign).
1281 // if no server just do the one object
1282 // - JJT Don't send request_assign if already assigned
1283 // - JJT Pass main_file with request_assign
1284 { Visibility=Private }
1285 Procedure Display_UI
1286 Integer Srvr# OldDisp No_refrsh mFile row#
1287 get Line_Display_State to oldDisp
1288 set Line_Display_State to true // set flag to prevent regen
1289 Get No_Refresh_state to No_Refrsh
1290 Get Server to Srvr#
1291 if (Srvr#=0 OR Deferred_State(self)) Begin
1292 If Not No_refrsh Send Display
1293 End
1294 Else Begin
1295 // 01/03/95 - only latch if we need to, else just display_ui.
1296 // main_file added in case server is not mainfile (from Lee)
1297 //Move (Current_record(self)=Current_record(srvr#)) to no_refrsh
1298 // 05/16/95 - don't use current-record (which is based on current_item)
1299 // instead use the row of the current base_item. This is the one we are
1300 // setting in request_assign or display_ui
1301 get row item (base_item(self)) to row#
1302 Move (IsSameRowId(record_rowId(self,row#),CurrentRowId(srvr#))) to no_refrsh
1303 Get Main_File to mFile
1304 //if No_refrsh Send Display_UI to srvr#
1305 //else Send Request_Assign to srvr# mFIle
1306
1307 //04/25/96 - It should be now safe to just send request_assign. This was
1308 // here because there was a bug in tables DSOs setting changed
1309 // state and not setting em to 0. This should have been fixed
1310 // in the 3.1 data-set.
1311 // if DDO is busy, the record will already by assigned by the DDO.
1312 If (operation_mode=mode_waiting) ;
1313 Send Request_Assign to srvr# mFIle
1314
1315 // if mFile is same as server main_file then the server's should be
1316 // unchanged. I would think that Request_assign would do this for us
1317 // so it is possible that this is not needed at all. But it must have
1318 // been here for some reason. Test removing this at some point. JJT
1319 if ( mFile=Main_File(Srvr#) ) Set Changed_State of Srvr# to FALSE
1320 End
1321 set Line_Display_State to oldDisp // reset no-regen flag
1322 End_Procedure
1323
1324 procedure ReadByRowId RowId riRec
1325 integer srvr# file#
1326 get Server to srvr#
1327 get Main_File to file#
1328 if srvr# ne 0 send ReadByRowId to srvr# file# riRec
1329 else send vReadRowId file# riRec
1330 end_procedure
1331
1332
1333 // This handles translation of find modes to make reverse ordering
1334 // work. Pass the mode and return the mode, translated if reverse ordering is needed
1335 { Visibility=Private }
1336 Function FindMode integer mode returns integer
1337 If (pbReverseOrdering(self)) begin
1338 case begin
1339 case (mode=ge) move (le) to mode
1340 case (mode=gt) move (lt) to mode
1341 case (mode=lt) move (gt) to mode
1342 case (mode=le) move (ge) to mode
1343 case (mode=FIRST_RECORD) move (LAST_RECORD) to mode
1344 case (mode=LAST_RECORD) move (FIRST_RECORD) to mode
1345 case end
1346 end
1347 function_return mode
1348 end_function
1349
1350
1351 // Establish finding direction
1352 // Pass: Mode
1353 //
1354 Procedure Establish_Find_Mode Integer eFindMode
1355 Handle hoServer hoOwnerDD
1356 Integer iFile
1357 Get Server to hoServer
1358 Get FindMode eFindMode to eFindMode // mode might change if reverse ordering
1359 if hoServer begin
1360 // we want to make sure we sent establish_find_direction to the owner DDO
1361 // (if a main owner can be found). Once established we will use request_read
1362 // to find next records. Request_read properly directs their constraints to
1363 // the correct owner (not that locate_next, which we don't use, does not)
1364 Get main_file to iFile
1365 If (main_file(hoServer)<>iFile) Begin
1366 Get which_data_set of hoServer iFile to hoOwnerDD
1367 if hoOwnerDD ;
1368 Move hoOwnerDD to hoServer
1369 end
1370 send establish_find_direction of hoServer eFindMode iFile (Ordering(self))
1371 end
1372 Else ;
1373 Set Find_Mode to eFindMode
1374
1375 End_Procedure
1376
1377 // Read_Next_Record
1378 // Return: FOUND, and record in and related
1379 //
1380 Procedure Read_Next_Record
1381 handle hoServer hoOwnerDD
1382 integer iFile
1383 Get main_file to iFile
1384 Get Server to hoServer
1385 If hoServer Begin
1386 If (main_file(hoServer)<>iFile) Begin
1387 Get which_data_set of hoServer iFile to hoOwnerDD
1388 if hoOwnerDD ;
1389 Move hoOwnerDD to hoServer
1390 end
1391 send Locate_Next of hoServer
1392 end
1393 Else ;
1394 Send vFind_Rec iFile (Ordering(self)) (Find_Mode(self))
1395 End_Procedure
1396
1397 Procedure Find_Init Integer Dir
1398 Integer srvr# file# Ordr# mode
1399 Get server to srvr#
1400 Get main_file to file#
1401 Get Ordering to Ordr#
1402 if Srvr# ne 0 Begin
1403 Move (if(Dir=Downward_Direction,FIRST_RECORD,LAST_RECORD)) to Mode
1404 Get FindMode Mode to Mode // mode might change if reverse ordering
1405 send Request_Read to srvr# mode file# Ordr#
1406 End
1407 else send vFind_Init File# Ordr# Dir
1408 End_Procedure
1409
1410 // Replaced with proc below 03/27/95
1411 //procedure Clear_Current_Record
1412 // integer ser# //oldchg
1413 // get Server to ser#
1414 // //
1415 // // NOTE: Clear may cause problems with other tables on the same data_Set
1416 // //
1417 // If Ser# ne 0 Send Clear to ser#
1418 // else Send vClear (Main_File(self))
1419 //end_procedure
1420
1421 // alternate better method for clearing file. If deferred or main-file
1422 // is not the same as the server then only the buffer should clear.
1423 procedure Clear_Current_Record
1424 integer ser# File#
1425 get Server to ser#
1426 Get Main_File to File#
1427 // Only send clear to server if not Deferred, a server exists
1428 // and the list's main-file is the same as the server or it is
1429 // 0 (which implies use server's main-file). Else just clear the
1430 // main-file's buffer.
1431 // 3/19/2002 JJT- added operation_mode check to avoid re-entrant DDO operation
1432 If ( (deferred_State(self)=0) AND ;
1433 (Ser# and operation_mode=mode_waiting And ;
1434 (File#=0 OR main_file(Ser#)=File#))) ;
1435 Send Clear to ser#
1436 else Send vClear File#
1437 end_procedure
1438
1439 // Function: FileRowId
1440 // Returns: The record number of the record currently in the buffer
1441 // Return FOUND if record is active
1442 //
1443 Function FileRowId Returns RowId
1444 integer iStat iFile
1445 RowId riRec
1446 get main_file to iFile
1447 if (iFile<>0) begin
1448 Get_Attribute DF_FILE_STATUS of iFile to iStat
1449 Indicate FOUND as (iStat<>DF_FILE_INACTIVE)
1450 Function_Return (GetRowId(iFile))
1451 end
1452 Else Begin
1453 Indicate FOUND as (False)
1454 Function_Return (NullRowId())
1455 end
1456 End_Function
1457
1458 Function FileRecord Returns Integer
1459 integer iStat iFile iRec
1460 get main_file to iFile
1461 if (iFile<>0) begin
1462 Get_Attribute DF_FILE_STATUS of iFile to iStat
1463 Get_field_value iFile 0 to iRec // compatibility w/ recnum
1464 Indicate FOUND as (iStat<>DF_FILE_INACTIVE)
1465 Function_Return iRec
1466 end
1467 End_Function
1468
1469
1470 //------- Various direct file commands. Called when no server ----
1471
1472 { Visibility=Private }
1473 Procedure vFind_Init Integer File# Integer ordr# Integer Dir
1474 Send vClear file#
1475 Send vFind_Rec File# Ordr# (if(Dir=Downward_Direction,3,1))
1476 End_Procedure
1477
1478 { Visibility=Private }
1479 Procedure vFind_Rec Integer File# Integer Ordr# Integer Mode
1480 vFind file# ordr# mode
1481 [found] Send vRelate file#
1482 End_Procedure
1483
1484 { Visibility=Private }
1485 procedure vReadRowId integer iFile RowId riRec
1486 boolean bFound
1487 Move (FindByRowId(iFile,riRec)) to bFound
1488 end_procedure
1489
1490 { Visibility=Private }
1491 Procedure vRelate integer File#
1492 If (No_Relate_State(self)) Procedure_Return
1493 Relate File#
1494 Indicate found TRUE
1495 End_Procedure
1496
1497 { Visibility=Private }
1498 Procedure vClear integer File#
1499 Clear file#
1500 End_Procedure
1501
1502 // private implementation: created post 8.2-JJT
1503 // Called by refresh (which is called by DDs) The purpose is to return true if the refresh is part
1504 // of a parent/child constrained autofill. When autofill is called the grid or dblist needs to refresh
1505 // based around an initial row and column (e.g. filling an order entry detail table). When not autofill
1506 // the refresh should be based around the current row and column (e.g. filling a dblist). The method for
1507 // determining if this is a DD based autofill is imperfect and might be changed in future revisions.
1508 { Visibility=Private }
1509 Function isAutoFillFind returns integer
1510 handle hoServer
1511 Get server to hoServer
1512 // is a child participating in a constrained auto-fill if:
1513 // 1) DD exists,
1514 // 2) DD has same main file as the grid,
1515 // 3) operation origin exists (meaning this is called via a DD operation)
1516 // 4) the DDO starting the operation (operation_origin) is a parent DDO. We
1517 // we which_data_set sent to operation origin. If it cannot find the main_file of
1518 // the grid, then it must be a child DDO (which_data_set only looks up).
1519 If (hoServer and ;
1520 main_file(self)=main_file(hoServer) and ;
1521 operation_origin<>0 and ;
1522 which_data_set(operation_origin,main_file(self))=0) ;
1523 function_return 1
1524 else ;
1525 function_return 0
1526 end_function
1527
1528
1529
1530 //-------------------------------------------------------------------
1531 { MethodType=Event }
1532 procedure Refresh integer notifyMode
1533 integer mainfile row# rowcount#
1534 integer iRec
1535
1536 // no_refresh_state is an internal optimizer. Batch state should never
1537 // use refresh. (initialize_list should load batch files)
1538 if (no_refresh_state(self) OR Batch_State(self)) Procedure_return
1539
1540 get main_file to mainfile
1541 Get Row_count to RowCount# // we need to know this later if we are filling
1542 // list. Since we add a row when empty, checking
1543 // row_count later on will never return a 0.
1544
1545 // Always make sure that we've a row.
1546 If (item_count(self)=0) begin // When we add a row
1547 Send ADD_ROW // Record must be 0 // we must make sure the rec#
1548 set recordStatus 0 to 0 // is 0 (rsCleared), not rsNewAtBottom or rsNewAtTop
1549 set record_rowId 0 to (NullRowId())
1550 end
1551
1552 //
1553 // If not active we do not fully refresh, we only refresh the
1554 // current line. If no line, create one. Set dirty-state as needed.
1555 if not (active_state(self)) begin
1556 // we only need to reset the dirty state if the main file is changed
1557 // if a parent file is changed there is no need to refill the
1558 // entire list.
1559 is_file_included mainfile 1 //look in done - sets [found]
1560 if not (found) is_file_included mainfile 0 //look in cleared - sets [found]
1561 if (found) ;
1562 set Refresh_dirty_state to true
1563 Forward Send refresh notifyMode
1564 procedure_return
1565 end
1566
1567 set Refresh_dirty_state to false
1568
1569 // If save or delete we display the current row. Note that a delete will
1570 // redisplay the deleted record (it is still in the buffer). This is
1571 // consistant with form behaviors. It will set current_record to 0 which
1572 // will make a subsequent request_clear work properly
1573 //
1574 if (notifyMode=MODE_DELETE OR NotifyMode=MODE_SAVE OR ;
1575 Line_Display_State(self) ) Begin
1576
1577 Forward Send refresh notifyMode
1578
1579 // set record of row of current base-item to
1580 // the current record in the buffer
1581 get row item (base_item(self)) to row#
1582 If (IsRecnumTable(self,Main_file(self))) begin
1583 Get FileRecord to iRec
1584 end
1585 else begin
1586 Set 1 to iRec // anything >0 means we have a rec
1587 end
1588 set recordStatus row# to iRec
1589 set record_rowId row# to (FileRowId(self))
1590 end
1591 else begin //notifyMode = find/clearSet or Clear
1592 is_file_included mainfile 1 //look in done
1593 if (found) Begin
1594// changed for 8.2. row count is never 0 (not true...Can be 0)
1595// if RowCount# eq 0 ;
1596// send Refresh_Page (Initial_Row(self)) (Initial_Column(self))
1597// else ;
1598// Send Refresh_Page (Current_Row(self)) (Current_Col(self))
1599 // If this is called during a DDO a relates-to auto-fill we want to center this around the initial-row and initial-column
1600 // If this is called any other time, use the current row and column.
1601 // Prior to 8.2 it always used the current but since this was filling from the first record it always
1602 // repositioned to row 1. But the column did not reset which could create wierd navigations from a
1603 // header to a grid. For 8.2 we tried always making this use initial row/col but this created problems with
1604 // dbLists. So we now, in a post 8.2 patch, call a function to see if the find is relates-to-autofind.
1605 // If it is use the initial (new 8.2 behavior) else use the old current (the way it always worked).
1606 // Post 8.2-B also checks that rowcount is 0, which is possible with first time dbLists)
1607 if ((RowCount#=0) or isAutoFillFind(self)) ;
1608 send Refresh_Page (Initial_Row(self)) (Initial_Column(self))
1609 else ;
1610 Send Refresh_Page (Current_Row(self)) (Current_Col(self))
1611 end
1612 else begin
1613 is_file_included mainfile 0 //look in cleared
1614 if [found] begin //empty list or insert blank row
1615 if (notifyMode = MODE_CLEAR_ALL OR ;
1616 notifyMode = MODE_FIND_OR_CLEAR_SET) send clear_all
1617 else Begin
1618 // If there is no current record just clear the current
1619 // line. If a current record exits do the clear which
1620 // will open up a new line.
1621 // Changed so that empty tables (rowcount=0) will
1622 // send clear & not refresh. Clear must know what
1623 // to do with lines that are already cleared.
1624 If ( IsNullRowId(CurrentRowId(self)) AND RowCount# ) ;
1625 forward send refresh notifyMode // just clear current line
1626 Else send clear // insert a new line
1627 end
1628 end
1629 else forward send refresh notifyMode
1630 end
1631 end
1632 end_procedure
1633
1634 //
1635 // added for dependent-items support
1636 //
1637 { MethodType=Property }
1638 function Prototype_Object returns integer
1639 function_return (element(self))
1640 end_function
1641
1642 //
1643 // This should only get called by an iEntry procedure
1644 //
1645 procedure Auto_Reorder_List integer item#
1646 Set Item_Index_State to TRUE
1647 end_procedure
1648
1649 // Added to make this work like the old 3.01 data_list
1650 //
1651 procedure Goto_Top_Row
1652 if (focus(desktop) <> self) send activate
1653 set current_item to (top_item(self) + current_Col(self) )
1654 end_procedure
1655
1656 procedure Goto_Bottom_Row
1657 integer lastRow
1658 if (focus(desktop) <> self) send activate
1659 move (row_count(self) - 1) to lastRow
1660 set current_item to ((lastRow * item_limit(self)) + current_Col(self) )
1661 end_procedure
1662
1663 // messages added to support reversing index ordering
1664 Procedure DoSetOrderingDirection integer bReverse
1665 If (bReverse<>pbReverseOrdering(Self)) begin
1666 set pbReverseOrdering to bReverse
1667 If (Active_State(self) and item_count(self)) Begin
1668 Send ReadByRowId (CurrentRowId(self)) // make sure current order is correct
1669 Send Display // refresh grid in new order.
1670 end
1671 end
1672 End_Procedure
1673
1674 // Good for augmentation.
1675 Procedure DoToggleColumnOrdering integer iCol
1676 integer iIndex
1677 Get Col_Index iCol to iIndex // the current index for this column
1678 If (iIndex=>0 AND Ordering(self)=iIndex) ;
1679 send DoSetOrderingDirection (not(pbReverseOrdering(self)))
1680 end_procedure
1681
1682 { MethodType=Event }
1683 Procedure OnNewOrdering integer iOrdering
1684 end_procedure
1685
1686 // Augmented to return the DDOs server if the DDO
1687 // should provide this information.
1688 { MethodType=Property }
1689 Function Ordering returns integer
1690 integer hoServer
1691 If (ServerOrderingOverride(self)) Begin
1692 Get Server to hoServer
1693 Function_return (Ordering(hoServer))
1694 end
1695 function_return (pbPrivateOrdering(self))
1696 end_function
1697
1698
1699 // Set is augmented to send OnNewOrdering when order changes. Can
1700 // be used to change the pbReverseOrdering property on a column by
1701 // column basis (by default this does nothing)
1702 // If the DDO determines the server, the set is canceled
1703 { MethodType=Property }
1704 { InitialValue=-1 }
1705 { Category=Data }
1706 procedure set Ordering integer iIndex
1707 integer iCurrent
1708 // If server is controlling the index, we do not make a change
1709 If (ServerOrderingOverride(self)) Procedure_return
1710 Get Ordering to iCurrent
1711 Set pbPrivateOrdering to iIndex
1712 If (iIndex<>iCurrent) ; // only send when it changes
1713 Send OnNewOrdering iIndex
1714 end_procedure
1715
1716
1717 // This is called in VDF when GuiSize changes. It is not called anywhere in character mode, but
1718 // it could be and it will work
1719 //
1720 // If the number of displayable rows changes we need to refresh non-batch
1721 // list by sending display. This is called by set GuiSize and could be called
1722 // by other methods that affect the number of rows in a grid.
1723 Procedure DoCheckDisplayableRows
1724 integer iOld iNew
1725 Get piLastDisplayableRows to iOld // what it was last time we checked
1726 Get Displayable_rows to iNew // what it is now
1727 If (iOld<>iNew) Begin // if different
1728 set line_width to (item_limit(self)) 0 // needed by class
1729 Set piLastDisplayableRows to iNew
1730 // we only redisplay for non-batch active lists /w rows
1731 if (batch_state(self)=0 AND active_state(self) and Item_count(self)) ;
1732 send AdjustGridRows iOld
1733 end
1734 End_Procedure
1735
1736 //
1737 // Adjust a current grid. This is called when the maximum number of rows changes in
1738 // a non batch grid. Rather than just doing a display to refresh the grid we add and
1739 //single rows as needed without changing the current row's data. This way you can resize
1740 // dbGrids with changed data without losing that data.
1741 //
1742 { Visibility=Private }
1743 Procedure AdjustGridRows integer iOldMaxRows
1744 integer iNewMaxRows iRows iCurRow
1745 RowId riRec
1746 integer iChg iDynUpdt
1747
1748 Get row_count to iRows
1749 Get displayable_rows to iNewMaxRows
1750
1751 // don't do anything if we don't have to. Both conditions must be met
1752 // If the grid is shrinking but the number of rows still fits - we are ok
1753 // If the grid is growing but the old grid was not full - we are ok.
1754 If (iRows<=iNewMaxRows and iRows<iOldMaxRows) ;
1755 procedure_return
1756
1757 Get current_Row to iCurRow
1758 get dynamic_update_state to iDynUpdt
1759 set dynamic_update_state to false
1760 get Changing_State to iChg
1761 set Changing_State to TRUE // this suppresses all item change messages.
1762
1763 // if we are shrinking in size
1764 If (iRows>iNewMaxRows) begin
1765 // first trim any rows off top if needed. It's needed
1766 // if the current row will not fit
1767 While (iCurRow>=iNewMaxRows and iCurRow>0) // we never remove the current row
1768 decrement iCurRow
1769 decrement iRows
1770 send delete_row 0 // delete top row
1771 end
1772 // next delete any rows from bottom
1773 While (iRows>iNewMaxRows and iRows>1) // we never remove row 0
1774 decrement iRows
1775 send delete_row iRows // delete bottom row
1776 end
1777 End
1778 // if we are getting bigger
1779 else begin
1780 // we will refind the last record in the last row and use that as
1781 // our basis for adding records below it.
1782 decrement iRows // this is now the last row
1783 Get record_rowId iRows to riRec // get last record number
1784 // if zero, it may be a new record so check record above. If it
1785 // is still zero, we are just out of luck, we assume we are at end.
1786 if ( IsNullRowId(riRec) and iRows>0) ;
1787 get record_rowId (iRows-1) to riRec
1788 If not (IsNullRowId(riRec)) Begin
1789 send ReadByRowId riRec
1790 Get Add_Rows DOWNWARD_DIRECTION (iNewMaxRows - iRows) to iRows
1791 // since this involves database activity, we will make sure the
1792 // buffers again have right records.
1793 If (server(self)) ;
1794 send refind_records to (server(self))
1795 end
1796 end
1797 set Row_base_item to (Current_Row(self)) // we must do this or VDF doesn't know what row it is on!
1798 set Changing_State to iChg
1799 set dynamic_update_state to iDynUpdt
1800 end_procedure
1801
1802//================================compatibility methods================
1803
1804 // Set record_number/Current_record will generate errors because you should not set these
1805 // without setting the RowId array. If you are calling this you need to make code changes.
1806
1807 { MethodType=Property Obsolete=True }
1808 procedure set Record_Number integer row# integer newval
1809 error dfErr_Program "You should no longer use Set Record_number in the Datalist class; Use Set Record_RowId"
1810 end_procedure
1811
1812 // this can only be used with recnum tables. You are better off using
1813 // Get record_rowId (to get the real rowId) or Get RecordStatus (to check top or bottom) or RowHasRecord
1814 { MethodType=Property Obsolete=True }
1815 function Record_Number integer row# returns integer
1816 #IFDEF Old$Recnum$Message$warnings
1817 showln "old message: get record_number"
1818 #ENDIF
1819 If (IsRecnumTable(self, Main_file(self))) begin
1820 Function_Return (RecordStatus(self,row#))
1821 End
1822 else Begin
1823 error dfErr_Program "you cannot use Get Record_Number/Current_Record in the Datalist class with non-recnum tables. Use Get record_rowId, Get RowHasRecord or Get RecordStatus"
1824 end
1825 end_function
1826
1827 // this can only be used with recnum tables. You are better off using
1828 // Get CurrentRowId (to get the real rowId) or Get CurrentRowHasRecord (to see if you have a record)
1829 { MethodType=Property Obsolete=True }
1830 function Current_Record returns integer
1831 #IFDEF Old$Recnum$Message$warnings
1832 showln "old message: get curent_record (in datalist)"
1833 #ENDIF
1834 Function_Return (Record_Number(self,current_row(self)))
1835 end_function
1836
1837 { MethodType=Property Obsolete=True }
1838 { DesignTime=False }
1839 procedure SET Current_Record integer newVal
1840 error dfErr_Program "You should no longer use Set current_record in the Datalist class; use Set CurrentRowId"
1841 end_procedure
1842
1843 // Read_By_Recnum:
1844 //
1845 // Pass: Rec# find from server or from direct file.
1846 // Returns: FOUND if record found and records in buffer & related
1847 //
1848 // If you try this with a non-recnum table you will get a runtime error
1849 { Obsolete=True }
1850 procedure Read_By_Recnum integer rec#
1851 integer srvr# file#
1852 get Server to srvr#
1853 get Main_File to file#
1854 if srvr# ne 0 send Read_By_RecNum to srvr# file# rec#
1855 else send vRead_Rec file# Rec#
1856 #IFDEF Old$Recnum$Message$warnings
1857 showln "old message: read_by_recnum (in datalist)"
1858 #ENDIF
1859 end_procedure
1860
1861 // If you try this with a non-recnum table you will get a runtime error
1862 { Obsolete=True }
1863 Function File_Record Returns Integer
1864 integer iStat iFile iRec
1865 #IFDEF Old$Recnum$Message$warnings
1866 showln "old message: get file_record"
1867 #ENDIF
1868 get fileRecord to iRec
1869 Function_Return iRec
1870 End_Function
1871
1872 // If you try this with a non-recnum table you will get a runtime error
1873 { Visibility=Private Obsolete=True }
1874 procedure vRead_rec integer file# integer rec#
1875 Send Clear File#
1876 Set_field_value File# 0 to rec# // compatibility w/ recnum
1877 Send vFind_Rec File# 0 EQ
1878 #IFDEF Old$Recnum$Message$warnings
1879 showln "old message: vRead_rec"
1880 #ENDIF
1881 end_procedure
1882
1883
1884 // Create this message because the old 3.01 data-list did it this
1885 // way. (Avoid this if possible - use Read_by_recnum. This might
1886 // go away).
1887 // If you try this with a non-recnum table you will get a runtime error
1888 //
1889 { Visibility=Private Obsolete=True }
1890 procedure Read_record integer Rec#
1891 Send read_by_recnum Rec#
1892 #IFDEF Old$Recnum$Message$warnings
1893 showln "old message: Read_record"
1894 #ENDIF
1895 end_procedure
1896
1897 // Refind & relate the record in rec# by Main_file.
1898 // If you try this with a non-recnum table you will get a runtime error
1899 //
1900 { Obsolete=True }
1901 Procedure Find_Record Integer rec#
1902 Send Read_by_Recnum Rec# // read and relate the record
1903 Send Display_UI
1904 #IFDEF Old$Recnum$Message$warnings
1905 showln "old message: find_record"
1906 #ENDIF
1907 end_procedure
1908
1909
1910end_class
1911
1912