diff options
Diffstat (limited to 'macosx/tkMacOSXSend.c')
| -rw-r--r-- | macosx/tkMacOSXSend.c | 191 |
1 files changed, 84 insertions, 107 deletions
diff --git a/macosx/tkMacOSXSend.c b/macosx/tkMacOSXSend.c index 09a5829..22afde4 100644 --- a/macosx/tkMacOSXSend.c +++ b/macosx/tkMacOSXSend.c @@ -1,49 +1,47 @@ -/* +/* * tkMacOSXSend.c -- * * This file provides procedures that implement the "send" * command, allowing commands to be passed from interpreter - * to interpreter. This current implementation for the Mac + * to interpreter. This current implementation for the Mac * has most functionality stubed out. * * The current plan, which we have not had time to implement, is * for the first Wish app to create a gestalt of type 'WIsH'. * This gestalt will point to a table, in system memory, of - * Tk apps. Each Tk app, when it starts up, will register their - * name, and process ID, in this table. This will allow us to + * Tk apps. Each Tk app, when it starts up, will register their + * name, and process ID, in this table. This will allow us to * implement "tk appname". * * Then the send command will look up the process id of the target - * app in this table, and send an AppleEvent to that process. The + * app in this table, and send an AppleEvent to that process. The * AppleEvent handler is much like the do script handler, except that - * you have to specify the name of the tk app as well, since there may + * you have to specify the name of the tk app as well, since there may * be many interps in one wish app, and you need to send it to the * right one. * * Implementing this has been on our list of things to do, but what - * with the demise of Tcl at Sun, and the lack of resources at - * Scriptics it may not get done for awhile. So this sketch is + * with the demise of Tcl at Sun, and the lack of resources at + * Scriptics it may not get done for awhile. So this sketch is * offered for the brave to attempt if they need the functionality... * * Copyright (c) 1989-1994 The Regents of the University of California. * Copyright (c) 1994-1998 Sun Microsystems, Inc. * Copyright 2001, Apple Computer, Inc. + * Copyright (c) 2005-2007 Daniel A. Steffen <das@users.sourceforge.net> * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tkMacOSXSend.c,v 1.2.2.2 2006/04/28 06:03:00 das Exp $ + * RCS: @(#) $Id: tkMacOSXSend.c,v 1.2.2.3 2007/04/29 02:26:50 das Exp $ */ #include "tkMacOSXInt.h" -MODULE_SCOPE int Tk_SendObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); - - /* - * The following structure is used to keep track of the - * interpreters registered by this process. - */ +/* + * The following structure is used to keep track of the + * interpreters registered by this process. + */ typedef struct RegisteredInterp { char *name; /* Interpreter's name (malloc-ed). */ @@ -60,7 +58,7 @@ typedef struct RegisteredInterp { * property "InterpRegistry" on the root window of the display. * It is organized as a series of zero or more concatenated strings * (in no particular order), each of the form - * window space name '\0' + * window space name '\0' * where "window" is the hex id of the comm. window to use to talk * to an interpreter named "name". * @@ -79,14 +77,14 @@ typedef struct NameRegistry { * out when the NameRegistry is closed. */ unsigned long propLength; /* Length of the property, in bytes. */ char *property; /* The contents of the property, or NULL - * if none. See format description above; + * if none. See format description above; * this is *not* terminated by the first - * null character. Dynamically allocated. */ + * null character. Dynamically allocated. */ int allocedByX; /* Non-zero means must free property with - * XFree; zero means use ckfree. */ + * XFree; zero means use ckfree. */ } NameRegistry; -static int initialized = false; /* A flag to denote if we have initialized yet. */ +static int initialized = false; /* A flag to denote if we have initialized yet. */ static RegisteredInterp *interpListPtr = NULL; /* List of all interpreters @@ -94,78 +92,78 @@ static RegisteredInterp *interpListPtr = NULL; /* * The information below is used for communication between processes - * during "send" commands. Each process keeps a private window, never - * even mapped, with one property, "Comm". When a command is sent to + * during "send" commands. Each process keeps a private window, never + * even mapped, with one property, "Comm". When a command is sent to * an interpreter, the command is appended to the comm property of the - * communication window associated with the interp's process. Similarly, + * communication window associated with the interp's process. Similarly, * when a result is returned from a sent command, it is also appended * to the comm property. * - * Each command and each result takes the form of ASCII text. For a + * Each command and each result takes the form of ASCII text. For a * command, the text consists of a zero character followed by several - * null-terminated ASCII strings. The first string consists of the - * single letter "c". Subsequent strings have the form "option value" + * null-terminated ASCII strings. The first string consists of the + * single letter "c". Subsequent strings have the form "option value" * where the following options are supported: * * -r commWindow serial * - * This option means that a response should be sent to the window - * whose X identifier is "commWindow" (in hex), and the response should - * be identified with the serial number given by "serial" (in decimal). - * If this option isn't specified then the send is asynchronous and - * no response is sent. + * This option means that a response should be sent to the window + * whose X identifier is "commWindow" (in hex), and the response should + * be identified with the serial number given by "serial" (in decimal). + * If this option isn't specified then the send is asynchronous and + * no response is sent. * * -n name - * "Name" gives the name of the application for which the command is - * intended. This option must be present. + * "Name" gives the name of the application for which the command is + * intended. This option must be present. * * -s script * - * "Script" is the script to be executed. This option must be present. + * "Script" is the script to be executed. This option must be present. * - * The options may appear in any order. The -n and -s options must be - * present, but -r may be omitted for asynchronous RPCs. For compatibility + * The options may appear in any order. The -n and -s options must be + * present, but -r may be omitted for asynchronous RPCs. For compatibility * with future releases that may add new features, there may be additional - * options present; as long as they start with a "-" character, they will + * options present; as long as they start with a "-" character, they will * be ignored. * * A result also consists of a zero character followed by several null- - * terminated ASCII strings. The first string consists of the single - * letter "r". Subsequent strings have the form "option value" where + * terminated ASCII strings. The first string consists of the single + * letter "r". Subsequent strings have the form "option value" where * the following options are supported: * * -s serial * - * Identifies the command for which this is the result. It is the - * same as the "serial" field from the -s option in the command. This - * option must be present. + * Identifies the command for which this is the result. It is the + * same as the "serial" field from the -s option in the command. This + * option must be present. * * -c code * - * "Code" is the completion code for the script, in decimal. If the - * code is omitted it defaults to TCL_OK. + * "Code" is the completion code for the script, in decimal. If the + * code is omitted it defaults to TCL_OK. * * -r result * - * "Result" is the result string for the script, which may be either - * a result or an error message. If this field is omitted then it - * defaults to an empty string. + * "Result" is the result string for the script, which may be either + * a result or an error message. If this field is omitted then it + * defaults to an empty string. * * -i errorInfo * - * "ErrorInfo" gives a string with which to initialize the errorInfo - * variable. This option may be omitted; it is ignored unless the - * completion code is TCL_ERROR. + * "ErrorInfo" gives a string with which to initialize the errorInfo + * variable. This option may be omitted; it is ignored unless the + * completion code is TCL_ERROR. * * -e errorCode * - * "ErrorCode" gives a string with with to initialize the errorCode - * variable. This option may be omitted; it is ignored unless the - * completion code is TCL_ERROR. + * "ErrorCode" gives a string with with to initialize the errorCode + * variable. This option may be omitted; it is ignored unless the + * completion code is TCL_ERROR. * * Options may appear in any order, and only the -s option must be - * present. As with commands, there may be additional options besides - * these; unknown options are ignored. + * present. As with commands, there may be additional options besides + * these; unknown options are ignored. */ /* @@ -179,29 +177,8 @@ static RegisteredInterp *interpListPtr = NULL; * Forward declarations for procedures defined later in this file: */ -static int SendInit _ANSI_ARGS_((Tcl_Interp *interp)); -/* -static int AppendErrorProc _ANSI_ARGS_((ClientData clientData, - XErrorEvent *errorPtr)); -static void DeleteProc _ANSI_ARGS_((ClientData clientData)); -static void RegAddName _ANSI_ARGS_((NameRegistry *regPtr, - char *name, Window commWindow)); -static void RegClose _ANSI_ARGS_((NameRegistry *regPtr)); -static void RegDeleteName _ANSI_ARGS_((NameRegistry *regPtr, - char *name)); -static Window RegFindName _ANSI_ARGS_((NameRegistry *regPtr, - char *name)); -static NameRegistry * RegOpen _ANSI_ARGS_((Tcl_Interp *interp, - TkWindow *winPtr, int lock)); -static void SendEventProc _ANSI_ARGS_((ClientData clientData, - XEvent *eventPtr)); -static Bool SendRestrictProc _ANSI_ARGS_((Display *display, - XEvent *eventPtr, char *arg)); -static int ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr)); -static void TimeoutProc _ANSI_ARGS_((ClientData clientData)); -static int ValidateName _ANSI_ARGS_((TkDisplay *dispPtr, - char *name, Window commWindow, int oldOK)); -*/ +static int SendInit(Tcl_Interp *interp); + /* *-------------------------------------------------------------- @@ -209,20 +186,20 @@ static int ValidateName _ANSI_ARGS_((TkDisplay *dispPtr, * Tk_SetAppName -- * * This procedure is called to associate an ASCII name with a Tk - * application. If the application has already been named, the + * application. If the application has already been named, the * name replaces the old one. * * Results: * The return value is the name actually given to the application. * This will normally be the same as name, but if name was already * in use for an application then a name of the form "name #2" will - * be chosen, with a high enough number to make the name unique. + * be chosen, with a high enough number to make the name unique. * * Side effects: * Registration info is saved, thereby allowing the "send" command - * to be used later to invoke commands in the application. In + * to be used later to invoke commands in the application. In * addition, the "send" command is created in the application's - * interpreter. The registration will be removed automatically + * interpreter. The registration will be removed automatically * if the interpreter is deleted or the "send" command is removed. * *-------------------------------------------------------------- @@ -231,18 +208,18 @@ static int ValidateName _ANSI_ARGS_((TkDisplay *dispPtr, CONST char * Tk_SetAppName( Tk_Window tkwin, /* Token for any window in the application - * to be named: it is just used to identify - * the application and the display. */ + * to be named: it is just used to identify + * the application and the display. */ CONST char *name) /* The name that will be used to * refer to the interpreter in later - * "send" commands. Must be globally + * "send" commands. Must be globally * unique. */ { TkWindow *winPtr = (TkWindow *) tkwin; Tcl_Interp *interp = winPtr->mainPtr->interp; int i, suffix, offset, result; RegisteredInterp *riPtr, *prevPtr; - CONST char *actualName; + const char *actualName; Tcl_DString dString; Tcl_Obj *resultObjPtr, *interpNamePtr; char *interpName; @@ -257,7 +234,7 @@ Tk_SetAppName( * will take care of disposing of this entry. */ - for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL; + for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL; prevPtr = riPtr, riPtr = riPtr->nextPtr) { if (riPtr->interp == interp) { if (prevPtr == NULL) { @@ -270,8 +247,8 @@ Tk_SetAppName( } /* - * Pick a name to use for the application. Use "name" if it's not - * already in use. Otherwise add a suffix such as " #2", trying + * Pick a name to use for the application. Use "name" if it's not + * already in use. Otherwise add a suffix such as " #2", trying * larger and larger numbers until we eventually find one that is * unique. */ @@ -289,7 +266,7 @@ Tk_SetAppName( if (interpNamePtr == NULL) { break; } - interpName = Tcl_GetStringFromObj(interpNamePtr, NULL); + interpName = Tcl_GetString(interpNamePtr); if (strcmp(actualName, interpName) == 0) { if (suffix == 1) { Tcl_DStringAppend(&dString, name, -1); @@ -320,7 +297,7 @@ Tk_SetAppName( interpListPtr = riPtr; strcpy(riPtr->name, actualName); - Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, + Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, (ClientData) riPtr, NULL /* TODO: DeleteProc */); if (Tcl_IsSafe(interp)) { Tcl_HideCommand(interp, "send", "send"); @@ -354,7 +331,7 @@ Tk_SendObjCmd( int objc, /* Number of arguments */ Tcl_Obj *CONST objv[]) /* The arguments */ { - CONST char *sendOptions[] = {"-async", "-displayof", "-", (char *) NULL}; + const char *sendOptions[] = {"-async", "-displayof", "-", NULL}; char *stringRep, *destName; int async = 0; int i, index, firstArg; @@ -363,7 +340,7 @@ Tk_SendObjCmd( int result = TCL_OK; for (i = 1; i < (objc - 1); ) { - stringRep = Tcl_GetStringFromObj(objv[i], NULL); + stringRep = Tcl_GetString(objv[i]); if (stringRep[0] == '-') { if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, "option", 0, &index) != TCL_OK) { @@ -381,32 +358,32 @@ Tk_SendObjCmd( break; } } - + if (objc < (i + 2)) { Tcl_WrongNumArgs(interp, 1, objv, "?options? interpName arg ?arg ...?"); return TCL_ERROR; } - destName = Tcl_GetStringFromObj(objv[i], NULL); + destName = Tcl_GetString(objv[i]); firstArg = i + 1; resultPtr = Tcl_GetObjResult(interp); /* - * See if the target interpreter is local. If so, execute + * See if the target interpreter is local. If so, execute * the command directly without going through the DDE server. * The only tricky thing is passing the result from the target - * interpreter to the invoking interpreter. Watch out: they + * interpreter to the invoking interpreter. Watch out: they * could be the same! */ - for (riPtr = interpListPtr; (riPtr != NULL) + for (riPtr = interpListPtr; (riPtr != NULL) && (strcmp(destName, riPtr->name)); riPtr = riPtr->nextPtr) { /* * Empty loop body. */ - + } if (riPtr != NULL) { @@ -442,16 +419,16 @@ Tk_SendObjCmd( /* * An error occurred, so transfer error information from the - * destination interpreter back to our interpreter. Must clear + * destination interpreter back to our interpreter. Must clear * interp's result before calling Tcl_AddErrorInfo, since * Tcl_AddErrorInfo will store the interp's result in errorInfo - * before appending riPtr's $errorInfo; we've already got + * before appending riPtr's $errorInfo; we've already got * everything we need in riPtr's $errorInfo. */ Tcl_ResetResult(interp); Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp, - "errorInfo", (char *) NULL, TCL_GLOBAL_ONLY)); + "errorInfo", NULL, TCL_GLOBAL_ONLY)); /* errorObjPtr = Tcl_GetObjVar2(localInterp, "errorCode", NULL, TCL_GLOBAL_ONLY); Tcl_SetObjErrorCode(interp, errorObjPtr); */ @@ -480,9 +457,9 @@ Tk_SendObjCmd( * of a particular window. * * Results: - * A standard Tcl return value. Interp->result will be set + * A standard Tcl return value. Interp->result will be set * to hold a list of all the interpreter names defined for - * tkwin's display. If an error occurs, then TCL_ERROR + * tkwin's display. If an error occurs, then TCL_ERROR * is returned and interp->result will hold an error message. * * Side effects: @@ -503,11 +480,11 @@ TkGetInterpNames( listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); riPtr = interpListPtr; while (riPtr != NULL) { - Tcl_ListObjAppendElement(interp, listObjPtr, + Tcl_ListObjAppendElement(interp, listObjPtr, Tcl_NewStringObj(riPtr->name, -1)); riPtr = riPtr->nextPtr; } - + Tcl_SetObjResult(interp, listObjPtr); return TCL_OK; } |