Tk Source Code

    KeySym keySym,		/* KeySym: only relevant for KeyPress and
				 * KeyRelease events). */
    unsigned int scriptCount,	/* The number of script-based binding patterns
				 * matched so far for this event. */
    Tcl_DString *dsPtr)		/* Dynamic string in which to append new
				 * command. */
{
    size_t spaceNeeded;
    int cvtFlags;	/* Used to substitute string as proper Tcl
				 * list element. */
    int number, flags, length;
#define NUM_SIZE 40
    const char *string;
    Tcl_DString buf;
    char numStorage[NUM_SIZE+1];

	/*
	 * Insert the prolog
	 */

	Tcl_AppendObjToObj(psObj, preambleObj);

	if (psInfo.chan != NULL) {
	    if ((size_t)Tcl_WriteObj(psInfo.chan, psObj) == (size_t)-1) {
	    channelWriteFailed:
		Tcl_SetObjResult(interp, Tcl_ObjPrintf(
			"problem writing postscript data to channel: %s",
			Tcl_PosixError(interp)));
		result = TCL_ERROR;
		goto cleanup;
	    }

		psInfo.x2, Tk_PostscriptY((double)psInfo.y,
			(Tk_PostscriptInfo)psInfoPtr),
		psInfo.x2, Tk_PostscriptY((double)psInfo.y2,
			(Tk_PostscriptInfo)psInfoPtr),
		psInfo.x, Tk_PostscriptY((double)psInfo.y2,
			(Tk_PostscriptInfo)psInfoPtr));
	if (psInfo.chan != NULL) {
	    if ((size_t)Tcl_WriteObj(psInfo.chan, psObj) == (size_t)-1) {
		goto channelWriteFailed;
	    }
	    Tcl_DecrRefCount(psObj);
	    psObj = Tcl_NewObj();
	}
    }

	}

	Tcl_AppendToObj(psObj, "gsave\n", -1);
	Tcl_AppendObjToObj(psObj, Tcl_GetObjResult(interp));
	Tcl_AppendToObj(psObj, "grestore\n", -1);

	if (psInfo.chan != NULL) {
	    if ((size_t)Tcl_WriteObj(psInfo.chan, psObj) == (size_t)-1) {
		goto channelWriteFailed;
	    }
	    Tcl_DecrRefCount(psObj);
	    psObj = Tcl_NewObj();
	}
    }

    /*
     * Output page-end information, such as commands to print the page and
     * document trailer stuff.
     */

    if (psInfo.prolog) {
	Tcl_AppendToObj(psObj,
		"restore showpage\n\n"
		"%%Trailer\n"
		"end\n"
		"%%EOF\n", -1);

	if (psInfo.chan != NULL) {
	    if ((size_t)Tcl_WriteObj(psInfo.chan, psObj) == (size_t)-1) {
		goto channelWriteFailed;
	    }
	}
    }

    if (psInfo.chan == NULL) {
	Tcl_SetObjResult(interp, psObj);

	/*
	 * The 'charPtr' arg must be a single Unicode.
	 */

	if (charPtr != NULL) {
	    const char *string = Tcl_GetString(charPtr);
	    size_t len = TkUtfToUniChar(string, &uniChar);

	    if (len != (size_t)charPtr->length) {
		resultPtr = Tcl_NewStringObj(
			"expected a single character but got \"", -1);
		Tcl_AppendLimitedToObj(resultPtr, string,
			-1, 40, "...");
		Tcl_AppendToObj(resultPtr, "\"", -1);
		Tcl_SetObjResult(interp, resultPtr);
		Tcl_SetErrorCode(interp, "TK", "VALUE", "FONT_SAMPLE", NULL);

 */

static int
GetByte(
    Tcl_Channel chan)	/* The channel we read from. */
{
    char buffer;
    size_t size;

    size = Tcl_Read(chan, &buffer, 1);
    if ((size + 1) < 2) {
	return EOF;
    } else {
	return buffer;
    }
}

/*

 * state keeps track of which byte we are about to read, or EOF.
 */

typedef struct mFile {
    unsigned char *data;	/* mmencoded source string */
    int c;			/* bits left over from previous character */
    int state;			/* decoder state (0-4 or GIF_DONE) */
    size_t length;			/* Total amount of bytes in data */
} MFile;

/*
 * Non-ASCII encoding support:
 * Most data in a GIF image is binary and is treated as such. However, a few
 * key bits are stashed in ASCII. If we try to compare those pieces to the
 * char they represent, it will fail on any non-ASCII (eg, EBCDIC) system. To

} GIFImageConfig;

/*
 * Type of a function used to do the writing to a file or buffer when
 * serializing in the GIF format.
 */

typedef size_t (WriteBytesFunc) (ClientData clientData, const char *bytes,
			    size_t byteCount);

/*
 * The format record for the GIF file format:
 */

static int		FileMatchGIF(Tcl_Channel chan, const char *fileName,
			    Tcl_Obj *format, int *widthPtr, int *heightPtr,

			    unsigned char cmap[MAXCOLORMAPSIZE][4], int srcX,
			    int srcY, int interlace, int transparent);

/*
 * these are for the BASE64 image reader code only
 */

static size_t		Fread(GIFImageConfig *gifConfPtr, unsigned char *dst,
			    size_t size, size_t count, Tcl_Channel chan);
static size_t		Mread(unsigned char *dst, size_t size, size_t count,
			    MFile *handle);
static int		Mgetc(MFile *handle);
static int		char64(int c);
static void		mInit(unsigned char *string, MFile *handle,
			    size_t length);

/*
 * Types, defines and variables needed to write and compress a GIF.
 */

#define LSB(a)		((unsigned char) (((short)(a)) & 0x00FF))
#define MSB(a)		((unsigned char) (((short)(a)) >> 8))

    int number,
    unsigned char buffer[MAXCOLORMAPSIZE][4])
{
    int i;
    unsigned char rgb[3];

    for (i = 0; i < number; ++i) {
	if (((size_t)Fread(gifConfPtr, rgb, sizeof(rgb), 1, chan) + 1) < 2) {
	    return 0;
	}

	if (buffer) {
	    buffer[i][CM_RED] = rgb[0];
	    buffer[i][CM_GREEN] = rgb[1];
	    buffer[i][CM_BLUE] = rgb[2];

GetDataBlock(
    GIFImageConfig *gifConfPtr,
    Tcl_Channel chan,
    unsigned char *buf)
{
    unsigned char count;

    if (((size_t)Fread(gifConfPtr, &count, 1, 1, chan) + 1) < 2) {
	return -1;
    }

    if ((count != 0) && (((size_t)Fread(gifConfPtr, buf, count, 1, chan) + 1) < 2)) {
	return -1;
    }

    return count;
}

/*

    int codeSize, clearCode, inCode, endCode, oldCode, maxCode;
    int code, firstCode, v;

    /*
     * Initialize the decoder
     */

    if (((size_t)Fread(gifConfPtr, &initialCodeSize, 1, 1, chan) + 1) < 2) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"error reading GIF image: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }

    if (initialCodeSize > MAX_LWZ_BITS) {
	Tcl_SetObjResult(interp, Tcl_NewStringObj("malformed image", -1));

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

static void
mInit(
    unsigned char *string,	/* string containing initial mmencoded data */
    MFile *handle,		/* mmdecode "file" handle */
    size_t length)			/* Number of bytes in string */
{
    handle->data = string;
    handle->state = 0;
    handle->c = 0;
    handle->length = length;
}


 *
 * Side effects:
 *	The base64 handle will change state.
 *
 *----------------------------------------------------------------------
 */

static size_t
Mread(
    unsigned char *dst,		/* where to put the result */
    size_t chunkSize,		/* size of each transfer */
    size_t numChunks,		/* number of chunks */
    MFile *handle)		/* mmdecode "file" handle */
{
    int c;
    size_t i, count = chunkSize * numChunks;

    for (i=0; i<count && (c=Mgetc(handle)) != GIF_DONE; i++) {
	*dst++ = c;
    }
    return i;
}


 *	a base64 encoded string.
 *
 * Results: - same as POSIX fread() or Tcl Tcl_Read()
 *
 *----------------------------------------------------------------------
 */

static size_t
Fread(
    GIFImageConfig *gifConfPtr,
    unsigned char *dst,		/* where to put the result */
    size_t hunk, size_t count,	/* how many */
    Tcl_Channel chan)
{
    if (gifConfPtr->fromData == INLINE_DATA_BASE64) {
	return Mread(dst, hunk, count, (MFile *) chan);
    }

    if (gifConfPtr->fromData == INLINE_DATA_BINARY) {
	MFile *handle = (MFile *) chan;

	if ((handle->length + 1 < 2) || (handle->length < hunk*count)) {
	    return (size_t)-1;
	}
	memcpy(dst, handle->data, hunk * count);
	handle->data += hunk * count;
	handle->length -= hunk * count;
	return hunk * count;
    }

    /*
     * Otherwise we've got a real file to read.
     */

    return Tcl_Read(chan, (char *) dst, hunk * count);
}

/*
 * ChanWriteGIF - writes a image in GIF format.
 *-------------------------------------------------------------------------
 * Author:		Lolo
 *			Engeneering Projects Area

    if (result == TCL_OK) {
	Tcl_SetObjResult(interp, objPtr);
    }
    Tcl_DecrRefCount(objPtr);
    return result;
}

static size_t
WriteToChannel(
    ClientData clientData,
    const char *bytes,
    size_t byteCount)
{
    Tcl_Channel handle = clientData;

    return Tcl_Write(handle, bytes, byteCount);
}

static size_t
WriteToByteArray(
    ClientData clientData,
    const char *bytes,
    size_t byteCount)
{
    Tcl_Obj *objPtr = clientData;
    Tcl_Obj *tmpObj = Tcl_NewByteArrayObj((unsigned char *) bytes, byteCount);

    Tcl_IncrRefCount(tmpObj);
    Tcl_AppendObjToObj(objPtr, tmpObj);
    Tcl_DecrRefCount(tmpObj);

    if (pngPtr->base64Data) {
	return ReadBase64(interp, pngPtr, destPtr, destSz, crcPtr);
    } else if (pngPtr->strDataBuf) {
	return ReadByteArray(interp, pngPtr, destPtr, destSz, crcPtr);
    }

    while (destSz) {
	size_t blockSz = PNG_MIN(destSz, PNG_BLOCK_SZ);

	blockSz = (size_t)Tcl_Read(pngPtr->channel, (char *)destPtr, blockSz);
	if (blockSz == (size_t)-1) {
	    /* TODO: failure info... */
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "channel read failed: %s", Tcl_PosixError(interp)));
	    return TCL_ERROR;
	}

	/*

	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
		    "memory allocation failed", -1));
	    Tcl_SetErrorCode(interp, "TK", "MALLOC", NULL);
	    return TCL_ERROR;
	}

	memcpy(destPtr+objSz, srcPtr, srcSz);
    } else if ((size_t)Tcl_Write(pngPtr->channel, (const char *) srcPtr, srcSz) == (size_t)-1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"write to channel failed: %s", Tcl_PosixError(interp)));
	return TCL_ERROR;
    }

    return TCL_OK;
}

				 * image to be written to. */
    int width, int height,	/* Dimensions of block of photo image to be
				 * written to. */
    int srcX, int srcY)		/* Coordinates of top-left pixel to be used in
				 * image being read. */
{
    int fileWidth, fileHeight, maxIntensity;
    int nLines, h, type, bytesPerChannel = 1;
    size_t nBytes, count;
    unsigned char *pixelPtr;
    Tk_PhotoImageBlock block;

    type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity);
    if (type == 0) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"couldn't read raw PPM header from file \"%s\"", fileName));

FileWritePPM(
    Tcl_Interp *interp,
    const char *fileName,
    Tcl_Obj *format,
    Tk_PhotoImageBlock *blockPtr)
{
    Tcl_Channel chan;
    int w, h, greenOffset, blueOffset;
    size_t nBytes;
    unsigned char *pixelPtr, *pixLinePtr;
    char header[16 + TCL_INTEGER_SPACE * 2];

    chan = Tcl_OpenFileChannel(interp, fileName, "w", 0666);
    if (chan == NULL) {
	return TCL_ERROR;
    }

    pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
    greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
    blueOffset = blockPtr->offset[2] - blockPtr->offset[0];

    if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
	    && (blockPtr->pitch == (blockPtr->width * 3))) {
	nBytes = blockPtr->height * blockPtr->pitch;
	if ((size_t)Tcl_Write(chan, (char *) pixLinePtr, nBytes) != nBytes) {
	    goto writeerror;
	}
    } else {
	for (h = blockPtr->height; h > 0; h--) {
	    pixelPtr = pixLinePtr;
	    for (w = blockPtr->width; w > 0; w--) {
		if ((size_t)Tcl_Write(chan,(char *)&pixelPtr[0], 1) == (size_t)-1 ||
			(size_t)Tcl_Write(chan,(char *)&pixelPtr[greenOffset],1)==(size_t)-1 ||
			(size_t)Tcl_Write(chan,(char *)&pixelPtr[blueOffset],1) ==(size_t)-1) {
		    goto writeerror;
		}
		pixelPtr += blockPtr->pixelSize;
	    }
	    pixLinePtr += blockPtr->pitch;
	}
    }

/*
 * Real definition of some events. Note that these events come from outside
 * but have internally generated pieces added to them.
 */

typedef struct {
    XKeyEvent keyEvent;	/* The real event from X11. */
    char *charValuePtr;	/* A pointer to a string that holds the key's
				 * %A substitution text (before backslash
				 * adding), or NULL if that has not been
				 * computed yet. If non-NULL, this string was
				 * allocated with ckalloc(). */
    size_t charValueLen;	/* Length of string in charValuePtr when that
				 * is non-NULL. */
    KeySym keysym;		/* Key symbol computed after input methods
				 * have been invoked */
} TkKeyEvent;

/*
 * Flags passed to TkpMakeMenuWindow's 'transient' argument.

    /* ARGSUSED */
static void
StdinProc(
    ClientData clientData,	/* The state of interactive cmd line */
    int mask)			/* Not used. */
{
    char *cmd;
    int code;
    size_t count;
    InteractiveState *isPtr = clientData;
    Tcl_Channel chan = isPtr->input;
    Tcl_Interp *interp = isPtr->interp;

    count = Tcl_Gets(chan, &isPtr->line);

    if (count == (size_t)-1 && !isPtr->gotPartial) {
	if (isPtr->tty) {
	    Tcl_Exit(0);
	} else {
	    Tcl_DeleteChannelHandler(chan, StdinProc, isPtr);
	}
	return;
    }

    int priority)		/* Priority level to use for options in this
				 * file, such as TK_USER_DEFAULT_PRIO or
				 * TK_INTERACTIVE_PRIO. Must be between 0 and
				 * TK_MAX_PRIO. */
{
    const char *realName;
    Tcl_Obj *buffer;
    int result;
    size_t bufferSize;
    Tcl_Channel chan;
    Tcl_DString newName;

    /*
     * Prevent file system access in a safe interpreter.
     */

	return TCL_ERROR;
    }

    buffer = Tcl_NewObj();
    Tcl_IncrRefCount(buffer);
    Tcl_SetChannelOption(NULL, chan, "-encoding", "utf-8");
    bufferSize = Tcl_ReadChars(chan, buffer, -1, 0);
    if (bufferSize == (size_t)-1) {
	Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		"error reading file \"%s\": %s",
		fileName, Tcl_PosixError(interp)));
	Tcl_Close(NULL, chan);
	return TCL_ERROR;
    }
    Tcl_Close(NULL, chan);

    int *intPtr)		/* Filled in with number of pages or lines to
				 * scroll, if any. */
{
    const char *arg = Tcl_GetString(objv[2]);
    size_t length = objv[2]->length;

#define ArgPfxEq(str) \
	((arg[0] == str[0]) && !strncmp(arg, str, length))

    if (ArgPfxEq("moveto")) {
	if (objc != 4) {
	    Tcl_WrongNumArgs(interp, 2, objv, "moveto fraction");
	    return TK_SCROLL_ERROR;
	}
	if (Tcl_GetDoubleFromObj(interp, objv[3], dblPtr) != TCL_OK) {

static void StateSpecUpdateString(Tcl_Obj *objPtr)
{
    unsigned int onbits = (objPtr->internalRep.longValue & 0xFFFF0000) >> 16;
    unsigned int offbits = objPtr->internalRep.longValue & 0x0000FFFF;
    unsigned int mask = onbits | offbits;
    Tcl_DString result;
    int i;
    size_t len;

    Tcl_DStringInit(&result);

    for (i=0; stateNames[i] != NULL; ++i) {
	if (mask & (1<<i)) {
	    if (offbits & (1<<i))
		Tcl_DStringAppend(&result, "!", 1);
	    Tcl_DStringAppend(&result, stateNames[i], -1);
	    Tcl_DStringAppend(&result, " ", 1);
	}
    }

    len = Tcl_DStringLength(&result);
    if (len) {
	/* 'len' includes extra trailing ' ' */
	objPtr->bytes = Tcl_Alloc(len);
	objPtr->length = len-1;
	strncpy(objPtr->bytes, Tcl_DStringValue(&result), len-1);
	objPtr->bytes[len-1] = '\0';
    } else {
	/* empty string */
	objPtr->length = 0;
	objPtr->bytes = Tcl_Alloc(1);
	*objPtr->bytes = '\0';
    }

CFLAGS_OPTIMIZE		= @CFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS			= $(CFLAGS_DEBUG)
#CFLAGS			= $(CFLAGS_OPTIMIZE)
#CFLAGS			= $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS			= @CFLAGS_DEFAULT@ @CFLAGS@ 

# Flags to pass to the linker
LDFLAGS_DEBUG		= @LDFLAGS_DEBUG@
LDFLAGS_OPTIMIZE	= @LDFLAGS_OPTIMIZE@
LDFLAGS			= @LDFLAGS_DEFAULT@ @LDFLAGS@

# A "-I" switch that can be used when compiling to make all of the

const char *
TkpGetString(
    TkWindow *winPtr,		/* Window where event occurred */
    XEvent *eventPtr,		/* X keyboard event. */
    Tcl_DString *dsPtr)		/* Initialized, empty string to hold result. */
{
    size_t len;
    int mincode, maxcode;
    Tcl_DString buf;
    TkKeyEvent *kePtr = (TkKeyEvent *) eventPtr;

    /*
     * If we have the value cached already, use it now. [Bug 1373712]
     */

    if (kePtr->charValuePtr != NULL) {
	Tcl_DStringSetLength(dsPtr, kePtr->charValueLen);
	memcpy(Tcl_DStringValue(dsPtr), kePtr->charValuePtr,
		kePtr->charValueLen+1);
	return Tcl_DStringValue(dsPtr);
    }

    /*
     * Only do this for KeyPress events, otherwise
     * further Xlib function behavior might be undefined.
     */

     * function, we will be able to produce it without asking X. This stops us
     * from having to reenter the XIM engine. [Bug 1373712]
     */

done:
    kePtr->charValuePtr = ckalloc(len + 1);
    kePtr->charValueLen = len;
    memcpy(kePtr->charValuePtr, Tcl_DStringValue(dsPtr), len + 1);
    return Tcl_DStringValue(dsPtr);
}

/*
 * When mapping from a keysym to a keycode, need information about the
 * modifier state to be used so that when they call TkKeycodeToKeysym taking
 * into account the xkey.state, they will get back the original keysym.

LDFLAGS_OPTIMIZE = @LDFLAGS_OPTIMIZE@

# To change the compiler switches, for example to change from optimization to
# debugging symbols, change the following line:
#CFLAGS		= $(CFLAGS_DEBUG)
#CFLAGS		= $(CFLAGS_OPTIMIZE)
#CFLAGS		= $(CFLAGS_DEBUG) $(CFLAGS_OPTIMIZE)
CFLAGS		= @CFLAGS@ @CFLAGS_DEFAULT@ -DUNICODE -D_UNICODE -D_ATL_XP_TARGETING

# Special compiler flags to use when building man2tcl on Windows.
MAN2TCLFLAGS	= @MAN2TCLFLAGS@

AR		= @AR@
RANLIB		= @RANLIB@
CC		= @CC@