Removed support for Mac OS Classic platform [Patch 918139]

1 files changed, 0 insertions, 548 deletions

diff --git a/mac/tkMacSend.c b/mac/tkMacSend.c
deleted file mode 100644
index e434d79..0000000
--- a/mac/tkMacSend.c
+++ /dev/null
@@ -1,548 +0,0 @@
-/* 
- * tkMacSend.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
- *	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 
- *	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
- *	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
- *	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
- *	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.
- *
- * See the file "license.terms" for information on usage and redistribution
- * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
- *
- * RCS: @(#) $Id: tkMacSend.c,v 1.7 2002/10/09 11:56:54 das Exp $
- */
-
-#include <Gestalt.h>
-#include "tkPort.h"
-#include "tkInt.h"
-
-EXTERN 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.
-      */
-
-typedef struct RegisteredInterp {
-    char *name;			/* Interpreter's name (malloc-ed). */
-    Tcl_Interp *interp;		/* Interpreter associated with
-				 * name. */
-    struct RegisteredInterp *nextPtr;
-    /* Next in list of names associated
-     * with interps in this process.
-     * NULL means end of list. */
-} RegisteredInterp;
-
-/*
- * A registry of all interpreters for a display is kept in a
- * 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'
- * where "window" is the hex id of the comm. window to use to talk
- * to an interpreter named "name".
- *
- * When the registry is being manipulated by an application (e.g. to
- * add or remove an entry), it is loaded into memory using a structure
- * of the following type:
- */
-
-typedef struct NameRegistry {
-    TkDisplay *dispPtr;		/* Display from which the registry was
-				 * read. */
-    int locked;			/* Non-zero means that the display was
-				 * locked when the property was read in. */
-    int modified;		/* Non-zero means that the property has
-				 * been modified, so it needs to be written
-				 * 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;
-				 * this is *not* terminated by the first
-				 * null character.  Dynamically allocated. */
-    int allocedByX;		/* Non-zero means must free property with
-				 * XFree;  zero means use ckfree. */
-} NameRegistry;
-
-static initialized = false;	/* A flag to denote if we have initialized yet. */
-
-static RegisteredInterp *interpListPtr = NULL;
-/* List of all interpreters
- * registered by this process. */
-
-     /*
-      * 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
-      * an interpreter, the command is appended to the comm property of the
-      * 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
-      * 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"
-      * 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.
-      *
-      * -n name
-      *	"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.
-      *
-      * 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
-      * 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
-      * 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.
-      *
-      * -c code
-      *
-      *	"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.
-      *
-      * -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.
-      *
-      * -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.
-      *
-      * 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.
-      */
-
-     /*
-      * The following variable is the serial number that was used in the
-      * last "send" command.  It is exported only for testing purposes.
-      */
-
-int tkSendSerial = 0;
-
-     /*
-      * Maximum size property that can be read at one time by
-      * this module:
-      */
-
-#define MAX_PROP_WORDS 100000
-
-/*
- * Forward declarations for procedures defined later in this file:
- */
-
-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 int		SendInit _ANSI_ARGS_((Tcl_Interp *interp));
-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));
-
-/*
- *--------------------------------------------------------------
- *
- * Tk_SetAppName --
- *
- *	This procedure is called to associate an ASCII name with a Tk
- *	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.
- *
- * Side effects:
- *	Registration info is saved, thereby allowing the "send" command
- *	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
- *	if the interpreter is deleted or the "send" command is removed.
- *
- *--------------------------------------------------------------
- */
-
-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.  */
-    CONST char *name)		/* The name that will be used to
-				 * refer to the interpreter in later
-				 * "send" commands.  Must be globally
-				 * unique. */
-{
-    TkWindow *winPtr = (TkWindow *) tkwin;
-    Tcl_Interp *interp = winPtr->mainPtr->interp;
-    int i, suffix, offset, result;
-    int createCommand = 0;
-    RegisteredInterp *riPtr, *prevPtr;
-    CONST char *actualName;
-    Tcl_DString dString;
-    Tcl_Obj *resultObjPtr, *interpNamePtr;
-    char *interpName;
-
-    if (!initialized) {
-	SendInit(interp);
-    }
-
-    /*
-     * See if the application is already registered; if so, remove its
-     * current name from the registry. The deletion of the command
-     * will take care of disposing of this entry.
-     */
-
-    for (riPtr = interpListPtr, prevPtr = NULL; riPtr != NULL; 
-	    prevPtr = riPtr, riPtr = riPtr->nextPtr) {
-	if (riPtr->interp == interp) {
-	    if (prevPtr == NULL) {
-		interpListPtr = interpListPtr->nextPtr;
-	    } else {
-		prevPtr->nextPtr = riPtr->nextPtr;
-	    }
-	    break;
-	}
-    }
-
-    /*
-     * 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.
-     */
-
-    actualName = name;
-    suffix = 1;
-    offset = 0;
-    Tcl_DStringInit(&dString);
-
-    TkGetInterpNames(interp, tkwin);
-    resultObjPtr = Tcl_GetObjResult(interp);
-    Tcl_IncrRefCount(resultObjPtr);
-    for (i = 0; ; ) {
-	result = Tcl_ListObjIndex(NULL, resultObjPtr, i, &interpNamePtr);
-	if (interpNamePtr == NULL) {
-	    break;
-	}
-	interpName = Tcl_GetStringFromObj(interpNamePtr, NULL);
-	if (strcmp(actualName, interpName) == 0) {
-	    if (suffix == 1) {
-		Tcl_DStringAppend(&dString, name, -1);
-		Tcl_DStringAppend(&dString, " #", 2);
-		offset = Tcl_DStringLength(&dString);
-		Tcl_DStringSetLength(&dString, offset + 10);
-		actualName = Tcl_DStringValue(&dString);
-	    }
-	    suffix++;
-	    sprintf(Tcl_DStringValue(&dString) + offset, "%d", suffix);
-	    i = 0;
-	} else {
-	    i++;
-	}
-    }
-
-    Tcl_DecrRefCount(resultObjPtr);
-    Tcl_ResetResult(interp);
-
-    /*
-     * We have found a unique name. Now add it to the registry.
-     */
-
-    riPtr = (RegisteredInterp *) ckalloc(sizeof(RegisteredInterp));
-    riPtr->interp = interp;
-    riPtr->name = ckalloc(strlen(actualName) + 1);
-    riPtr->nextPtr = interpListPtr;
-    interpListPtr = riPtr;
-    strcpy(riPtr->name, actualName);
-
-    Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, 
-	    (ClientData) riPtr, NULL /* TODO: DeleteProc */);
-    if (Tcl_IsSafe(interp)) {
-	Tcl_HideCommand(interp, "send", "send");
-    }
-    Tcl_DStringFree(&dString);
-
-    return riPtr->name;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * Tk_SendObjCmd --
- *
- *	This procedure is invoked to process the "send" Tcl command.
- *	See the user documentation for details on what it does.
- *
- * Results:
- *	A standard Tcl result.
- *
- * Side effects:
- *	See the user documentation.
- *
- *--------------------------------------------------------------
- */
-
-int
-Tk_SendObjCmd(
-    ClientData clientData,	/* Used only for deletion */
-    Tcl_Interp *interp,		/* The interp we are sending from */
-    int objc,			/* Number of arguments */
-    Tcl_Obj *CONST objv[])	/* The arguments */
-{
-    static CONST char *sendOptions[] = {"-async", "-displayof", "-", (char *) NULL};
-    char *stringRep, *destName;
-    int async = 0;
-    int i, index, firstArg;
-    RegisteredInterp *riPtr;
-    Tcl_Obj *resultPtr, *listObjPtr;
-    int result;
-
-    for (i = 1; i < (objc - 1); ) {
-	stringRep = Tcl_GetStringFromObj(objv[i], NULL);
-	if (stringRep[0] == '-') {
-	    if (Tcl_GetIndexFromObj(interp, objv[i], sendOptions, "option", 0,
-		    &index) != TCL_OK) {
-		return TCL_ERROR;
-	    }
-	    if (index == 0) {
-		async = 1;
-		i++;
-	    } else if (index == 1) {
-		i += 2;
-	    } else {
-		i++;
-	    }
-	} else {
-	    break;
-	}
-    }
-	
-    if (objc < (i + 2)) {
-	Tcl_WrongNumArgs(interp, 1, objv,
-		"?options? interpName arg ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    destName = Tcl_GetStringFromObj(objv[i], NULL);
-    firstArg = i + 1;
-
-    resultPtr = Tcl_GetObjResult(interp);
-
-    /*
-     * 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
-     * could be the same!
-     */
-
-    for (riPtr = interpListPtr; (riPtr != NULL) 
-	    && (strcmp(destName, riPtr->name)); riPtr = riPtr->nextPtr) {
-	/*
-	 * Empty loop body.
-	 */
-    
-    }
-
-    if (riPtr != NULL) {
-	/*
-	 * This command is to a local interp. No need to go through
-	 * the server.
-	 */
-
-	Tcl_Interp *localInterp;
-
-	Tcl_Preserve((ClientData) riPtr);
-	localInterp = riPtr->interp;
-	Tcl_Preserve((ClientData) localInterp);
-	if (firstArg == (objc - 1)) {
-	    /*
-	     * This might be one of those cases where the new
-	     * parser is faster.
-	     */
-
-	    result = Tcl_EvalObjEx(localInterp, objv[firstArg], TCL_EVAL_DIRECT);
-	} else {
-	    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-	    for (i = firstArg; i < objc; i++) {
-		Tcl_ListObjAppendList(interp, listObjPtr, objv[i]);
-	    }
-	    Tcl_IncrRefCount(listObjPtr);
-	    result = Tcl_EvalObjEx(localInterp, listObjPtr, TCL_EVAL_DIRECT);
-	    Tcl_DecrRefCount(listObjPtr);
-	}
-	if (interp != localInterp) {
-	    if (result == TCL_ERROR) {
-		/* Tcl_Obj *errorObjPtr; */
-
-		/*
-		 * An error occurred, so transfer error information from the
-		 * 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
-		 * everything we need in riPtr's $errorInfo.
-		 */
-
-		Tcl_ResetResult(interp);
-		Tcl_AddErrorInfo(interp, Tcl_GetVar2(localInterp,
-			"errorInfo", (char *) NULL, TCL_GLOBAL_ONLY));
-		/* errorObjPtr = Tcl_GetObjVar2(localInterp, "errorCode", NULL,
-			TCL_GLOBAL_ONLY);
-		Tcl_SetObjErrorCode(interp, errorObjPtr); */
-	    }
-	    Tcl_SetObjResult(interp, Tcl_GetObjResult(localInterp));
-	}
-	Tcl_Release((ClientData) riPtr);
-	Tcl_Release((ClientData) localInterp);
-    } else {
-	/*
-	 * This is a non-local request. Send the script to the server and poll
-	 * it for a result. TODO!!!
-	 */
-    }
-
-done:
-    return result;
-}
-
-/*
- *----------------------------------------------------------------------
- *
- * TkGetInterpNames --
- *
- *	This procedure is invoked to fetch a list of all the
- *	interpreter names currently registered for the display
- *	of a particular window.
- *
- * Results:
- *	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
- *	is returned and interp->result will hold an error message.
- *
- * Side effects:
- *	None.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TkGetInterpNames(
-    Tcl_Interp *interp,		/* Interpreter for returning a result. */
-    Tk_Window tkwin)		/* Window whose display is to be used
-				 * for the lookup. */
-{
-    Tcl_Obj *listObjPtr;
-    RegisteredInterp *riPtr;
-
-    listObjPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
-    riPtr = interpListPtr;
-    while (riPtr != NULL) {
-	Tcl_ListObjAppendElement(interp, listObjPtr, 
-		Tcl_NewStringObj(riPtr->name, -1));
-	riPtr = riPtr->nextPtr;
-    }
-    
-    Tcl_SetObjResult(interp, listObjPtr);
-    return TCL_OK;
-}
-
-/*
- *--------------------------------------------------------------
- *
- * SendInit --
- *
- *	This procedure is called to initialize the
- *	communication channels for sending commands and
- *	receiving results.
- *
- * Results:
- *	None.
- *
- * Side effects:
- *	Sets up various data structures and windows.
- *
- *--------------------------------------------------------------
- */
-
-static int
-SendInit(
-    Tcl_Interp *interp)		/* Interpreter to use for error reporting
-				 * (no errors are ever returned, but the
-				 * interpreter is needed anyway). */
-{
-    return TCL_OK;
-}