Tcl Source Code

				 * interpreter/thread containing its Tcl
				 * command is gone.
				 */
#ifdef TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
#endif
    Tcl_Obj *cmd;		/* Callback command prefix */
    Tcl_Obj *methods;		/* Methods to append to command prefix */


    Tcl_Obj *name;		/* Name of the channel as created */


    int mode;			/* Mask of R/W mode */
    int interest;		/* Mask of events the channel is interested
				 * in. */

    /*
     * Note regarding the usage of timers.

			    const char *objName, Tcl_Obj *obj, int *mask);
static Tcl_Obj *	DecodeEventMask(int mask);
static ReflectedChannel * NewReflectedChannel(Tcl_Interp *interp,
			    Tcl_Obj *cmdpfxObj, int mode, Tcl_Obj *handleObj);
static Tcl_Obj *	NextHandle(void);
static void		FreeReflectedChannel(ReflectedChannel *rcPtr);
static int		InvokeTclMethod(ReflectedChannel *rcPtr,
			    MethodName method, Tcl_Obj *argOneObj,
			    Tcl_Obj *argTwoObj, Tcl_Obj **resultObjPtr);

static ReflectedChannelMap *	GetReflectedChannelMap(Tcl_Interp *interp);
static void		DeleteReflectedChannelMap(ClientData clientData,
			    Tcl_Interp *interp);
static int              ErrnoReturn(ReflectedChannel *rcPtr, Tcl_Obj* resObj);

     * 'initialize' is invoked with canonical mode names, and no
     * abbreviations. Using modeObj directly could feed abbreviations into the
     * handler, and the handler is not specified to handle such.
     */

    modeObj = DecodeEventMask(mode);
    /* assert modeObj.refCount == 1 */
    result = InvokeTclMethod(rcPtr, METH_INIT, modeObj, NULL, &resObj);
    Tcl_DecrRefCount(modeObj);
    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
	Tcl_DecrRefCount(resObj);	/* Remove reference held from invoke */
	goto error;
    }

     * Return handle as result of command.
     */

    Tcl_SetObjResult(interp, rcId);
    return TCL_OK;

 error:
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    ckfree((char*) rcPtr);
    return TCL_ERROR;

#undef MODE
#undef CMD
}

	 */

	if (result != TCL_OK) {
	    PassReceivedErrorInterp(interp, &p);
	}
    } else {
#endif
	result = InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj);
	if ((result != TCL_OK) && (interp != NULL)) {
	    Tcl_SetChannelErrorInterp(interp, resObj);
	}

	Tcl_DecrRefCount(resObj);	/* Remove reference we held from the
					 * invoke */

    /* ASSERT: rcPtr->mode & TCL_READABLE */

    Tcl_Preserve(rcPtr);

    toReadObj = Tcl_NewIntObj(toRead);
    Tcl_IncrRefCount(toReadObj);

    if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK) {
	int code = ErrnoReturn (rcPtr, resObj);

	if (code < 0) {
	    *errorCodePtr = -code;
            goto error;
	}

    /* ASSERT: rcPtr->mode & TCL_WRITABLE */

    Tcl_Preserve(rcPtr);

    bufObj = Tcl_NewByteArrayObj((unsigned char *) buf, toWrite);
    Tcl_IncrRefCount(bufObj);

    if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
	int code = ErrnoReturn(rcPtr, resObj);

	if (code < 0) {
	    *errorCodePtr = -code;
            goto error;
	}

    offObj = Tcl_NewWideIntObj(offset);
    baseObj = Tcl_NewStringObj((seekMode == SEEK_SET) ? "start" :
	    ((seekMode == SEEK_CUR) ? "current" : "end"), -1);
    Tcl_IncrRefCount(offObj);
    Tcl_IncrRefCount(baseObj);

    if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
        goto invalid;
    }

    if (Tcl_GetWideIntFromObj(rcPtr->interp, resObj, &newLoc) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, MarshallError(rcPtr->interp));
        goto invalid;

    }
#endif

    Tcl_Preserve(rcPtr);

    maskObj = DecodeEventMask(mask);
    /* assert maskObj.refCount == 1 */
    (void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
    Tcl_DecrRefCount(maskObj);

    Tcl_Release(rcPtr);
}

/*
 *----------------------------------------------------------------------

#endif

    blockObj = Tcl_NewBooleanObj(!nonblocking);
    Tcl_IncrRefCount(blockObj);

    Tcl_Preserve(rcPtr);

    if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL, &resObj) != TCL_OK) {
	Tcl_SetChannelError(rcPtr->chan, resObj);
	errorNum = EINVAL;
    } else {
	errorNum = EOK;
    }

    Tcl_DecrRefCount(blockObj);

    optionObj = Tcl_NewStringObj(optionName, -1);
    valueObj = Tcl_NewStringObj(newValue, -1);

    Tcl_IncrRefCount(optionObj);
    Tcl_IncrRefCount(valueObj);

    result = InvokeTclMethod(rcPtr, METH_CONFIGURE,optionObj,valueObj, &resObj);
    if (result != TCL_OK) {
	UnmarshallErrorResult(interp, resObj);
    }

    Tcl_DecrRefCount(optionObj);
    Tcl_DecrRefCount(valueObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */

     */

    ReflectedChannel *rcPtr = (ReflectedChannel*) clientData;
    Tcl_Obj *optionObj;
    Tcl_Obj *resObj;		/* Result data for 'configure' */
    int listc, result = TCL_OK;
    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */

#ifdef TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {

#endif

    if (optionName == NULL) {
	/*
	 * Retrieve all options.
	 */

	method = METH_CGETALL;
	optionObj = NULL;
    } else {
	/*
	 * Retrieve the value of one option.
	 */

	method = METH_CGET;
	optionObj = Tcl_NewStringObj(optionName, -1);
        Tcl_IncrRefCount(optionObj);
    }

    Tcl_Preserve(rcPtr);

    if (InvokeTclMethod(rcPtr, method, optionObj, NULL, &resObj)!=TCL_OK) {

NewReflectedChannel(
    Tcl_Interp *interp,
    Tcl_Obj *cmdpfxObj,
    int mode,
    Tcl_Obj *handleObj)
{
    ReflectedChannel *rcPtr;
    MethodName mn = METH_BLOCKING;

    rcPtr = (ReflectedChannel *) ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
#ifdef TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
    Tcl_IncrRefCount(rcPtr->cmd);
    rcPtr->methods = Tcl_NewListObj(METH_WRITE + 1, NULL);
    while (mn <= METH_WRITE) {
	Tcl_ListObjAppendElement(NULL, rcPtr->methods,
		Tcl_NewStringObj(methodNames[mn++], -1));
    }
    Tcl_IncrRefCount(rcPtr->methods);
    rcPtr->name = handleObj;
    Tcl_IncrRefCount(rcPtr->name);
    return rcPtr;
}

/*
 *----------------------------------------------------------------------
 *
 * NextHandle --

	/*
	 * Delete a cloned ChannelType structure.
	 */

	ckfree((char*) chanPtr->typePtr);
    }
    Tcl_Release(chanPtr);
    Tcl_DecrRefCount(rcPtr->name);
    Tcl_DecrRefCount(rcPtr->methods);
    Tcl_DecrRefCount(rcPtr->cmd);
    ckfree((char*) rcPtr);
}

/*
 *----------------------------------------------------------------------
 *

 *
 *----------------------------------------------------------------------
 */

static int
InvokeTclMethod(
    ReflectedChannel *rcPtr,
    MethodName method,
    Tcl_Obj *argOneObj,		/* NULL'able */
    Tcl_Obj *argTwoObj,		/* NULL'able */
    Tcl_Obj **resultObjPtr)	/* NULL'able */
{
    Tcl_Obj *methObj = NULL;	/* Method name in object form */
    Tcl_InterpState sr;		/* State of handler interp */
    int result;			/* Result code of method invokation */
    Tcl_Obj *resObj = NULL;	/* Result of method invokation. */
    Tcl_Obj *cmd;


    if (!rcPtr->interp) {
	/*
	 * The channel is marked as dead. Bail out immediately, with an
	 * appropriate error.
	 */

         * Not touching argOneObj, argTwoObj, they have not been used.
         * See the contract as well.
         */

	return TCL_ERROR;
    }







    /*
     * Insert method into the callback command, after the command prefix,
     * before the channel id.
     */


    cmd = TclListObjCopy(NULL, rcPtr->cmd);

    Tcl_ListObjIndex(NULL, rcPtr->methods, method, &methObj);
    Tcl_ListObjAppendElement(NULL, cmd, methObj);
    Tcl_ListObjAppendElement(NULL, cmd, rcPtr->name);

    /*
     * Append the additional argument containing method specific details
     * behind the channel id. If specified.
     */

    if (argOneObj) {

			"chan handler returned bad code: %d", result));
		Tcl_LogCommandInfo(rcPtr->interp, cmdString, cmdString,
			cmdLen);
		Tcl_DecrRefCount(cmd);
		result = TCL_ERROR;
	    }
	    Tcl_AppendObjToErrorInfo(rcPtr->interp, Tcl_ObjPrintf(
		    "\n    (chan handler subcommand \"%s\")",
		    methodNames[method]));
	    resObj = MarshallError(rcPtr->interp);
	}
	Tcl_IncrRefCount(resObj);
    }
    Tcl_DecrRefCount(cmd);
    Tcl_RestoreInterpState(rcPtr->interp, sr);
    Tcl_Release(rcPtr->interp);

	 */

    case ForwardedClose:
	/*
	 * No parameters/results.
	 */

	if (InvokeTclMethod(rcPtr, METH_FINAL, NULL, NULL, &resObj)!=TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}

	/*
	 * Freeing is done here, in the origin thread, callback command
	 * objects belong to this thread. Deallocating them in a different
	 * thread is not allowed

	break;

    case ForwardedInput: {
	Tcl_Obj *toReadObj = Tcl_NewIntObj(paramPtr->input.toRead);
        Tcl_IncrRefCount(toReadObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_READ, toReadObj, NULL, &resObj)!=TCL_OK){
	    int code = ErrnoReturn (rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }

    case ForwardedOutput: {
	Tcl_Obj *bufObj = Tcl_NewByteArrayObj((unsigned char *)
		paramPtr->output.buf, paramPtr->output.toWrite);
        Tcl_IncrRefCount(bufObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_WRITE, bufObj, NULL, &resObj) != TCL_OK) {
	    int code = ErrnoReturn(rcPtr, resObj);

	    if (code < 0) {
		paramPtr->base.code = code;
	    } else {
		ForwardSetObjError(paramPtr, resObj);
	    }

		(paramPtr->seek.seekMode==SEEK_SET) ? "start" :
		(paramPtr->seek.seekMode==SEEK_CUR) ? "current" : "end", -1);

        Tcl_IncrRefCount(offObj);
        Tcl_IncrRefCount(baseObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_SEEK, offObj, baseObj, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	    paramPtr->seek.offset = -1;
	} else {
	    /*
	     * Process a regular result. If the type is wrong this may change
	     * into an error.
	     */

    }

    case ForwardedWatch: {
	Tcl_Obj *maskObj = DecodeEventMask(paramPtr->watch.mask);
        /* assert maskObj.refCount == 1 */

        Tcl_Preserve(rcPtr);
	(void) InvokeTclMethod(rcPtr, METH_WATCH, maskObj, NULL, NULL);
	Tcl_DecrRefCount(maskObj);
        Tcl_Release(rcPtr);
	break;
    }

    case ForwardedBlock: {
	Tcl_Obj *blockObj = Tcl_NewBooleanObj(!paramPtr->block.nonblocking);
        Tcl_IncrRefCount(blockObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_BLOCKING, blockObj, NULL,
		&resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(blockObj);
	break;
    }

    case ForwardedSetOpt: {
	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->setOpt.name, -1);
	Tcl_Obj *valueObj = Tcl_NewStringObj(paramPtr->setOpt.value, -1);

        Tcl_IncrRefCount(optionObj);
        Tcl_IncrRefCount(valueObj);
        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_CONFIGURE, optionObj, valueObj,
		&resObj) != TCL_OK) {
	    ForwardSetObjError(paramPtr, resObj);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
        Tcl_DecrRefCount(valueObj);
	break;
    }

    case ForwardedGetOpt: {
	/*
	 * Retrieve the value of one option.
	 */

	Tcl_Obj *optionObj = Tcl_NewStringObj(paramPtr->getOpt.name, -1);
        Tcl_IncrRefCount(optionObj);

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_CGET, optionObj, NULL, &resObj)!=TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    Tcl_DStringAppend(paramPtr->getOpt.value,
		    TclGetString(resObj), -1);
	}
        Tcl_Release(rcPtr);
        Tcl_DecrRefCount(optionObj);
	break;
    }

    case ForwardedGetOptAll:
	/*
	 * Retrieve all options.
	 */

        Tcl_Preserve(rcPtr);
	if (InvokeTclMethod(rcPtr, METH_CGETALL, NULL, NULL, &resObj) != TCL_OK){
	    ForwardSetObjError(paramPtr, resObj);
	} else {
	    /*
	     * Extract list, validate that it is a list, and #elements. See
	     * NOTE (4) as well.
	     */