Module Server.pkg
1//************************************************************************
2//
3// Confidential Trade Secret.
4// Copyright 1987-1997 Data Access Corporation, Miami FL, USA
5// All Rights reserved
6// DataFlex is a registered trademark of Data Access Corporation.
7//
8//************************************************************************
9
10//************************************************************************/
11// 12/20/94 (JJT) Added Change_disabled_state.
12// Altered SET Changed_state to respect above property
13// Removed Validate_items (added to Val_mx.pkg)
14// Added Explicit_server_state and altered Set Server to
15// support it.
16// 12/27/94 (JJT) Deferred_state is now respected in set changed_state
17// procedure (see comments for that proc.).
18//
19//************************************************************************/
20
21//************************************************************************
22// Server.Pkg
23// Version: 1.0
24// Copyright (c) 1993 2E Software
25// 06-13-1992 : Created
26//
27// Author: John J. Tuohy
28//
29// THIS REPLACES THE DAC SERVER.PKG !!!!!
30//
31// Except for the lines marked "===mods to server===" this is an exact
32// copy of the server package. This is used to add request_destroy_object
33// using what is now considered to be a fairly standard C/D method. The main
34// change is to include an additonal file named SERVMOD.PKG which add the
35// C/D support for server based DEOs.
36//
37//=================================mods to server===================
38// John Tuohy...added to support request_destroy_object
39//************************************************************************
40// 02/03/95 JJT Changes marked **JJT**(2). Changes in DEO<->DSO connecting.
41// 10/19/95 JJT Changes marked **JJT**(3) to support better table/list
42// beahviors when active and inactive.
43// 01/24/96 JJT Changes marked **JJT**(4). Optimized the setting of
44// watched servers to 1) act smarter when there is only a
45// single item to check and 2) to not create the watched
46// server broadcaster if it is not required.
47//03/29/96 JJT Changes marked **JJT**(5) Changed find_servers_to_watch
48// to send Copy_item_options. This is needed by xds. Create
49// stump procedure copy_item_Options to support this.
50
51//************************************************************************/
52
53//************************************************************************
54//
55// Confidential Trade Secret.
56// Copyright 1987-1992 Data Access Corporation, Miami FL, USA
57// All Rights reserved
58// DataFlex is a registered trademark of Data Access Corporation.
59//
60// File Name: Server.Inc
61// Creation Date: January 1, 1991
62// Modified Date: January 17, 1992
63// Author(s): Steven A. Lowe
64//
65// This module defines the operations and properties required to support
66// a seperate database 'server' object (as exemplified by Data_Set),
67// collected in the abstract class Server_Mixin.
68//
69// This file should be USEd prior to and IMPORTed within the scope of the
70// class definition by any user-interface (esp. data-entry) class which
71// must support the data-entry object standards.
72//
73// This file is used by ENTRYFRM.PKG, TEXT_WIN.PKG, DATALIST.PKG,
74// ENCLIENT.PKG, and PICKLIST.PKG.
75//************************************************************************/
76
77
78//
79// Description
80//
81// This block defines constants for the spceial find-modes understood by
82// the Request_Find, Request_Read, Request_SuperFind, and Item_Find
83// messages.
84//
85// Assumptions/Preconditions
86//
87// If NEXT_RECORD is already defined as a symbol (i.e. using #REPLACE),
88// it is assumed that FIRST_RECORD and LAST_RECORD are also assigned.
89//
90// Exceptions
91//
92// If NEXT_RECORD is already defined as a symbol, no action is taken.
93//
94// Notes
95//
96// None.
97//
98#IFSUB 'NEXT_RECORD'
99#ELSE
100 #REPLACE NEXT_RECORD 5
101 #REPLACE FIRST_RECORD 6
102 #REPLACE LAST_RECORD 7
103#ENDIF
104
105#CHKSUB 1 1 // Verify the UI subsystem.
106
107//=================================mods to server===================
108use VDFBase.pkg
109use brdcster.pkg
110
111//
112// Description
113//
114// These declarations permit forward-referencing of the messages provided
115// by the Data_Set class (in its role as database server).
116//
117// Assumptions/Preconditions
118//
119// None.
120//
121// Exceptions
122//
123// None.
124//
125// Notes
126//
127// None.
128//
129Register_Procedure Item_Find integer mode integer datafile integer datafield ;
130 integer entUpdtFlag integer errFlag integer dfrdFlag
131Register_Procedure Add_User_Interface integer obj#
132Register_Procedure Remove_User_Interface integer obj#
133Register_Procedure Clear
134Register_Function Component_State returns integer
135Register_Function Can_Delete returns integer
136Register_Object Element
137
138// **JJT**(2)
139// Values for DSO_Detach_Mode
140// DETACH_NEVER = Never
141// DETACH_IF_ALLOWED = do if changed_state=F and DEO Static_Server
142// DETACH_IF_NO_CHANGE = do if changed_state=F
143// DETACH_ALWAYS = do it no matter what
144
145Enumeration_list
146 Define Detach_Never
147 Define Detach_If_No_Change
148 Define Detach_Always
149 Define Detach_If_Allowed
150End_Enumeration_list
151
152
153Class server_mixin is a mixin
154
155 //
156 // Description
157 //
158 // This procedure defines the properties which are required to support a
159 // server-object for database access.
160 //
161 // Assumptions/Preconditions
162 //
163 // The global function MAKE_BROADCASTER must be defined to return the
164 // object id of a new instance of the Broadcaster class (see BRDCSTER.PKG).
165 //
166 // Exceptions
167 //
168 // None.
169 //
170 // Notes
171 //
172 // Server is the object id of the database agent for this object.
173 //
174 // Watched_Servers is a set of object ids for database agents whose state
175 // must also be monitored by this object (but which never receive requests
176 // directly from this object, unlike the Server).
177 //
178 // Servers_Scanned determines if the items of this object have been
179 // scanned to see if this object should be connected to other database
180 // agents as 'just watching' (see Watched_Servers, above).
181 //
182 // Auto_Fill_State determines if this object should always automatically
183 // fill itself with data when it is activated.
184 //
185 // Deferred_State determines if this object's browsing in database files
186 // should be reflected immediately in this object's database agent (and
187 // the agents' agents, etc.), or not.
188 //
189 //
190 { MethodType=Event Visibility=Private }
191 procedure define_server
192 integer obj#
193 { Visibility=Private }
194 Property integer private.Server 0
195 { Visibility=Private }
196 Property integer Watched_Servers 0
197 { Visibility=Private }
198 Property integer private.Servers_Scanned 0
199
200 // **JJT**(4) - moved logic to create broadcasters elsewhere. Only
201 // created if needed now
202 // move (make_broadcaster(DESKTOP)) to obj#
203 // set Watched_Servers to obj#
204 // set broadcast_state of obj# to TRUE
205
206 { Category=Data }
207 { PropertyType=Boolean }
208 Property Integer Auto_Fill_State False
209 { Category=Behavior }
210 { PropertyType=Boolean }
211 Property Integer Deferred_State False
212
213 // (JJT) added to support DEO request-delegation. This is set true
214 // if the server is explicitly set in this DEO (normally via a
215 // USING parameter).
216 { Visibility=Private }
217 property integer explicit_server_state FALSE
218
219 // (JJT) Since this package's SET changed_state is using change_
220 // disabled_state we might as well define it here. This gets changed
221 // by Clear_mx to support setting of defaults without changing the
222 // objects changed_state.
223
224 // This stops changed_state from getting changed. It allows item_changed_
225 // state to chagne without the object's changed_state getting changed.
226 // This should be considered protected (i.e., likely to change). The new
227 // messages Entry_Defaults and Set Default_Value are both public and use
228 // this. Try to use these messages instead of this property.
229 { Visibility=Private }
230 Property Integer Change_Disabled_State FALSE
231
232 // **JJT**(2)
233 // If true DEO will not disconnect from server when deactivating.
234 // If true View should handles attaching and detaching.
235 Register_Function Default_static_server_state returns integer
236 { Visibility=Private }
237 Property Integer Static_Server_State (Default_Static_Server_State(self))
238
239 // **JJT**(3)
240 // new properties to better support tables. If Refresh_dirty_state
241 // is true then the list object needs refreshing (because it was inactive
242 // and changes were made that were not updated). After add_focus is
243 // complete the add_focus_msg is sent (allows tables to initialize the
244 // list).
245 { Visibility=Private }
246 Property Integer Refresh_dirty_state true // when not active/dirty
247 { Visibility=Private }
248 Property Integer Add_focus_msg 0 // by dflt no message
249
250 // **JJT**(5)
251 // This will call a stub procedure which will be augmented (or replaced)
252 // by the xdeo mixins
253 Send Define_Extended_DEO_Mixin
254
255 end_procedure
256
257
258 //
259 // Description
260 //
261 // This procedure establishes a connection between this object and its
262 // database agent(s) (Server and Watched_Servers).
263 //
264 // Assumptions/Preconditions
265 //
266 // This object must understand Client_Area_State; its database agent(s)
267 // must understand Add_User_Interface.
268 //
269 // Exceptions
270 //
271 // If this object has no database agents, no action is taken.
272 //
273 // Notes
274 //
275 // During the establishment of the connection, the database agent(s) may
276 // direct this object to Display or Clear, depending on the state of the
277 // record buffers and Auto_Fill_State.
278 //
279 // **JJT**(2) - Moved
280 //procedure attach_deo_to_server
281 // integer obj# isclient
282 // get Server to obj#
283 // get client_area_state to isclient
284 // if (obj# <> 0 AND isclient = 0) ;
285 // send add_user_interface to obj# self
286 // if isclient eq 0 send add_user_interface ;
287 // to (Watched_Servers(self)) self
288 // if (obj# <> 0 AND isclient = 0) send update_dependent_items
289 //end_procedure
290
291
292 //
293 // Description
294 //
295 // This procedure discontinues the connection between this object and its
296 // database agent(s) (Server and Watched_Servers).
297 //
298 // Assumptions/Preconditions
299 //
300 // This object must understand Client_Area_State; its database agent(s)
301 // must understand Remove_User_Interface.
302 //
303 // Exceptions
304 //
305 // If this object has no database agents, no action is taken.
306 //
307 // Notes
308 //
309 // None.
310 //
311 { Visibility=Private }
312 procedure remove_deo_from_server
313 integer obj# isclient wsrvr
314 get Server to obj#
315 get client_area_state to isclient
316 if (obj# <> 0 AND isclient = 0) ;
317 send remove_user_interface to obj# self
318 // **JJT**(4) - Only send if watched-server exists
319 Get Watched_Servers to wsrvr
320 if wsrvr ;
321 send remove_user_interface to wsrvr self TRUE // TRUE for watchers
322 // **JJT**(3) - when removed the deo is no longer up to date.
323 Set Refresh_dirty_state to true
324 end_procedure
325
326
327 //
328 // Description
329 //
330 // This procedure adds this object into the focus-tree as a child of the
331 // specified toObj#, and also add the child-objects of this object into
332 // the focus-tree as children of this object. If necessary, it also
333 // scans the fields of this object's items to determine which database
334 // agents to 'watch', and creates a connection between this object and its
335 // database agents.
336 //
337 // Assumptions/Preconditions
338 //
339 // This object must understand Client_Area_State.
340 //
341 // Exceptions
342 //
343 // None.
344 //
345 // Notes
346 //
347 // Client-objects already automatically add their children into the focus-
348 // tree.
349 //
350 // **JJT**(2) - Moved
351 //procedure add_focus integer toObj# returns integer
352 // integer srvscn retval
353 // //
354 // // standard DEO behavior
355 // //
356 // forward get msg_add_focus toObj# to retval
357 // if retval procedure_return retval
358 //
359 // if (client_area_State(self) = 0) ; //clients already broadcast
360 // broadcast NO_STOP send add_focus self
361 // //
362 // // server augmentation
363 // //
364 // get private.Servers_Scanned to srvscn
365 // if srvscn eq 0 send scan_servers
366 // if (focus_mode(self) <> NO_ACTIVATE AND Active_State(self)) ;
367 // send attach_DEO_to_server
368 //end_procedure
369
370
371 //
372 // Description
373 //
374 // This procedure removes this object from the focus-tree, and disconnects
375 // it from its database agents, if any.
376 //
377 // Assumptions/Preconditions
378 //
379 // This object must understand Changed_State.
380 //
381 // Exceptions
382 //
383 // If this object has been changed, it will not be detached from its
384 // database agents until the changes are saved or abandoned.
385 //
386 // Notes
387 //
388 // Opposite of Add_Focus.
389 //
390 // **JJT**(2) - Moved
391 //procedure remove_object
392 // forward send remove_object
393 // if (Changed_State(self) = 0) ; //only detach if unchanged!
394 // send remove_DEO_from_server
395 //end_procedure
396
397
398 //
399 // Description
400 //
401 // This function returns the object id of the database server which
402 // encloses this object, if any. Note that only the Data_Set class
403 // defines this function to return anything other than 0.
404 //
405 // Assumptions/Preconditions
406 //
407 // None.
408 //
409 // Exceptions
410 //
411 // None.
412 //
413 // Notes
414 //
415 // This function is used with delegation to locate the Data_Set
416 // which is the closest parent of this object.
417 //
418 { MethodType=Property Visibility=Private }
419 function Find_Server returns integer
420 end_function //returns 0; only Data_Set returns non-zero
421
422 Register_Function Server returns integer
423
424
425 //
426 // Description
427 //
428 // This function returns the object id of the database agent of this object,
429 // or 0.
430 //
431 // Assumptions/Preconditions
432 //
433 // None.
434 //
435 // Exceptions
436 //
437 // None.
438 //
439 // Notes
440 //
441 // See the Server function. below.
442 //
443 { MethodType=Property Visibility=Private }
444 function Locate_Server returns integer
445 function_return (Server(self))
446 end_function
447
448
449 //
450 // Description
451 //
452 // This function returns the object id of the database agent of this
453 // object, or 0.
454 //
455 // Assumptions/Preconditions
456 //
457 // This object must understand Component_State.
458 //
459 // Exceptions
460 //
461 // If this object's Server is 0, this object's parent's Server is
462 // returned, if any.
463 //
464 // Notes
465 //
466 // This function is used to allow nested data-entry objects to use the
467 // database agent defined by their parent object.
468 //
469 { MethodType=Property }
470 function Server returns integer
471 integer obj#
472 get private.Server to obj#
473 if (obj# = 0 AND Component_State(self)) ;
474 function_return (Locate_Server(parent(self)))
475 function_return obj#
476 end_function
477
478
479 //
480 // Description
481 //
482 // This procedure sets the value of the Server property of this object,
483 // notifying child-objects of the change, and destroying and creating
484 // connections with database agents, as required.
485 //
486 // Assumptions/Preconditions
487 //
488 // This object must understand Active_State.
489 //
490 // Exceptions
491 //
492 // If the Server of this object is changed while this object is inactive,
493 // no notification of child-objects is required or performed.
494 //
495 // Notes
496 //
497 // None.
498 //
499 { MethodType=Property }
500 { DesignTime=False }
501 procedure set Server integer newVal
502 integer oldVal
503 set explicit_server_state to (newVal <> 0) // (JJT) from DEODLG
504 get Server to oldVal
505 if newVal ne 0 set private.Server to (object_id(newVal))
506 else set private.Server to newVal
507 if (active_state(self)) begin
508 broadcast send server_changed oldVal newVal
509 if oldVal ne 0 send remove_deo_from_server //detach from current server
510 if newval ne 0 send attach_deo_to_server //attach to new server
511 end
512 end_procedure
513
514
515 //
516 // Description
517 //
518 // This procedure servers as notification of a change in the connection
519 // of this object's parent to its database agent. If this object uses
520 // its parent's database agent by default (see the Server and Find_Server
521 // functions, above), it must disconnect from the old agent and connect
522 // with the new agent.
523 //
524 // Assumptions/Preconditions
525 //
526 // This object must understand Client_Area_State.
527 //
528 // Exceptions
529 //
530 // None.
531 //
532 // Notes
533 //
534 // None.
535 //
536 { Visibility=Private }
537 procedure server_changed integer oldVal integer newVal
538 integer oldSrvr
539 if (client_area_state(self) = 0) begin
540 get private.Server to oldSrvr
541 if (oldSrvr = 0) begin //assumes Server(self) = oldVal by deleg
542 if oldVal ne 0 send remove_user_interface to oldVal self
543 if newVal ne 0 send add_user_interface to newVal self
544 end
545 end
546 end_procedure
547
548
549 //
550 // Description
551 //
552 // This procedure empties the Watched_Servers broadcaster, after
553 // detaching this object from all of the broadcaster's elements.
554 //
555 // Assumptions/Preconditions
556 //
557 // None.
558 //
559 // Exceptions
560 //
561 // None.
562 //
563 // Notes
564 //
565 // This procedure is invoked by Find_Servers_to_Watch, in preparation
566 // for a scan.
567 //
568 { Visibility=Private }
569 procedure delete_watched_servers
570 integer vis#
571 get watched_servers to vis#
572 // **JJT**(4) - Only if w server exists
573 If vis# Begin
574 send Remove_User_Interface to vis# self TRUE //detach from all, TRUE for watchers
575 set broadcast_state of vis# to false
576 send delete_Data to vis# //empty it
577 set broadcast_state of vis# to true
578 end
579 end_procedure
580
581
582 //
583 // Description
584 //
585 // This procedure adds the specified object id (obj#) to this object's
586 // set of database agents who are merely 'watched', and establishes a
587 // connection between the database agent and this object.
588 //
589 // Assumptions/Preconditions
590 //
591 // This object must understand Active_State.
592 //
593 // Exceptions
594 //
595 // None.
596 //
597 // Notes
598 //
599 // None.
600 //
601 { Visibility=Private }
602 procedure add_watched_server integer obj#
603 integer vis# ndx
604 get watched_servers to vis#
605 // **JJT**(4) - if w server does not exist, first create it
606 //
607 if Vis# eq 0 Begin
608// #IFDEF IS$Windows
609 Get Create of Desktop U_Broadcaster to Vis# // modern syntax
610// #ELSE
611// move (make_broadcaster(DESKTOP)) to Vis#
612// #ENDIF
613
614 set Watched_Servers to Vis#
615 End
616 //
617 set broadcast_state of vis# to false
618 get find_element of vis# obj# to ndx
619 if ndx lt 0 send add_element to vis# obj#
620 set broadcast_state of vis# to true
621 if (ndx lt 0 AND active_State(self)) ;
622 send add_user_interface to obj# self TRUE // TRUE for watchers
623 end_procedure
624
625
626 //
627 // Description
628 //
629 // This procedure removes the specified object id (obj#) from this object's
630 // set of database agents who are merely 'watched', and destroys the
631 // connection between the database agent and this object.
632 //
633 // Assumptions/Preconditions
634 //
635 // This object must understand Active_State.
636 //
637 // Exceptions
638 //
639 // None.
640 //
641 // Notes
642 //
643 // None.
644 //
645 { Visibility=Private }
646 procedure remove_watched_server integer obj#
647 integer vis# ndx
648 get watched_servers to vis#
649 // **JJT**(4) - Only if w server exists
650 If vis# Begin
651 set broadcast_state of vis# to false
652 get find_element of vis# obj# to ndx
653 if ndx ge 0 send remove_element to vis# obj#
654 set broadcast_state of vis# to true
655 if (ndx >= 0 AND active_State(self)) ;
656 send remove_user_interface to obj# self TRUE // TRUE for watchers
657 end
658 end_procedure
659
660
661 //
662 // Description
663 //
664 // This procedure causes the scanning of this object's items' fields,
665 // and the production of a set of database agents who should be 'watched'.
666 //
667 // Assumptions/Preconditions
668 //
669 // None.
670 //
671 // Exceptions
672 //
673 // None.
674 //
675 // Notes
676 //
677 // This procedure depends completely upon Find_Servers_To_Watch, below.
678 //
679 { Visibility=Private }
680 procedure Scan_Servers
681 send find_servers_to_watch FALSE
682 end_procedure
683
684 // **JJT**(4) - Major change to optimize and not use watched server if
685 // not needed!
686 //
687 // Description
688 //
689 // This procedure scans the fields of this object's items to determine
690 // what other database agents (data_sets) other than this object's Server
691 // should be 'watched' (for data changes).
692 //
693 // Assumptions/Preconditions
694 //
695 // tableFlag is a boolean determining whether this object relies on a
696 // prototype row (TRUE) or an item list (FALSE).
697 //
698 // This object must understand Client_Area_State, and have a private
699 // boolean property named Private.Servers_Scanned to note the event.
700 //
701 // Exceptions
702 //
703 // None.
704 //
705 // Notes
706 //
707 // This procedure is invoked once per object, the first time the object
708 // is activated. If the data_file, data_field, and/or main_file of this
709 // object are changed (don't change them while this object is active!),
710 // set Private.Servers_Scanned to FALSE to force this object to scan
711 // again (when it is next activated).
712 //
713 { Visibility=Private }
714 procedure find_servers_to_watch integer tableFlag
715 integer i file# obj# maxitems count p srvr# self# srvrfile
716 string fileStr fStr
717
718 if (client_area_state(self)) procedure_return // won't happen
719 set private.Servers_Scanned to TRUE
720
721 get Server to srvr#
722
723 If srvr# Begin
724 send delete_watched_servers //empty Watched_Servers broadcaster first
725
726 get main_file of srvr# to srvrfile // data-set's main-file
727
728 if tableFlag ne 0 get Prototype_Object to self# // tables
729 else move self to self# // forms and text windows
730
731 get item_count of self# to maxitems
732 decrement maxitems
733
734 // if no items do nothing
735 // if one item do quick check
736 // if multiple items do it the hard way
737
738 If maxitems lt 0 procedure_return // no items
739
740 If maxitems eq 0 Begin // only 1 item - skip most of the nonsense
741 get data_file of self# item 0 to file#
742 // we need watched server if file exists, it is not the main file
743 // and is not an updating file (as opposed to updating data-set).
744 if (file#>0 AND file#<>srvrfile) Begin
745 get which_data_set of srvr# file# to obj#
746 if (obj# <> 0 AND obj# <> srvr#) send add_Watched_server obj#
747 end
748 // **JJT**(5) - Added for Xds Support
749 If File# ;
750 Send Copy_Item_Options Srvr# file# (Data_Field(Self#,0)) Self# 0
751 end
752 Else Begin // multiple items - do what you must
753 move -1 to count
754 move "," to fileStr
755 if tableFlag begin
756 get main_file to file#
757 if file# ne srvrfile Begin // only do this if mainfile is not the srvr file
758 append fileStr file# "," //insert mainfile to be sure it's watched
759 increment count
760 end
761 end
762 for i from 0 to maxitems
763 get data_file of self# item i to file#
764 if (file# > 0 AND file#<>srvrfile AND ;
765 not(fileStr contains (","+string(file#)+",")) ) begin
766 move (fileStr+string(file#) + ",") to fileStr
767 increment count
768 end
769 // **JJT**(5) - Added for Xds Support
770 If File# ;
771 Send Copy_Item_Options Srvr# file# (Data_Field(Self#,i)) Self# i
772 loop
773 //
774 if count ge 0 Begin // any watched items?
775 right fileStr to fileStr (length(fileStr) - 1) //remove leading comma
776 for i from 0 to count
777 pos "," in fileStr to p
778 if p gt 1 begin
779 left fileStr to fStr (p-1)
780 right fileStr to fileStr (length(fileStr) - p)
781 move fStr to file#
782 get which_data_set of srvr# file# to obj#
783 if (obj# <> 0 AND obj# <> srvr#) send add_Watched_server obj#
784 end
785 loop
786 end
787 end
788 End
789 end_procedure
790
791 // **JJT**(5) - Added for Xds Support
792 // This does nothing. Other sub-classes (or later mixins) should add
793 // logic to this.
794 { Visibility=Private }
795 Procedure Copy_Item_Options Integer iDSO Integer iFile Integer iField ;
796 Integer iDEO Integer iItem
797 End_Procedure
798
799 // **JJT**(5) - Added for Xds Support
800 // This does little. Other sub-classes (or later mixins) should add
801 // logic to this.
802 { Visibility=Private }
803 Procedure Define_Extended_DEO_Mixin
804 End_Procedure
805
806
807 //
808 // created for Nesting support
809 //
810 { Visibility=Private }
811 procedure Mark_As_Component
812 integer ser#
813 set Component_State to true
814 delegate set Has_Components_State to true
815 get private.Server to ser#
816 if ser# eq 0 begin
817 delegate get Locate_Server to ser#
818 if ser# ne 0 set private.Server to ser#
819 end
820 end_procedure
821
822 // **JJT**(2) - Moved
823 //procedure SET Changed_State integer newVal
824 // integer srvr#
825 // forward set Changed_State to newVal
826 // get server to srvr#
827 // if (newVal AND srvr#) set Changed_State of srvr# to TRUE
828 // if (newVal) set Changed_State of (Watched_Servers(self)) to TRUE
829 // if (not(newVal) AND not(Active_State(self))) ;
830 // send remove_DEO_from_Server
831 //end_procedure
832
833 // (JJT) Moved to Val_mx
834 //function validate_items integer flag returns integer
835 // integer retval oldautotop
836 // forward get validate_items flag to retval
837 // if (retval <> 0 AND focus(desktop) <> self) begin
838 // get auto_top_item_state to oldautotop
839 // set auto_top_item_state to false
840 // send activate //take focus w/out changing current_item
841 // set auto_top_item_state to oldautotop
842 // end
843 // function_return retval
844 //end_function
845
846//************************************************************************
847// Servmod.Pkg
848// Version: 1.0
849// 04-22-1992 : Created
850//
851// Author: John J. Tuohy
852//
853// Mod for Server.pkg package
854//
855// 04-22-1992 Altered to fix watched server bug
856// 07-07-1992 Altered for 3.01 to destroy bcaster after the object. Suggested
857// by Doug G. and Bob W.
858// 09-12-1992 Altered to support reverse order child destruction using new
859// desktop procedure request_destroy_children.
860//************************************************************************
861
862 // This only gets called when the developer is killing this object. During application
863 // shut-down, only destroy_object is called. This augmentation destroys the watched broadcaster
864 // (which is sitting on the desktop). During program shut down we don't care if this is called
865 // because it is getting destroyed anyway. We are making the assumption that a developer controlled
866 // destroy will always be called with the watcher still existing.
867
868 { NoDoc=True }
869 Procedure Destroy
870 Handle hoWatched
871 Set Changed_State To False // is this really needed anymore???
872 // if non 0, The watched server, must still exist.
873 Get Watched_Servers To hoWatched
874 If hoWatched begin
875 Set Broadcast_State Of hoWatched To False
876 Send Destroy of hoWatched // destroy the bcaster
877 end
878 Forward Send Destroy
879 End_Procedure
880
881
882// (LS) moved into server.pkg from various pkgs.
883 { MethodType=Property }
884 Function Should_Save Returns Integer
885 Integer Obj# Chngd
886 Get Server to Obj#
887 get Changed_state to Chngd
888 Function_Return ( Chngd OR (obj# <> 0 AND Should_Save(obj#)) )
889 End_function
890
891 // **JJT**(2) --- Start of changes
892 // Added server scan logic here instead of add_focus.
893 { Visibility=Private }
894 procedure Attach_Deo_To_Server
895 integer obj# isclient srvscn wsrvr
896 get Server to obj#
897 get client_area_state to isclient
898 if (obj# <> 0 AND isclient = 0) ;
899 send add_user_interface to obj# self
900 if isclient eq 0 Begin
901 get private.Servers_Scanned to srvscn // **JJT**(2)
902 if srvscn eq 0 send scan_servers // **JJT**(2)
903 Get Watched_Servers to wsrvr
904 If wsrvr send add_user_interface ;
905 to wsrvr self TRUE // TRUE for watchers
906 End
907 if (obj# <> 0 AND isclient = 0) send update_dependent_items
908 end_procedure
909
910 // Removed server scan logic and moved it to attach-deo_to_server
911 { NoDoc=True }
912 Procedure Add_Focus Handle hoParent Returns Integer
913 integer srvscn retval msg
914 //
915 // standard DEO behavior
916 //
917 forward get msg_Add_Focus hoParent to retval
918 if retval procedure_return retval
919
920 if (client_area_State(self) = 0) ; //clients already broadcast
921 broadcast NO_STOP send add_focus self
922 //
923 // server augmentation
924 //
925 //get private.Servers_Scanned to srvscn // **JJT**(2)
926 //if srvscn eq 0 send scan_servers // **JJT**(2)
927 if (focus_mode(self) <> NO_ACTIVATE AND Active_State(self)) ;
928 send attach_DEO_to_server
929
930 // **JJT**(3) - last thing to do is send custom message. With list deos
931 // msg is probably initialize_list. With non-list deos it
932 // is probably nothing
933 get add_focus_msg to msg
934 if msg send msg
935 end_procedure
936
937 // Connect DEO to Server if Demanded (DoAllfg=t) or ;
938 // allowed (static_server_State=t). Broadcast if children exist
939 { Visibility=Private }
940 Procedure Connect_DEOs_to_Servers Integer DoAllFg
941 If (DoAllfg OR Static_Server_State(self)) ;
942 Send Attach_Deo_to_Server
943 If (Has_Components_State(self)) ;
944 Broadcast Send Connect_DEOs_to_Servers DoAllfg
945 End_Procedure
946
947 // Disconnect DEOs from Servers according to rules. Broadcast
948 // to child components.
949 //
950 // Pass: DoAllMode
951 // DETACH_NEVER Never
952 // DETACH_IF_NO_CHANGE Do if changed_state=F
953 // DETACH_ALWAYS Do it no matter what
954 // DETACH_IF_ALLOWED Do if changed_state=F and auto_attach
955 // (I don't think this will be needed!)
956 //
957 { Visibility=Private }
958 Procedure Disconnect_DEOs_from_Servers Integer DoAllMode
959 If DoAllMode NE DETACH_NEVER Begin
960 If ( DoAllMode=DETACH_ALWAYS OR ; // do all no matter what
961 ( (Changed_state(self)=0) AND ;
962 ( (DoAllMode=DETACH_IF_NO_CHANGE) OR ;
963 (Static_Server_State(self)) ) ) ) ;
964 Send Remove_deo_from_server
965 if (Has_Components_State(self)) ;
966 Broadcast Send Disconnect_DEOs_from_Servers DoAllMode
967 End
968 End_Procedure
969
970 // Changed to not remove from server if static.
971 { Visibility=Private }
972 procedure Remove_Object
973 forward send remove_object
974 // remove if not static and no changes
975 if ( Static_Server_State(self)=0 AND ;
976 Changed_State(self)=0 ) ; // only detach if unchanged!
977 send remove_DEO_from_server
978 end_procedure
979
980
981 // (JJT) Changed so that this respects Change_disabled_state. I don't
982 // like this here but its the best I can think of. Therefore, all
983 // objects using server.pkg must understand Change_disabled_state.
984 //
985 //12/27/94 (JJT) Checks deferred_state and if set do not change the
986 // changed state of the server object. This had been in datalist and is
987 // required to make deferred_state work right. Deferred_state was created
988 // to make selection-lists work correctly and as far as I am concerned it
989 // should be the only supported use of this. Therefore, I would not *ever*
990 // expect deferred_state to be set true in tables, entry_forms, or text_
991 // windows. Since deferred-state is known to this mixin the change
992 // belongs here - but I expect it to only ever change behaviors in
993 // selection-lists.
994
995 // Changed to not remove from server if static.
996 { MethodType=Property NoDoc=True }
997 { DesignTime=False }
998 { PropertyType=Boolean }
999 procedure SET Changed_State Integer newVal
1000 integer srvr# wsrvr
1001 If Not (Change_Disabled_State(self)) Begin
1002 forward set Changed_State to newVal
1003 get server to srvr#
1004
1005 // if deferred keep the server out of it.
1006 if not (deferred_State(self)) begin
1007 if (newVal AND srvr#) Begin
1008 set Changed_State of srvr# to TRUE
1009 // **JJT**(4) - if no watcher do nothing
1010 Get Watched_Servers to wsrvr
1011 if wsrvr set Changed_State of wSrvr to TRUE
1012 End
1013 // Remove is changed-state=false, not active and not static
1014 if ( not(newVal) AND not(Active_State(self)) AND ;
1015 not(Static_Server_State(self)) ) ;
1016 send remove_DEO_from_Server
1017 End
1018 End
1019 end_procedure
1020
1021 // When an object is created this sets the default value for
1022 // Static_Server_state. If a parent DEO exists it will use its
1023 // static_server_state property. An Entry_view_Client0 object sets
1024 // this - this way view based daf programs will use the new behavior
1025 // (although it can be disabled) but non-daf programs will work like
1026 // they always did.
1027 { MethodType=Property Visibility=Private }
1028 Function Default_Static_Server_State Returns Integer
1029 Integer rVal
1030 // We delegate to get the actual (not default) static state
1031 // Note: Can't check with component_state - it not defined yet
1032 Delegate Get Static_Server_State to rVal
1033 Function_Return rVal
1034 End_Function // Default_Static_Server_State
1035
1036 // **JJT**(2) --- End of changes
1037
1038end_class
1039
1040//
1041// The use of using on an object name is no longer supported. We will check for it's usage in case
1042// developer's use this in old code.
1043// Insetad of using, one should use "Set Server"
1044//
1045#COMMAND bind_using
1046 #IF (!0>0)
1047 #IFSAME !1 USING
1048 #ERROR DFERR_COMP_OBSOLETE_UNSUPPORTED_FEATURE "Using object syntax is no longer supported. Use Set Server instead."
1049 //#IFDEF !2
1050 //set Server to !2
1051 //#ELSE
1052 //set Server to !2.obj
1053 //#ENDIF
1054 #ELSE
1055 bind_using !2 !3 !4 !5 !6 !7 !8 !9
1056 #ENDIF
1057 #ENDIF
1058#ENDCOMMAND
1059