Module Widelist.pkg
1//************************************************************************
2// File Name: Widelist.Pkg
3// Creation Date: Thu 06-06-1991
4// Author(s): John J. Tuohy
5//
6// This replaces the Wide_List and is designed to be used in its place.
7// check for *DAF* for changes
8// 12/19/94 JJT Added Movable support here
9// 05/22/95 JJT Added object_item_validation to focus support in
10// request_clear and request_clear_all (also see deodlgmx.pkg)
11// 08/31/95 JJT Altered order of clmovemx and entitem mixins
12//************************************************************************/
13// 04/01/97 JJT Altered Current_col to not use base_item.
14//************************************************************************/
15
16//************************************************************************
17//
18// Confidential Trade Secret.
19// Copyright 1987-1997 Data Access Corporation, Miami FL, USA
20// All Rights reserved
21// DataFlex is a registered trademark of Data Access Corporation.
22//
23//************************************************************************/
24
25//************************************************************************
26// File Name: WideList.Pkg
27// Creation Date: January 1, 1991
28// Modified Date: July 1, 1991
29// Author(s): Steven A. Lowe
30//
31// This module contains the Wide_List class definition.
32//************************************************************************/
33
34#CHKSUB 1 1 // Verify the UI subsystem.
35
36Use Nesting.pkg
37Use Navigate.pkg
38Use Server.pkg
39Use ActionBr.pkg
40Use EntItem.pkg
41
42class Wide_List_mixin is a mixin
43 procedure Construct_Object integer img
44 forward send construct_object img
45 set entry_msg to Initialize_List
46 set item_limit to 1
47 set auto_top_item_state to FALSE
48 on_key kUPARROW send up_row PRIVATE
49 on_key kDOWNARROW send down_row PRIVATE
50 send define_nesting //invoke DEO nesting standard support constructor
51 send define_navigation //invoke DEO navigation standard support constructor
52 send define_server //invoke Server support constructor
53 send define_Action_bar //invoke action-bar support constructor
54 send define_entry_item //invoke Entry-Item support constructor
55
56 end_procedure
57
58 IMPORT_CLASS_PROTOCOL Nesting_Mixin
59 IMPORT_CLASS_PROTOCOL Navigate_Mixin
60 IMPORT_CLASS_PROTOCOL Server_Mixin
61 IMPORT_CLASS_PROTOCOL Action_Bar_Mixin
62
63 // entry_item_mixin must mixin after Movable_cient_mixin. A message
64 // in entry-item (move_client_location) needs to replace the message
65 // in movable-client. (see entitem)
66 IMPORT_CLASS_PROTOCOL Entry_Item_Mixin
67
68
69 { MethodType=Event }
70 procedure Initialize_List
71 end_procedure
72
73 procedure Down_Row
74 integer toitem
75 Move (current_item(self) + item_limit(self)) ;
76 to toitem
77 if toitem lt (item_count(self)) set current_item to toitem
78 end_procedure
79
80 procedure Up_Row
81 Integer toitem
82 Move (current_item(self) - item_limit(self)) ;
83 to toitem
84 if toitem ge 0 set current_item to toitem
85 end_procedure
86
87 //
88 // created for nesting support
89 //
90 { MethodType=Event Visibility=private Obsolete=True }
91 procedure Child_Wrapping integer direction integer xorigID
92 Integer base targetItem lim origID
93
94 if NUM_ARGUMENTS gt 1 move xorigID to origID
95 else get focus of desktop to origID
96 if origID eq 0 move self to origID
97
98 send activate
99// get base_item to base
100// if direction ne 0 begin
101// Move (item_count(self) - 1) to lim
102// Move (base + item_limit(self)) to targetItem
103// if targetItem gt lim move lim to targetItem
104// end
105// else begin
106// Move (base - 1) to targetItem
107// if targetItem lt 0 move 0 to targetItem
108// end
109// set current_item to targetItem
110
111 // set item direction //sets current_item to first/last enterable item
112
113 procedure_return 1
114 end_procedure
115
116
117 //
118 // created for navigation support
119 //
120 { Visibility=Private Obsolete=True }
121 procedure Top_of_Panel
122 Integer retval
123 //
124 // modification for EntItem support
125 //
126 get Object_Validation to retval
127 set Object_Validation to false
128 if (focus(desktop) <> self) send activate
129// set current_item to (top_item(self))
130
131 set item to TRUE //sets current_item to first enterable item
132
133 set Object_Validation to retval
134 end_procedure
135
136 //
137 // created for Bottom_of_Panel support
138 //
139 { Visibility=Private }
140 function last_panel_item returns integer
141 integer lastitem maxitem
142 Move (top_item(self) + Display_Size(self) - 1) ;
143 to lastitem
144 get item_count to maxitem
145 if lastItem gt maxitem move (maxitem - 1) to lastitem
146 function_return lastitem
147 end_function
148
149 //
150 // created for navigation support
151 //
152 { Visibility=Private Obsolete=True }
153 procedure Bottom_of_Panel
154 Integer lastChild
155 //
156 // modification for composition support
157 //
158 if (Has_Components_State(self)) begin
159 get Find_Last_DEO to lastChild
160 if lastChild ne 0 begin
161 send Bottom_Of_Panel to lastChild
162 procedure_return
163 end
164 end
165 send activate
166// set current_item to (last_panel_item(self))
167
168 set item to FALSE //sets current_item to last enterable item
169
170 end_procedure
171
172 //
173 // created for navigation support
174 //
175 { Visibility=Private }
176 function Next_Entry_Ok returns integer
177 Integer retval wrapstate
178 forward get next_entry_ok to retval
179 get wrap_State to wrapstate
180 if (retval >= 0 AND wrapstate = 0 AND ;
181 row(self,retval) <> current_row(self)) ;
182 move -1 to retval //out of row bounds, pretend must switch
183 else if (retval < 0 AND wrapstate) begin //on last row w/wrap_state true
184 send add_row //add new row at end
185 forward get next_entry_ok to retval //try to rotate to it
186 end
187 function_Return retval
188 end_function
189
190 //
191 // created for navigation support
192 //
193 // *DAF* This has been altered to work right for us. Since we support the
194 // ability of tables to insert rows at the top we must check if a
195 // previous should open up a line at the top (more like what next_
196 // entry_ok). It seems that neither of these (next_item_ok or prev-
197 // ious_entry_ok) really belongs here - but to be consistant....
198 { Visibility=Private }
199 function Previous_Entry_Ok returns integer
200 Integer retval curitem // *DAF* curitem is new
201 get current_item to curitem // *DAF* new
202 forward get previous_entry_ok to retval
203 if (retval >= 0 AND wrap_state(self) = 0 AND ;
204 row(self,retval) <> current_row(self)) ;
205 function_return -1 //out of row bounds, pretend must switch back
206
207 // *DAF* this block is new. If no more items and wrap_state is true we
208 // will create a new row on top and attempt to go to it.
209 if (retval < 0 AND wrap_state(self)) begin //on 1st row w/wrap_state true
210 send Insert_row 0 //insert new row at top
211 // after insert we must move down one row to stay in place
212 set new_Item to (CurItem + item_limit(self))
213 set Row_base_Item to (Current_Row(self))
214 forward get previous_entry_ok to retval //try to rotate to it
215 end
216
217 function_Return retval
218 end_function
219
220 procedure End_Construct_Object
221 send Mark_Components // nesting
222 send Define_Access_Keys 0 // action_bar_keys
223 forward send End_Construct_Object
224 end_procedure
225
226 //..*DAF*.......................................................
227 // These have been added to wide_list. They just belong here
228 // (hey could be added to data_list allowing us to avoid changing
229 // wide_list - however, this is where they belong). We could change
230 // this
231 //
232 // new Handlers: Up, Down, Column, current_col, Row_base_item
233
234 procedure Up // custom for wlist
235 send up_Row
236 end_procedure
237
238 procedure Down // custom for wlist
239 send down_Row
240 end_procedure
241
242 { NoDoc=True }
243 Function Column Integer Item# returns Integer
244 If (Item#=CURRENT) Begin // if the CURRENT symbol replace with current Item
245 Get Current_Item to item#
246 end
247 Function_Return (Mod(Item#,Item_Limit(self)))
248 End_Function
249
250 { MethodType=Property NoDoc=True }
251 Function Current_Col Returns Integer
252 Function_Return (Column(self,Current_Item(self)))
253 //Function_Return (Current_Item(self)-Base_Item(self))
254 End_Function
255
256 // sets base item to Row#
257 { Visibility=Private }
258 Procedure Set Row_Base_Item Integer Row#
259 Set Base_Item to (Row# * Item_Limit(self) )
260 End_Procedure
261
262 //.........................................................
263end_class
264
265