Tk Source Code

    /*
     * If we're displaying a special character instead of the value of the
     * entry, recompute the displayString.
     */

    if (entryPtr->showChar != NULL) {
	Tcl_UniChar ch;
	char buf[TCL_UTF_MAX];
	int ch;
	char buf[6];
	int size;

	/*
	 * Normalize the special character so we can safely duplicate it in
	 * the display string. If we didn't do this, then two malformed
	 * characters might end up looking like one valid UTF character in the
	 * resulting string.
	 */

	Tcl_UtfToUniChar(entryPtr->showChar, &ch);
	size = Tcl_UniCharToUtf(ch, buf);
	TkUtfToUniChar(entryPtr->showChar, &ch);
	size = TkUniCharToUtf(ch, buf);

	entryPtr->numDisplayBytes = entryPtr->numChars * size;
	p = ckalloc(entryPtr->numDisplayBytes + 1);
	entryPtr->displayString = p;

	for (i = entryPtr->numChars; --i >= 0; ) {
	    memcpy(p, buf, size);

     Tcl_DString *dsPtr)	/* Dynamic string in which to append new
				 * command. */
{
    int spaceNeeded, cvtFlags;	/* Used to substitute string as proper Tcl
				 * list element. */
    int number, length;
    register const char *string;
    Tcl_UniChar ch;
    int ch;
    char numStorage[2*TCL_INTEGER_SPACE];

    while (1) {
	if (*before == '\0') {
	    break;
	}
	/*

	/*
	 * There's a percent sequence here. Process it.
	 */

	before++; /* skip over % */
	if (*before != '\0') {
	    before += Tcl_UtfToUniChar(before, &ch);
	    before += TkUtfToUniChar(before, &ch);
	} else {
	    ch = '%';
	}
	if (type == VALIDATE_BUTTON) {
	    /*
	     * -command %-substitution
	     */

	    switch (ch) {
	    case 's':		/* Current string value of spinbox */
		string = entryPtr->string;
		break;
	    case 'd':		/* direction, up or down */
		string = change;
		break;
	    case 'W':		/* widget name */
		string = Tk_PathName(entryPtr->tkwin);
		break;
	    default:
		length = Tcl_UniCharToUtf(ch, numStorage);
		length = TkUniCharToUtf(ch, numStorage);
		numStorage[length] = '\0';
		string = numStorage;
		break;
	    }
	} else {
	    /*
	     * -validatecommand / -invalidcommand %-substitution

		    break;
		}
		break;
	    case 'W': /* widget name */
		string = Tk_PathName(entryPtr->tkwin);
		break;
	    default:
		length = Tcl_UniCharToUtf(ch, numStorage);
		length = TkUniCharToUtf(ch, numStorage);
		numStorage[length] = '\0';
		string = numStorage;
		break;
	    }
	}

	spaceNeeded = Tcl_ScanCountedElement(string, -1, &cvtFlags);

    switch ((enum options) index) {
    case FONT_ACTUAL: {
	int skip, result, n;
	const char *s;
	Tk_Font tkfont;
	Tcl_Obj *optPtr, *charPtr, *resultPtr;
	Tcl_UniChar uniChar = 0;
	int uniChar = 0;
	const TkFontAttributes *faPtr;
	TkFontAttributes fa;

	/*
	 * Params 0 and 1 are 'font actual'. Param 2 is the font name. 3-4 may
	 * be '-displayof $window'
	 */

	}

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

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

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

	/*
	 * Find the font.
	 */

	tkfont = Tk_AllocFontFromObj(interp, tkwin, objv[2]);

    } else if (strcasecmp(family, "AvantGarde") == 0) {
	family = "AvantGarde";
    } else if (strcasecmp(family, "ZapfChancery") == 0) {
	family = "ZapfChancery";
    } else if (strcasecmp(family, "ZapfDingbats") == 0) {
	family = "ZapfDingbats";
    } else {
	Tcl_UniChar ch;
	int ch;

	/*
	 * Inline, capitalize the first letter of each word, lowercase the
	 * rest of the letters in each word, and then take out the spaces
	 * between the words. This may make the DString shorter, which is safe
	 * to do.
	 */

	Tcl_DStringAppend(dsPtr, family, -1);

	src = dest = Tcl_DStringValue(dsPtr) + len;
	upper = 1;
	for (; *src != '\0'; ) {
	    while (isspace(UCHAR(*src))) { /* INTL: ISO space */
		src++;
		upper = 1;
	    }
	    src += Tcl_UtfToUniChar(src, &ch);
	    src += TkUtfToUniChar(src, &ch);
	    if (upper) {
		ch = Tcl_UniCharToUpper(ch);
		upper = 0;
	    } else {
		ch = Tcl_UniCharToLower(ch);
	    }
	    dest += Tcl_UniCharToUtf(ch, dest);
	    dest += TkUniCharToUtf(ch, dest);
	}
	*dest = '\0';
	Tcl_DStringSetLength(dsPtr, dest - Tcl_DStringValue(dsPtr));
	family = Tcl_DStringValue(dsPtr) + len;
    }
    if (family != Tcl_DStringValue(dsPtr) + len) {
	Tcl_DStringAppend(dsPtr, family, -1);

    TextLayout *layoutPtr = (TextLayout *) layout;
    LayoutChunk *chunkPtr = layoutPtr->chunks;
    int baseline = chunkPtr->y;
    Tcl_Obj *psObj = Tcl_NewObj();
    int i, j, len;
    const char *p, *glyphname;
    char uindex[5], c, *ps;
    Tcl_UniChar ch;
    int ch;

    Tcl_AppendToObj(psObj, "[(", -1);
    for (i = 0; i < layoutPtr->numChunks; i++, chunkPtr++) {
	if (baseline != chunkPtr->y) {
	    Tcl_AppendToObj(psObj, ")]\n[(", -1);
	    baseline = chunkPtr->y;
	}

	    /*
	     * INTL: We only handle symbols that have an encoding as a glyph
	     * from the standard set defined by Adobe. The rest get punted.
	     * Eventually this should be revised to handle more sophsticiated
	     * international postscript fonts.
	     */

	    p += Tcl_UtfToUniChar(p, &ch);
	    p += TkUtfToUniChar(p, &ch);
	    if ((ch == '(') || (ch == ')') || (ch == '\\') || (ch < 0x20)) {
		/*
		 * Tricky point: the "03" is necessary in the sprintf below,
		 * so that a full three digits of octal are always generated.
		 * Without the "03", a number following this sequence could be
		 * interpreted by Postscript as part of this sequence.
		 */

	    }

	    /*
	     * This character doesn't belong to the ASCII character set, so we
	     * use the full glyph name.
	     */

	    if (ch > 0xffff) {
		goto noMapping;
	    }
	    sprintf(uindex, "%04X", ch);		/* endianness? */
	    glyphname = Tcl_GetVar2(interp, "::tk::psglyphs", uindex, 0);
	    if (glyphname) {
		ps = Tcl_GetStringFromObj(psObj, &len);
		if (ps[len-1] == '(') {
		    /*
		     * In-place edit. Ewww!
		     */

		    ps[len-1] = '/';
		} else {
		    Tcl_AppendToObj(psObj, ")/", -1);
		}
		Tcl_AppendToObj(psObj, glyphname, -1);
		Tcl_AppendToObj(psObj, "(", -1);
	    } else {
		/*
		 * No known mapping for the character into the space of
		 * PostScript glyphs. Ignore it. :-(
		 */
noMapping:	;

#ifdef TK_DEBUG_POSTSCRIPT_OUTPUT
		fprintf(stderr, "Warning: no mapping to PostScript "
			"glyphs for \\u%04x\n", ch);
#endif
	    }
	}

    Tcl_Obj *stringPtr)		/* Description of the tab stops. See the text
				 * manual entry for details. */
{
    int objc, i, count;
    Tcl_Obj **objv;
    TkTextTabArray *tabArrayPtr;
    TkTextTab *tabPtr;
    Tcl_UniChar ch;
    int ch;
    double prevStop, lastStop;
    /*
     * Map these strings to TkTextTabAlign values.
     */
    static const char *const tabOptionStrings[] = {
	"left", "right", "center", "numeric", NULL
    };

	    continue;
	}

	/*
	 * There may be a more efficient way of getting this.
	 */

	Tcl_UtfToUniChar(Tcl_GetString(objv[i+1]), &ch);
	TkUtfToUniChar(Tcl_GetString(objv[i+1]), &ch);
	if (!Tcl_UniCharIsAlpha(ch)) {
	    continue;
	}
	i += 1;

	if (Tcl_GetIndexFromObjStruct(interp, objv[i], tabOptionStrings,
		sizeof(char *), "tab alignment", 0, &index) != TCL_OK) {

	if (searchSpecPtr->exact) {
	    int maxExtraLines = 0;
	    const char *startOfLine = Tcl_GetString(theLine);

	    CLANG_ASSERT(pattern);
	    do {
		Tcl_UniChar ch;
		int ch;
		const char *p;
		int lastFullLine = lastOffset;

		if (firstNewLine == -1) {
		    if (searchSpecPtr->strictLimits
			    && (firstOffset + matchLength > lastOffset)) {
			/*

		    if (searchSpecPtr->backwards) {
			alreadySearchOffset = p - startOfLine - 1;
			if (alreadySearchOffset < 0) {
			    break;
			}
		    } else {
			firstOffset = p - startOfLine +
				Tcl_UtfToUniChar(startOfLine+matchOffset,&ch);
				TkUtfToUniChar(startOfLine+matchOffset,&ch);
		    }
		}
	    } while (searchSpecPtr->all);
	} else {
	    int maxExtraLines = 0;
	    int matches = 0;
	    int lastNonOverlap = -1;

#else /* !TK_LAYOUT_WITH_BASE_CHUNKS */
    bytesThatFit = CharChunkMeasureChars(chunkPtr, p, maxBytes, 0, -1,
	    chunkPtr->x, maxX, TK_ISOLATE_END, &nextX);
#endif /* TK_LAYOUT_WITH_BASE_CHUNKS */

    if (bytesThatFit < maxBytes) {
	if ((bytesThatFit == 0) && noCharsYet) {
	    Tcl_UniChar ch;
	    int chLen = Tcl_UtfToUniChar(p, &ch);
	    int ch;
	    int chLen = TkUtfToUniChar(p, &ch);

#if TK_LAYOUT_WITH_BASE_CHUNKS
	    bytesThatFit = CharChunkMeasureChars(chunkPtr, line,
		    lineOffset+chLen, lineOffset, -1, chunkPtr->x, -1, 0,
		    &nextX);
#else /* !TK_LAYOUT_WITH_BASE_CHUNKS */
	    bytesThatFit = CharChunkMeasureChars(chunkPtr, p, chLen, 0, -1,

		    COUNT_DISPLAY_INDICES);
	}
	segPtr = TkTextIndexToSeg(indexPtr, &offset);
	while (1) {
	    int chSize = 1;

	    if (segPtr->typePtr == &tkTextCharType) {
		Tcl_UniChar ch;
		int ch;

		chSize = Tcl_UtfToUniChar(segPtr->body.chars + offset, &ch);
		chSize = TkUtfToUniChar(segPtr->body.chars + offset, &ch);
		if (!Tcl_UniCharIsWordChar(ch)) {
		    break;
		}
		firstChar = 0;
	    }
	    offset += chSize;
	    indexPtr->byteIndex += chSize;

	 */

	segPtr = TkTextIndexToSeg(indexPtr, &offset);
	while (1) {
	    int chSize = 1;

	    if (segPtr->typePtr == &tkTextCharType) {
		Tcl_UniChar ch;

		int ch;
		Tcl_UtfToUniChar(segPtr->body.chars + offset, &ch);
		TkUtfToUniChar(segPtr->body.chars + offset, &ch);
		if (!Tcl_UniCharIsWordChar(ch)) {
		    break;
		}
		if (offset > 0) {
		    chSize = (segPtr->body.chars + offset
			    - Tcl_UtfPrev(segPtr->body.chars + offset,
			    segPtr->body.chars));

 * 	of (the first character in the string) 'showChar'.
 * 	Used to compute the displayString if -show is non-NULL.
 */
static char *EntryDisplayString(const char *showChar, int numChars)
{
    char *displayString, *p;
    int size;
    Tcl_UniChar ch;
    char buf[TCL_UTF_MAX];
    int ch;
    char buf[6];

    Tcl_UtfToUniChar(showChar, &ch);
    size = Tcl_UniCharToUtf(ch, buf);
    TkUtfToUniChar(showChar, &ch);
    size = TkUniCharToUtf(ch, buf);
    p = displayString = ckalloc(numChars * size + 1);

    while (numChars--) {
	memcpy(p, buf, size);
	p += size;
    }
    *p = '\0';

     VREASON reason,		/* Reason for change */
     Tcl_DString *dsPtr)	/* Result of %-substitutions */
{
    int spaceNeeded, cvtFlags;
    int number, length;
    const char *string;
    int stringLength;
    Tcl_UniChar ch;
    int ch;
    char numStorage[2*TCL_INTEGER_SPACE];

    while (*template) {
	/* Find everything up to the next % character and append it
	 * to the result string.
	 */
	string = Tcl_UtfFindFirst(template, '%');

	    template = string;
	}

	/* There's a percent sequence here.  Process it.
	 */
	++template; /* skip over % */
	if (*template != '\0') {
	    template += Tcl_UtfToUniChar(template, &ch);
	    template += TkUtfToUniChar(template, &ch);
	} else {
	    ch = '%';
	}

	stringLength = -1;
	switch (ch) {
	    case 'd': /* Type of call that caused validation */

	    case 'V': /* type of validation in effect */
		string = validateReasonStrings[reason];
		break;
	    case 'W': /* widget name */
		string = Tk_PathName(entryPtr->core.tkwin);
		break;
	    default:
		length = Tcl_UniCharToUtf(ch, numStorage);
		length = TkUniCharToUtf(ch, numStorage);
		numStorage[length] = '\0';
		string = numStorage;
		break;
	}

	spaceNeeded = Tcl_ScanCountedElement(string, stringLength, &cvtFlags);
	length = Tcl_DStringLength(dsPtr);

				 * the conversion. */
    int *dstCharsPtr)		/* Filled with the number of characters that
				 * correspond to the bytes stored in the
				 * output buffer. */
{
    const char *srcStart, *srcEnd;
    char *dstStart, *dstEnd;
    Tcl_UniChar ch;
    int ch;
    int result;
    static char hexChars[] = "0123456789abcdef";
    static char mapChars[] = {
	0, 0, 0, 0, 0, 0, 0,
	'a', 'b', 't', 'n', 'v', 'f', 'r'
    };

    result = TCL_OK;

    srcStart = src;
    srcEnd = src + srcLen;

    dstStart = dst;
    dstEnd = dst + dstLen - 6;

    for ( ; src < srcEnd; ) {
	if (dst > dstEnd) {
	    result = TCL_CONVERT_NOSPACE;
	    break;
	}
	src += Tcl_UtfToUniChar(src, &ch);
	src += TkUtfToUniChar(src, &ch);
	dst[0] = '\\';
	if ((ch < sizeof(mapChars)) && (mapChars[ch] != 0)) {
	if (((size_t) ch < sizeof(mapChars)) && (mapChars[ch] != 0)) {
	    dst[1] = mapChars[ch];
	    dst += 2;
	} else if (ch < 256) {
	    dst[1] = 'x';
	    dst[2] = hexChars[(ch >> 4) & 0xf];
	    dst[3] = hexChars[ch & 0xf];
	    dst += 4;
	} else {
	} else if (ch < 0x10000) {
	    dst[1] = 'u';
	    dst[2] = hexChars[(ch >> 12) & 0xf];
	    dst[3] = hexChars[(ch >> 8) & 0xf];
	    dst[4] = hexChars[(ch >> 4) & 0xf];
	    dst[5] = hexChars[ch & 0xf];
	    dst += 6;
	} else {
	    /* TODO we can do better here */
	    dst[1] = 'u';
	    dst[2] = 'f';
	    dst[3] = 'f';
	    dst[4] = 'f';
	    dst[5] = 'd';
	    dst += 6;
	}
    }
    *srcReadPtr = src - srcStart;
    *dstWrotePtr = dst - dstStart;
    *dstCharsPtr = dst - dstStart;
    return result;
}

    lastSubFontPtr = &fontPtr->subFontArray[0];

    if (numBytes == 0) {
	curX = 0;
	curByte = 0;
    } else if (maxLength < 0) {
	const char *p, *end, *next;
	Tcl_UniChar ch;
	int ch;
	SubFont *thisSubFontPtr;
	FontFamily *familyPtr;
	Tcl_DString runString;

	/*
	 * A three step process:
	 * 1. Find a contiguous range of characters that can all be
	 *    represented by a single screen font.
	 * 2. Convert those chars to the encoding of that font.
	 * 3. Measure converted chars.
	 */

	curX = 0;
	end = source + numBytes;
	for (p = source; p < end; ) {
	    next = p + Tcl_UtfToUniChar(p, &ch);
	    next = p + TkUtfToUniChar(p, &ch);
	    thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr);
	    if (thisSubFontPtr != lastSubFontPtr) {
		familyPtr = lastSubFontPtr->familyPtr;
		Tcl_UtfToExternalDString(familyPtr->encoding, source,
			p - source, &runString);
		if (familyPtr->isTwoByteFont) {
		    curX += XTextWidth16(lastSubFontPtr->fontStructPtr,

    int len = 0;
#endif /* DEBUG_FONTSEL */

    curX = 0;
    curByte = 0;
    sawNonSpace = 0;
    while (numBytes > 0) {
	Tcl_UniChar unichar;
	int unichar;

	clen = Tcl_UtfToUniChar(source, &unichar);
	clen = TkUtfToUniChar(source, &unichar);
	c = (FcChar32) unichar;

	if (clen <= 0) {
	    /*
	     * This can't happen (but see #1185640)
	     */

    int *lengthPtr)		/* Filled with x-location just after the
				 * terminating character. */
{
    HDC hdc;
    HFONT oldFont;
    WinFont *fontPtr;
    int curX, moretomeasure;
    Tcl_UniChar ch;
    int ch;
    SIZE size;
    FontFamily *familyPtr;
    Tcl_DString runString;
    SubFont *thisSubFontPtr, *lastSubFontPtr;
    const char *p, *end, *next = NULL, *start;

    if (numBytes == 0) {

     */

    moretomeasure = 0;
    curX = 0;
    start = source;
    end = start + numBytes;
    for (p = start; p < end; ) {
	next = p + Tcl_UtfToUniChar(p, &ch);
	next = p + TkUtfToUniChar(p, &ch);
	thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr);
	if (thisSubFontPtr != lastSubFontPtr) {
	    familyPtr = lastSubFontPtr->familyPtr;
	    Tcl_UtfToExternalDString(familyPtr->encoding, start,
		    (int) (p - start), &runString);
	    size.cx = 0;
	    familyPtr->getTextExtentPoint32Proc(hdc,

	char buf[16];
	int dstWrote;
	int lastSize = 0;

	familyPtr = lastSubFontPtr->familyPtr;
	Tcl_DStringInit(&runString);
	for (p = start; p < end; ) {
	    next = p + Tcl_UtfToUniChar(p, &ch);
	    next = p + TkUtfToUniChar(p, &ch);
	    Tcl_UtfToExternal(NULL, familyPtr->encoding, p,
		    (int) (next - p), 0, NULL, buf, sizeof(buf), NULL,
		    &dstWrote, NULL);
	    Tcl_DStringAppend(&runString,buf,dstWrote);
	    size.cx = 0;
	    familyPtr->getTextExtentPoint32Proc(hdc,
		    (TCHAR *) Tcl_DStringValue(&runString),

    if ((flags & TK_WHOLE_WORDS) && (p < end)) {
	/*
	 * Scan the string for the last word break and than repeat the whole
	 * procedure without the maxLength limit or any flags.
	 */

	const char *lastWordBreak = NULL;
	Tcl_UniChar ch2;
	int ch2;

	end = p;
	p = source;
	ch = ' ';
	while (p < end) {
	    next = p + Tcl_UtfToUniChar(p, &ch2);
	    next = p + TkUtfToUniChar(p, &ch2);
	    if ((ch != ' ') && (ch2 == ' ')) {
		lastWordBreak = p;
	    }
	    p = next;
	    ch = ch2;
	}

				 * following string. */
    const char *source,		/* Potentially multilingual UTF-8 string. */
    int numBytes,		/* Length of string in bytes. */
    int x, int y,		/* Coordinates at which to place origin of
				 * string when drawing. */
    double angle)
{
    Tcl_UniChar ch;
    int ch;
    SIZE size;
    HFONT oldFont;
    FontFamily *familyPtr;
    Tcl_DString runString;
    const char *p, *end, *next;
    SubFont *lastSubFontPtr, *thisSubFontPtr;
    TEXTMETRICA tm;

    lastSubFontPtr = &fontPtr->subFontArray[0];
    oldFont = SelectFont(hdc, fontPtr, lastSubFontPtr, angle);
    GetTextMetricsA(hdc, &tm);

    end = source + numBytes;
    for (p = source; p < end; ) {
	next = p + Tcl_UtfToUniChar(p, &ch);
	next = p + TkUtfToUniChar(p, &ch);
	thisSubFontPtr = FindSubFontForChar(fontPtr, ch, &lastSubFontPtr);
	if (thisSubFontPtr != lastSubFontPtr) {
	    if (p > source) {
		familyPtr = lastSubFontPtr->familyPtr;
 		Tcl_UtfToExternalDString(familyPtr->encoding, source,
			(int) (p - source), &runString);
		familyPtr->textOutProc(hdc, x-(tm.tmOverhang/2), y,

}

/*
 *----------------------------------------------------------------------
 *
 * HandleIMEComposition --
 *
 *	This function works around a definciency in some versions of Windows
 *	This function works around a deficiency in some versions of Windows
 *	2000 to make it possible to entry multi-lingual characters under all
 *	versions of Windows 2000.
 *
 *	When an Input Method Editor (IME) is ready to send input characters to
 *	an application, it sends a WM_IME_COMPOSITION message with the
 *	GCS_RESULTSTR. However, The DefWindowProc() on English Windows 2000
 *	arbitrarily converts all non-Latin-1 characters in the composition to

static int
HandleIMEComposition(
    HWND hwnd,			/* Window receiving the message. */
    LPARAM lParam)		/* Flags for the WM_IME_COMPOSITION message */
{
    HIMC hIMC;
    int n;
    int high = 0;

    if ((lParam & GCS_RESULTSTR) == 0) {
	/*
	 * Composition is not finished yet.
	 */

	return 0;

	    /*
	     * Simulate a pair of KeyPress and KeyRelease events for each
	     * UNICODE character in the composition.
	     */

	    event.xkey.keycode = buff[i++];

	    if ((event.xkey.keycode & 0xfc00) == 0xd800) {
		high = ((event.xkey.keycode & 0x3ff) << 10) + 0x10000;
		break;
	    } else if (high && (event.xkey.keycode & 0xfc00) == 0xdc00) {
		event.xkey.keycode &= 0x3ff;
		event.xkey.keycode += high;
		high = 0;
	    }
	    event.type = KeyPress;
	    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);

	    event.type = KeyRelease;
	    Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
	}