Oberon || Library || Module Index || Search Engine || Definition || Module
TYPE Interpreter = POINTER TO InterpreterRec; TYPE InterpreterRec = RECORD (Services.ObjectRec) END; (* objects used to communicate with Tcl *) TYPE Record = POINTER TO RecordRec; TYPE RecordRec = RECORD (Disciplines.ObjectRec) typename: ConstStrings.String; END; (* lists used within a object of type Record *) TYPE List = POINTER TO ListRec; TYPE ListRec = RECORD (Objects.ObjectRec) END; TYPE IntList = POINTER TO IntListRec; TYPE IntListRec = RECORD (ListRec) value: INTEGER; next: IntList; END; TYPE RealList = POINTER TO RealListRec; TYPE RealListRec = RECORD (ListRec) value: REAL; next: RealList; END; TYPE StringList = POINTER TO StringListRec; TYPE StringListRec = RECORD (ListRec) value: Streams.Stream; next: StringList; END; TYPE BoolList = POINTER TO BoolListRec; TYPE BoolListRec = RECORD (ListRec) value: BOOLEAN; next: BoolList; END; (* events exchanged with Tcl *) TYPE EventType = ARRAY 20 OF CHAR; TYPE Event = POINTER TO EventRec; TYPE EventRec = RECORD (Events.EventRec) from: Interpreter; record: Record; END; CONST connectionFailed = 0; (* unable to access the port listener *) connectionRefused = 1; (* setup failed *) connectionBroken = 2; (* connection is broken *) sendFailed = 3; (* failed to send the requested data *) receiveFailed = 4; (* failed to receive the requested data *) serverExit = 5; (* tcltk-server receives an exit-Event *) protocolError = 6; (* got an unexpected value *) tkError = 7; (* tkerror occured *) callProcError = 8; (* tclerror or no record returned by proc *) errors = 9; TYPE ErrorEvent = POINTER TO ErrorEventRec; TYPE ErrorEventRec = RECORD (Events.EventRec); errorcode: SHORTINT; END; VAR error: Events.EventType; VAR errormsg: ARRAY errors OF Events.Message;
(* handling a connection to a interpreter *) PROCEDURE Open(VAR interp: Interpreter; address: Internet.Address; display, appName, className: ARRAY OF CHAR; errors: RelatedEvents.Object) : BOOLEAN; PROCEDURE Close(interp: Interpreter); (* evaluating Tcl scripts *) PROCEDURE Eval(interp: Interpreter; script: ARRAY OF CHAR; result: Streams.Stream) : BOOLEAN; PROCEDURE EvalStream(interp: Interpreter; script: Streams.Stream; result: Streams.Stream) : BOOLEAN; (* event handling *) PROCEDURE Define(interp: Interpreter; type: Events.EventType; VAR tcltypename: EventType); PROCEDURE Handler(interp: Interpreter; type: Events.EventType; tclhandler: ARRAY OF CHAR); PROCEDURE GetEventType(interp: Interpreter; tcltypename: EventType; VAR type: Events.EventType); PROCEDURE CreateEventConditions(interp: Interpreter; record: Record; slotnames: ARRAY OF ARRAY OF CHAR; VAR conditions: ARRAY OF Conditions.Condition; conditionset: Conditions.ConditionSet); PROCEDURE DropEventConditions(conditions: ARRAY OF Conditions.Condition); (* remote procedure call *) PROCEDURE CallProc(interp: Interpreter; proc: ARRAY OF CHAR; arguments: Record; VAR result: Record) : BOOLEAN; (* handling with objects for communication *) PROCEDURE CreateRecord(VAR record: Record; interp: Interpreter; tcltypename: ARRAY OF CHAR); PROCEDURE GetStringSlot(record: Record; slotname: ARRAY OF CHAR; VAR value: ARRAY OF CHAR); PROCEDURE GetStringSlotAsStream(record: Record; slotname: ARRAY OF CHAR; VAR value: Streams.Stream); PROCEDURE GetIntSlot(record: Record; slotname: ARRAY OF CHAR; VAR value: INTEGER); PROCEDURE GetRealSlot(record: Record; slotname: ARRAY OF CHAR; VAR value: REAL); PROCEDURE GetBooleanSlot(record: Record; slotname: ARRAY OF CHAR; VAR value: BOOLEAN); PROCEDURE GetListSlot(record: Record; slotname: ARRAY OF CHAR; VAR value: List); PROCEDURE SetStringSlot(record: Record; slotname: ARRAY OF CHAR; value: ARRAY OF CHAR); PROCEDURE SetStringSlotFromStream(record: Record; slotname: ARRAY OF CHAR; value: Streams.Stream); PROCEDURE SetIntSlot(record: Record; slotname: ARRAY OF CHAR; value: INTEGER); PROCEDURE SetRealSlot(record: Record; slotname: ARRAY OF CHAR; value: REAL); PROCEDURE SetBooleanSlot(record: Record; slotname: ARRAY OF CHAR; value: BOOLEAN); PROCEDURE SetListSlot(record: Record; slotname: ARRAY OF CHAR; value: List);
In order to realize access to a interpreter there is a server, called tcltks. The server can run on every machine that is connected via internet to the machine, in which the Oberon application is running.
In order to avoid network traffic evoked by the X-protocol, running between Tk and X, the port listener should reside in the same machine as the X-server for the specified display does.
Due to security, the server checks if the connecting partie is authorized. To do so, there have to be a file called .tcltks in the users home directory. This file should only be readable by the user himself and it has to contain a password in the first line. This file must also be accessible by the server. If the server runs on a different file system the same file has to be provided there.
After having connected successfully a server, Open passes the first line of .tcltks to the server together with display, appName and className. The server tries to create a main window on display and assigns className as name for the class of the main window (among other thing the class name is used for the resource database). appName is the name of the application as registered by the window manager and may be used by the tk_send command. On success Open returns TRUE and a new object of type Interpreter is created, representing the server.
For terminating a server TclTk supports Resources. Close terminates the server immediately.
Eval sends the script to the server, in order to evaluate it. If there was no error during evaluation, Eval returns TRUE and the resulting string can be found in result. Otherwise result contains the resulting error message returned by Tcl. EvalStream works like Eval except that it reads the script from a given stream, starting at the current stream position.
Records have to be defined in Tcl to keep the interface clear. For dealing with records in Tcl there is a new command called Records, which comes along with a few options:
In Oberon, objects for communication are of type Record. CreateRecord creates a new object, that previously was defined in Tcl. tcltypename specifies the typename of the object, that has to be created.
For dealing with such objects, TclTk provides some procedures in order to assign or retrieve values (GetStringSlot ... SetListSlot). A list assigned to a slot in Tcl is converted to the coressponding list type IntList, RealList, StringList or BoolList, and vice versa. The procedure used has to match the declared type of the slot, she should operate on. I.e. a slot declared of type integer can only be accessed by GetIntSlot or SetIntSlot.
Build upon these objects, CallProc offers a possibility to call a Tcl procedure from within Oberon. The Tcl procedure expects a object as argument that is given in arguments and returns another object on her part, which is accessible in result. NIL objects in Tcl are denoted by "" or {}. Note the object passed to the Tcl procedure gets deleted after the procedure returns.
For event handling there is another new Tcl command called Events:
A handler for an event type is a Tcl procedure with three arguments:
proc procname {typename message record} body
The arguments equals the ones given to Events raise.
Events raised in Tcl are delivered in Oberon as events of type Event. The transmitted communication object can be found in record. Receiving and raising events in Oberon can be done in the traditional fashion with the procedures provided by the module Events.
GetEventType retrieves the object of type Events.EventType that is used as event type denoted by tcltypename.
To receive an event within a task, EventConditions can be used. CreateEventConditions therefore helps to create event conditions for event types transmitted from Tcl to Oberon within a communication object. For every slotname given in slotnames a event condition is produced and assigned in the same order to conditions as the names are given. In addition, every condition is included in conditionset. Note each value of the slots given in slotnames have to contain a valid slotname which was defined in Tcl by Events define. DropEventConditions calls EventConditions.Drop for every condition in conditions.
In addition to event types created by the Events define command, existing event types can be prepared to use for communication with Tcl. This is done by Define that also creates a unique tcltypename for the given type. Define can be called multiple for one type with different interpreters.
Handler defines an additional Tcl procedure for handling events of event type type, that previously was defined by Define or Events define.
Records define MyType \\ slot1 integer \\ slot2 string \\ slot3 { \\ slot31 list<string> \\ slot32 boolean \\ } Records create MyType var1 var2 Records set var1 \\ slot1 1234 \\ slot3.slot32 1 Records get var1 -> {slot1 1234} {slot2 {}} {slot3 {{slot31 {}} {slot32 1}}} Records get var1 slot1 -> 1234 Records typename var1 -> MyType
A Tcl program, that is used to provide a GUI for Oberon, therefore looks like this: The type definition of the objects can reside anywhere in the script, but it is a good practice to define all object types at the beginning. To get the thing started, the defined event types must be known to the oberon application. To do so, a communication object can be used that is returned by a procedure so that the Oberon application can do a call to CallProc to get the object:
proc StartUp { record } {
Records define UsedEvents \\
ev1 string \\
ev2 string \\
ev3 string
Records create UsedEvents myevents
Records set myevents \\
ev1 [Events define] \\
ev2 [Events define] \\
ev3 [Events define]
# if ev3 is used for incoming events,
# a handler is needed
Events handler [Records get myevents ev3] MyHandler
return myevents
}
proc MyHandler {typename msg record} {
puts "it works: $msg"
# assuming, the record is of type MyType, we can write
puts "slot1: [Records get $record slot1]"
}
An event may then be raised in the following manner:
# ... Events raise [Records get myevents ev1] mymessage var2
The text for the Oberon program may be structured like this:
TYPE Slotname = ARRAY 5 OF CHAR; PROCEDURE Init();
VAR cr: Coroutines.Coroutine; task: Tasks.Task; result: TclTk.Record; interp: TclTk.Interpreter; BEGIN (* create a server via Open and eval the script for the GUI *) (* * Note a script like "source myscript.tcl" is much more * faster then sending the script accross the network. * *) (* start the whole thing and get the object *) IF TclTk.CallProc(interp, "StartUp", NIL, result) THEN MyTask(cr, interp, result); Tasks.Create(task, cr); END; END Init; PROCEDURE MyTask(VAR cr: Coroutines.Coroutine; interp: TclTk.Interpeter; record: TclTk.Record); CONST ev1 = 0; ev2 = 1; events = 2; VAR tkeventtype: TclTk.EventType; tkevent, event: TclTk.Event; ev3: Events.EventType; slotnames: ARRAY events OF Slotname; conditions: ARRAY events OF Conditions.Condition; cset: Conditions.ConditionSet; BEGIN (* create conditions for incoming events from Tcl *) slotnames[ev1] := "ev1"; slotnames[ev2] := "ev2"; Conditions.CreateSet(cset); TclTk.CreateEventConditions(interp, record, slotnames, conditions, cset); (* create and init an event in order to send it to Tcl *) NEW(event); TclTk.GetStringSlot(record, "ev3", tkeventtype); TclTk.GetEventType(interp, tkeventtype, event.type); TclTk.CreateRecord(event.record, interp, "MyType"); SYSTEM.CRSPAWN(cr); (* lets wait *) LOOP Tasks.WaitForOneOf(cset); IF EventConditions.TestAndGet(conditions[ev1], tkevent) THEN (* do what you wonna do *) ELSIF EventConditions.TestAndGet(conditions[ev2], tkevent) THEN (* assign values to event.record *) TclTk.SetIntSlot(event.record, "slot1", 12345); (* transmit the event to Tcl *) Events.Raise(event); END; END; TclTk.DropEventConditions(conditions); TclTk.Close(interp); Tasks.Terminate; END MyTask;
Several errors which results from programming mistakes are covered by assertions:
Oberon || Library || Module Index || Search Engine || Definition || Module