Remove Carbon directory from source tree

1 files changed, 0 insertions, 506 deletions

diff --git a/carbon/tkMacOSXSend.c b/carbon/tkMacOSXSend.c
deleted file mode 100644
index df6b2af..0000000
--- a/carbon/tkMacOSXSend.c
+++ /dev/null
@@ -1,506 +0,0 @@
-/*
- * 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 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.
- * 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.
- */
-
-#include "tkMacOSXInt.h"
-
-/*
- * 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 int 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.
- */
-
-/*
- * 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 SendInit(Tcl_Interp *interp);
-
-/*
- *--------------------------------------------------------------
- *
- * 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;
-    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 (result != TCL_OK || interpNamePtr == NULL) {
-	    break;
-	}
-	interpName = Tcl_GetString(interpNamePtr);
-	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 = ckalloc(sizeof(RegisteredInterp));
-    riPtr->interp = interp;
-    riPtr->name = ckalloc(strlen(actualName) + 1);
-    riPtr->nextPtr = interpListPtr;
-    interpListPtr = riPtr;
-    strcpy(riPtr->name, actualName);
-
-    /*
-     * TODO: DeleteProc
-     */
-
-    Tcl_CreateObjCommand(interp, "send", Tk_SendObjCmd, riPtr, NULL);
-    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 */
-{
-    const char *const sendOptions[] = {"-async", "-displayof", "-", NULL};
-    char *stringRep, *destName;
-    /*int async = 0;*/
-    int i, index, firstArg;
-    RegisteredInterp *riPtr;
-    Tcl_Obj *listObjPtr;
-    int result = TCL_OK;
-
-    for (i = 1; i < (objc - 1); ) {
-	stringRep = Tcl_GetString(objv[i]);
-	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,
-		"?-option value ...? interpName arg ?arg ...?");
-	return TCL_ERROR;
-    }
-
-    destName = Tcl_GetString(objv[i]);
-    firstArg = i + 1;
-
-    /*
-     * 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(riPtr);
-	localInterp = riPtr->interp;
-	Tcl_Preserve(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, 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", 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(riPtr);
-	Tcl_Release(localInterp);
-    } else {
-	/*
-	 * TODO: This is a non-local request. Send the script to the server
-	 * and poll it for a result.
-	 */
-    }
-
-    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, 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;
-}