C++ Tcl_ObjPrintf函数代码示例

/*
  discover the sequencer devices currently available
*/
static int alsa_sequencer_list(ClientData clientData, Tcl_Interp *interp) {
  snd_seq_client_info_t *cinfo;
  snd_seq_port_info_t *pinfo;
  Tcl_Obj *result = Tcl_NewListObj(0, NULL);
  if (init_seq(clientData, interp) != TCL_OK) {
    return TCL_ERROR;
  }
  snd_seq_client_info_alloca(&cinfo);
  snd_seq_port_info_alloca(&pinfo);

  snd_seq_client_info_set_client(cinfo, -1);
  while (snd_seq_query_next_client(seq, cinfo) >= 0) {
    int client = snd_seq_client_info_get_client(cinfo);
    snd_seq_port_info_set_client(pinfo, client);
    snd_seq_port_info_set_port(pinfo, -1);
    while (snd_seq_query_next_port(seq, pinfo) >= 0) {
      /* we need both READ and SUBS_READ */
      int capability = snd_seq_port_info_get_capability(pinfo);
      char *readable = ((capability &
			 (SND_SEQ_PORT_CAP_READ | SND_SEQ_PORT_CAP_SUBS_READ)) ==
			(SND_SEQ_PORT_CAP_READ | SND_SEQ_PORT_CAP_SUBS_READ)) ? "r" : "";
      char *writable = ((capability &
			 (SND_SEQ_PORT_CAP_WRITE | SND_SEQ_PORT_CAP_SUBS_WRITE)) ==
			(SND_SEQ_PORT_CAP_WRITE | SND_SEQ_PORT_CAP_SUBS_WRITE)) ? "w" : "";
      Tcl_Obj *element = Tcl_ObjPrintf("%3d:%-3d  %-32.32s %s %s%s",
				       snd_seq_port_info_get_client(pinfo),
				       snd_seq_port_info_get_port(pinfo),
				       snd_seq_client_info_get_name(cinfo),
				       snd_seq_port_info_get_name(pinfo),
				       readable, writable);
      Tcl_ListObjAppendElement(interp, result, element);
    }
  }
  Tcl_SetObjResult(interp, result);
  return TCL_OK;
}

static int
ScaleWidgetObjCmd(
    ClientData clientData,	/* Information about scale widget. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument strings. */
{
    TkScale *scalePtr = clientData;
    Tcl_Obj *objPtr;
    int index, result;

    if (objc < 2) {
        Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
        return TCL_ERROR;
    }
    result = Tcl_GetIndexFromObj(interp, objv[1], commandNames,
                                 "option", 0, &index);
    if (result != TCL_OK) {
        return result;
    }
    Tcl_Preserve(scalePtr);

    switch (index) {
    case COMMAND_CGET:
        if (objc != 3) {
            Tcl_WrongNumArgs(interp, 1, objv, "cget option");
            goto error;
        }
        objPtr = Tk_GetOptionValue(interp, (char *) scalePtr,
                                   scalePtr->optionTable, objv[2], scalePtr->tkwin);
        if (objPtr == NULL) {
            goto error;
        }
        Tcl_SetObjResult(interp, objPtr);
        break;
    case COMMAND_CONFIGURE:
        if (objc <= 3) {
            objPtr = Tk_GetOptionInfo(interp, (char *) scalePtr,
                                      scalePtr->optionTable,
                                      (objc == 3) ? objv[2] : NULL, scalePtr->tkwin);
            if (objPtr == NULL) {
                goto error;
            }
            Tcl_SetObjResult(interp, objPtr);
        } else {
            result = ConfigureScale(interp, scalePtr, objc-2, objv+2);
        }
        break;
    case COMMAND_COORDS: {
        int x, y;
        double value;
        Tcl_Obj *coords[2];

        if ((objc != 2) && (objc != 3)) {
            Tcl_WrongNumArgs(interp, 1, objv, "coords ?value?");
            goto error;
        }
        if (objc == 3) {
            if (Tcl_GetDoubleFromObj(interp, objv[2], &value) != TCL_OK) {
                goto error;
            }
        } else {
            value = scalePtr->value;
        }
        if (scalePtr->orient == ORIENT_VERTICAL) {
            x = scalePtr->vertTroughX + scalePtr->width/2
                + scalePtr->borderWidth;
            y = TkScaleValueToPixel(scalePtr, value);
        } else {
            x = TkScaleValueToPixel(scalePtr, value);
            y = scalePtr->horizTroughY + scalePtr->width/2
                + scalePtr->borderWidth;
        }
        coords[0] = Tcl_NewIntObj(x);
        coords[1] = Tcl_NewIntObj(y);
        Tcl_SetObjResult(interp, Tcl_NewListObj(2, coords));
        break;
    }
    case COMMAND_GET: {
        double value;
        int x, y;

        if ((objc != 2) && (objc != 4)) {
            Tcl_WrongNumArgs(interp, 1, objv, "get ?x y?");
            goto error;
        }
        if (objc == 2) {
            value = scalePtr->value;
        } else {
            if ((Tcl_GetIntFromObj(interp, objv[2], &x) != TCL_OK) ||
                    (Tcl_GetIntFromObj(interp, objv[3], &y) != TCL_OK)) {
                goto error;
            }
            value = TkScalePixelToValue(scalePtr, x, y);
        }
        Tcl_SetObjResult(interp, Tcl_ObjPrintf(scalePtr->format, value));
        break;
    }
    case COMMAND_IDENTIFY: {
        int x, y;
//.........这里部分代码省略.........

int
TclpMatchInDirectory(
    Tcl_Interp *interp,		/* Interpreter to receive errors. */
    Tcl_Obj *resultPtr,		/* List object to lappend results. */
    Tcl_Obj *pathPtr,		/* Contains path to directory to search. */
    const char *pattern,	/* Pattern to match against. */
    Tcl_GlobTypeData *types)	/* Object containing list of acceptable types.
				 * May be NULL. In particular the directory
				 * flag is very important. */
{
    const char *native;
    Tcl_Obj *fileNamePtr;
    int matchResult = 0;

    if (types != NULL && types->type == TCL_GLOB_TYPE_MOUNT) {
	/*
	 * The native filesystem never adds mounts.
	 */

	return TCL_OK;
    }

    fileNamePtr = Tcl_FSGetTranslatedPath(interp, pathPtr);
    if (fileNamePtr == NULL) {
	return TCL_ERROR;
    }

    if (pattern == NULL || (*pattern == '\0')) {
	/*
	 * Match a file directly.
	 */

	Tcl_Obj *tailPtr;
	const char *nativeTail;

	native = Tcl_FSGetNativePath(pathPtr);
	tailPtr = TclPathPart(interp, pathPtr, TCL_PATH_TAIL);
	nativeTail = Tcl_FSGetNativePath(tailPtr);
	matchResult = NativeMatchType(interp, native, nativeTail, types);
	if (matchResult == 1) {
	    Tcl_ListObjAppendElement(interp, resultPtr, pathPtr);
	}
	Tcl_DecrRefCount(tailPtr);
	Tcl_DecrRefCount(fileNamePtr);
    } else {
	DIR *d;
	Tcl_DirEntry *entryPtr;
	const char *dirName;
	int dirLength, nativeDirLen;
	int matchHidden, matchHiddenPat;
	Tcl_StatBuf statBuf;
	Tcl_DString ds;		/* native encoding of dir */
	Tcl_DString dsOrig;	/* utf-8 encoding of dir */

	Tcl_DStringInit(&dsOrig);
	dirName = TclGetStringFromObj(fileNamePtr, &dirLength);
	Tcl_DStringAppend(&dsOrig, dirName, dirLength);

	/*
	 * Make sure that the directory part of the name really is a
	 * directory. If the directory name is "", use the name "." instead,
	 * because some UNIX systems don't treat "" like "." automatically.
	 * Keep the "" for use in generating file names, otherwise "glob
	 * foo.c" would return "./foo.c".
	 */

	if (dirLength == 0) {
	    dirName = ".";
	} else {
	    dirName = Tcl_DStringValue(&dsOrig);

	    /*
	     * Make sure we have a trailing directory delimiter.
	     */

	    if (dirName[dirLength-1] != '/') {
		dirName = TclDStringAppendLiteral(&dsOrig, "/");
		dirLength++;
	    }
	}

	/*
	 * Now open the directory for reading and iterate over the contents.
	 */

	native = Tcl_UtfToExternalDString(NULL, dirName, -1, &ds);

	if ((TclOSstat(native, &statBuf) != 0)		/* INTL: Native. */
		|| !S_ISDIR(statBuf.st_mode)) {
	    Tcl_DStringFree(&dsOrig);
	    Tcl_DStringFree(&ds);
	    Tcl_DecrRefCount(fileNamePtr);
	    return TCL_OK;
	}

	d = opendir(native);				/* INTL: Native. */
	if (d == NULL) {
	    Tcl_DStringFree(&ds);
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
//.........这里部分代码省略.........

Tcl_Channel
Tcl_OpenTcpClient(
    Tcl_Interp *interp,		/* For error reporting; can be NULL. */
    int port,			/* Port number to open. */
    const char *host,		/* Host on which to open port. */
    const char *myaddr,		/* Client-side address */
    int myport,			/* Client-side port */
    int async)			/* If nonzero, attempt to do an asynchronous
				 * connect. Otherwise we do a blocking
				 * connect. */
{
    TcpState *statePtr;
    const char *errorMsg = NULL;
    struct addrinfo *addrlist = NULL, *myaddrlist = NULL;
    char channelName[SOCK_CHAN_LENGTH];

    /*
     * Do the name lookups for the local and remote addresses.
     */

    if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg)
            || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
                    &errorMsg)) {
        if (addrlist != NULL) {
            freeaddrinfo(addrlist);
        }
        if (interp != NULL) {
            Tcl_SetObjResult(interp, Tcl_ObjPrintf(
                    "couldn't open socket: %s", errorMsg));
        }
        return NULL;
    }

    /*
     * Allocate a new TcpState for this socket.
     */
    statePtr = ckalloc(sizeof(TcpState));
    memset(statePtr, 0, sizeof(TcpState));
    statePtr->flags = async ? TCP_ASYNC_CONNECT : 0;
    statePtr->cachedBlocking = TCL_MODE_BLOCKING;
    statePtr->addrlist = addrlist;
    statePtr->myaddrlist = myaddrlist;
    statePtr->fds.fd = -1;

    /*
     * Create a new client socket and wrap it in a channel.
     */
    if (TcpConnect(interp, statePtr) != TCL_OK) {
        TcpCloseProc(statePtr, NULL);
        return NULL;
    }

    sprintf(channelName, SOCK_TEMPLATE, (long) statePtr);

    statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr,
            (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(interp, statePtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_Close(NULL, statePtr->channel);
	return NULL;
    }
    return statePtr->channel;
}

static int
ConfigureSlave(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tk_Window tkwin,		/* Token for the window to manipulate. */
    Tk_OptionTable table,	/* Token for option table. */
    int objc,			/* Number of config arguments. */
    Tcl_Obj *const objv[])	/* Object values for arguments. */
{
    register Master *masterPtr;
    Tk_SavedOptions savedOptions;
    int mask;
    Slave *slavePtr;
    Tk_Window masterWin = (Tk_Window) NULL;

    if (Tk_TopWinHierarchy(tkwin)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"can't use placer on top-level window \"%s\"; use "
		"wm command instead", Tk_PathName(tkwin)));
	Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "TOPLEVEL", NULL);
	return TCL_ERROR;
    }

    slavePtr = CreateSlave(tkwin, table);

    if (Tk_SetOptions(interp, (char *) slavePtr, table, objc, objv,
	    slavePtr->tkwin, &savedOptions, &mask) != TCL_OK) {
	goto error;
    }

    /*
     * Set slave flags. First clear the field, then add bits as needed.
     */

    slavePtr->flags = 0;
    if (slavePtr->heightPtr) {
	slavePtr->flags |= CHILD_HEIGHT;
    }

    if (slavePtr->relHeightPtr) {
	slavePtr->flags |= CHILD_REL_HEIGHT;
    }

    if (slavePtr->relWidthPtr) {
	slavePtr->flags |= CHILD_REL_WIDTH;
    }

    if (slavePtr->widthPtr) {
	slavePtr->flags |= CHILD_WIDTH;
    }

    if (!(mask & IN_MASK) && (slavePtr->masterPtr != NULL)) {
	/*
	 * If no -in option was passed and the slave is already placed then
	 * just recompute the placement.
	 */

	masterPtr = slavePtr->masterPtr;
	goto scheduleLayout;
    } else if (mask & IN_MASK) {
	/* -in changed */
	Tk_Window tkwin;
	Tk_Window ancestor;

	tkwin = slavePtr->inTkwin;

	/*
	 * Make sure that the new master is either the logical parent of the
	 * slave or a descendant of that window, and that the master and slave
	 * aren't the same.
	 */

	for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) {
	    if (ancestor == Tk_Parent(slavePtr->tkwin)) {
		break;
	    }
	    if (Tk_TopWinHierarchy(ancestor)) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"can't place %s relative to %s",
			Tk_PathName(slavePtr->tkwin), Tk_PathName(tkwin)));
		Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "HIERARCHY", NULL);
		goto error;
	    }
	}
	if (slavePtr->tkwin == tkwin) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't place %s relative to itself",
		    Tk_PathName(slavePtr->tkwin)));
	    Tcl_SetErrorCode(interp, "TK", "GEOMETRY", "LOOP", NULL);
	    goto error;
	}
	if ((slavePtr->masterPtr != NULL)
		&& (slavePtr->masterPtr->tkwin == tkwin)) {
	    /*
	     * Re-using same old master. Nothing to do.
	     */

	    masterPtr = slavePtr->masterPtr;
	    goto scheduleLayout;
	}
	if ((slavePtr->masterPtr != NULL) &&
//.........这里部分代码省略.........

int
Tcl_ParseArgsObjv(
    Tcl_Interp *interp,		/* Place to store error message. */
    const Tcl_ArgvInfo *argTable,
				/* Array of option descriptions. */
    int *objcPtr,		/* Number of arguments in objv. Modified to
				 * hold # args left in objv at end. */
    Tcl_Obj *const *objv,	/* Array of arguments to be parsed. */
    Tcl_Obj ***remObjv)		/* Pointer to array of arguments that were not
				 * processed here. Should be NULL if no return
				 * of arguments is desired. */
{
    Tcl_Obj **leftovers;	/* Array to write back to remObjv on
				 * successful exit. Will include the name of
				 * the command. */
    int nrem;			/* Size of leftovers.*/
    register const Tcl_ArgvInfo *infoPtr;
				/* Pointer to the current entry in the table
				 * of argument descriptions. */
    const Tcl_ArgvInfo *matchPtr;
				/* Descriptor that matches current argument */
    Tcl_Obj *curArg;		/* Current argument */
    const char *str = NULL;
    register char c;		/* Second character of current arg (used for
				 * quick check for matching; use 2nd char.
				 * because first char. will almost always be
				 * '-'). */
    int srcIndex;		/* Location from which to read next argument
				 * from objv. */
    int dstIndex;		/* Used to keep track of current arguments
				 * being processed, primarily for error
				 * reporting. */
    int objc;			/* # arguments in objv still to process. */
    int length;			/* Number of characters in current argument */

    if (remObjv != NULL) {
	/*
	 * Then we should copy the name of the command (0th argument). The
	 * upper bound on the number of elements is known, and (undocumented,
	 * but historically true) there should be a NULL argument after the
	 * last result. [Bug 3413857]
	 */

	nrem = 1;
	leftovers = ckalloc((1 + *objcPtr) * sizeof(Tcl_Obj *));
	leftovers[0] = objv[0];
    } else {
	nrem = 0;
	leftovers = NULL;
    }

    /*
     * OK, now start processing from the second element (1st argument).
     */

    srcIndex = dstIndex = 1;
    objc = *objcPtr-1;

    while (objc > 0) {
	curArg = objv[srcIndex];
	srcIndex++;
	objc--;
	str = Tcl_GetStringFromObj(curArg, &length);
	if (length > 0) {
	    c = str[1];
	} else {
	    c = 0;
	}

	/*
	 * Loop throught the argument descriptors searching for one with the
	 * matching key string. If found, leave a pointer to it in matchPtr.
	 */

	matchPtr = NULL;
	infoPtr = argTable;
	for (; infoPtr != NULL && infoPtr->type != TCL_ARGV_END ; infoPtr++) {
	    if (infoPtr->keyStr == NULL) {
		continue;
	    }
	    if ((infoPtr->keyStr[1] != c)
		    || (strncmp(infoPtr->keyStr, str, length) != 0)) {
		continue;
	    }
	    if (infoPtr->keyStr[length] == 0) {
		matchPtr = infoPtr;
		goto gotMatch;
	    }
	    if (matchPtr != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"ambiguous option \"%s\"", str));
		goto error;
	    }
	    matchPtr = infoPtr;
	}
	if (matchPtr == NULL) {
	    /*
	     * Unrecognized argument. Just copy it down, unless the caller
	     * prefers an error to be registered.
	     */
//.........这里部分代码省略.........

static int
RectOvalCoords(
    Tcl_Interp *interp,		/* Used for error reporting. */
    Tk_Canvas canvas,		/* Canvas containing item. */
    Tk_Item *itemPtr,		/* Item whose coordinates are to be read or
				 * modified. */
    int objc,			/* Number of coordinates supplied in objv. */
    Tcl_Obj *const objv[])	/* Array of coordinates: x1,y1,x2,y2,... */
{
    RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;

    /*
     * If no coordinates, return the current coordinates (i.e. bounding box).
     */

    if (objc == 0) {
	Tcl_Obj *bbox[4];

	bbox[0] = Tcl_NewDoubleObj(rectOvalPtr->bbox[0]);
	bbox[1] = Tcl_NewDoubleObj(rectOvalPtr->bbox[1]);
	bbox[2] = Tcl_NewDoubleObj(rectOvalPtr->bbox[2]);
	bbox[3] = Tcl_NewDoubleObj(rectOvalPtr->bbox[3]);
	Tcl_SetObjResult(interp, Tcl_NewListObj(4, bbox));
	return TCL_OK;
    }

    /*
     * If one "coordinate", treat as list of coordinates.
     */

    if (objc == 1) {
	if (Tcl_ListObjGetElements(interp, objv[0], &objc,
		(Tcl_Obj ***) &objv) != TCL_OK) {
	    return TCL_ERROR;
	}
    }

    /*
     * Better have four coordinates now. Spit out an error message otherwise.
     */

    if (objc != 4) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"wrong # coordinates: expected 0 or 4, got %d", objc));
	Tcl_SetErrorCode(interp, "TK", "CANVAS", "COORDS",
		(rectOvalPtr->header.typePtr == &tkRectangleType
			? "RECTANGLE" : "OVAL"), NULL);
	return TCL_ERROR;
    }

    /*
     * Parse the coordinates and update our bounding box.
     */

    if ((Tk_CanvasGetCoordFromObj(interp, canvas, objv[0],
		&rectOvalPtr->bbox[0]) != TCL_OK)
	    || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[1],
		&rectOvalPtr->bbox[1]) != TCL_OK)
	    || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[2],
		&rectOvalPtr->bbox[2]) != TCL_OK)
	    || (Tk_CanvasGetCoordFromObj(interp, canvas, objv[3],
		&rectOvalPtr->bbox[3]) != TCL_OK)) {
	return TCL_ERROR;
    }
    ComputeRectOvalBbox(canvas, rectOvalPtr);
    return TCL_OK;
}

static TkBitmap *
GetBitmap(
    Tcl_Interp *interp,		/* Interpreter to use for error reporting,
				 * this may be NULL. */
    Tk_Window tkwin,		/* Window in which bitmap will be used. */
    const char *string)		/* Description of bitmap. See manual entry for
				 * details on legal syntax. */
{
    Tcl_HashEntry *nameHashPtr, *predefHashPtr;
    TkBitmap *bitmapPtr, *existingBitmapPtr;
    TkPredefBitmap *predefPtr;
    Pixmap bitmap;
    int isNew, width, height, dummy2;
    TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
    ThreadSpecificData *tsdPtr =
	    Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (!dispPtr->bitmapInit) {
	BitmapInit(dispPtr);
    }

    nameHashPtr = Tcl_CreateHashEntry(&dispPtr->bitmapNameTable, string,
	    &isNew);
    if (!isNew) {
	existingBitmapPtr = Tcl_GetHashValue(nameHashPtr);
	for (bitmapPtr = existingBitmapPtr; bitmapPtr != NULL;
		bitmapPtr = bitmapPtr->nextPtr) {
	    if ((Tk_Display(tkwin) == bitmapPtr->display) &&
		    (Tk_ScreenNumber(tkwin) == bitmapPtr->screenNum)) {
		bitmapPtr->resourceRefCount++;
		return bitmapPtr;
	    }
	}
    } else {
	existingBitmapPtr = NULL;
    }

    /*
     * No suitable bitmap exists. Create a new bitmap from the information
     * contained in the string. If the string starts with "@" then the rest of
     * the string is a file name containing the bitmap. Otherwise the string
     * must refer to a bitmap defined by a call to Tk_DefineBitmap.
     */

    if (*string == '@') {	/* INTL: ISO char */
	Tcl_DString buffer;
	int result;

	if (Tcl_IsSafe(interp)) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "can't specify bitmap with '@' in a safe interpreter",
		    -1));
	    Tcl_SetErrorCode(interp, "TK", "SAFE", "BITMAP_FILE", NULL);
	    goto error;
	}

	/*
	 * Note that we need to cast away the const from the string because
	 * Tcl_TranslateFileName is non-const, even though it doesn't modify
	 * the string.
	 */

	string = Tcl_TranslateFileName(interp, (char *) string + 1, &buffer);
	if (string == NULL) {
	    goto error;
	}
	result = TkReadBitmapFile(Tk_Display(tkwin),
		RootWindowOfScreen(Tk_Screen(tkwin)), string,
		(unsigned int *) &width, (unsigned int *) &height,
		&bitmap, &dummy2, &dummy2);
	if (result != BitmapSuccess) {
	    if (interp != NULL) {
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"error reading bitmap file \"%s\"", string));
		Tcl_SetErrorCode(interp, "TK", "BITMAP", "FILE_ERROR", NULL);
	    }
	    Tcl_DStringFree(&buffer);
	    goto error;
	}
	Tcl_DStringFree(&buffer);
    } else {
	predefHashPtr = Tcl_FindHashEntry(&tsdPtr->predefBitmapTable, string);
	if (predefHashPtr == NULL) {
	    /*
	     * The following platform specific call allows the user to define
	     * bitmaps that may only exist during run time. If it returns None
	     * nothing was found and we return the error.
	     */

	    bitmap = TkpGetNativeAppBitmap(Tk_Display(tkwin), string,
		    &width, &height);

	    if (bitmap == None) {
		if (interp != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "bitmap \"%s\" not defined", string));
		    Tcl_SetErrorCode(interp, "TK", "LOOKUP", "BITMAP", string,
			    NULL);
		}
		goto error;
//.........这里部分代码省略.........

	/* ARGSUSED */
static int
MemoryCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int argc,
    const char *argv[])
{
    const char *fileName;
    FILE *fileP;
    Tcl_DString buffer;
    int result;
    size_t len;

    if (argc < 2) {
	Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		" option [args..]\"", NULL);
	return TCL_ERROR;
    }

    if ((strcmp(argv[1],"active") == 0) || (strcmp(argv[1],"display") == 0)) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " ", argv[1], " file\"", NULL);
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	result = Tcl_DumpActiveMemory(fileName);
	Tcl_DStringFree(&buffer);
	if (result != TCL_OK) {
	    Tcl_AppendResult(interp, "error accessing ", argv[2], NULL);
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(argv[1],"break_on_malloc") == 0) {
	if (argc != 3) {
	    goto argError;
	}
	if (Tcl_GetInt(interp, argv[2], &break_on_malloc) != TCL_OK) {
	    return TCL_ERROR;
	}
	return TCL_OK;
    }
    if (strcmp(argv[1],"info") == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"%-25s %10d\n%-25s %10d\n%-25s %10d\n%-25s %10lu\n%-25s %10d\n%-25s %10lu\n",
		"total mallocs", total_mallocs, "total frees", total_frees,
		"current packets allocated", current_malloc_packets,
		"current bytes allocated", current_bytes_malloced,
		"maximum packets allocated", maximum_malloc_packets,
		"maximum bytes allocated", maximum_bytes_malloced));
	return TCL_OK;
    }
    if (strcmp(argv[1],"init") == 0) {
	if (argc != 3) {
	    goto bad_suboption;
	}
	init_malloced_bodies = (strcmp(argv[2],"on") == 0);
	return TCL_OK;
    }
    if (strcmp(argv[1],"objs") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " objs file\"", NULL);
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	fileP = fopen(fileName, "w");
	if (fileP == NULL) {
	    Tcl_AppendResult(interp, "cannot open output file", NULL);
	    return TCL_ERROR;
	}
	TclDbDumpActiveObjects(fileP);
	fclose(fileP);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(argv[1],"onexit") == 0) {
	if (argc != 3) {
	    Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
		    " onexit file\"", NULL);
	    return TCL_ERROR;
	}
	fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
	if (fileName == NULL) {
	    return TCL_ERROR;
	}
	onExitMemDumpFileName = dumpFile;
	strcpy(onExitMemDumpFileName,fileName);
	Tcl_DStringFree(&buffer);
	return TCL_OK;
    }
    if (strcmp(argv[1],"tag") == 0) {
//.........这里部分代码省略.........

static int
TestwineventObjCmd(
    ClientData clientData,	/* Main window for application. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])		/* Argument strings. */
{
    HWND hwnd = 0;
    HWND child = 0;
    HWND control;
    int id;
    char *rest;
    UINT message;
    WPARAM wParam;
    LPARAM lParam;
    LRESULT result;
    static const TkStateMap messageMap[] = {
	{WM_LBUTTONDOWN,	"WM_LBUTTONDOWN"},
	{WM_LBUTTONUP,		"WM_LBUTTONUP"},
	{WM_CHAR,		"WM_CHAR"},
	{WM_GETTEXT,		"WM_GETTEXT"},
	{WM_SETTEXT,		"WM_SETTEXT"},
	{WM_COMMAND,            "WM_COMMAND"},
	{-1,			NULL}
    };

    if ((objc == 3) && (strcmp(Tcl_GetString(objv[1]), "debug") == 0)) {
	int b;

	if (Tcl_GetBoolean(interp, Tcl_GetString(objv[2]), &b) != TCL_OK) {
	    return TCL_ERROR;
	}
	TkWinDialogDebug(b);
	return TCL_OK;
    }

    if (objc < 4) {
	return TCL_ERROR;
    }

    hwnd = INT2PTR(strtol(Tcl_GetString(objv[1]), &rest, 0));
    if (rest == Tcl_GetString(objv[1])) {
	hwnd = FindWindowA(NULL, Tcl_GetString(objv[1]));
	if (hwnd == NULL) {
	    Tcl_SetObjResult(interp, Tcl_NewStringObj("no such window", -1));
	    return TCL_ERROR;
	}
    }
    UpdateWindow(hwnd);

    id = strtol(Tcl_GetString(objv[2]), &rest, 0);
    if (rest == Tcl_GetString(objv[2])) {
	char buf[256];

	child = GetWindow(hwnd, GW_CHILD);
	while (child != NULL) {
	    SendMessageA(child, WM_GETTEXT, (WPARAM) sizeof(buf), (LPARAM) buf);
	    if (strcasecmp(buf, Tcl_GetString(objv[2])) == 0) {
		id = GetDlgCtrlID(child);
		break;
	    }
	    child = GetWindow(child, GW_HWNDNEXT);
	}
	if (child == NULL) {
	    Tcl_AppendResult(interp, "could not find a control matching \"",
		Tcl_GetString(objv[2]), "\"", NULL);
	    return TCL_ERROR;
	}
    }

    message = TkFindStateNum(NULL, NULL, messageMap, Tcl_GetString(objv[3]));
    wParam = 0;
    lParam = 0;

    if (objc > 4) {
	wParam = strtol(Tcl_GetString(objv[4]), NULL, 0);
    }
    if (objc > 5) {
	lParam = strtol(Tcl_GetString(objv[5]), NULL, 0);
    }

    switch (message) {
    case WM_GETTEXT: {
	Tcl_DString ds;
	char buf[256];

#if 0
	GetDlgItemTextA(hwnd, id, buf, 256);
#else
        control = TestFindControl(hwnd, id);
        if (control == NULL) {
            Tcl_SetObjResult(interp,
                             Tcl_ObjPrintf("Could not find control with id %d", id));
            return TCL_ERROR;
        }
        buf[0] = 0;
        SendMessageA(control, WM_GETTEXT, (WPARAM)sizeof(buf),
                     (LPARAM) buf);
#endif
	Tcl_ExternalToUtfDString(NULL, buf, -1, &ds);
//.........这里部分代码省略.........

int
TkpUseWindow(
    Tcl_Interp *interp,		/* If not NULL, used for error reporting if
				 * string is bogus. */
    Tk_Window tkwin,		/* Tk window that does not yet have an
				 * associated X window. */
    const char *string)		/* String identifying an X window to use for
				 * tkwin; must be an integer value. */
{
    TkWindow *winPtr = (TkWindow *) tkwin;
    TkWindow *usePtr;
    int id, anyError;
    Window parent;
    Tk_ErrorHandler handler;
    Container *containerPtr;
    XWindowAttributes parentAtts;
    ThreadSpecificData *tsdPtr =
            Tcl_GetThreadData(&dataKey, sizeof(ThreadSpecificData));

    if (winPtr->window != None) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"can't modify container after widget is created", -1));
	Tcl_SetErrorCode(interp, "TK", "EMBED", "POST_CREATE", NULL);
	return TCL_ERROR;
    }
    if (Tcl_GetInt(interp, string, &id) != TCL_OK) {
	return TCL_ERROR;
    }
    parent = (Window) id;

    usePtr = (TkWindow *) Tk_IdToWindow(winPtr->display, parent);
    if (usePtr != NULL && !(usePtr->flags & TK_CONTAINER)) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"window \"%s\" doesn't have -container option set",
		usePtr->pathName));
	Tcl_SetErrorCode(interp, "TK", "EMBED", "CONTAINER", NULL);
	return TCL_ERROR;
    }

    /*
     * Tk sets the window colormap to the screen default colormap in
     * tkWindow.c:AllocWindow. This doesn't work well for embedded windows. So
     * we override the colormap and visual settings to be the same as the
     * parent window (which is in the container app).
     */

    anyError = 0;
    handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
	    EmbedErrorProc, &anyError);
    if (!XGetWindowAttributes(winPtr->display, parent, &parentAtts)) {
        anyError = 1;
    }
    XSync(winPtr->display, False);
    Tk_DeleteErrorHandler(handler);
    if (anyError) {
	if (interp != NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "couldn't create child of window \"%s\"", string));
	    Tcl_SetErrorCode(interp, "TK", "EMBED", "NO_TARGET", NULL);
	}
	return TCL_ERROR;
    }
    Tk_SetWindowVisual(tkwin, parentAtts.visual, parentAtts.depth,
	    parentAtts.colormap);

    /*
     * Create an event handler to clean up the Container structure when tkwin
     * is eventually deleted.
     */

    Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc,
	    winPtr);

    /*
     * Save information about the container and the embedded window in a
     * Container structure. If there is already an existing Container
     * structure, it means that both container and embedded app. are in the
     * same process.
     */

    for (containerPtr = tsdPtr->firstContainerPtr; containerPtr != NULL;
	    containerPtr = containerPtr->nextPtr) {
	if (containerPtr->parent == parent) {
	    winPtr->flags |= TK_BOTH_HALVES;
	    containerPtr->parentPtr->flags |= TK_BOTH_HALVES;
	    break;
	}
    }
    if (containerPtr == NULL) {
	containerPtr = ckalloc(sizeof(Container));
	containerPtr->parent = parent;
	containerPtr->parentRoot = parentAtts.root;
	containerPtr->parentPtr = NULL;
	containerPtr->wrapper = None;
	containerPtr->nextPtr = tsdPtr->firstContainerPtr;
	tsdPtr->firstContainerPtr = containerPtr;
    }
    containerPtr->embeddedPtr = winPtr;
    winPtr->flags |= TK_EMBEDDED;
    return TCL_OK;
//.........这里部分代码省略.........

//.........这里部分代码省略.........
	 */

	XUngrabPointer(dispPtr->display, CurrentTime);
	serial = NextRequest(dispPtr->display);

	/*
	 * Another tricky point: there are races with some window managers
	 * that can cause grabs to fail because the window manager hasn't
	 * released its grab quickly enough. To work around this problem,
	 * retry a few times after AlreadyGrabbed errors to give the grab
	 * release enough time to register with the server.
	 */

	grabResult = 0;			/* Needed only to prevent gcc compiler
					 * warnings. */
	for (numTries = 0; numTries < 10; numTries++) {
	    grabResult = XGrabPointer(dispPtr->display, winPtr->window,
		    True, ButtonPressMask|ButtonReleaseMask|ButtonMotionMask
		    |PointerMotionMask, GrabModeAsync, GrabModeAsync, None,
		    None, CurrentTime);
	    if (grabResult != AlreadyGrabbed) {
		break;
	    }
	    Tcl_Sleep(100);
	}
	if (grabResult != 0) {
	    goto grabError;
	}
	grabResult = XGrabKeyboard(dispPtr->display, Tk_WindowId(tkwin),
		False, GrabModeAsync, GrabModeAsync, CurrentTime);
	if (grabResult != 0) {
	    XUngrabPointer(dispPtr->display, CurrentTime);
	    goto grabError;
	}

	/*
	 * Eat up any grab-related events generated by the server for the
	 * grab. There are several reasons for doing this:
	 *
	 * 1. We have to synthesize the events for local grabs anyway, since
	 *    the server doesn't participate in them.
	 * 2. The server doesn't always generate the right events for global
	 *    grabs (e.g. it generates events even if the current window is in
	 *    the grab tree, which we don't want).
	 * 3. We want all the grab-related events to be processed immediately
	 *    (before other events that are already queued); events coming
	 *    from the server will be in the wrong place, but events we
	 *    synthesize here will go to the front of the queue.
	 */

	EatGrabEvents(dispPtr, serial);
    }

    /*
     * Synthesize leave events to move the pointer from its current window up
     * to the lowest ancestor that it has in common with the grab window.
     * However, only do this if the pointer is outside the grab window's
     * subtree but inside the grab window's application.
     */

    if ((dispPtr->serverWinPtr != NULL)
	    && (dispPtr->serverWinPtr->mainPtr == winPtr->mainPtr)) {
	for (winPtr2 = dispPtr->serverWinPtr; ; winPtr2 = winPtr2->parentPtr) {
	    if (winPtr2 == winPtr) {
		break;
	    }
	    if (winPtr2 == NULL) {
		MovePointer2(dispPtr->serverWinPtr, winPtr, NotifyGrab, 1, 0);
		break;
	    }
	}
    }
    QueueGrabWindowChange(dispPtr, winPtr);
    return TCL_OK;

  grabError:
    if (grabResult == GrabNotViewable) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"grab failed: window not viewable", -1));
	Tcl_SetErrorCode(interp, "TK", "GRAB", "UNVIEWABLE", NULL);
    } else if (grabResult == AlreadyGrabbed) {
    alreadyGrabbed:
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"grab failed: another application has grab", -1));
	Tcl_SetErrorCode(interp, "TK", "GRAB", "GRABBED", NULL);
    } else if (grabResult == GrabFrozen) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"grab failed: keyboard or pointer frozen", -1));
	Tcl_SetErrorCode(interp, "TK", "GRAB", "FROZEN", NULL);
    } else if (grabResult == GrabInvalidTime) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj(
		"grab failed: invalid time", -1));
	Tcl_SetErrorCode(interp, "TK", "GRAB", "BAD_TIME", NULL);
    } else {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"grab failed for unknown reason (code %d)", grabResult));
	Tcl_SetErrorCode(interp, "TK", "GRAB", "UNKNOWN", NULL);
    }
    return TCL_ERROR;
}

int
Tk_ParseArgv(
    Tcl_Interp *interp,		/* Place to store error message. */
    Tk_Window tkwin,		/* Window to use for setting Tk options. NULL
				 * means ignore Tk option specs. */
    int *argcPtr,		/* Number of arguments in argv. Modified to
				 * hold # args left in argv at end. */
    const char **argv,		/* Array of arguments. Modified to hold those
				 * that couldn't be processed here. */
    const Tk_ArgvInfo *argTable,	/* Array of option descriptions */
    int flags)			/* Or'ed combination of various flag bits,
				 * such as TK_ARGV_NO_DEFAULTS. */
{
    register const Tk_ArgvInfo *infoPtr;
				/* Pointer to the current entry in the table
				 * of argument descriptions. */
    const Tk_ArgvInfo *matchPtr;/* Descriptor that matches current argument. */
    const char *curArg;		/* Current argument */
    register char c;		/* Second character of current arg (used for
				 * quick check for matching; use 2nd char.
				 * because first char. will almost always be
				 * '-'). */
    int srcIndex;		/* Location from which to read next argument
				 * from argv. */
    int dstIndex;		/* Index into argv to which next unused
				 * argument should be copied (never greater
				 * than srcIndex). */
    int argc;			/* # arguments in argv still to process. */
    size_t length;		/* Number of characters in current argument. */
    char *endPtr;		/* Used for identifying junk in arguments. */
    int i;

    if (flags & TK_ARGV_DONT_SKIP_FIRST_ARG) {
	srcIndex = dstIndex = 0;
	argc = *argcPtr;
    } else {
	srcIndex = dstIndex = 1;
	argc = *argcPtr-1;
    }

    while (argc > 0) {
	curArg = argv[srcIndex];
	srcIndex++;
	argc--;
	length = strlen(curArg);
	if (length > 0) {
	    c = curArg[1];
	} else {
	    c = 0;
	}

	/*
	 * Loop throught the argument descriptors searching for one with the
	 * matching key string. If found, leave a pointer to it in matchPtr.
	 */

	matchPtr = NULL;
	for (i = 0; i < 2; i++) {
	    if (i == 0) {
		infoPtr = argTable;
	    } else {
		infoPtr = defaultTable;
	    }
	    for (; (infoPtr != NULL) && (infoPtr->type != TK_ARGV_END);
		    infoPtr++) {
		if (infoPtr->key == NULL) {
		    continue;
		}
		if ((infoPtr->key[1] != c)
			|| (strncmp(infoPtr->key, curArg, length) != 0)) {
		    continue;
		}
		if ((tkwin == NULL)
			&& ((infoPtr->type == TK_ARGV_CONST_OPTION)
			|| (infoPtr->type == TK_ARGV_OPTION_VALUE)
			|| (infoPtr->type == TK_ARGV_OPTION_NAME_VALUE))) {
		    continue;
		}
		if (infoPtr->key[length] == 0) {
		    matchPtr = infoPtr;
		    goto gotMatch;
		}
		if (flags & TK_ARGV_NO_ABBREV) {
		    continue;
		}
		if (matchPtr != NULL) {
		    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			    "ambiguous option \"%s\"", curArg));
		    Tcl_SetErrorCode(interp, "TK", "ARG", "AMBIGUOUS", curArg,
			    NULL);
		    return TCL_ERROR;
		}
		matchPtr = infoPtr;
	    }
	}
	if (matchPtr == NULL) {
	    /*
	     * Unrecognized argument. Just copy it down, unless the caller
	     * prefers an error to be registered.
	     */
//.........这里部分代码省略.........

//.........这里部分代码省略.........
			ckalloc(sizeof(InteractiveState));
		isPtr->input = inChannel;
		isPtr->tty = tty;
		isPtr->commandPtr = commandPtr;
		isPtr->prompt = prompt;
		isPtr->interp = interp;

		Tcl_UnlinkVar(interp, "tcl_interactive");
		Tcl_LinkVar(interp, "tcl_interactive", (char *) &(isPtr->tty),
			TCL_LINK_BOOLEAN);

		Tcl_CreateChannelHandler(inChannel, TCL_READABLE, StdinProc,
			isPtr);
	    }

	    mainLoopProc();
	    mainLoopProc = NULL;

	    if (inChannel) {
		tty = isPtr->tty;
		Tcl_UnlinkVar(interp, "tcl_interactive");
		Tcl_LinkVar(interp, "tcl_interactive", (char *) &tty,
			TCL_LINK_BOOLEAN);
		prompt = isPtr->prompt;
		commandPtr = isPtr->commandPtr;
		if (isPtr->input != NULL) {
		    Tcl_DeleteChannelHandler(isPtr->input, StdinProc, isPtr);
		}
		ckfree((char *) isPtr);
	    }
	    inChannel = Tcl_GetStdChannel(TCL_STDIN);
	    outChannel = Tcl_GetStdChannel(TCL_STDOUT);
	    errChannel = Tcl_GetStdChannel(TCL_STDERR);
	}
#ifdef TCL_MEM_DEBUG

	/*
	 * This code here only for the (unsupported and deprecated) [checkmem]
	 * command.
	 */

	if (tclMemDumpFileName != NULL) {
	    mainLoopProc = NULL;
	    Tcl_DeleteInterp(interp);
	}
#endif
    }

  done:
    if ((exitCode == 0) && (mainLoopProc != NULL)
	    && !Tcl_LimitExceeded(interp)) {
	/*
	 * If everything has gone OK so far, call the main loop proc, if it
	 * exists. Packages (like Tk) can set it to start processing events at
	 * this point.
	 */

	mainLoopProc();
	mainLoopProc = NULL;
    }
    if (commandPtr != NULL) {
	Tcl_DecrRefCount(commandPtr);
    }

    /*
     * Rather than calling exit, invoke the "exit" command so that users can
     * replace "exit" with some other command to do additional cleanup on
     * exit. The Tcl_EvalObjEx call should never return.
     */

    if (!Tcl_InterpDeleted(interp)) {
	if (!Tcl_LimitExceeded(interp)) {
	    Tcl_Obj *cmd = Tcl_ObjPrintf("exit %d", exitCode);

	    Tcl_IncrRefCount(cmd);
	    Tcl_EvalObjEx(interp, cmd, TCL_EVAL_GLOBAL);
	    Tcl_DecrRefCount(cmd);
	}

	/*
	 * If Tcl_EvalObjEx returns, trying to eval [exit], something unusual
	 * is happening. Maybe interp has been deleted; maybe [exit] was
	 * redefined, maybe we've blown up because of an exceeded limit. We
	 * still want to cleanup and exit.
	 */

	if (!Tcl_InterpDeleted(interp)) {
	    Tcl_DeleteInterp(interp);
	}
    }
    Tcl_SetStartupScript(NULL, NULL);

    /*
     * If we get here, the master interp has been deleted. Allow its
     * destruction with the last matching Tcl_Release.
     */

    Tcl_Release(interp);
    Tcl_Exit(exitCode);
}

static int
RectOvalToPostscript(
    Tcl_Interp *interp,		/* Interpreter for error reporting. */
    Tk_Canvas canvas,		/* Information about overall canvas. */
    Tk_Item *itemPtr,		/* Item for which Postscript is wanted. */
    int prepass)		/* 1 means this is a prepass to collect font
				 * information; 0 means final Postscript is
				 * being created. */
{
    Tcl_Obj *pathObj, *psObj;
    RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
    double y1, y2;
    XColor *color;
    XColor *fillColor;
    Pixmap fillStipple;
    Tk_State state = itemPtr->state;
    Tcl_InterpState interpState;

    y1 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[1]);
    y2 = Tk_CanvasPsY(canvas, rectOvalPtr->bbox[3]);

    /*
     * Generate a string that creates a path for the rectangle or oval. This
     * is the only part of the function's code that is type-specific.
     */

    if (rectOvalPtr->header.typePtr == &tkRectangleType) {
	pathObj = Tcl_ObjPrintf(
		"%.15g %.15g moveto "
		"%.15g 0 rlineto "
		"0 %.15g rlineto "
		"%.15g 0 rlineto "
		"closepath\n",
		rectOvalPtr->bbox[0], y1,
		rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0],
		y2-y1,
		rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]);
    } else {
	pathObj = Tcl_ObjPrintf(
		"matrix currentmatrix\n"
		"%.15g %.15g translate "
		"%.15g %.15g scale "
		"1 0 moveto 0 0 1 0 360 arc\n"
		"setmatrix\n",
		(rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2,
		(rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2);
    }

    if (state == TK_STATE_NULL) {
	state = Canvas(canvas)->canvas_state;
    }
    color = rectOvalPtr->outline.color;
    fillColor = rectOvalPtr->fillColor;
    fillStipple = rectOvalPtr->fillStipple;
    if (Canvas(canvas)->currentItemPtr == itemPtr) {
	if (rectOvalPtr->outline.activeColor!=NULL) {
	    color = rectOvalPtr->outline.activeColor;
	}
	if (rectOvalPtr->activeFillColor!=NULL) {
	    fillColor = rectOvalPtr->activeFillColor;
	}
	if (rectOvalPtr->activeFillStipple!=None) {
	    fillStipple = rectOvalPtr->activeFillStipple;
	}
    } else if (state == TK_STATE_DISABLED) {
	if (rectOvalPtr->outline.disabledColor!=NULL) {
	    color = rectOvalPtr->outline.disabledColor;
	}
	if (rectOvalPtr->disabledFillColor!=NULL) {
	    fillColor = rectOvalPtr->disabledFillColor;
	}
	if (rectOvalPtr->disabledFillStipple!=None) {
	    fillStipple = rectOvalPtr->disabledFillStipple;
	}
    }

    /*
     * Make our working space.
     */

    psObj = Tcl_NewObj();
    interpState = Tcl_SaveInterpState(interp, TCL_OK);

    /*
     * First draw the filled area of the rectangle.
     */

    if (fillColor != NULL) {
	Tcl_AppendObjToObj(psObj, pathObj);

	Tcl_ResetResult(interp);
	if (Tk_CanvasPsColor(interp, canvas, fillColor) != TCL_OK) {
	    goto error;
	}
	Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));

	if (fillStipple != None) {
	    Tcl_AppendToObj(psObj, "clip ", -1);

	    Tcl_ResetResult(interp);
//.........这里部分代码省略.........