summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclCmdMZ.c535
1 files changed, 253 insertions, 282 deletions
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index cbb2f83..cc17067 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.c
@@ -8,12 +8,12 @@
*
* Copyright (c) 1987-1993 The Regents of the University of California.
* Copyright (c) 1994-1997 Sun Microsystems, Inc.
- * Copyright (c) 1998-1999 by Scriptics Corporation.
+ * Copyright (c) 1998-2000 Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdMZ.c,v 1.26 2000/04/10 21:08:26 ericm Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.27 2000/05/26 08:51:11 hobbs Exp $
*/
#include "tclInt.h"
@@ -61,7 +61,7 @@ typedef struct {
static char * TraceVarProc _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, char *name1, char *name2,
int flags));
-
+
/*
*----------------------------------------------------------------------
*
@@ -444,11 +444,12 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
int objc; /* Number of arguments. */
Tcl_Obj *CONST objv[]; /* Argument objects. */
{
- int i, result, cflags, all, wlen, numMatches, offset;
+ int idx, result, cflags, all, wlen, wsublen, numMatches, offset;
+ int start, end, subStart, subEnd, match;
Tcl_RegExp regExpr;
+ Tcl_RegExpInfo info;
Tcl_Obj *resultPtr, *varPtr, *objPtr;
- Tcl_UniChar *wstring;
- char *subspec;
+ Tcl_UniChar ch, *wsrc, *wfirstChar, *wstring, *wsubspec;
static char *options[] = {
"-all", "-nocase", "-expanded",
@@ -465,16 +466,16 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
all = 0;
offset = 0;
- for (i = 1; i < objc; i++) {
+ for (idx = 1; idx < objc; idx++) {
char *name;
int index;
- name = Tcl_GetString(objv[i]);
+ name = Tcl_GetString(objv[idx]);
if (name[0] != '-') {
break;
}
- if (Tcl_GetIndexFromObj(interp, objv[i], options, "switch", TCL_EXACT,
- &index) != TCL_OK) {
+ if (Tcl_GetIndexFromObj(interp, objv[idx], options, "switch",
+ TCL_EXACT, &index) != TCL_OK) {
return TCL_ERROR;
}
switch ((enum options) index) {
@@ -503,10 +504,10 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
break;
}
case REGSUB_START: {
- if (++i >= objc) {
+ if (++idx >= objc) {
goto endOfForLoop;
}
- if (Tcl_GetIntFromObj(interp, objv[i], &offset) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[idx], &offset) != TCL_OK) {
return TCL_ERROR;
}
if (offset < 0) {
@@ -515,35 +516,36 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
break;
}
case REGSUB_LAST: {
- i++;
+ idx++;
goto endOfForLoop;
}
}
}
endOfForLoop:
- if (objc - i != 4) {
+ if (objc - idx != 4) {
Tcl_WrongNumArgs(interp, 1, objv,
"?switches? exp string subSpec varName");
return TCL_ERROR;
}
- objv += i;
+ objv += idx;
regExpr = Tcl_GetRegExpFromObj(interp, objv[0], cflags);
if (regExpr == NULL) {
return TCL_ERROR;
}
+ objPtr = objv[1];
+ wstring = Tcl_GetUnicode(objPtr);
+ wlen = Tcl_GetCharLength(objPtr);
+ wsubspec = Tcl_GetUnicode(objv[2]);
+ wsublen = Tcl_GetCharLength(objv[2]);
+ varPtr = objv[3];
+
result = TCL_OK;
- resultPtr = Tcl_NewObj();
+ resultPtr = Tcl_NewUnicodeObj(wstring, 0);
Tcl_IncrRefCount(resultPtr);
- objPtr = objv[1];
- wlen = Tcl_GetCharLength(objPtr);
- wstring = Tcl_GetUnicode(objPtr);
- subspec = Tcl_GetString(objv[2]);
- varPtr = objv[3];
-
/*
* The following loop is to handle multiple matches within the
* same source string; each iteration handles one match and its
@@ -553,10 +555,6 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
numMatches = 0;
for ( ; offset < wlen; ) {
- int start, end, subStart, subEnd, match;
- char *src, *firstChar;
- char c;
- Tcl_RegExpInfo info;
/*
* The flags argument is set if string is part of a larger string,
@@ -598,22 +596,21 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
* subSpec to reduce the number of calls to Tcl_SetVar.
*/
- src = subspec;
- firstChar = subspec;
- for (c = *src; c != '\0'; src++, c = *src) {
- int index;
-
- if (c == '&') {
- index = 0;
- } else if (c == '\\') {
- c = src[1];
- if ((c >= '0') && (c <= '9')) {
- index = c - '0';
- } else if ((c == '\\') || (c == '&')) {
- Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
- Tcl_AppendToObj(resultPtr, &c, 1);
- firstChar = src + 2;
- src++;
+ wsrc = wfirstChar = wsubspec;
+ for (ch = *wsrc; ch != '\0'; wsrc++, ch = *wsrc) {
+ if (ch == '&') {
+ idx = 0;
+ } else if (ch == '\\') {
+ ch = wsrc[1];
+ if ((ch >= '0') && (ch <= '9')) {
+ idx = ch - '0';
+ } else if ((ch == '\\') || (ch == '&')) {
+ *wsrc = ch;
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
+ wsrc - wfirstChar + 1);
+ *wsrc = '\\';
+ wfirstChar = wsrc + 2;
+ wsrc++;
continue;
} else {
continue;
@@ -621,24 +618,25 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
} else {
continue;
}
- if (firstChar != src) {
- Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
+ if (wfirstChar != wsrc) {
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar,
+ wsrc - wfirstChar);
}
- if (index <= info.nsubs) {
- subStart = info.matches[index].start;
- subEnd = info.matches[index].end;
+ if (idx <= info.nsubs) {
+ subStart = info.matches[idx].start;
+ subEnd = info.matches[idx].end;
if ((subStart >= 0) && (subEnd >= 0)) {
Tcl_AppendUnicodeToObj(resultPtr,
wstring + offset + subStart, subEnd - subStart);
}
}
- if (*src == '\\') {
- src++;
+ if (*wsrc == '\\') {
+ wsrc++;
}
- firstChar = src + 1;
+ wfirstChar = wsrc + 1;
}
- if (firstChar != src) {
- Tcl_AppendToObj(resultPtr, firstChar, src - firstChar);
+ if (wfirstChar != wsrc) {
+ Tcl_AppendUnicodeToObj(resultPtr, wfirstChar, wsrc - wfirstChar);
}
if (end == 0) {
/*
@@ -648,8 +646,9 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
Tcl_AppendUnicodeToObj(resultPtr, wstring + offset, 1);
offset++;
+ } else {
+ offset += end;
}
- offset += end;
if (!all) {
break;
}
@@ -675,8 +674,8 @@ Tcl_RegsubObjCmd(dummy, interp, objc, objv)
result = TCL_ERROR;
} else {
/*
- * Set the interpreter's object result to an integer object holding the
- * number of matches.
+ * Set the interpreter's object result to an integer object
+ * holding the number of matches.
*/
Tcl_SetIntObj(Tcl_GetObjResult(interp), numMatches);
@@ -1021,10 +1020,10 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
for (i = 2; i < objc-2; i++) {
string2 = Tcl_GetStringFromObj(objv[i], &length2);
if ((length2 > 1)
- && strncmp(string2, "-nocase", (size_t) length2) == 0) {
+ && strncmp(string2, "-nocase", (size_t)length2) == 0) {
nocase = 1;
} else if ((length2 > 1)
- && strncmp(string2, "-length", (size_t) length2) == 0) {
+ && strncmp(string2, "-length", (size_t)length2) == 0) {
if (i+1 >= objc-2) {
goto str_cmp_args;
}
@@ -1103,91 +1102,75 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
break;
}
case STR_FIRST: {
- register char *p, *end;
- int match, utflen, start;
+ Tcl_UniChar *ustring1, *ustring2;
+ int match, start;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv,
- "string1 string2 ?startIndex?");
+ "subString string ?startIndex?");
return TCL_ERROR;
}
/*
- * This algorithm fails on improperly formed UTF strings.
* We are searching string2 for the sequence string1.
*/
match = -1;
start = 0;
- utflen = -1;
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- string2 = Tcl_GetStringFromObj(objv[3], &length2);
+ length2 = -1;
+
+ ustring1 = Tcl_GetUnicode(objv[2]);
+ length1 = Tcl_GetCharLength(objv[2]);
+ ustring2 = Tcl_GetUnicode(objv[3]);
+ length2 = Tcl_GetCharLength(objv[3]);
if (objc == 5) {
/*
- * If a startIndex is specified, we will need to fast forward
- * to that point in the string before we think about a match
+ * If a startIndex is specified, we will need to fast
+ * forward to that point in the string before we think
+ * about a match
*/
- utflen = Tcl_NumUtfChars(string2, length2);
- if (TclGetIntForIndex(interp, objv[4], utflen-1,
- &start) != TCL_OK) {
+ if (TclGetIntForIndex(interp, objv[4], length2 - 1,
+ &start) != TCL_OK) {
return TCL_ERROR;
}
- if (start >= utflen) {
+ if (start >= length2) {
goto str_first_done;
} else if (start > 0) {
- if (length2 == utflen) {
- /* no unicode chars */
- string2 += start;
- length2 -= start;
- } else {
- char *s = Tcl_UtfAtIndex(string2, start);
- length2 -= s - string2;
- string2 = s;
- }
+ ustring2 += start;
+ length2 -= start;
}
}
if (length1 > 0) {
- end = string2 + length2 - length1 + 1;
- for (p = string2; p < end; p++) {
+ register Tcl_UniChar *p, *end;
+
+ end = ustring2 + length2 - length1 + 1;
+ for (p = ustring2; p < end; p++) {
/*
* Scan forward to find the first character.
*/
-
- p = memchr(p, *string1, (unsigned) (end - p));
- if (p == NULL) {
- break;
- }
- if (memcmp(string1, p, (unsigned) length1) == 0) {
- match = p - string2;
+ if ((*p == *ustring1) &&
+ (Tcl_UniCharNcmp(ustring1, p,
+ (unsigned long) length1) == 0)) {
+ match = p - ustring2;
break;
}
}
}
-
/*
* Compute the character index of the matching string by
* counting the number of characters before the match.
*/
- str_first_done:
- if (match != -1) {
- if (objc == 4) {
- match = Tcl_NumUtfChars(string2, match);
- } else if (length2 == utflen) {
- /* no unicode chars */
- match += start;
- } else {
- match = start + Tcl_NumUtfChars(string2, match);
- }
+ if ((match != -1) && (objc == 5)) {
+ match += start;
}
+
+ str_first_done:
Tcl_SetIntObj(resultPtr, match);
break;
}
case STR_INDEX: {
- char buf[TCL_UTF_MAX];
- Tcl_UniChar unichar;
-
if (objc != 4) {
Tcl_WrongNumArgs(interp, 2, objv, "string charIndex");
return TCL_ERROR;
@@ -1201,33 +1184,33 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
*/
if (objv[2]->typePtr == &tclByteArrayType) {
-
- string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
+ string1 = (char *) Tcl_GetByteArrayFromObj(objv[2], &length1);
if (TclGetIntForIndex(interp, objv[3], length1 - 1,
&index) != TCL_OK) {
return TCL_ERROR;
}
- Tcl_SetByteArrayObj(resultPtr,
- (unsigned char *)(&string1[index]), 1);
+ if ((index >= 0) && (index < length1)) {
+ Tcl_SetByteArrayObj(resultPtr,
+ (unsigned char *)(&string1[index]), 1);
+ }
} else {
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
-
/*
- * convert to Unicode internal rep to calulate what
- * 'end' really means.
+ * Get Unicode char length to calulate what 'end' means.
*/
+ length1 = Tcl_GetCharLength(objv[2]);
- length2 = Tcl_GetCharLength(objv[2]);
-
- if (TclGetIntForIndex(interp, objv[3], length2 - 1,
+ if (TclGetIntForIndex(interp, objv[3], length1 - 1,
&index) != TCL_OK) {
return TCL_ERROR;
}
- if ((index >= 0) && (index < length2)) {
- unichar = Tcl_GetUniChar(objv[2], index);
- length2 = Tcl_UniCharToUtf((int)unichar, buf);
- Tcl_SetStringObj(resultPtr, buf, length2);
+ if ((index >= 0) && (index < length1)) {
+ char buf[TCL_UTF_MAX];
+ Tcl_UniChar ch;
+
+ ch = Tcl_GetUniChar(objv[2], index);
+ length1 = Tcl_UniCharToUtf(ch, buf);
+ Tcl_SetStringObj(resultPtr, buf, length1);
}
}
break;
@@ -1275,7 +1258,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
strncmp(string2, "-strict", (size_t) length2) == 0) {
strict = 1;
} else if ((length2 > 1) &&
- strncmp(string2, "-failindex", (size_t) length2) == 0) {
+ strncmp(string2, "-failindex",
+ (size_t) length2) == 0) {
if (i+1 >= objc-1) {
Tcl_WrongNumArgs(interp, 3, objv,
"?-strict? ?-failindex var? str");
@@ -1508,78 +1492,63 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
break;
}
case STR_LAST: {
- register char *p;
- int match, utflen, start;
+ Tcl_UniChar *ustring1, *ustring2, *p;
+ int match, start;
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv,
- "string1 string2 ?startIndex?");
+ "subString string ?startIndex?");
return TCL_ERROR;
}
/*
- * This algorithm fails on improperly formed UTF strings.
+ * We are searching string2 for the sequence string1.
*/
match = -1;
start = 0;
- utflen = -1;
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- string2 = Tcl_GetStringFromObj(objv[3], &length2);
+ length2 = -1;
+
+ ustring1 = Tcl_GetUnicode(objv[2]);
+ length1 = Tcl_GetCharLength(objv[2]);
+ ustring2 = Tcl_GetUnicode(objv[3]);
+ length2 = Tcl_GetCharLength(objv[3]);
if (objc == 5) {
/*
* If a startIndex is specified, we will need to restrict
* the string range to that char index in the string
*/
- utflen = Tcl_NumUtfChars(string2, length2);
- if (TclGetIntForIndex(interp, objv[4], utflen-1,
- &start) != TCL_OK) {
+ if (TclGetIntForIndex(interp, objv[4], length2 - 1,
+ &start) != TCL_OK) {
return TCL_ERROR;
}
if (start < 0) {
goto str_last_done;
- } else if (start < utflen) {
- if (length2 == utflen) {
- /* no unicode chars */
- p = string2 + start + 1 - length1;
- } else {
- p = Tcl_UtfAtIndex(string2, start+1) - length1;
- }
+ } else if (start < length2) {
+ p = ustring2 + start + 1 - length1;
} else {
- p = string2 + length2 - length1;
+ p = ustring2 + length2 - length1;
}
} else {
- p = string2 + length2 - length1;
+ p = ustring2 + length2 - length1;
}
if (length1 > 0) {
- for (; p >= string2; p--) {
+ for (; p >= ustring2; p--) {
/*
* Scan backwards to find the first character.
*/
-
- while ((p != string2) && (*p != *string1)) {
- p--;
- }
- if (memcmp(string1, p, (unsigned) length1) == 0) {
- match = p - string2;
+ if ((*p == *ustring1) &&
+ (memcmp((char *) ustring1, (char *) p, (size_t)
+ (length1 * sizeof(Tcl_UniChar))) == 0)) {
+ match = p - ustring2;
break;
}
}
}
- /*
- * Compute the character index of the matching string by counting
- * the number of characters before the match.
- */
- str_last_done:
- if (match != -1) {
- if ((objc == 4) || (length2 != utflen)) {
- /* only check when we've got unicode chars */
- match = Tcl_NumUtfChars(string2, match);
- }
- }
+ str_last_done:
Tcl_SetIntObj(resultPtr, match);
break;
}
@@ -1592,7 +1561,6 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
if ((enum options) index == STR_BYTELENGTH) {
(void) Tcl_GetStringFromObj(objv[2], &length1);
- Tcl_SetIntObj(resultPtr, length1);
} else {
/*
* If we have a ByteArray object, avoid recomputing the
@@ -1603,20 +1571,19 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
if (objv[2]->typePtr == &tclByteArrayType) {
(void) Tcl_GetByteArrayFromObj(objv[2], &length1);
- Tcl_SetIntObj(resultPtr, length1);
} else {
- Tcl_SetIntObj(resultPtr,
- Tcl_GetCharLength(objv[2]));
+ length1 = Tcl_GetCharLength(objv[2]);
}
}
+ Tcl_SetIntObj(resultPtr, length1);
break;
}
case STR_MAP: {
- int uselen, mapElemc, len, nocase = 0;
+ int mapElemc, nocase = 0;
Tcl_Obj **mapElemv;
- char *end;
- Tcl_UniChar ch;
- int (*str_comp_fn)();
+ Tcl_UniChar *ustring1, *ustring2, *p, *end;
+ int (*strCmpFn)(CONST Tcl_UniChar*, CONST Tcl_UniChar*,
+ unsigned long);
if (objc < 4 || objc > 5) {
Tcl_WrongNumArgs(interp, 2, objv, "?-nocase? charMap string");
@@ -1652,63 +1619,111 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
Tcl_SetStringObj(resultPtr, "char map list unbalanced", -1);
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[objc-1], &length1);
+ objc--;
+
+ ustring1 = Tcl_GetUnicode(objv[objc]);
+ length1 = Tcl_GetCharLength(objv[objc]);
if (length1 == 0) {
+ /*
+ * Empty input string, just stop now
+ */
break;
}
- end = string1 + length1;
+ end = ustring1 + length1;
- if (nocase) {
- length1 = Tcl_NumUtfChars(string1, length1);
- str_comp_fn = Tcl_UtfNcasecmp;
- } else {
- str_comp_fn = memcmp;
- }
+ strCmpFn = (nocase) ? Tcl_UniCharNcasecmp : Tcl_UniCharNcmp;
- for ( ; string1 < end; string1 += len) {
- len = Tcl_UtfToUniChar(string1, &ch);
- for (index = 0; index < mapElemc; index +=2) {
- /*
- * Get the key string to match on
- */
- string2 = Tcl_GetStringFromObj(mapElemv[index],
- &length2);
- if (nocase) {
- uselen = Tcl_NumUtfChars(string2, length2);
- } else {
- uselen = length2;
+ /*
+ * Force result to be Unicode
+ */
+ Tcl_SetUnicodeObj(resultPtr, ustring1, 0);
+
+ if (mapElemc == 2) {
+ /*
+ * Special case for one map pair which avoids the extra
+ * for loop and extra calls to get Unicode data. The
+ * algorithm is otherwise identical to the multi-pair case.
+ * This will be >30% faster on larger strings.
+ */
+ Tcl_UniChar *mapString = Tcl_GetUnicode(mapElemv[1]);
+ int mapLen = Tcl_GetCharLength(mapElemv[1]);
+ ustring2 = Tcl_GetUnicode(mapElemv[0]);
+ length2 = Tcl_GetCharLength(mapElemv[0]);
+ for (p = ustring1; ustring1 < end; ustring1++) {
+ if ((length2 > 0) &&
+ (nocase || (*ustring1 == *ustring2)) &&
+ (strCmpFn(ustring1, ustring2,
+ (unsigned long) length2) == 0)) {
+ if (p != ustring1) {
+ Tcl_AppendUnicodeToObj(resultPtr, p,
+ ustring1 - p);
+ p = ustring1 + length2;
+ } else {
+ p += length2;
+ }
+ ustring1 = p - 1;
+
+ Tcl_AppendUnicodeToObj(resultPtr, mapString, mapLen);
}
- if ((uselen > 0) && (uselen <= length1) &&
- (str_comp_fn(string2, string1, uselen) == 0)) {
- /*
- * Adjust len to be full length of matched string
- * it has to be the BYTE length
- */
- len = length2;
+ }
+ } else {
+ Tcl_UniChar **mapStrings =
+ (Tcl_UniChar **) ckalloc((mapElemc * 2)
+ * sizeof(Tcl_UniChar *));
+ int *mapLens =
+ (int *) ckalloc((mapElemc * 2) * sizeof(int));
+ /*
+ * Precompute pointers to the unicode string and length.
+ * This saves us repeated function calls later,
+ * significantly speeding up the algorithm.
+ */
+ for (index = 0; index < mapElemc; index++) {
+ mapStrings[index] = Tcl_GetUnicode(mapElemv[index]);
+ mapLens[index] = Tcl_GetCharLength(mapElemv[index]);
+ }
+ for (p = ustring1; ustring1 < end; ustring1++) {
+ for (index = 0; index < mapElemc; index += 2) {
/*
- * Change string2 and length2 to the map value
+ * Get the key string to match on
*/
- string2 = Tcl_GetStringFromObj(mapElemv[index+1],
- &length2);
- Tcl_AppendToObj(resultPtr, string2, length2);
- break;
+ ustring2 = mapStrings[index];
+ length2 = mapLens[index];
+ if ((length2 > 0) &&
+ (nocase || (*ustring1 == *ustring2)) &&
+ (strCmpFn(ustring2, ustring1,
+ (unsigned long) length2) == 0)) {
+ if (p != ustring1) {
+ /*
+ * Put the skipped chars onto the result first
+ */
+ Tcl_AppendUnicodeToObj(resultPtr, p,
+ ustring1 - p);
+ p = ustring1 + length2;
+ } else {
+ p += length2;
+ }
+ /*
+ * Adjust len to be full length of matched string
+ */
+ ustring1 = p - 1;
+
+ /*
+ * Append the map value to the unicode string
+ */
+ Tcl_AppendUnicodeToObj(resultPtr,
+ mapStrings[index+1], mapLens[index+1]);
+ break;
+ }
}
}
- if (index == mapElemc) {
- /*
- * No match was found, put the char onto result
- */
- Tcl_AppendToObj(resultPtr, string1, len);
- }
+ ckfree((char *) mapStrings);
+ ckfree((char *) mapLens);
+ }
+ if (p != ustring1) {
/*
- * in nocase, length1 is in chars
- * otherwise it is in bytes
+ * Put the rest of the unmapped chars onto result
*/
- if (nocase) {
- length1--;
- } else {
- length1 -= len;
- }
+ Tcl_AppendUnicodeToObj(resultPtr, p, ustring1 - p);
}
break;
}
@@ -1734,9 +1749,8 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
Tcl_SetBooleanObj(resultPtr,
- Tcl_StringCaseMatch(Tcl_GetString(objv[objc-1]),
- Tcl_GetString(objv[objc-2]),
- nocase));
+ Tcl_UniCharCaseMatch(Tcl_GetUnicode(objv[objc-1]),
+ Tcl_GetUnicode(objv[objc-2]), nocase));
break;
}
case STR_RANGE: {
@@ -1748,64 +1762,24 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
}
/*
- * If we have a ByteArray object, avoid indexing in the
- * Utf string since the byte array contains one byte per
- * character. Otherwise, use the Unicode string rep to
- * get the range.
+ * Get the length in actual characters.
*/
+ length1 = Tcl_GetCharLength(objv[2]) - 1;
- if (objv[2]->typePtr == &tclByteArrayType) {
-
- string1 = (char *)Tcl_GetByteArrayFromObj(objv[2], &length1);
-
- if (TclGetIntForIndex(interp, objv[3], length1 - 1,
- &first) != TCL_OK) {
- return TCL_ERROR;
- }
- if (TclGetIntForIndex(interp, objv[4], length1 - 1,
- &last) != TCL_OK) {
- return TCL_ERROR;
- }
- if (first < 0) {
- first = 0;
- }
- if (last >= length1 - 1) {
- last = length1 - 1;
- }
- if (last >= first) {
- int numBytes = last - first + 1;
- resultPtr = Tcl_NewByteArrayObj(
- (unsigned char *) &string1[first], numBytes);
- Tcl_SetObjResult(interp, resultPtr);
- }
- } else {
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
-
- /*
- * Convert to Unicode internal rep to calulate length and
- * create a result object.
- */
+ if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
+ || (TclGetIntForIndex(interp, objv[4], length1,
+ &last) != TCL_OK)) {
+ return TCL_ERROR;
+ }
- length2 = Tcl_GetCharLength(objv[2]) - 1;
-
- if (TclGetIntForIndex(interp, objv[3], length2,
- &first) != TCL_OK) {
- return TCL_ERROR;
- }
- if (TclGetIntForIndex(interp, objv[4], length2,
- &last) != TCL_OK) {
- return TCL_ERROR;
- }
- if (first < 0) {
- first = 0;
- }
- if (last >= length2) {
- last = length2;
- }
- if (last >= first) {
- resultPtr = Tcl_GetRange(objv[2], first, last);
- Tcl_SetObjResult(interp, resultPtr);
- }
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= length1) {
+ last = length1;
+ }
+ if (last >= first) {
+ Tcl_SetObjResult(interp, Tcl_GetRange(objv[2], first, last));
}
break;
}
@@ -1830,6 +1804,7 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
break;
}
case STR_REPLACE: {
+ Tcl_UniChar *ustring1;
int first, last;
if (objc < 5 || objc > 6) {
@@ -1838,33 +1813,29 @@ Tcl_StringObjCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- string1 = Tcl_GetStringFromObj(objv[2], &length1);
- length1 = Tcl_NumUtfChars(string1, length1) - 1;
- if (TclGetIntForIndex(interp, objv[3], length1,
- &first) != TCL_OK) {
- return TCL_ERROR;
- }
- if (TclGetIntForIndex(interp, objv[4], length1,
- &last) != TCL_OK) {
+ ustring1 = Tcl_GetUnicode(objv[2]);
+ length1 = Tcl_GetCharLength(objv[2]) - 1;
+
+ if ((TclGetIntForIndex(interp, objv[3], length1, &first) != TCL_OK)
+ || (TclGetIntForIndex(interp, objv[4], length1,
+ &last) != TCL_OK)) {
return TCL_ERROR;
}
- if ((last < first) || (first > length1) || (last < 0)) {
+
+ if ((last < first) || (last < 0) || (first > length1)) {
Tcl_SetObjResult(interp, objv[2]);
} else {
- char *start, *end;
-
if (first < 0) {
first = 0;
}
- start = Tcl_UtfAtIndex(string1, first);
- end = Tcl_UtfAtIndex(start, ((last > length1) ? length1 : last)
- - first + 1);
- Tcl_SetStringObj(resultPtr, string1, start - string1);
+
+ Tcl_SetUnicodeObj(resultPtr, ustring1, first);
if (objc == 6) {
Tcl_AppendObjToObj(resultPtr, objv[5]);
}
if (last < length1) {
- Tcl_AppendToObj(resultPtr, end, -1);
+ Tcl_AppendUnicodeToObj(resultPtr, ustring1 + last + 1,
+ length1 - last);
}
}
break;
generated by cgit v0.12 at 2024-11-01 01:09:24 (GMT)