1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251
|
/* Copyright(c) 1993 Association of Universities for Research in Astronomy Inc.
*/
#include <ObmP.h>
/*
* CLIENT class.
* --------------------------
* The client is the client application, which provides the functionality
* underlying the UI. When a message is sent to the client object it usually
* results in a message being sent to the client *application*, usually an
* external program communicating via IPC, which has little or no knowledge
* of the UI. The client application receives and executes commands delivered
* by the UI via the client object. Output from the client may or may not
* come back to the object manager. That portion of the output which comes
* back to the object manager is in the form of assignments of string values
* to UI parameter-class objects (another way of thinking of this is that
* messages or events are sent to and acted upon by the parameter objects).
* Hence, the client object is output only so far as the client application
* is concerned.
*
* The Client-class commands are used to send a message to the client.
*
* gkey <key>
* gcmd <command-string>
* literal <command>
*
* or just <command>, e.g., "send client <command>" will work in most cases.
*
* GKEY sends and IRAF graphics keystroke. GCMD sends and IRAF graphics
* colon command. LITERAL sends a literal command string to the client.
* The keyword "literal" may optionally be omitted, i.e., "send client foo"
* and "send client literal foo" are the same. The keyword "literal" may
* be used to ensure that the client command string which follows will not
* be interpreted as a Client-class command (such as gkey, gcmd, or literal).
*/
struct clientPrivate {
ObmContext obm;
Tcl_Interp *tcl;
};
typedef struct clientPrivate *ClientPrivate;
struct clientObject {
struct obmObjectCore core;
struct clientPrivate client;
};
typedef struct clientObject *ClientObject;
static void ClientDestroy();
static int ClientEvaluate();
static ObmObject ClientCreate();
static int clientGcmd(), clientGkey(), clientLiteral();
static int client_output();
/* ClientClassInit -- Initialize the class record for the client class.
*/
void
ClientClassInit (obm, classrec)
ObmContext obm;
register ObjClassRec classrec;
{
classrec->ClassDestroy = obmGenericClassDestroy;
classrec->Create = (ObmFunc) ClientCreate;
classrec->Destroy = ClientDestroy;
classrec->Evaluate = ClientEvaluate;
}
/* ClientCreate -- Create an instance of a client object.
*/
static ObmObject
ClientCreate (obm, name, classrec, parent, args, nargs)
ObmContext obm;
char *name;
ObjClassRec classrec;
char *parent;
ArgList args;
int nargs;
{
register ClientObject obj;
register Tcl_Interp *tcl;
obj = (ClientObject) XtCalloc (1, sizeof (struct clientObject));
obj->client.tcl = tcl = Tcl_CreateInterp();
obj->client.obm = obm;
/* Register client-object actions. */
Tcl_CreateCommand (tcl,
"gcmd", clientGcmd, (ClientData)obj, NULL);
Tcl_CreateCommand (tcl,
"gkey", clientGkey, (ClientData)obj, NULL);
Tcl_CreateCommand (tcl,
"literal", clientLiteral, (ClientData)obj, NULL);
return ((ObmObject) obj);
}
/* ClientDestroy -- Destroy an instance of a client object.
*/
static void
ClientDestroy (object)
ObmObject object;
{
register ClientObject obj = (ClientObject) object;
if (obj->core.being_destroyed++)
Tcl_DeleteInterp (obj->client.tcl);
}
/* ClientEvaluate -- Evaluate a client command or message.
*/
static int
ClientEvaluate (object, command)
ObmObject object;
char *command;
{
register ClientObject obj = (ClientObject) object;
register Tcl_Interp *tcl = obj->client.tcl;
int status, argc, i;
char *argv[MAX_ARGS];
char **argvp;
if (!obmClientCommand (tcl, command))
goto literal;
/* If the command is unrecognized pass it on to the client as a
* literal to be processed by the client.
*/
if ((status = Tcl_Eval (tcl, command)) != TCL_OK) {
literal: if (Tcl_SplitList (tcl, command, &argc, &argvp) == TCL_OK) {
argv[0] = "literal";
if (argc > MAX_ARGS)
argc = MAX_ARGS;
for (i=0; i <= argc; i++)
argv[i+1] = argvp[i];
status = clientLiteral (object, tcl, argc + 1, argv);
free ((char *) argvp);
}
}
return (status);
}
/* clientGcmd -- Send a graphics command string to the client application.
* A graphics command string is a graphics cursor value with the key set
* to `:' and the command string given as the string part of the cursor
* value. The protocol module which posted the client output procedure is
* responsible for encoding and sending the cursor command.
*
* Usage: gcmd <command-string>
*/
static int
clientGcmd (object, tcl, argc, argv)
ObmObject object;
Tcl_Interp *tcl;
int argc;
char **argv;
{
register ClientObject obj = (ClientObject) object;
register ObmContext obm = obj->client.obm;
int stat;
if (argc >= 2) {
char *message = Tcl_Concat (argc-1, &argv[1]);
stat = client_output (obm, ':', message);
free ((char *)message);
} else
stat = -1;
return (stat < 0 ? TCL_ERROR : TCL_OK);
}
/* clientGkey -- Send a graphics key event to the client application.
* A graphics key event is a graphics cursor value with the key set to some
* integer value and a null string part.
*
* Usage: gkey <key>
*/
static int
clientGkey (object, tcl, argc, argv)
ObmObject object;
Tcl_Interp *tcl;
int argc;
char **argv;
{
register ClientObject obj = (ClientObject) object;
register ObmContext obm = obj->client.obm;
int stat;
if (argc >= 2)
stat = client_output (obm, *argv[1], "");
else
stat = -1;
return (stat < 0 ? TCL_ERROR : TCL_OK);
}
/* clientLiteral -- Send a literal command to the client application.
*
* Usage: literal <command>
*/
static int
clientLiteral (object, tcl, argc, argv)
ObmObject object;
Tcl_Interp *tcl;
int argc;
char **argv;
{
register ClientObject obj = (ClientObject) object;
register ObmContext obm = obj->client.obm;
int stat;
if (argc >= 2) {
char *message = Tcl_Concat (argc-1, &argv[1]);
stat = client_output (obm, 0, message);
free ((char *)message);
} else
stat = -1;
return (stat < 0 ? TCL_ERROR : TCL_OK);
}
/* client_output -- Call the client output callbacks if any.
*/
static int
client_output (obm, key, strval)
register ObmContext obm;
int key;
char *strval;
{
register ObmCallback cb;
register int stat = 0;
for (cb = obm->callback_list; cb; cb = cb->next)
if ((cb->callback_type & OBMCB_clientOutput) && cb->u.fcn)
stat |= ((*cb->u.fcn) (cb->client_data, obm->tcl, key, strval));
return (stat != 0);
}
|